1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
implementation module MIPS.MIPS32
import StdEnv
import Text
instance toString Line
where
toString (StartSection s) = "\t." +++ s
toString (Align i) = "\t.align\t" +++ toString i
toString (Label l) = l +++ ":"
toString (Global l) = "\t.globl\t" +++ l
toString (Instr i) = "\t" +++ toString i
toString (RawByte i) = "\t.byte\t" +++ toString i
toString (RawWord i) = "\t.word\t" +++ toString i
toString (RawWordLabel l) = "\t.word\t" +++ l
toString (RawAscii s) = concat3 "\t.ascii\t\"" s "\"" // TODO: escaping
instance toString Instruction
where
toString (LoadByte signed rt offset base) =
memInstrS (if (signed=:Signed) "lb" "lbu") rt (checkOffset offset) base
toString (LoadHalfword signed rt offset base) =
memInstrS (if (signed=:Signed) "lh" "lhu") rt (checkOffset offset) base
toString (LoadWord rt offset base) =
memInstrS "lw" rt (checkOffset offset) base
toString (StoreByte rt offset base) =
memInstrS "sb" rt (checkOffset offset) base
toString (StoreHalfword rt offset base) =
memInstrS "sh" rt (checkOffset offset) base
toString (StoreWord rt offset base) =
memInstrS "sw" rt (checkOffset offset) base
toString (AddImmediate signed rt rs imm) =
immediateInstrS (if (signed=:Signed) "addi" "addiu") rt rs (checkImmediate signed imm)
toString (AndImmediate rt rs imm) =
immediateInstrS "andi" rt rs (checkImmediate Unsigned imm)
toString (LoadUpperImmediate rt imm) =
concat ["lui\t",toString rt,",",toString (checkImmediate Unsigned imm)]
toString (OrImmediate rt rs imm) =
immediateInstrS "ori" rt rs (checkImmediate Unsigned imm)
toString (XorImmediate rt rs imm) =
immediateInstrS "xori" rt rs (checkImmediate Unsigned imm)
toString (AddWord signed rd rs rt) =
threeRegInstrS (if (signed=:Signed) "add" "addu") rd rs rt
toString (AndWord rd rs rt) =
threeRegInstrS "and" rd rs rt
toString (NorWord rd rs rt) =
threeRegInstrS "nor" rd rs rt
toString (OrWord rd rs rt) =
threeRegInstrS "or" rd rs rt
toString (SubWord signed rd rs rt) =
threeRegInstrS (if (signed=:Signed) "sub" "subu") rd rs rt
toString (XorWord rd rs rt) =
threeRegInstrS "xor" rd rs rt
toString (Jump link target) =
instr +++ toString target
where
instr = case (link, target) of
(NoLink, Direct _) -> "j\t"
(Link, Direct _) -> "jal\t"
(NoLink, Register _) -> "jr\t"
(Link, Register _) -> "jalr\t"
toString (BranchOn1 (BCGeZero link) rs offset) =
branch1InstrS (if (link=:Link) "bgezal" "bgez") rs (checkOffset offset)
toString (BranchOn1 BCGtZero rs offset) =
branch1InstrS "bgtz" rs (checkOffset offset)
toString (BranchOn1 BCLeZero rs offset) =
branch1InstrS "blez" rs (checkOffset offset)
toString (BranchOn1 (BCLtZero link) rs offset) =
branch1InstrS (if (link=:Link) "bltzal" "bltz") rs (checkOffset offset)
toString (BranchOn2 cond rs rt offset) =
immediateInstrS (if (cond=:BCEq) "beq" "bne") rs rt (Immediate (checkOffset offset))
toString (Break arg) =
"break\t" +++ toString arg
toString (Syscall arg) =
"syscall\t" +++ toString arg
toString (LoadAddress rd imm) =
concat4 "la\t" (toString rd) "," (toString imm)
toString Nop =
"nop"
instance toString JumpTarget
where
toString (Direct imm)
= toString imm
toString (Register r)
= toString r
instance toString Immediate
where
toString (Immediate i)
= toString i
toString (Address offset label)
| offset == 0
= label
| offset > 0
= concat3 label "+" (toString offset)
= concat3 label "-" (toString offset)
memInstrS :: !String !Register !Offset !Base -> String
memInstrS opcode rt 0 base = concat [opcode,"\t",toString rt,",(",toString base,")"]
memInstrS opcode rt offset base = concat [opcode,"\t",toString rt,",",toString offset,"(",toString base,")"]
immediateInstrS :: !String !TargetRegister !SourceRegister !Immediate -> String
immediateInstrS opcode rt rs imm = concat [opcode,"\t",toString rt,",",toString rs,",",toString imm]
threeRegInstrS :: !String !DestinationRegister !SourceRegister !TargetRegister -> String
threeRegInstrS opcode rd rs rt = concat [opcode,"\t",toString rd,",",toString rs,",",toString rt]
branch1InstrS :: !String !SourceRegister !Offset -> String
branch1InstrS opcode rs offset = concat [opcode,"\t",toString rs,",",toString offset]
instance toString Register
where
toString reg = toString` (checkReg reg)
where
/* Sorted by estimated frequency for efficiency */
toString` (T n) = "$t" +++ toString n
toString` (S n) = "$s" +++ toString n
toString` (A n) = "$a" +++ toString n
toString` R0 = "$0"
toString` GP = "$gp"
toString` SP = "$sp"
toString` FP = "$fp"
toString` RA = "$ra"
toString` AT = "$at"
toString` V0 = "$v0"
toString` V1 = "$v1"
toString` K0 = "$k0"
toString` K1 = "$k1"
checkReg :: !Register -> Register
checkReg (T n) | not (0 <= n && n <= 9)
= abort ("non-existing register $t" +++ toString n +++ "\n")
checkReg (S n) | not (0 <= n && n <= 7)
= abort ("non-existing register $s" +++ toString n +++ "\n")
checkReg (A n) | not (0 <= n && n <= 3)
= abort ("non-existing register $a" +++ toString n +++ "\n")
checkReg reg
= reg
checkOffset :: !Int -> Int
checkOffset offset
| 0 <= offset && offset <= 0x7fff
= offset
| offset >= -0x8000
= offset bitand 0xffff
= abort ("offset " +++ toString offset +++ " out of bounds\n")
checkImmediate :: !Signedness !Immediate -> Immediate
checkImmediate Signed (Immediate imm)
| 0 <= imm && imm <= 0x7fff
= Immediate imm
| imm >= -0x8000
= Immediate (imm bitand 0xffff)
= abort ("signed immediate " +++ toString imm +++ " out of bounds\n")
checkImmediate Unsigned (Immediate imm)
| 0 <= imm && imm <= 0xffff
= Immediate imm
= abort ("unsigned immediate " +++ toString imm +++ " out of bounds\n")
|
