fastavr interrupt int0(),save
This code is for AT90S4433.
'///////////////////////////////////////////////////////////////////////////////////////
'/// FastAVR Basic Compiler for AVR by MICRODESIGN
www.FastAVR.com ///
'/// TagReader.bas Wireless ReadOnly TAG reader (Miro,......) ///
'/// using Phillips chip HTRC110 ///
'/// readOnly Tags gas 64 bit unique number (manchester coded wireless) ///
'/// continious reads Tags and comunicate result via RS-485 ///
'///////////////////////////////////////////////////////////////////////////////////////
$Device = 4433 ' used device
$Stack = 32 ' stack depth
$Clock = 8 ' adjust for used crystal
$Timer0 = Timer, Prescale=64
$Timer1 = Timer, Prescale=256, Compare=DisConnect, Clear
$Baud=19200
$Def RTX=PORTD.4
$Def DOUT = PIND.2
$Def SCLK = PORTB.2
$Def DIN = PORTB.1
$Def Z=PORTD.6
$Def R=PORTD.7
'$Def Z=PORTB.4
'$Def R=PORTB.5
$Def xx=PORTB.0
Declare Sub Init()
Declare Sub SendCmd(db As Byte)
Declare Sub ASTadjust(Offset As Byte)
Declare Sub SetSampTime(Stime As Byte)
Declare Sub GeneralSetling()
Declare Sub MakeCmd(pCmd As Byte, adr As Byte)
Declare Sub ReceiveMIRO()
Declare Sub ProcessCommand()
Declare Sub SendID()
Declare Sub SendBack(Data As Byte)
Declare Function GetSerNumber() As Byte
Declare Function LastParCheck() As Byte
Declare Function ReceiveData() As Byte
Declare Function ReadPhase() As Byte
Declare Function CalcCrc(ptr As Byte, j As Byte) As Byte
Declare Interrupt Oc1A()
Declare Interrupt Int0()
Declare Interrupt Urxc()
Declare Interrupt Utxc()
Dim TXbuff(12) As Byte, TXlen As Byte, TXn As Byte, Char As Byte, x As Byte
Dim RXbuff(8) As Byte, RXlen As Byte, c(7) As Byte
Dim ID(8) As Byte, ReadyID(8) As Byte, Crc As Byte
Dim OldTime As Byte, BitNum As Byte, State As Byte
Dim ByteNum As Byte, DataByte As Byte
Dim OldBit As Byte, NewBit As Byte
Dim Adr As Byte, Time As Byte
Dim db As Byte
Dim Crc8Tab As Flash Byte
Dim Bussy As Bit, ParBit As Bit, DataBit As Bit
Dim Flanka As Bit, GorDol As Bit, ByteFull As Bit
Dim Kratek As Bit, Escape As Bit, Received As Bit
Dim b As Bit, TimeOut As Bit
Const WriteDIN=&hc0, ReadDIN =&he0
Const True=1, False=0, Frame=&h7e, ESC=&h7d
Const StartBits=0, SerialNum=1, ParCheck=2, StopBit=3, Error=4
Const cmdWriteNum=&h55, cmdReadNum=&h33
Const cmdWritePage=&h50, cmdReadPage=&h56
Const cmdReadID=&h8e
Init()
Set DDRD.7: Set DDRD.6 ' here are LEDs
'Set DDRB.4: Set DDRB.5:
Set z: Set r ' here are LEDs
Set DDRB.0
SendCmd(&h16) ' write pages to HTRC110
SendCmd(&h4f)
SendCmd(&h50)
SendCmd(&h60)
SendCmd(&h71)
'Do
ASTadjust(&h3f)
GeneralSetling()
WaitMs 3
SendCmd(&h69)
SendCmd(WriteDIN)
WaitUs 25
SendCmd(&h6b)
WaitUs 30
SendCmd(&h60)
SendCmd(ReadDIN)
Do
ReceiveMIRO() ' decode manchester coded ID
Loop
'///////////////////////////////////////////////////////////////////////////////////////
Sub Init()
Set DDRB.1: Set DDRB.2: Set DDRD.4
Set DIN: Escape=False
'WriteEE(1,18)
Compare1=&h0c35 ' 100 ms
Start Timer0
Start Timer1
Int0 Falling
Enable Urxc
Enable Interrupts
ByteFull=False: BitNum=0: RXlen=0: TXn=0
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub ReceiveMIRO()
Local Delta As Byte, CurTime As Byte
ByteNum=0: State=StartBits
TimeOut=False: DataByte=0: ParBit=0
Reset Int0: Enable Int0
Timer1=0: Enable Oc1A
Do
If Flanka Then ' waiting for interrupt
Flanka=False
' measuring time beetween transitions
CurTime=Timer0: Delta=CurTime-OldTime: OldTime=CurTime
If GorDol Then ' change Int0 trigg
Int0 Rising: GorDol=False
Else
Int0 Falling: GorDol=True
End If
If Delta>18 And Delta<46 Then ' short bit
DataBit=0
ElseIf Delta>48 And Delta<82 Then ' long bit
DataBit=1
Else
State=StartBits ' error
End If
If Not DataBit And GorDol Then ' after short0
NewBit=0
ElseIf Not DataBit And Not GorDol Then ' after short1
NewBit=1
ElseIf DataBit And GorDol Then ' after long0
NewBit=2
Else ' after long1
NewBit=3
End If
If Kratek Then ' if short then get another
OldBit=NewBit
Kratek=False
Else
Kratek=True
If OldBit=0 And NewBit=1 Then DataBit=1 ' logical bits
If OldBit=0 And NewBit=3 Then DataBit=1
If OldBit=1 And NewBit=0 Then DataBit=0
If OldBit=1 And NewBit=2 Then DataBit=0
If OldBit=2 And NewBit=1 Then DataBit=1
If OldBit=2 And NewBit=3 Then DataBit=1
If OldBit=3 And NewBit=0 Then DataBit=0
If OldBit=3 And NewBit=2 Then DataBit=0
If NewBit=2 Or NewBit=3 Then ' if last bit was long
Kratek=False ' must be used also next time
OldBit=NewBit
End If
Select Case State
Case StartBits ' wait for 9 start bits (1)
If DataBit Then
Incr BitNum
If BitNum=9 Then ' found, advanced State
BitNum=0
State=SerialNum
End If
Else ' not found 9 1s
BitNum=0 ' start again
End If
Case SerialNum
GetSerNumber() ' Get ID and check
' Rows parity bits
Case ParCheck
Shift(Left, 1, DataByte) ' receiving last 5 bits
DataByte.0=DataBit ' DataByte=---43210
Incr BitNum ' ^ Stop
If BitNum=5 Then ' ^^^^
BitNum=0 ' Column parity
LastParCheck() ' check this 5 bits
End If ' if no Errors
Case StopBit
If DataByte.0 Then ' if last bit=1
State=Error ' error, Error
Else
Set Z: Reset R
MemCopy(5, VarPtr(ID), VarPtr(ReadyID))
Exit Do
End If
Case Error ' to Main loop after
Exit Do ' any Error
End Select
End If
End If
If TimeOut Then ' after 100 ms
TimeOut=False ' we clear last ID
ReadyID(1)=0:ReadyID(2)=0:ReadyID(3)=0:ReadyID(4)=0
Set R: Reset Z
Exit Do
End If
If UCSRA.Udre And TXn<TXlen Then ' have we something to transmit
Set RTX ' yes, so switch 485 to TX
PrintBin Peek(VarPtr(TXbuff)+TXn) ' send byte
Incr TXn ' increment pointer to next
If TXn=TXlen Then Enable Utxc ' if last byte then enable
End If ' TX interrupt (to switch 485 back)
If Received Then ProcessCommand() ' proccess request
Loop
Disable Oc1A: Disable Int0
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub GetSerNumber() ' decodes 5 bytes ID
Incr BitNum
If BitNum=5 Then ' every 4 bits is column parity
BitNum=0
If DataBit<>ParBit Then ' parity dont match, so
State=Error
End If
ParBit=0
If ByteFull Then ' received 8 bits, so
ID(ByteNum)=DataByte ' save it to array
DataByte=0
ByteFull=False
Incr ByteNum
If ByteNum=5 Then ' ID received
State=ParCheck ' proccess next 5 parity bits
ByteNum=0
End If
Else
ByteFull=True
End If
Else
Shift(Left, 1, DataByte) ' continue receiving bits
DataByte.0=DataBit
ParBit=ParBit Xor DataBit
End If
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub LastParCheck() ' check column parity bits
Local i As Byte
BitNum=1: NewBit=0
NextPar:
parbit=0
OldBit=NewBit+4
For i=0 To 4
db=ID(i)
b=db.OldBit
ParBit=ParBit Xor b
b=db.NewBit
ParBit=ParBit Xor b
Next
b=DataByte.BitNum
If ParBit<>b Then
State=Error
Exit Sub
End If
Incr BitNum: Incr NewBit
If NewBit<4 Then GoTo NextPar
State=StopBit
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub SendCmd(db As Byte)
Local i As Byte
Reset DIN: Set SCLK: Set DIN: Reset SCLK
If db>&hbf Then
i=3
Else
i=8
End If
Do
DIN=db.7
Set SCLK
Shift(Left, 1, db)
Reset SCLK
Decr i
Loop While i
Reset DIN
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Function ReceiveData() As Byte
Local tmp As Byte, i As Byte
For i=0 To 7
Set SCLK: WaitUs 1
Shift(Left,1,tmp)
tmp.0=DOUT
Reset SCLK: WaitUs 1
Next
Return tmp
End Function
'///////////////////////////////////////////////////////////////////////////////////////
Function ReadPhase() As Byte
SendCmd(&h08)
Return ReceiveData()
End Function
'///////////////////////////////////////////////////////////////////////////////////////
Sub ASTadjust(Offset As Byte)
Local tmp As Byte
tmp=ReadPhase()
Shift(Left, 1, tmp)
tmp=tmp+Offset
tmp=tmp And &h3f
SetSampTime(tmp)
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub SetSampTime(Stime As Byte)
SendCmd((&h80 Or Stime))
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub GeneralSetling()
SendCmd(&h6b)
WaitMs 5
SendCmd(&h68)
WaitMs 1
SendCmd(&h60)
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Int0() ' trigg with manchester coded signal
Flanka=True
End Interrupt
'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Oc1A() ' generate 100 ms timeout
TimeOut=True
End Interrupt
'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Utxc(), Save 1 ' need to know when to switch 485 back
Reset RTX ' to receive
Disable Utxc
End Interrupt
'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Urxc(), Save 4 ' saves received char in ID
Local tmp As Byte
InputBin tmp
Select Case tmp
Case Frame ' ~
If CalcCrc(VarPtr(RXbuff), RXlen)=0 Then
If RXbuff(0)=ReadEE(1) Or RXbuff(0)=&hff Then
Received=True
End If
End If
Case ESC
Escape=True ' }
Case Else
If Escape Then
tmp=tmp Xor &h20
Escape=False
End If
Poke(VarPtr(RXbuff)+RXlen, tmp)
Incr RXlen
End Select
End Interrupt
'///////////////////////////////////////////////////////////////////////////////////////
Sub ProcessCommand() ' cmd is RXbuff(1)
Local Data As Byte
Select Case RXbuff(1)
Case cmdReadID
SendID()
Case cmdWriteNum
If RXbuff(0)=&hff And RXlen=4 Then
Data=RXbuff(2)
WriteEE(1,Data)
SendBack(Data)
End If
Case cmdReadNum
SendBack(ReadEE(1))
End Select
Received=False: RXlen=0
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub SendBack(Data As Byte)
Set xx
TXbuff(0)=Data
TXbuff(1)=Frame
WaitMs 1
Reset xx
TXlen=2: TXn=0
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Sub SendID() ' builds ID packet
Local i As Byte, j As Byte, Data As Byte
j=1
TXbuff(0)=ReadEE(1)
For i=1 To 4
Data=ReadyID(i)
Select Case Data
Case Frame ' if data=~ then esc them
TXbuff(j)=ESC: Incr j
TXbuff(j)=&h5e
Case ESC ' if data=esc then esc them
TXbuff(j)=ESC: Incr j
TXbuff(j)=&h5d
Case Else
TXbuff(j)=Data
End Select
Incr j
Next
TXbuff(j)=CalcCrc(VarPtr(TXbuff),j): Incr j
TXbuff(j)=Frame: Incr j
TXlen=j: TXn=0 ' this defference drives TX
End Sub
'///////////////////////////////////////////////////////////////////////////////////////
Function CalcCrc(ptr As Byte, j As Byte) As Byte
Local crc As Byte, tmp As Byte, i As Byte
crc=0: i=0
While i<j
tmp=crc Xor Peek(ptr)
crc=Crc8Tab(tmp)
Incr i: Incr ptr
Wend
Return crc
End Function
'///////////////////////////////////////////////////////////////////////////////////////
Crc8Tab=&h00,&h5E,&hBC,&hE2,&h61,&h3F,&hDD,&h83,&hC2,&h9C,&h7E,&h20,&hA3,&hFD,&h1F,&h41,
&h9D,&hC3,&h21,&h7F,&hFC,&hA2,&h40,&h1E,&h5F,&h01,&hE3,&hBD,&h3E,&h60,&h82,&hDC,
&h23,&h7D,&h9F,&hC1,&h42,&h1C,&hFE,&hA0,&hE1,&hBF,&h5D,&h03,&h80,&hDE,&h3C,&h62,
&hBE,&hE0,&h02,&h5C,&hDF,&h81,&h63,&h3D,&h7C,&h22,&hC0,&h9E,&h1D,&h43,&hA1,&hFF,
&h46,&h18,&hFA,&hA4,&h27,&h79,&h9B,&hC5,&h84,&hDA,&h38,&h66,&hE5,&hBB,&h59,&h07,
&hDB,&h85,&h67,&h39,&hBA,&hE4,&h06,&h58,&h19,&h47,&hA5,&hFB,&h78,&h26,&hC4,&h9A,
&h65,&h3B,&hD9,&h87,&h04,&h5A,&hB8,&hE6,&hA7,&hF9,&h1B,&h45,&hC6,&h98,&h7A,&h24,
&hF8,&hA6,&h44,&h1A,&h99,&hC7,&h25,&h7B,&h3A,&h64,&h86,&hD8,&h5B,&h05,&hE7,&hB9,
&h8C,&hD2,&h30,&h6E,&hED,&hB3,&h51,&h0F,&h4E,&h10,&hF2,&hAC,&h2F,&h71,&h93,&hCD,
&h11,&h4F,&hAD,&hF3,&h70,&h2E,&hCC,&h92,&hD3,&h8D,&h6F,&h31,&hB2,&hEC,&h0E,&h50,
&hAF,&hF1,&h13,&h4D,&hCE,&h90,&h72,&h2C,&h6D,&h33,&hD1,&h8F,&h0C,&h52,&hB0,&hEE,
&h32,&h6C,&h8E,&hD0,&h53,&h0D,&hEF,&hB1,&hF0,&hAE,&h4C,&h12,&h91,&hCF,&h2D,&h73,
&hCA,&h94,&h76,&h28,&hAB,&hF5,&h17,&h49,&h08,&h56,&hB4,&hEA,&h69,&h37,&hD5,&h8B,
&h57,&h09,&hEB,&hB5,&h36,&h68,&h8A,&hD4,&h95,&hCB,&h29,&h77,&hF4,&hAA,&h48,&h16,
&hE9,&hB7,&h55,&h0B,&h88,&hD6,&h34,&h6A,&h2B,&h75,&h97,&hC9,&h4A,&h14,&hF6,&hA8,
&h74,&h2A,&hC8,&h96,&h15,&h4B,&hA9,&hF7,&hB6,&hE8,&h0A,&h54,&hD7,&h89,&h6B,&h35