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

Parent Directory | Revision Log

---

Revision 208 - (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 :	monnier	207	then (if i>255 then die ("movb: immediate value " ^ Int.toString(i) ^ " is not byte-sized")
210 :			else (* Apparently, update on word8array is currently implemented
211 :			as int8array update --- so the Immed i can be 255. See
212 :			the eXene/lib/protocol/xrequest.sml file. *)
213 :			emit (ebyte 198 ^ emitImmext(0, y) ^ ebyte i))
214 :	monnier	16	else emit (ebyte 198 ^ emitImmext(0, y) ^ ebyte i)
215 :			| movb(Immed32 w, y) =
216 :			if sizeintW32 w <> SevenBits
217 :			then die "movb: immediate word is not byte-sized"
218 :			else emit (ebyte 198 ^ emitImmext(0, y) ^ ebyteW32 w)
219 :			| movb(x, y as Direct y') = if y' > 3 then die "movb: bad register"
220 :			else emit(ebyte(138) ^ emitext(x,y))
221 :			| movb(x as Direct x', y) = if x' > 3 then die "movb: bad register"
222 :			else emit(ebyte(136) ^ emitext(x,y))
223 :			| movb _ = die "movb: bad args"
224 :
225 :			fun movzx(x, y as Direct _) = emit(ebyte(15) ^ ebyte(182) ^ emitext(x,y))
226 :			| movzx _ = die "movzx: bad args"
227 :
228 :			fun stos(Direct 0) = emit(ebyte(171))
229 :			| stos _ = die "stos: bad args"
230 :
231 :			fun push(Direct d) = emit(ebyte(80 + d))
232 :			| push _ = die "push: bad args"
233 :
234 :			fun pop(Direct d) = emit(ebyte(88 + d))
235 :			| pop _ = die "pop: bad args"
236 :
237 :			fun shift(_,Immed 0, _) = ()
238 :			| shift(TTT, Immed 1, dest) =
239 :			emit(ebyte(209) ^ emitImmext(TTT,dest))
240 :			| shift(TTT, cnt as Immed i, dest) =
241 :			emit(ebyte(193) ^ emitImmext(TTT,dest) ^ ebyte(i))
242 :			| shift(TTT, cnt as Immed32 w, dest) =
243 :			emit(ebyte(193) ^ emitImmext(TTT,dest) ^ ebyteW32 w)
244 :			| shift(TTT, cnt as Direct 1, dest) =
245 :			emit(ebyte(211) ^ emitImmext(TTT,dest))
246 :			| shift _ = die "shift: bad args"
247 :
248 :			fun asll(cnt, dest) = shift(4, cnt, dest)
249 :			fun asrl(cnt, dest) = shift(7, cnt, dest)
250 :			fun lsrl(cnt, dest) = shift(5, cnt, dest)
251 :
252 :			(****
253 :			fun lea(Displace(s, 0),Direct r) =
254 :			emit(ebyte(139) ^ ebyte(3*64 + 8*r + s))
255 :			| lea(Displace(s, i),Direct r) = emit(
256 :			ebyte(141) ^
257 :			(case sizeint(i) of
258 :			Byte => (ebyte(1*64 + 8*r + s) ^ ebyte(i))
259 :			| _ => (ebyte(2*64 + 8*r + s) ^ elong(i))))
260 :			| lea(Immedlab l, Direct r) = jump(LEA(r), l)
261 :			| lea _ = die "lea: bad args"
262 :			****)
263 :
264 :			fun lea(Displace(s, 0), Direct d) = movl (Direct s, Direct d)
265 :			| lea(s as Displace _, d as Direct _) = emit(ebyte(141) ^ emitext(s,d))
266 :			| lea(s as Index _, d as Direct _) = emit(ebyte(141) ^ emitext(s,d))
267 :			| lea(Immedlab l, Direct d) = jump(LEA(d), l)
268 :			| lea _ = die "lea: bad args"
269 :
270 :			fun btst(src as Immed i, dst as Direct _) = emit(
271 :			ebyte(15) ^
272 :			ebyte(186) ^
273 :			emitImmext(4,dst) ^
274 :			ebyte(i) )
275 :			| btst(src as Immed i, dst as Displace _) = emit(
276 :			ebyte(15) ^
277 :			ebyte(186) ^
278 :			emitImmext(4,dst) ^
279 :			ebyte(i) )
280 :			| btst(src as Immed32 w, dst as Direct _) = emit(
281 :			ebyte(15) ^
282 :			ebyte(186) ^
283 :			emitImmext(4,dst) ^
284 :			ebyteW32 w)
285 :			| btst(src as Immed32 w, dst as Displace _) = emit(
286 :			ebyte(15) ^
287 :			ebyte(186) ^
288 :			emitImmext(4,dst) ^
289 :			ebyteW32 w)
290 :			| btst _ = die "btst: bad args"
291 :
292 :			fun emitlab(i,lab) = jump(LABPTR(i), lab)
293 :
294 :			local fun jcc i (Immedlab lab) = jump (Jcc i, lab)
295 :			| jcc _ _ = die "jcc: bad args"
296 :			in
297 :			val jne = jcc 5
298 :			val jeq = jcc 4
299 :			val jgt = jcc 15
300 :			val jge = jcc 13
301 :			val jlt = jcc 12
302 :			val jle = jcc 14
303 :			val jb = jcc 2
304 :			val jbe = jcc 6
305 :			val ja = jcc 7
306 :			val jae = jcc 3
307 :			val jc = jcc 2
308 :			val jnc = jcc 3
309 :			val jp = jcc 0xa
310 :			val jnp = jcc 0xb
311 :			end
312 :
313 :			fun jra(arg as Immedlab lab) = jump(JMP, lab)
314 :			| jra _ = die "jra: bad args"
315 :
316 :			fun jmp(x as Displace _) = emit(ebyte(255) ^ emitImmext(4,x))
317 :			| jmp(x as Direct _) = emit(ebyte(255) ^ emitImmext(4,x))
318 :			| jmp _ = die "jmp: bad args"
319 :
320 :			(****
321 :			fun mull(x as Direct _, y as Direct _) = emit(
322 :			ebyte(15) ^
323 :			ebyte(175) ^
324 :			emitext(x,y))
325 :			| mull _ = die "mull: bad args"
326 :			****)
327 :
328 :			fun mull(Immed i, Direct r) =
329 :			emit(ebyte(105) ^ ebyte(3*64 + 8*r + r) ^ elong(i))
330 :			| mull(Immed32 w, Direct r) =
331 :			emit(ebyte(105) ^ ebyte(3*64 + 8*r + r) ^ elongW32 w)
332 :			| mull(src, dest as Direct _) =
333 :			emit(ebyte(15) ^ ebyte(175) ^ emitext(src,dest))
334 :			| mull _ = die "mull: bad args"
335 :
336 :			fun mullExtend (args as (Immed i, Direct r)) =
337 :			if sizeint(i) = Byte
338 :			then emit(ebyte(107) ^ ebyte(3*64 + 8*r + r) ^ ebyte(i))
339 :			else
340 :			mull args
341 :			| mullExtend (args as (Immed32 w, Direct r)) =
342 :			if sizeintW32 w = SevenBits
343 :			then emit(ebyte(107) ^ ebyte(3*64 + 8*r + r) ^ ebyteW32 w)
344 :			else
345 :			mull args
346 :			| mullExtend args = mull args
347 :
348 :
349 :			fun divl (op1,op2) (x as Direct r) = emit(ebyte(op1) ^ emitImmext(op2,x))
350 :			| divl (op1,op2) (x as Displace _) = emit(ebyte(op1) ^ emitImmext(op2,x))
351 :			| divl _ _ = die "divl: bad args"
352 :
353 :			val idivl = divl (247,7)
354 :			val udivl = divl (247,6)
355 :
356 :			fun cdq() = emit(ebyte(153))
357 :
358 :			(******************** Floating point operations *******************)
359 :
360 :			(* Instead of using separate functions for those operations that pop
361 :			the 80387 stack (e.g. faddp, fstp, etc.), these functions take a
362 :			boolean argument that specifies whether to pop. *)
363 :
364 :			(* floatarith() emits an arithmetic floating point instruction (e.g.,
365 :			fadd, fmul, etc.) The operation is encoded in the REG field of the
366 :			MOD/RM byte, which is generated by emitext(). These instructions
367 :			are binary, but one of the arguments must be the top of the
368 :			register stack. If the destination is the the top of the stack, the
369 :			instruction cannot pop. *)
370 :
371 :			fun float_arith opr true (Floatreg 0, Floatreg r) =
372 :			emit (ebyte 0xde ^ emitext (Direct r, Direct opr))
373 :			| float_arith opr false (Floatreg 0, Floatreg r) =
374 :			emit (ebyte 0xdc ^ emitext (Direct r, Direct opr))
375 :			| float_arith opr false (Floatreg r, Floatreg 0) =
376 :			emit (ebyte 0xd8 ^ emitext (Direct r, Direct opr))
377 :			| float_arith opr false (src as Displace _, Floatreg 0) =
378 :			emit (ebyte 0xdc ^ emitext (src, Direct opr))
379 :			| float_arith _ _ _ = die "float_arith: bad args"
380 :
381 :			val fadd = float_arith 0
382 :			val fmul = float_arith 1
383 :			val fcom = fn pop => if pop then float_arith 3 false
384 :			else float_arith 2 false
385 :			fun fucom true (Floatreg 0, Floatreg r) = emit (ebyte 0xdd ^ ebyte (r+0xe8))
386 :			| fucom false (Floatreg 0, Floatreg r) = emit (ebyte 0xdd ^ ebyte (r+0xe0))
387 :			| fucom _ _ = die "fucom"
388 :
389 :			val fsub = float_arith 4
390 :			val fsubr = float_arith 5
391 :			val fdiv = float_arith 6
392 :			val fdivr = float_arith 7
393 :
394 :			fun fchs () = emit (ebyte 0xd9 ^ ebyte 0xe0)
395 :			fun fabs () = emit (ebyte 0xd9 ^ ebyte 0xe1)
396 :			fun fstsw () = emit (ebyte 0x9b ^ ebyte 0xdf ^ ebyte 0xe0)
397 :			fun fnstsw() = emit (ebyte 0xdf ^ ebyte 0xe0)
398 :
399 :
400 :			fun fld (Floatreg r) =
401 :			emit (ebyte 0xd9 ^ emitext (Direct r, Direct 0))
402 :			| fld (src as Displace _) =
403 :			emit (ebyte 0xdd ^ emitext (src, Direct 0))
404 :			| fld (src as Index _) =
405 :			emit (ebyte 0xdd ^ emitext (src, Direct 0))
406 :			| fld _ = die "fld: bad args"
407 :
408 :			fun fild (src as Displace _) =
409 :			emit (ebyte 0xdb ^ emitext (src, Direct 0))
410 :			| fild (src as Index _) =
411 :			emit (ebyte 0xdb ^ emitext (src, Direct 0))
412 :			| fild _ = die "fild: bad args"
413 :
414 :			fun fst pop dst =
415 :			let val opr = if pop then 3 else 2
416 :			in
417 :			emit (ebyte 0xdd);
418 :			case dst
419 :			of Floatreg r => emit (emitext (Direct r, Direct opr))
420 :			| Displace _ => emit (emitext (dst, Direct opr))
421 :			| Index _ => emit (emitext (dst, Direct opr))
422 :			| _ => die "fst: bad args"
423 :			end
424 :
425 :			(********************* Misc. Functions *********************)
426 :
427 :			fun sahf() = emit(ebyte(158))
428 :
429 :			fun into () = emit(ebyte(206))
430 :
431 :			fun comment _ = ()
432 :
433 :			val finish = Emitter.finish
434 :
435 :			end (* functor X86MCode *)
436 :
437 :			(*
438 :	monnier	113	* $Log$
439 :	monnier	16	*)

---

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