Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /archive/mlsave.11/m68/m68ascode.sml
ViewVC logotype

Annotation of /archive/mlsave.11/m68/m68ascode.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4054 - (view) (download)

1 : dbm 4054 structure M68Assem = struct val outfile = ref std_out end
2 :    
3 :     structure M68AsCode : M68CODER = struct
4 :    
5 :     open System.Tags M68Assem
6 :    
7 :     val offset = ref 0
8 :    
9 :     type Label = string
10 :    
11 :     local val i = ref 0 in
12 :     fun newlabel () = (i := !i + 1; "L" ^ makestring (!i))
13 :     end
14 :    
15 :     fun itoa (i:int) = if i < 0 then "-" ^ makestring (~i)
16 :     else makestring i
17 :    
18 :     datatype Register = DataReg of int
19 :     | AddrReg of int
20 :     | FloatReg of int
21 :    
22 :     datatype Size = Byte | Word | Long
23 :    
24 :     datatype EA = Direct of Register
25 :     | PostInc of Register
26 :     | PreDec of Register
27 :     | Displace of Register * int
28 :     | Index of Register * int * Register * Size
29 :     | Immed of int
30 :     | Abs of int
31 :     | Address of Label
32 :    
33 :     val d0 = DataReg 0
34 :     and d1 = DataReg 1
35 :     and d2 = DataReg 2
36 :     and d3 = DataReg 3
37 :     and d4 = DataReg 4
38 :     and d5 = DataReg 5
39 :     and d6 = DataReg 6
40 :     and d7 = DataReg 7
41 :     and a0 = AddrReg 0
42 :     and a1 = AddrReg 1
43 :     and a2 = AddrReg 2
44 :     and a3 = AddrReg 3
45 :     and a4 = AddrReg 4
46 :     and a5 = AddrReg 5
47 :     and a6 = AddrReg 6
48 :     and sp = AddrReg 7
49 :     and fp0 = FloatReg 0
50 :     and fp1 = FloatReg 1
51 :     and fp2 = FloatReg 2
52 :     and fp3 = FloatReg 3
53 :     and fp4 = FloatReg 4
54 :     and fp5 = FloatReg 5
55 :     and fp6 = FloatReg 6
56 :     and fp7 = FloatReg 7
57 :    
58 :     fun emit (s:string) = (print s;output(!outfile,s))
59 :    
60 :     fun emitreg (DataReg 0) = emit "d0"
61 :     | emitreg (DataReg 1) = emit "d1"
62 :     | emitreg (DataReg 2) = emit "d2"
63 :     | emitreg (DataReg 3) = emit "d3"
64 :     | emitreg (DataReg 4) = emit "d4"
65 :     | emitreg (DataReg 5) = emit "d5"
66 :     | emitreg (DataReg 6) = emit "d6"
67 :     | emitreg (DataReg 7) = emit "d7"
68 :     | emitreg (AddrReg 0) = emit "a0"
69 :     | emitreg (AddrReg 1) = emit "a1"
70 :     | emitreg (AddrReg 2) = emit "a2"
71 :     | emitreg (AddrReg 3) = emit "a3"
72 :     | emitreg (AddrReg 4) = emit "a4"
73 :     | emitreg (AddrReg 5) = emit "a5"
74 :     | emitreg (AddrReg 6) = emit "a6"
75 :     | emitreg (AddrReg 7) = emit "sp"
76 :     | emitreg (FloatReg 0) = emit "fp0"
77 :     | emitreg (FloatReg 1) = emit "fp1"
78 :     | emitreg (FloatReg 2) = emit "fp2"
79 :     | emitreg (FloatReg 3) = emit "fp3"
80 :     | emitreg (FloatReg 4) = emit "fp4"
81 :     | emitreg (FloatReg 5) = emit "fp5"
82 :     | emitreg (FloatReg 6) = emit "fp6"
83 :     | emitreg (FloatReg 7) = emit "fp7"
84 :    
85 :     fun sizeint i =
86 :     if i < 128 andalso i > ~129 then Byte
87 :     else if i < 32768 andalso i > ~32769 then Word
88 :     else Long
89 :    
90 :     fun emitarg (Immed i) = (emit "#"; emit (itoa i))
91 :     | emitarg (Abs i) = emit (itoa i)
92 :     | emitarg (Direct r) = emitreg r
93 :     | emitarg (Displace (ra,0)) = (emitreg ra; emit "@")
94 :     | emitarg (PostInc ra) = (emitreg ra; emit "@+")
95 :     | emitarg (PreDec ra) = (emitreg ra; emit "@-")
96 :     | emitarg (Displace (r,i)) =
97 :     (emitreg r;
98 :     emit "@(";
99 :     emit (itoa i);
100 :     emit ")")
101 :     | emitarg (Index (ra,disp,r,Word)) =
102 :     (emitreg ra;
103 :     emit "@(";
104 :     emit (itoa disp);
105 :     emitreg r;
106 :     emit ":W)")
107 :     | emitarg (Index (ra,disp,r,Long)) =
108 :     (emitreg ra;
109 :     emit "@(";
110 :     emit (itoa disp);
111 :     emitreg r;
112 :     emit ":L)")
113 :     | emitarg (Address lab) = emit lab
114 :    
115 :     fun emit2arg (a,b) = (emitarg a; emit ","; emitarg b; emit "\n")
116 :    
117 :     fun emit1arg (a) = (emitarg a; emit "\n")
118 :    
119 :     fun align () = emit ".align 2\n"
120 :    
121 :     local val p = makestring power_tags
122 :     val t = makestring tag_backptr
123 :     in
124 :     fun mark () = let val lab = newlabel()
125 :     in emit lab;
126 :     emit ": .long ((";
127 :     emit lab;
128 :     emit "-base)/4+1)*"; (* STRING dependency *)
129 :     emit p;
130 :     emit "+";
131 :     emit t;
132 :     emit "\n"
133 :     end
134 :     end
135 :    
136 :     fun define lab = (emit lab; emit ":\n")
137 :     fun oct i = let val m = Integer.makestring
138 :     in m(i div 64)^m((i div 8)mod 8)^m(i mod 8) end
139 :     fun c_char "\n" = "\\n"
140 :     | c_char "\t" = "\\t"
141 :     | c_char "\\" = "\\\\"
142 :     | c_char "\"" = "\\\""
143 :     | c_char c = if ord c < 32 then "\\"^oct(ord c) else c
144 :     fun a_str s = implode(map c_char (explode s))
145 :     fun emitstring s = (emit ".ascii \""; emit(a_str s); emit "\"\n")
146 :     fun realconst s = (emit ".double 0r"; emit s; emit "\n")
147 :     fun emitlong (i : int) = (emit ".long "; emit(makestring i); emit "\n")
148 :    
149 :     exception Illegal
150 :    
151 :     fun rts () = emit "rts\n"
152 :    
153 :     fun exg (arg as (Direct(AddrReg a),Direct(AddrReg b))) =
154 :     if a = b then ()
155 :     else (emit "exg "; emit2arg arg)
156 :     | exg (arg as (Direct(DataReg a),Direct(DataReg b))) =
157 :     if a = b then ()
158 :     else (emit "exg "; emit2arg arg)
159 :     | exg (arg as (Direct(AddrReg b),Direct(DataReg a))) =
160 :     (emit "exg "; emit2arg arg)
161 :     | exg (arg as (Direct(DataReg a),Direct(AddrReg b))) =
162 :     (emit "exg "; emit2arg arg)
163 :    
164 :     fun movl (_,Immed _) = raise Illegal
165 :     (* labels not implemented *)
166 :     | movl (Address _,_) = raise Illegal
167 :     | movl (_,Address _) = raise Illegal
168 :     (* MOVEQ/MOVE *)
169 :     | movl (src as (Immed i),dest as (Direct(DataReg d))) =
170 :     (case sizeint i of
171 :     Byte => (emit "moveq "; emit2arg (src,dest))
172 :     | _ => (emit "movl "; emit2arg (src,dest)))
173 :     (* MOVEA *)
174 :     | movl (src,dest as (Direct(AddrReg a))) =
175 :     (emit "movl "; emit2arg (src,dest))
176 :     (* general MOVE *)
177 :     | movl (src,dest) =
178 :     (emit "movl "; emit2arg (src,dest))
179 :    
180 :     fun addl (_,Immed _) = raise Illegal
181 :     (* ADDQ/ADDA *)
182 :     | addl (src as (Immed i),dest as (Direct(AddrReg a))) =
183 :     if i <= 8 andalso i >= 1 then
184 :     (emit "addql "; emit2arg(src,dest))
185 :     else (emit "addl "; emit2arg(src,dest))
186 :     | addl (src,dest as (Direct(AddrReg a))) =
187 :     (emit "addl "; emit2arg (src,dest))
188 :     (* ADDQ/ADDI *)
189 :     | addl (src as (Immed i),dest) =
190 :     if i <= 8 andalso i >= 1 then
191 :     (emit "addql "; emit2arg (src,dest))
192 :     else (emit "addl "; emit2arg (src,dest))
193 :     (* general ADD *)
194 :     | addl (src,dest as (Direct(DataReg d))) =
195 :     (emit "addl "; emit2arg (src,dest))
196 :     | addl (src as (Direct(DataReg d)),dest) =
197 :     (emit "addl "; emit2arg (src,dest))
198 :    
199 :     fun subl (_,Immed _) = raise Illegal
200 :     (* SUBQ/SUBA *)
201 :     | subl (src as (Immed i),dest as (Direct(AddrReg a))) =
202 :     if i <= 8 andalso i >= 1 then
203 :     (emit "subql "; emit2arg(src,dest))
204 :     else (emit "subl "; emit2arg(src,dest))
205 :     (* SUBA *)
206 :     | subl (src,dest as (Direct(AddrReg a))) =
207 :     (emit "subl "; emit2arg(src,dest))
208 :     (* SUBQ/SUBI *)
209 :     | subl (src as (Immed i),dest) =
210 :     if i <= 8 andalso i >= 1 then
211 :     (emit "subql "; emit2arg(src,dest))
212 :     else (emit "subl "; emit2arg(src,dest))
213 :     (* general SUB *)
214 :     | subl (src,dest as (Direct(DataReg d))) =
215 :     (emit "subl "; emit2arg(src,dest))
216 :     | subl (src as (Direct(DataReg d)),dest) =
217 :     (emit "subl "; emit2arg(src,dest))
218 :    
219 :     fun divl args = (emit "divl "; emit2arg args)
220 :     fun mull args = (emit "mull "; emit2arg args)
221 :     fun asll (Immed 1, arg) = (emit "asll "; emit1arg arg)
222 :     | asll args = (emit "asll "; emit2arg args)
223 :     fun asrl (Immed 1, arg) = (emit "asrl "; emit1arg arg)
224 :     | asrl args = (emit "asrl "; emit2arg args)
225 :     fun movb (Immed 0, arg) = (emit "clrb "; emit1arg arg)
226 :     | movb args = (emit "movb "; emit2arg args)
227 :    
228 :     fun cmpl (_,Immed _) = raise Illegal
229 :     (* CMP *)
230 :     | cmpl (src,dest as (Direct(DataReg d))) =
231 :     (emit "cmpl "; emit2arg (src,dest))
232 :     (* CMPA *)
233 :     | cmpl (src,dest as (Direct(AddrReg a))) =
234 :     (emit "cmpl "; emit2arg (src,dest))
235 :     (* CMPI *)
236 :     | cmpl (src as (Immed i),dest) =
237 :     (emit "cmpl "; emit2arg (src,dest))
238 :     (* CMPM *)
239 :     | cmpl (src as (PostInc(AddrReg y)),dest as (PostInc(AddrReg x))) =
240 :     (emit "cmpm "; emit2arg (src,dest))
241 :    
242 :     fun btst (_,Direct(AddrReg _)) = raise Illegal
243 :     | btst (_,Immed _) = raise Illegal
244 :     | btst (src as (Direct(DataReg d)),dest) =
245 :     (emit "btst "; emit2arg (src,dest))
246 :     | btst (src as (Immed i),dest) =
247 :     (emit "btst "; emit2arg (src,dest))
248 :    
249 :     fun pea (Direct _) = raise Illegal
250 :     | pea (PreDec _) = raise Illegal
251 :     | pea (PostInc _) = raise Illegal
252 :     | pea (Immed _) = raise Illegal
253 :     | pea (arg as (Address lab)) =
254 :     (emit "pea "; emit1arg arg)
255 :     | pea (arg) =
256 :     (emit "pea "; emit1arg arg)
257 :    
258 :     fun lea (Direct _,_) = raise Illegal
259 :     | lea (PreDec _,_) = raise Illegal
260 :     | lea (PostInc _,_) = raise Illegal
261 :     | lea (Immed _,_) = raise Illegal
262 :     | lea (src as Address _,dest as Direct(AddrReg _)) =
263 :     (emit "lea "; emit2arg (src,dest))
264 :     | lea (src,dest as (Direct(AddrReg a))) =
265 :     (emit "lea "; emit2arg (src,dest))
266 :    
267 :     fun jne (arg as (Address lab)) = (emit "jne "; emit1arg arg)
268 :     fun jeq (arg as (Address lab)) = (emit "jeq "; emit1arg arg)
269 :     fun jgt (arg as (Address lab)) = (emit "jgt "; emit1arg arg)
270 :     fun jge (arg as (Address lab)) = (emit "jge "; emit1arg arg)
271 :     fun jlt (arg as (Address lab)) = (emit "jlt "; emit1arg arg)
272 :     fun jle (arg as (Address lab)) = (emit "jle "; emit1arg arg)
273 :    
274 :     fun jra (arg as (Address lab)) =
275 :     (emit "jra "; emit1arg arg)
276 :     | jra (arg as (Displace(AddrReg a,i))) =
277 :     (emit "jra "; emit1arg arg)
278 :    
279 :     fun jbsr (arg as (Address lab)) =
280 :     (emit "jbsr "; emit1arg arg)
281 :     | jbsr (arg as (Displace(AddrReg _,_))) =
282 :     (emit "jbsr "; emit1arg arg)
283 :    
284 :     (* 68881 float operations *)
285 :     (* Some src/dest combinations are illegal, but not caught here. *)
286 :     fun fjne (arg as (Address lab)) = (emit "fjne "; emit1arg arg)
287 :     fun fjeq (arg as (Address lab)) = (emit "fjeq "; emit1arg arg)
288 :     fun fjgt (arg as (Address lab)) = (emit "fjgt "; emit1arg arg)
289 :     fun fjge (arg as (Address lab)) = (emit "fjge "; emit1arg arg)
290 :     fun fjlt (arg as (Address lab)) = (emit "fjlt "; emit1arg arg)
291 :     fun fjle (arg as (Address lab)) = (emit "fjle "; emit1arg arg)
292 :    
293 :     fun fcmpd (arg as (src,dest)) = (emit "fcmpd "; emit2arg arg)
294 :     fun faddd (arg as (src,dest)) = (emit "faddd "; emit2arg arg)
295 :     fun fsubd (arg as (src,dest)) = (emit "fsubd "; emit2arg arg)
296 :     fun fmuld (arg as (src,dest)) = (emit "fmuld "; emit2arg arg)
297 :     fun fdivd (arg as (src,dest)) = (emit "fdivd "; emit2arg arg)
298 :     fun fnegd (arg as (src,dest)) = (emit "fnegd "; emit2arg arg)
299 :     fun fmoved (arg as (src,dest as Direct(FloatReg f))) =
300 :     (emit "fmoved "; emit2arg arg)
301 :     | fmoved (arg as (src as Direct(FloatReg f),dest)) =
302 :     (emit "fmoved "; emit2arg arg)
303 :    
304 :     fun trapv() = emit "trapv\n"
305 :    
306 :     fun push ea = movl(ea,PreDec sp)
307 :    
308 :     fun pop ea = movl(PostInc sp,ea)
309 :    
310 :     val pusha = pea
311 :    
312 :     end (* structure AsCode *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0