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 /sml/trunk/src/compiler/OldCGen/x86/x86mcode.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/OldCGen/x86/x86mcode.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* x86mcode.sml
2 :     * by Yngvi Guttesen (ysg@id.dth.dk) and Mark Leone (mleone@cs.cmu.edu)
3 :     *
4 :     * Copyright 1989 by Department of Computer Science,
5 :     * The Technical University of Denmak
6 :     * DK-2800 Lyngby
7 :     *
8 :     *)
9 :    
10 :     functor X86MCode (Jumps : X86JUMPS) : X86CODER = struct
11 :    
12 :     structure Emitter : BACKPATCH = Backpatch(Jumps)
13 :     open Emitter Jumps
14 :    
15 :     val emit = emitstring (* uses Backpatch's emitstring: no padding *)
16 :    
17 :     fun padString s = (case ((size s) mod 4)
18 :     of 0 => s
19 :     | 1 => (s ^ "\000\000\000")
20 :     | 2 => (s ^ "\000\000")
21 :     | 3 => (s ^ "\000")
22 :     | _ => ErrorMsg.impossible "x86.sml: padString")
23 :    
24 :     val emitstring = (* for ML strings, pads last word of string with 0s *)
25 :     fn s => let val s' = padString s
26 :     in
27 :     emit s'
28 :     end
29 :    
30 :     val emitbyte = fn i => emit(ebyte i)
31 :     val emitlong = fn i => emit(elong i)
32 :     fun realconst s = emit(implode(rev(explode(IEEEReal.realconst s))))
33 :    
34 :    
35 :    
36 :     datatype EA = Direct of int
37 :     | Displace of int * int
38 :     | Index of int * int * int * Size
39 :     | Immed of int
40 :     | Immed32 of Word32.word
41 :     | Immedlab of Label
42 :     | Floatreg of int
43 :    
44 :     (*************************** The 80386 registers ******************************)
45 :    
46 :     val eax = 0
47 :     and ebx = 3
48 :     and ecx = 1
49 :     and edx = 2
50 :     and esi = 6
51 :     and edi = 7
52 :     and ebp = 5
53 :     and esp = 4
54 :    
55 :     (*********************** Emit the addr. and data extension *******************)
56 :    
57 :     fun die s = ErrorMsg.impossible ("x86/x86mcode.sml: " ^ s)
58 :    
59 :     (* Emit the Scaled/Index/Base byte *)
60 :     fun emitsib(Index(base, _, index, size)) =
61 :     let val ss = if index=4 then 0
62 :     else (case size of Byte => 0 | Word => 1 | Long => 2)
63 :     in ebyte(ss*64 + index*8 + base) end
64 :     | emitsib _ = die "emitsib: bad args"
65 :    
66 :     (* Emit the mod-reg-r/m byte and addr. and data
67 :     * extension for binary operations
68 :     *)
69 :     fun emitext(Direct s, Direct d) = ebyte(3*64 + 8*d + s)
70 :     | emitext(Displace(s, 0), b as Direct d) =
71 :     if s=esp
72 :     then emitext(Index(s,0,4,Byte), b)
73 :     else if s=ebp
74 :     then (ebyte(1*64 + d*8 + ebp) ^ ebyte(0))
75 :     else ebyte(d*8 + s)
76 :     | emitext(Displace(s,i), b as Direct d) =
77 :     if s=esp
78 :     then emitext(Index(s,i,4,Byte), b)
79 :     else if sizeint(i)=Byte
80 :     then (ebyte(1*64 + d*8 + s) ^ ebyte(i))
81 :     else (ebyte(2*64 + d*8 + s) ^ elong(i))
82 :     | emitext(src as Index(s, 0,_,_), Direct d) =
83 :     if s=ebp
84 :     then (ebyte(1*64 + 8*d + 4) ^ emitsib(src) ^ ebyte(0))
85 :     else (ebyte(8*d + 4) ^ emitsib(src))
86 :     | emitext(src as Index(_,i,_,_), Direct d) =
87 :     if sizeint(i)=Byte
88 :     then (ebyte(1*64 + d*8 + 4) ^ emitsib(src) ^ ebyte(i))
89 :     else (ebyte(2*64 + d*8 + 4) ^ emitsib(src) ^ elong(i))
90 :     | emitext(a as Direct _, b as Displace _) = emitext(b,a)
91 :     | emitext(a as Direct _, b as Index _) = emitext(b,a)
92 :     | emitext _ = die "emitext: bad args"
93 :    
94 :     fun emitimm i = if sizeint(i)=Byte then ebyte(i) else elong(i)
95 :    
96 :     (* Emit the mod-reg-r/m byte and addr. and data extension for
97 :     * immediate operations. This is also used in unary operations
98 :     *)
99 :     fun emitImmext(opcode, Direct r) = ebyte(3*64 + opcode*8 +r)
100 :     | emitImmext(opcode, Displace(r, 0)) =
101 :     if r=esp
102 :     then emitImmext(opcode, Index(r,0,4,Byte))
103 :     else if r=ebp
104 :     then (ebyte(1*64 + opcode*8 + 5) ^ ebyte(0))
105 :     else ebyte(opcode*8 + r)
106 :     | emitImmext(opcode, Displace(r, j)) =
107 :     if r=esp
108 :     then emitImmext(opcode, Index(r,j,4,Byte))
109 :     else let val mode = (if (sizeint(j) = Byte) then 1 else 2)
110 :     in
111 :     (ebyte(mode*64 + opcode*8 + r) ^ emitimm(j))
112 :     end
113 :     | emitImmext(opcode, dest as Index(r, 0, _, _)) =
114 :     if r=ebp
115 :     then (ebyte(1*64 + opcode*8 + 4) ^ emitsib(dest) ^ ebyte(0))
116 :     else (ebyte(opcode*8 + 4) ^ emitsib(dest))
117 :     | emitImmext(opcode, dest as Index(b, j, _, _)) =
118 :     let val mode = (if (sizeint(j) = Byte) then 1 else 2)
119 :     in (ebyte(mode*64 + opcode*8 + 4) ^ emitsib(dest) ^ emitimm(j))
120 :     end
121 :     | emitImmext _ = die "emitImmext: bad args"
122 :    
123 :     (* Generate code for binary operations *)
124 :     (******
125 :     fun gen2(frst,nxt, src, dest) =
126 :     (case (src,dest) of
127 :     (Immed i, _) => if ~128<=i andalso i<128
128 :     then (ebyte(131) ^
129 :     emitImmext(nxt,dest) ^
130 :     ebyte(i))
131 :     else (ebyte(129) ^
132 :     emitImmext(nxt,dest) ^
133 :     elong(i))
134 :     | (Immed32 w, _) => if sizeintW32 w = SevenBits
135 :     then (ebyte(131) ^
136 :     emitImmext(nxt,dest) ^
137 :     ebyteW32(w))
138 :     else (ebyte(129) ^
139 :     emitImmext(nxt,dest) ^
140 :     elongW32(w))
141 :     | (_, Direct _) => (ebyte(frst+3) ^ emitext(src, dest))
142 :     | (Direct _, _) => (ebyte(frst+1) ^ emitext(src, dest))
143 :     | _ => die "gen2: bad args")
144 :     ******)
145 :    
146 :     fun gen2(frst,nxt, src, dest) =
147 :     (case (src,dest) of
148 :     (Immed i, _) =>
149 :     if sizeint(i) = Byte
150 :     then (ebyte(131) ^ emitImmext(nxt,dest) ^ ebyte(i))
151 :     else if dest = Direct 0
152 :     then ebyte (8 * nxt + 5) ^ elong i
153 :     else ebyte(129) ^ emitImmext(nxt,dest) ^ elong(i)
154 :     | (Immed32 w, _) =>
155 :     if sizeintW32 w = SevenBits
156 :     then (ebyte(131) ^ emitImmext(nxt,dest) ^ ebyteW32 w)
157 :     else if dest = Direct 0
158 :     then ebyte (8 * nxt + 5) ^ elongW32 w
159 :     else ebyte(129) ^ emitImmext(nxt,dest) ^ elongW32 w
160 :     | (_, Direct _) => (ebyte(frst+3) ^ emitext(src, dest))
161 :     | (Direct _, _) => (ebyte(frst+1) ^ emitext(src, dest))
162 :     | _ => die "gen2: bad args")
163 :    
164 :     fun incl(x as Direct d) = emit(ebyte(64+d))
165 :     | incl(x as Displace _) = emit(ebyte(255) ^ emitImmext(0,x))
166 :     | incl(x as Index _) = emit(ebyte(255) ^ emitImmext(0,x))
167 :     | incl _ = die "incl: bad args"
168 :    
169 :     fun decl(x as Direct d) = emit(ebyte(72+d))
170 :     | decl(x as Displace _) = emit(ebyte(255) ^ emitImmext(1,x))
171 :     | decl(x as Index _) = emit(ebyte(255) ^ emitImmext(1,x))
172 :     | decl _ = die "decl: bad args"
173 :    
174 :     fun addl(Immed 1, dest) = incl(dest)
175 :     | addl(src, dest) = emit(gen2( 0, 0, src, dest))
176 :    
177 :     fun subl(Immed 1, dest) = decl(dest)
178 :     | subl(src, dest) = emit(gen2( 40, 5, src, dest))
179 :    
180 :     fun orl (src, dest) = emit(gen2( 8, 1, src, dest))
181 :     fun xorl(src, dest) = emit(gen2( 48, 6, src, dest))
182 :     fun andl(src, dest) = emit(gen2( 32, 4, src, dest))
183 :     fun cmpl(src, dest) = emit(gen2( 56, 7, src, dest))
184 :    
185 :     fun xchg(Direct 0, Direct r) = emit(ebyte(144+r))
186 :     | xchg(Direct r, Direct 0) = emit(ebyte(144+r))
187 :     | xchg(x, y) = emit(ebyte(135) ^ emitext(x,y))
188 :    
189 :     fun notl(x as Direct _) = emit(ebyte(247) ^ emitImmext(2,x))
190 :     | notl(x as Displace _) = emit(ebyte(247) ^ emitImmext(2,x))
191 :     | notl _ = die "notl: bad args"
192 :    
193 :     fun negl(x as Direct _) = emit(ebyte(247) ^ emitImmext(3,x))
194 :     | negl(x as Displace _) = emit(ebyte(247) ^ emitImmext(3,x))
195 :     | negl _ = die "negl: bad args"
196 :    
197 :     fun movl(Immed i, Direct r) =
198 :     emit(ebyte(184+r) ^ elong(i))
199 :     | movl(Immed32 w, Direct r) =
200 :     emit(ebyte(184+r) ^ elongW32 w)
201 :     | movl(Immed i, dest) =
202 :     emit(ebyte(199) ^ emitImmext(0,dest) ^ elong(i))
203 :     | movl(Immed32 w, dest) =
204 :     emit(ebyte(199) ^ emitImmext(0,dest) ^ elongW32 w)
205 :     | movl(src, dest) = emit(gen2(136, 0, src, dest))
206 :    
207 :     fun movb(Immed i, y) =
208 :     if sizeint i <> Byte
209 :     then die "movb: immediate value is not byte-sized"
210 :     else emit (ebyte 198 ^ emitImmext(0, y) ^ ebyte i)
211 :     | movb(Immed32 w, y) =
212 :     if sizeintW32 w <> SevenBits
213 :     then die "movb: immediate word is not byte-sized"
214 :     else emit (ebyte 198 ^ emitImmext(0, y) ^ ebyteW32 w)
215 :     | movb(x, y as Direct y') = if y' > 3 then die "movb: bad register"
216 :     else emit(ebyte(138) ^ emitext(x,y))
217 :     | movb(x as Direct x', y) = if x' > 3 then die "movb: bad register"
218 :     else emit(ebyte(136) ^ emitext(x,y))
219 :     | movb _ = die "movb: bad args"
220 :    
221 :     fun movzx(x, y as Direct _) = emit(ebyte(15) ^ ebyte(182) ^ emitext(x,y))
222 :     | movzx _ = die "movzx: bad args"
223 :    
224 :     fun stos(Direct 0) = emit(ebyte(171))
225 :     | stos _ = die "stos: bad args"
226 :    
227 :     fun push(Direct d) = emit(ebyte(80 + d))
228 :     | push _ = die "push: bad args"
229 :    
230 :     fun pop(Direct d) = emit(ebyte(88 + d))
231 :     | pop _ = die "pop: bad args"
232 :    
233 :     fun shift(_,Immed 0, _) = ()
234 :     | shift(TTT, Immed 1, dest) =
235 :     emit(ebyte(209) ^ emitImmext(TTT,dest))
236 :     | shift(TTT, cnt as Immed i, dest) =
237 :     emit(ebyte(193) ^ emitImmext(TTT,dest) ^ ebyte(i))
238 :     | shift(TTT, cnt as Immed32 w, dest) =
239 :     emit(ebyte(193) ^ emitImmext(TTT,dest) ^ ebyteW32 w)
240 :     | shift(TTT, cnt as Direct 1, dest) =
241 :     emit(ebyte(211) ^ emitImmext(TTT,dest))
242 :     | shift _ = die "shift: bad args"
243 :    
244 :     fun asll(cnt, dest) = shift(4, cnt, dest)
245 :     fun asrl(cnt, dest) = shift(7, cnt, dest)
246 :     fun lsrl(cnt, dest) = shift(5, cnt, dest)
247 :    
248 :     (****
249 :     fun lea(Displace(s, 0),Direct r) =
250 :     emit(ebyte(139) ^ ebyte(3*64 + 8*r + s))
251 :     | lea(Displace(s, i),Direct r) = emit(
252 :     ebyte(141) ^
253 :     (case sizeint(i) of
254 :     Byte => (ebyte(1*64 + 8*r + s) ^ ebyte(i))
255 :     | _ => (ebyte(2*64 + 8*r + s) ^ elong(i))))
256 :     | lea(Immedlab l, Direct r) = jump(LEA(r), l)
257 :     | lea _ = die "lea: bad args"
258 :     ****)
259 :    
260 :     fun lea(Displace(s, 0), Direct d) = movl (Direct s, Direct d)
261 :     | lea(s as Displace _, d as Direct _) = emit(ebyte(141) ^ emitext(s,d))
262 :     | lea(s as Index _, d as Direct _) = emit(ebyte(141) ^ emitext(s,d))
263 :     | lea(Immedlab l, Direct d) = jump(LEA(d), l)
264 :     | lea _ = die "lea: bad args"
265 :    
266 :     fun btst(src as Immed i, dst as Direct _) = emit(
267 :     ebyte(15) ^
268 :     ebyte(186) ^
269 :     emitImmext(4,dst) ^
270 :     ebyte(i) )
271 :     | btst(src as Immed i, dst as Displace _) = emit(
272 :     ebyte(15) ^
273 :     ebyte(186) ^
274 :     emitImmext(4,dst) ^
275 :     ebyte(i) )
276 :     | btst(src as Immed32 w, dst as Direct _) = emit(
277 :     ebyte(15) ^
278 :     ebyte(186) ^
279 :     emitImmext(4,dst) ^
280 :     ebyteW32 w)
281 :     | btst(src as Immed32 w, dst as Displace _) = emit(
282 :     ebyte(15) ^
283 :     ebyte(186) ^
284 :     emitImmext(4,dst) ^
285 :     ebyteW32 w)
286 :     | btst _ = die "btst: bad args"
287 :    
288 :     fun emitlab(i,lab) = jump(LABPTR(i), lab)
289 :    
290 :     local fun jcc i (Immedlab lab) = jump (Jcc i, lab)
291 :     | jcc _ _ = die "jcc: bad args"
292 :     in
293 :     val jne = jcc 5
294 :     val jeq = jcc 4
295 :     val jgt = jcc 15
296 :     val jge = jcc 13
297 :     val jlt = jcc 12
298 :     val jle = jcc 14
299 :     val jb = jcc 2
300 :     val jbe = jcc 6
301 :     val ja = jcc 7
302 :     val jae = jcc 3
303 :     val jc = jcc 2
304 :     val jnc = jcc 3
305 :     val jp = jcc 0xa
306 :     val jnp = jcc 0xb
307 :     end
308 :    
309 :     fun jra(arg as Immedlab lab) = jump(JMP, lab)
310 :     | jra _ = die "jra: bad args"
311 :    
312 :     fun jmp(x as Displace _) = emit(ebyte(255) ^ emitImmext(4,x))
313 :     | jmp(x as Direct _) = emit(ebyte(255) ^ emitImmext(4,x))
314 :     | jmp _ = die "jmp: bad args"
315 :    
316 :     (****
317 :     fun mull(x as Direct _, y as Direct _) = emit(
318 :     ebyte(15) ^
319 :     ebyte(175) ^
320 :     emitext(x,y))
321 :     | mull _ = die "mull: bad args"
322 :     ****)
323 :    
324 :     fun mull(Immed i, Direct r) =
325 :     emit(ebyte(105) ^ ebyte(3*64 + 8*r + r) ^ elong(i))
326 :     | mull(Immed32 w, Direct r) =
327 :     emit(ebyte(105) ^ ebyte(3*64 + 8*r + r) ^ elongW32 w)
328 :     | mull(src, dest as Direct _) =
329 :     emit(ebyte(15) ^ ebyte(175) ^ emitext(src,dest))
330 :     | mull _ = die "mull: bad args"
331 :    
332 :     fun mullExtend (args as (Immed i, Direct r)) =
333 :     if sizeint(i) = Byte
334 :     then emit(ebyte(107) ^ ebyte(3*64 + 8*r + r) ^ ebyte(i))
335 :     else
336 :     mull args
337 :     | mullExtend (args as (Immed32 w, Direct r)) =
338 :     if sizeintW32 w = SevenBits
339 :     then emit(ebyte(107) ^ ebyte(3*64 + 8*r + r) ^ ebyteW32 w)
340 :     else
341 :     mull args
342 :     | mullExtend args = mull args
343 :    
344 :    
345 :     fun divl (op1,op2) (x as Direct r) = emit(ebyte(op1) ^ emitImmext(op2,x))
346 :     | divl (op1,op2) (x as Displace _) = emit(ebyte(op1) ^ emitImmext(op2,x))
347 :     | divl _ _ = die "divl: bad args"
348 :    
349 :     val idivl = divl (247,7)
350 :     val udivl = divl (247,6)
351 :    
352 :     fun cdq() = emit(ebyte(153))
353 :    
354 :     (******************** Floating point operations *******************)
355 :    
356 :     (* Instead of using separate functions for those operations that pop
357 :     the 80387 stack (e.g. faddp, fstp, etc.), these functions take a
358 :     boolean argument that specifies whether to pop. *)
359 :    
360 :     (* floatarith() emits an arithmetic floating point instruction (e.g.,
361 :     fadd, fmul, etc.) The operation is encoded in the REG field of the
362 :     MOD/RM byte, which is generated by emitext(). These instructions
363 :     are binary, but one of the arguments must be the top of the
364 :     register stack. If the destination is the the top of the stack, the
365 :     instruction cannot pop. *)
366 :    
367 :     fun float_arith opr true (Floatreg 0, Floatreg r) =
368 :     emit (ebyte 0xde ^ emitext (Direct r, Direct opr))
369 :     | float_arith opr false (Floatreg 0, Floatreg r) =
370 :     emit (ebyte 0xdc ^ emitext (Direct r, Direct opr))
371 :     | float_arith opr false (Floatreg r, Floatreg 0) =
372 :     emit (ebyte 0xd8 ^ emitext (Direct r, Direct opr))
373 :     | float_arith opr false (src as Displace _, Floatreg 0) =
374 :     emit (ebyte 0xdc ^ emitext (src, Direct opr))
375 :     | float_arith _ _ _ = die "float_arith: bad args"
376 :    
377 :     val fadd = float_arith 0
378 :     val fmul = float_arith 1
379 :     val fcom = fn pop => if pop then float_arith 3 false
380 :     else float_arith 2 false
381 :     fun fucom true (Floatreg 0, Floatreg r) = emit (ebyte 0xdd ^ ebyte (r+0xe8))
382 :     | fucom false (Floatreg 0, Floatreg r) = emit (ebyte 0xdd ^ ebyte (r+0xe0))
383 :     | fucom _ _ = die "fucom"
384 :    
385 :     val fsub = float_arith 4
386 :     val fsubr = float_arith 5
387 :     val fdiv = float_arith 6
388 :     val fdivr = float_arith 7
389 :    
390 :     fun fchs () = emit (ebyte 0xd9 ^ ebyte 0xe0)
391 :     fun fabs () = emit (ebyte 0xd9 ^ ebyte 0xe1)
392 :     fun fstsw () = emit (ebyte 0x9b ^ ebyte 0xdf ^ ebyte 0xe0)
393 :     fun fnstsw() = emit (ebyte 0xdf ^ ebyte 0xe0)
394 :    
395 :    
396 :     fun fld (Floatreg r) =
397 :     emit (ebyte 0xd9 ^ emitext (Direct r, Direct 0))
398 :     | fld (src as Displace _) =
399 :     emit (ebyte 0xdd ^ emitext (src, Direct 0))
400 :     | fld (src as Index _) =
401 :     emit (ebyte 0xdd ^ emitext (src, Direct 0))
402 :     | fld _ = die "fld: bad args"
403 :    
404 :     fun fild (src as Displace _) =
405 :     emit (ebyte 0xdb ^ emitext (src, Direct 0))
406 :     | fild (src as Index _) =
407 :     emit (ebyte 0xdb ^ emitext (src, Direct 0))
408 :     | fild _ = die "fild: bad args"
409 :    
410 :     fun fst pop dst =
411 :     let val opr = if pop then 3 else 2
412 :     in
413 :     emit (ebyte 0xdd);
414 :     case dst
415 :     of Floatreg r => emit (emitext (Direct r, Direct opr))
416 :     | Displace _ => emit (emitext (dst, Direct opr))
417 :     | Index _ => emit (emitext (dst, Direct opr))
418 :     | _ => die "fst: bad args"
419 :     end
420 :    
421 :     (********************* Misc. Functions *********************)
422 :    
423 :     fun sahf() = emit(ebyte(158))
424 :    
425 :     fun into () = emit(ebyte(206))
426 :    
427 :     fun comment _ = ()
428 :    
429 :     val finish = Emitter.finish
430 :    
431 :     end (* functor X86MCode *)
432 :    
433 :     (*
434 :     * $Log: x86mcode.sml,v $
435 :     * Revision 1.1.1.1 1997/01/14 01:38:50 george
436 :     * Version 109.24
437 :     *
438 :     *)

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