Commit fc307e2a authored by Axel Simon's avatar Axel Simon
Browse files

adjust AVR to syntax check

parent 67db551c
......@@ -6,7 +6,7 @@ structure Types = struct
type varset = TVar.set
val freshTVar = TVar.freshTVar
val concisePrint = false
val concisePrint = true
datatype texp =
(* a function taking at least one argument *)
......
granularity = 8
export = decode
val decode = do
update@{rd='',rr='',ck='',cs='',cb='',io=''};
/
end
datatype imm =
granularity = 16
# export = decode
#
# val decode = do
# update@{rd='',rr='',ck='',cs='',cb='',io=''};
# /
# end
type imm =
IMM3 of 3
| IMM4 of 4
| IMM6 of 6
......@@ -14,7 +14,7 @@ datatype imm =
| IMM8 of 8
| IMM22 of 22
datatype operand =
type operand =
REG of register
| REGHL of {regh:register,regl:register}
| IOREG of io-register
......@@ -22,11 +22,11 @@ datatype operand =
type binop = {first:operand,second:operand}
type unop = {operand:operand}
type nullop = {}
type instruction =
ADC of binop
| ADD of binop
| ADIW of binop
| AND of binop
| ANDI of binop
| ASR of unop
......@@ -34,18 +34,19 @@ type instruction =
| BLD of binop
| BRBC of binop
| BRBS of binop
| BREAK of nullop
| BREAK
| BSET of unop
| BST of binop
| CALL of unop
| CBI of binop
| CLC of nullop
| CLH of nullop
| CLI of nullop
| CLN of nullop
| CLS of nullop
| CLT of nullop
| CLV of nullop
| CLZ of nullop
| CLC
| CLH
| CLI
| CLN
| CLS
| CLT
| CLV
| CLZ
| COM of unop
| CP of binop
| CPC of binop
......@@ -53,9 +54,9 @@ type instruction =
| CPSE of binop
| DEC of unop
| DES of unop
| EICALL of nullop
| EIJMP of nullop
| ELPM of nullop
| EICALL
| EIJMP
| ELPM
type register =
R0
......@@ -91,7 +92,7 @@ type register =
| R30
| R31
datatype io-register =
type io-register =
IO0
| IO1
| IO2
......@@ -161,9 +162,9 @@ val register-from-bits bits =
| '11111': R31
end
val X = REGHL {regh=REG R27,regl=REG R26}
val Y = REGHL {regh=REG R29,regl=REG R28}
val Z = REGHL {regh=REG R31,regl=REG R30}
val /X = REGHL {regh=R27,regl=R26}
val /Y = REGHL {regh=R29,regl=R28}
val /Z = REGHL {regh=R31,regl=R30}
val io-register-from-bits bits =
case bits of
......@@ -202,151 +203,169 @@ val io-register-from-bits bits =
end
val d ['bit:1'] = do
rd <- (query $rd) ^ bit;
update@{rd=rd}
rd <- query $rd;
update@{rd=rd ^ bit}
end
val r ['bit:1'] = do
rr <- (query $rr) ^ bit;
update@{rr=rr}
rr <- query $rr;
update@{rr=rr ^ bit}
end
val k ['bit:1'] = do
ck <- (query $ck) ^ bit;
update@{ck=ck}
ck <- query $ck;
update@{ck=ck ^ bit}
end
val s ['bit:1'] = do
cs <- (query $cs) ^ bit;
update@{cs=cs}
cs <- query $cs;
update@{cs=cs ^ bit}
end
val a ['bit:1'] = do
io <- (query $io) ^ bit;
update@{io=io}
io <- query $io;
update@{io=io ^ bit}
end
val b ['bit:1'] = do
cb <- query $cb;
update@{cb=cb ^ bit}
end
val rd5 = do
rd <- query $rd;
update @{rd=''};
return (REG (register-from-bits rd))
end
val rd4 = do
rd <- query $rd;
update @{rd=''};
return (REG (register-from-bits ('1' ^ rd)))
end
val rr5 = do
rr <- query $rd;
rr <- query $rr;
update @{rr=''};
return (REG (register-from-bits rr))
end
val rr4 = do
rr <- query $rd;
rr <- query $rr;
update @{rr=''};
return (REG (register-from-bits ('1' ^ rr)))
end
val ck4 = do
ck <- query $ck;
update @{ck=''};
return (IMM (IMM4 ck))
end
val ck6 = do
ck <- query $ck;
update @{ck=''};
return (IMM (IMM6 ck))
end
val ck7 = do
ck <- query $ck;
update @{ck=''};
return (IMM (IMM7 ck))
end
val ck8 = do
ck <- query $ck;
update @{ck=''};
return (IMM (IMM8 ck))
end
val ck22 = do
ck <- query $ck;
update @{ck=''};
return (IMM (IMM22 ck))
end
val cs3 = do
cs <- query $cs;
update @{cs=''};
return (IMM (IMM3 cs))
end
val cb3 = do
cb <- query $cb;
update @{cb=''};
return (IMM (IMM3 cb))
end
val io = do
io <- query $io;
update @{io=''};
return (IOREG (io-register-from-bits io))
end
val rd5h-rd5l = do
rd <- query $rd;
rd-regl <- register-from-bits ('11' ^ rd ^ '0');
rd-regh <- register-from-bits ('11' ^ rd ^ '1');
return (REGHL {regh=rd-regh,regl=rd-regl});
rd-regl <- return (register-from-bits ('11' ^ rd ^ '0'));
rd-regh <- return (register-from-bits ('11' ^ rd ^ '1'));
update @{rd=''};
return (REGHL {regh=rd-regh,regl=rd-regl})
end
val binop cons first second = do
first <- first;
second <- second;
return (cons {first=first, second=second});
return (cons {first=first, second=second})
end
val unop cons operand = do
operand <- operand;
return (cons {operand=operand});
return (cons {operand=operand})
end
val nullop cons = do
return (cons {});
return cons
end
### ADC
### - Add with Carry
val / ['000111' r d d d d d r r r r] = binop ADC rd5 rr5
val / ['000111 r d d d d d r r r r '] = binop ADC rd5 rr5
### ADD
### - Add without Carry
val / ['000011' r d d d d d r r r r] = binop ADD rd5 rr5
val / ['000011 r d d d d d r r r r '] = binop ADD rd5 rr5
### ADIW
### - Add Immediate to Word
val / ['10010110' k k d d k k k k] = binop ADIW rd5h-rd5l ck6
val / ['10010110 k k d d k k k k '] = binop ADIW rd5h-rd5l ck6
### AND
### - Logical AND
val / ['001000' r d d d d d r r r r] = binop AND rd5 rr5
val / ['001000 r d d d d d r r r r '] = binop AND rd5 rr5
### ANDI
### - Logical AND with Immediate
val / ['0111' k k k k d d d d k k k k] = binop ANDI rd4 ck8
val / ['0111 k k k k d d d d k k k k '] = binop ANDI rd4 ck8
### ASR
### - Arithmetic Shift Right
val / ['1001010' d d d d d '0101'] = unop ASR rd5
val / ['1001010 d d d d d 0101'] = unop ASR rd5
### BCLR
### - Bit Clear in SREG
val / ['100101001' s s s '1000'] = unop BCLR cs3
val / ['100101001 s s s 1000'] = unop BCLR cs3
### BLD
### - Bit Load from the T Flag in SREG to a Bit in Register
val / ['1111100' d d d d d '0' b b b] = binop BLD rd5 cb3
val / ['1111100 d d d d d 0 b b b '] = binop BLD rd5 cb3
### BRBC
### - Branch if Bit in SREG is Cleared
val / ['111101' k k k k k k k s s s] = binop BRBC cs3 ck7
val / ['111101 k k k k k k k s s s '] = binop BRBC cs3 ck7
### BRBS
### - Branch if Bit in SREG is Set
val / ['111100' k k k k k k k s s s] = binop BRBS cs3 ck7
val / ['111100 k k k k k k k s s s '] = binop BRBS cs3 ck7
### BREAK
### - Break
......@@ -354,19 +373,19 @@ val / ['1001010110011000'] = nullop BREAK
### BSET
### - Bit Set in SREG
val / ['100101000' s s s '1000'] = unop BSET cs3
val / ['100101000 s s s 1000'] = unop BSET cs3
### BST
### - Bit Store from Bit in Register to T Flag in SREG
val / ['1111101' d d d d d '0' b b b] = binop BST rd5 cb3
val / ['1111101 d d d d d 0 b b b '] = binop BST rd5 cb3
### CALL
### - Long Call to a Subroutine
val / ['1001010' k k k k k '111' k k k k k k k k k k k k k k k k k] = unop CALL ck22
val / ['1001010 k k k k k 111 k ' 'k k k k k k k k k k k k k k k k '] = unop CALL ck22
### CBI
### - Clear Bit in I/O Register
val / ['10011000' a a a a a b b b] = binop CBI io cb3
val / ['10011000 a a a a a b b b '] = binop CBI io cb3
### CLC
### - Clear Carry Flag
......@@ -402,31 +421,31 @@ val / ['1001010010011000'] = nullop CLZ
### COM
### - Ones Complement
val / ['1001010' d d d d d '0000'] = unop COM rd5
val / ['1001010 d d d d d 0000'] = unop COM rd5
### CP
### - Compare
val / ['000101' r d d d d d r r r r] = binop CP rd5 rr5
val / ['000101 r d d d d d r r r r '] = binop CP rd5 rr5
### CPC
### - Compare with Carry
val / ['000001' r d d d d d r r r r] = binop CPC rd5 rr5
val / ['000001 r d d d d d r r r r '] = binop CPC rd5 rr5
### CPI
### - Compare with Immediate
val / ['0011' k k k k d d d d k k k k] = binop CPI rd4 ck8
val / ['0011 k k k k d d d d k k k k '] = binop CPI rd4 ck8
### CPSE
### - Compare Skip if Equal
val / ['000100' r d d d d d r r r r] = binop CPSE rd5 rr5
val / ['000100 r d d d d d r r r r '] = binop CPSE rd5 rr5
### DEC
### - Decrement
val / ['1001010' d d d d d '1010'] = unop DEC rd5
val / ['1001010 d d d d d 1010'] = unop DEC rd5
### DES
### - Data Encryption Standard
val / ['10010100' k k k k '1011'] = unop DES ck4
val / ['10010100 k k k k 1011'] = unop DES ck4
### EICALL
### - Extended Indirect Call to Subroutine
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment