Annotation of /sml/trunk/src/MLRISC/x86/x86.mdl

Parent Directory | Revision Log

---

Revision 951 - (view) (download)

1 :	leunga	746	(*
2 :			* 32bit, x86 instruction set.
3 :			*
4 :			* Note:
5 :			* 1. Segmentation registers and other weird stuff are not modelled.
6 :			* 2. The instruction set that I model is 32-bit oriented.
7 :			* I don't try to fit that 16-bit mode stuff in.
8 :			* 3. BCD arithmetic is missing
9 :			* 4. Multi-precision stuff is incomplete
10 :			* 5. No MMX (maybe we'll add this in later)
11 :			* 6. Slegdehammer extensions from AMD (more later)
12 :			*
13 :			* Allen Leung (leunga@cs.nyu.edu)
14 :			*
15 :			*)
16 :			architecture X86 =
17 :			struct
18 :
19 :			superscalar (* superscalar machine *)
20 :
21 :			little endian (* little endian architecture *)
22 :
23 :			lowercase assembly (* print assembly in lower case *)
24 :
25 :			(*------------------------------------------------------------------------
26 :			* Note: While the x86 has only 8 integer and 8 floating point registers,
27 :			* the SMLNJ compiler fakes it by assuming that it has 32 integer
28 :			* and 32 floating point registers. That's why we have 32 integer
29 :			* and 32 floating point registers in this description.
30 :			* Probably pseudo memory registers should understood directly by
31 :			* the md tool.
32 :			*
33 :			*------------------------------------------------------------------------*)
34 :
35 :			storage
36 :			GP = $r[32] of 32 bits
37 :			asm: (fn (0,8) => "%al" | (0,16) => "%ax" | (0,32) => "%eax"
38 :			| (1,8) => "%cl" | (1,16) => "%cx" | (1,32) => "%ecx"
39 :			| (2,8) => "%dl" | (2,16) => "%dx" | (2,32) => "%edx"
40 :			| (3,8) => "%bl" | (3,16) => "%bx" | (3,32) => "%ebx"
41 :			| (4,16) => "%sp" | (4,32) => "%esp"
42 :			| (5,16) => "%bp" | (5,32) => "%ebp"
43 :			| (6,16) => "%si" | (6,32) => "%esi"
44 :			| (7,16) => "%di" | (7,32) => "%edi"
45 :			| (r,_) => "%"^Int.toString r
46 :			)
47 :			| FP = $f[32] of 64 bits
48 :			asm: (fn (f,_) =>
49 :			if f < 8 then "%st("^Int.toString f^")"
50 :			else "%f"^Int.toString f (* pseudo register *)
51 :			)
52 :			| CC = $cc[] of 32 bits aliasing GP asm: "cc"
53 :			| EFLAGS = $eflags[1] of 32 bits asm: "$eflags"
54 :			| FFLAGS = $fflags[1] of 32 bits asm: "$fflags"
55 :			| MEM = $m[] of 8 aggregable bits asm: "mem"
56 :			| CTRL = $ctrl[] asm: "ctrl"
57 :
58 :			locations
59 :			eax = $r[0]
60 :			and ecx = $r[1]
61 :			and edx = $r[2]
62 :			and ebx = $r[3]
63 :			and esp = $r[4]
64 :			and ebp = $r[5]
65 :			and esi = $r[6]
66 :			and edi = $r[7]
67 :			and stackptrR = $r[4]
68 :			and ST(x) = $f[x]
69 :	leunga	775	and ST0 = $f[0]
70 :	leunga	746	and asmTmpR = $r[0] (* not used *)
71 :			and fasmTmp = $f[0] (* not used *)
72 :			and eflags = $eflags[0]
73 :
74 :			(*------------------------------------------------------------------------
75 :			*
76 :			* Representation for various opcodes.
77 :			*
78 :			*------------------------------------------------------------------------*)
79 :			structure Instruction =
80 :			struct
81 :			(* An effective address can be any combination of
82 :			* base + index*scale + disp
83 :			* or
84 :			* B + I*SCALE + DISP
85 :			*
86 :			* where any component is optional. The operand datatype captures
87 :			* all these combinations.
88 :			*
89 :			* DISP == Immed | ImmedLabel | Const
90 :			* B == Displace{base=B, disp=0}
91 :			* B+DISP == Displace{base=B, disp=DISP}
92 :			* I*SCALE+DISP == Indexed{base=NONE,index=I,scale=SCALE,disp=D}
93 :			* B+I*SCALE+DISP == Indexed{base=SOME B,index=I,scale=SCALE,disp=DISP}
94 :			* Note1: The index register cannot be EBP.
95 :			* The disp field must be one of Immed, ImmedLabel, or Const.
96 :			*)
97 :
98 :			(* Note: Relative is only generated after sdi resolution *)
99 :			datatype operand =
100 :			Immed of Int32.int rtl: int
101 :	leunga	775	| ImmedLabel of T.labexp rtl: labexp
102 :	leunga	746	| Relative of int (* no semantics given *)
103 :	leunga	775	| LabelEA of T.labexp rtl: labexp (* XXX *)
104 :	leunga	746	| Direct of $GP rtl: $r[GP]
105 :			(* pseudo memory register for floating point *)
106 :			| FDirect of $FP rtl: $f[FP]
107 :			(* virtual floating point register *)
108 :			| FPR of $FP rtl: $f[FP]
109 :			| ST of $FP rtl: $f[FP]
110 :			(* pseudo memory register *)
111 :			| MemReg of $GP rtl: $r[GP]
112 :			| Displace of {base: $GP, disp:operand, mem:Region.region}
113 :			rtl: $m[$r[base] + disp : mem]
114 :			| Indexed of {base: $GP option, index: $GP, scale:int,
115 :			disp:operand, mem:Region.region}
116 :			rtl: $m[$r[base] + $r[index] << scale + disp : mem]
117 :
118 :			type addressing_mode = operand
119 :
120 :			type ea = operand
121 :
122 :			datatype cond! =
123 :			EQ "e" 0w4 | NE 0w5 | LT "l" 0w12 | LE 0w14 | GT "g" 0w15 | GE 0w13
124 :			| B 0w2 | BE (* below *) 0w6 | A 0w7 | AE (* above *) 0w3
125 :			| C 0w2 | NC (* if carry *) 0w3 | P 0wxa | NP (* if parity *) 0wxb
126 :			| O 0w0 | NO (* overflow *) 0w1
127 :
128 :			(* LOCK can only be used in front of
129 :			* (Intel ordering, not gasm ordering)
130 :			* ADC, ADD, AND, BT mem, reg/imm
131 :			* BTS, BTR, BTC, OR mem, reg/imm
132 :			* SBB, SUB, XOR mem, reg/imm
133 :			* XCHG reg, mem
134 :			* XCHG mem, reg
135 :			* DEC, INC, NEG, NOT mem
136 :			*)
137 :
138 :			datatype binaryOp! =
139 :	leunga	815	ADDL | SUBL | ANDL | ORL | XORL | SHLL | SARL | SHRL | MULL | IMULL
140 :			| ADCL | SBBL
141 :			| ADDW | SUBW | ANDW | ORW | XORW | SHLW | SARW | SHRW | MULW | IMULW
142 :			| ADDB | SUBB | ANDB | ORB | XORB | SHLB | SARB | SHRB | MULB | IMULB
143 :	leunga	746	| BTSW | BTCW | BTRW | BTSL | BTCL | BTRL
144 :			| ROLW | RORW | ROLL | RORL
145 :			| XCHGB | XCHGW | XCHGL
146 :
147 :			(* Moby need these but I'm not going to handle them in the optimzer
148 :			* until Moby starts generating these things
149 :			*)
150 :			| LOCK_ADCW "lock\n\tadcw"
151 :			| LOCK_ADCL "lock\n\tadcl"
152 :			| LOCK_ADDW "lock\n\taddw"
153 :			| LOCK_ADDL "lock\n\taddl"
154 :			| LOCK_ANDW "lock\n\tandw"
155 :			| LOCK_ANDL "lock\n\tandl"
156 :			| LOCK_BTSW "lock\n\tbtsw"
157 :			| LOCK_BTSL "lock\n\tbtsl"
158 :			| LOCK_BTRW "lock\n\tbtrw"
159 :			| LOCK_BTRL "lock\n\tbtrl"
160 :			| LOCK_BTCW "lock\n\tbtcw"
161 :			| LOCK_BTCL "lock\n\tbtcl"
162 :			| LOCK_ORW "lock\n\torw"
163 :			| LOCK_ORL "lock\n\torl"
164 :			| LOCK_SBBW "lock\n\tsbbw"
165 :			| LOCK_SBBL "lock\n\tsbbl"
166 :			| LOCK_SUBW "lock\n\tsubw"
167 :			| LOCK_SUBL "lock\n\tsubl"
168 :			| LOCK_XORW "lock\n\txorw"
169 :			| LOCK_XORL "lock\n\txorl"
170 :			| LOCK_XADDB "lock\n\txaddb"
171 :			| LOCK_XADDW "lock\n\txaddw"
172 :			| LOCK_XADDL "lock\n\txaddl"
173 :	leunga	815
174 :			(* One operand opcodes *)
175 :			datatype multDivOp! = MULL1 "mull" | IDIVL1 "idivl" | DIVL1 "divl"
176 :	leunga	746
177 :	leunga	797	datatype unaryOp! = DECL | INCL | NEGL | NOTL
178 :			| DECW | INCW | NEGW | NOTW
179 :			| DECB | INCB | NEGB | NOTB
180 :	leunga	746	| LOCK_DECL "lock\n\tdecl"
181 :			| LOCK_INCL "lock\n\tincl"
182 :			| LOCK_NEGL "lock\n\tnegl"
183 :			| LOCK_NOTL "lock\n\tnotl"
184 :
185 :			datatype bitOp! = BTW
186 :			| BTL
187 :			| LOCK_BTW "lock\n\tbtw"
188 :			| LOCK_BTL "lock\n\tbtl"
189 :
190 :			datatype move! = MOVL
191 :			| MOVB
192 :			| MOVW
193 :	leunga	815	| MOVSWL (* sx(word) -> long *)
194 :			| MOVZWL (* zx(word) -> long *)
195 :			| MOVSBL (* sx(byte) -> long *)
196 :			| MOVZBL (* zx(byte) -> long *)
197 :	leunga	746
198 :			(* The Intel manual is incorrect on the description of FDIV and FDIVR *)
199 :			datatype fbinOp! =
200 :			FADDP | FADDS
201 :			| FMULP | FMULS
202 :			| FCOMS
203 :			| FCOMPS
204 :			| FSUBP | FSUBS (* ST(1) := ST-ST(1); [pop] *)
205 :			| FSUBRP | FSUBRS (* ST(1) := ST(1)-ST; [pop] *)
206 :			| FDIVP | FDIVS (* ST(1) := ST/ST(1); [pop] *)
207 :			| FDIVRP | FDIVRS (* ST(1) := ST(1)/ST; [pop] *)
208 :			| FADDL
209 :			| FMULL
210 :			| FCOML
211 :			| FCOMPL
212 :			| FSUBL (* ST(1) := ST-ST(1); [pop] *)
213 :			| FSUBRL (* ST(1) := ST(1)-ST; [pop] *)
214 :			| FDIVL (* ST(1) := ST/ST(1); [pop] *)
215 :			| FDIVRL (* ST(1) := ST(1)/ST; [pop] *)
216 :
217 :			datatype fibinOp! =
218 :			FIADDS (0wxde,0) | FIMULS (0wxde,1)
219 :			| FICOMS (0wxde,2) | FICOMPS (0wxde,3)
220 :			| FISUBS (0wxde,4) | FISUBRS (0wxde,5)
221 :			| FIDIVS (0wxde,6) | FIDIVRS (0wxde,7)
222 :			| FIADDL (0wxda,0) | FIMULL (0wxda,1)
223 :			| FICOML (0wxda,2) | FICOMPL (0wxda,3)
224 :			| FISUBL (0wxda,4) | FISUBRL (0wxda,5)
225 :			| FIDIVL (0wxda,6) | FIDIVRL (0wxda,7)
226 :
227 :			datatype funOp! =
228 :			(* the first byte is always d9; the second byte is listed *)
229 :			FCHS 0wxe0
230 :			| FABS 0wxe1
231 :			| FTST 0wxe4
232 :			| FXAM 0wxe5
233 :			| FPTAN 0wxf2
234 :			| FPATAN 0wxf3
235 :			| FXTRACT 0wxf4
236 :			| FPREM1 0wxf5
237 :			| FDECSTP 0wxf6
238 :			| FINCSTP 0wxf7
239 :			| FPREM 0wxf8
240 :			| FYL2XP1 0wxf9
241 :			| FSQRT 0wxfa
242 :			| FSINCOS 0wxfb
243 :			| FRNDINT 0wxfc
244 :			| FSCALE 0wxfd
245 :			| FSIN 0wxfe
246 :			| FCOS 0wxff
247 :
248 :			datatype fenvOp! = FLDENV | FNLDENV | FSTENV | FNSTENV
249 :
250 :			(* Intel floating point precision *)
251 :			datatype fsize = FP32 "s" | FP64 "l" | FP80 "t"
252 :
253 :			(* Intel integer precision *)
254 :			datatype isize = I8 "8" | I16 "16" | I32 "32" | I64 "64"
255 :
256 :			end (* Instruction *)
257 :
258 :			(*------------------------------------------------------------------------
259 :			*
260 :			* Here, I'm going to define the semantics of the instructions
261 :			*
262 :			*------------------------------------------------------------------------*)
263 :			structure RTL =
264 :			struct
265 :
266 :			(* Get the basis *)
267 :			include "Tools/basis.mdl"
268 :			open Basis
269 :			infix 1 || (* parallel effects *)
270 :			infix 2 := (* assignment *)
271 :
272 :			(* Some type abbreviations *)
273 :			fun byte x = (x : #8 bits)
274 :			fun word x = (x : #16 bits)
275 :			fun long x = (x : #32 bits)
276 :			fun float x = (x : #32 bits)
277 :			fun double x = (x : #64 bits)
278 :			fun real80 x = (x : #80 bits)
279 :
280 :			(* Intel register abbreviations *)
281 :			val eax = $r[0] and ecx = $r[1] and edx = $r[2] and ebx = $r[3]
282 :			and esp = $r[4] and ebp = $r[5] and esi = $r[6] and edi = $r[7]
283 :
284 :			(* Condition codes bits in eflag.
285 :			* Let's give symbolic name for each bit as per the Intel doc.
286 :			*)
287 :			rtl setFlag : #n bits -> #n bits
288 :			fun flag b = andb($eflags[0] >> b, 1)
289 :			val CF = flag 0 and PF = flag 2
290 :			and ZF = flag 6 and SF = flag 7 and OF = flag 11
291 :
292 :			(* Now gets use the bits to express the conditions. Again from Intel. *)
293 :			(* conditions *) (* aliases *)
294 :			val B = CF == 1 val C = B and NAE = B
295 :			val BE = CF == 1 orelse ZF == 1 val NA = BE
296 :			val E = ZF == 1 val Z = E
297 :			val L = SF <> OF val NGE = L
298 :			val LE = SF <> OF orelse ZF == 1 val NG = LE
299 :			val NB = CF == 0 val AE = NB and NC = NB
300 :			val NBE = CF == 0 andalso ZF == 0 val A = NBE
301 :			val NE = ZF == 0 val NZ = NE
302 :			val NL = SF == OF val GE = NL
303 :			val NLE = ZF == 0 andalso SF == OF val G = NLE
304 :			val NO = OF == 0
305 :			val NP = PF == 0 val PO = NP
306 :			val NS = SF == 0
307 :			val O = OF == 1
308 :			val P = PF == 1 val PE = P
309 :			val S = SF == 1
310 :
311 :			rtl NOP{} = () (* duh! *)
312 :			rtl LEA{addr, r32} = $r[r32] := addr (* this is completely wrong! XXX *)
313 :
314 :			(* moves with type conversion *)
315 :			rtl MOVL{src,dst} = dst := long src
316 :			rtl MOVW{src,dst} = dst := word src
317 :			rtl MOVB{src,dst} = dst := byte src
318 :			rtl MOVSWL{src,dst} = dst := long(sx(word src))
319 :			rtl MOVZWL{src,dst} = dst := long(zx(word src))
320 :			rtl MOVSBL{src,dst} = dst := long(sx(byte src))
321 :			rtl MOVZBL{src,dst} = dst := long(zx(byte src))
322 :
323 :			(* semantics of integer arithmetic;
324 :			* all instructions sets the condition code
325 :			*)
326 :			fun binop typ oper {dst,src} = dst := typ(oper(dst,src))
327 :			fun arith typ oper {dst,src} = dst := typ(oper(dst,src))
328 :			|| $eflags[0] := ??? (* XXX *)
329 :			fun unary typ oper {opnd} = opnd := typ(oper opnd)
330 :
331 :			fun inc x = x + 1
332 :			fun dec x = x - 1
333 :
334 :			(* I'm too lazy to specify the semantics of these for now *)
335 :			rtl adc sbb bts btc btr rol ror xchg xadd cmpxchg
336 :			: #n bits * #n bits -> #n bits
337 :
338 :			rtl [ADD,SUB,AND,OR,XOR]^^B = map (arith byte) [(+),(-),andb,orb,xorb]
339 :			rtl [ADD,SUB,AND,OR,XOR]^^W = map (arith word) [(+),(-),andb,orb,xorb]
340 :			rtl [ADD,SUB,AND,OR,XOR]^^L = map (arith long) [(+),(-),andb,orb,xorb]
341 :			rtl [SHR,SHL,SAR]^^B = map (binop byte) [(>>),(<<),(~>>)]
342 :			rtl [SHR,SHL,SAR]^^W = map (binop word) [(>>),(<<),(~>>)]
343 :			rtl [SHR,SHL,SAR]^^L = map (binop long) [(>>),(<<),(~>>)]
344 :			rtl [NEG,NOT,INC,DEC]^^B = map (unary byte) [(~),notb,inc,dec]
345 :			rtl [NEG,NOT,INC,DEC]^^W = map (unary word) [(~),notb,inc,dec]
346 :			rtl [NEG,NOT,INC,DEC]^^L = map (unary long) [(~),notb,inc,dec]
347 :
348 :
349 :			rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^B =
350 :			map (arith byte) [adc,sbb,bts,btc,btr,rol,ror,xchg]
351 :			rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^W =
352 :			map (arith word) [adc,sbb,bts,btc,btr,rol,ror,xchg]
353 :			rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^L =
354 :			map (arith long) [adc,sbb,bts,btc,btr,rol,ror,xchg]
355 :
356 :			fun lockarith typ oper {src,dst}=
357 :			dst := typ(oper(dst,src))
358 :			|| Kill $eflags[0] (* XXX *)
359 :			fun lockunary typ oper {opnd} =
360 :			opnd := typ(oper(opnd))
361 :			|| Kill $eflags[0] (* XXX *)
362 :
363 :			rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^B =
364 :			map (lockarith byte) [(+),(-),andb,orb,xorb,xadd]
365 :			rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^W =
366 :			map (lockarith word) [(+),(-),andb,orb,xorb,xadd]
367 :			rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^L =
368 :			map (lockarith long) [(+),(-),andb,orb,xorb,xadd]
369 :			rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^B =
370 :			map (lockarith byte) [adc,sbb,bts,btc,btr,rol,ror,xchg]
371 :			rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^W =
372 :			map (lockarith word) [adc,sbb,bts,btc,btr,rol,ror,xchg]
373 :			rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^L =
374 :			map (lockarith long) [adc,sbb,bts,btc,btr,rol,ror,xchg]
375 :			rtl LOCK_^^[DEC,INC,NEG,NOT]^^L =
376 :			map (lockunary long) [dec,inc,(~),notb]
377 :			rtl LOCK_^^[CMPXCHG]^^B = map (lockarith byte) [cmpxchg]
378 :			rtl LOCK_^^[CMPXCHG]^^W = map (lockarith word) [cmpxchg]
379 :			rtl LOCK_^^[CMPXCHG]^^L = map (lockarith long) [cmpxchg]
380 :
381 :			(* Multiplication/division *)
382 :			rtl upperMultiply : #n bits * #n bits -> #n bits
383 :	leunga	815	rtl MULL1{src} = eax := muls(eax, src) ||
384 :			edx := upperMultiply(eax, src) ||
385 :			$eflags[0] := ???
386 :			rtl IDIVL1{src} = eax := divs(eax, src) ||
387 :			edx := rems(eax, src) ||
388 :			$eflags[0] := ???
389 :			rtl DIVL1{src} = edx := divu(eax, src) ||
390 :			edx := remu(eax, src) ||
391 :			$eflags[0] := ???
392 :	leunga	746
393 :			(* test[b,w,l] *)
394 :			rtl TESTB {lsrc,rsrc} = $eflags[0] := setFlag(andb(byte lsrc, rsrc))
395 :			rtl TESTW {lsrc,rsrc} = $eflags[0] := setFlag(andb(word lsrc, rsrc))
396 :			rtl TESTL {lsrc,rsrc} = $eflags[0] := setFlag(andb(long lsrc, rsrc))
397 :
398 :			(* setcc *)
399 :			fun set cc {opnd} = opnd := byte(cond(cc, 0xff, 0x0))
400 :			rtl SET^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
401 :			map set [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
402 :
403 :			(* conditional move *)
404 :			fun cmov cc {src,dst} = if cc then $r[dst] := long src else ()
405 :			rtl CMOV^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
406 :			map cmov [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
407 :
408 :			(* push and pops *)
409 :			rtl PUSHL {operand} = $m[esp - 4] := long(operand) || esp := esp - 4
410 :			rtl PUSHW {operand} = $m[esp - 2] := word(operand) || esp := esp - 2
411 :			rtl PUSHB {operand} = $m[esp - 1] := byte(operand) || esp := esp - 1
412 :			rtl POP {operand} = operand := long($m[esp]) || esp := esp + 4
413 :
414 :			(* semantics of branches and jumps *)
415 :			rtl JMP{operand} = Jmp(long operand)
416 :			fun jcc cc {opnd} = if cc then Jmp(long opnd) else ()
417 :			rtl J^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
418 :			map jcc [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
419 :	leunga	796	rtl CALL{opnd,defs,uses} =
420 :			Call(long opnd) ||
421 :			Kill $cellset[defs] ||
422 :			Use $cellset[uses]
423 :	leunga	746
424 :			(* semantics of floating point operators
425 :			* The 3-address fake operators first.
426 :			*)
427 :			fun fbinop typ oper {lsrc, rsrc, dst} = dst := typ(oper(lsrc, rsrc))
428 :			fun funary typ oper {src, dst} = dst := typ(oper src)
429 :			rtl F^^[ADD,SUB,MUL,DIV]^^L = map (fbinop double) f^^[add,sub,mul,div]
430 :			rtl F^^[ADD,SUB,MUL,DIV]^^S = map (fbinop float) f^^[add,sub,mul,div]
431 :			rtl F^^[ADD,SUB,MUL,DIV]^^T = map (fbinop real80) f^^[add,sub,mul,div]
432 :
433 :			(* semantics of trig/transendental functions are abstract *)
434 :			rtl fsqrt fsin fcos ftan fasin facos fatan fln fexp : #n bits -> #n bits
435 :			rtl F^^[CHS,ABS,SQRT,SIN,COS,TAN,ASIN,ACOS,ATAN,LN,EXP] =
436 :			map (funary real80)
437 :			f^^[neg,abs,sqrt,sin,cos,tan,asin,acos,atan,ln,exp]
438 :			end (* RTL *)
439 :
440 :			(*------------------------------------------------------------------------
441 :			* Machine Instruction encoding on the x86
442 :			* Because of variable width instructions.
443 :			* We decompose each byte field into a seperate format first, then combine
444 :			* then to form the real instructions
445 :			*------------------------------------------------------------------------*)
446 :			instruction formats 8 bits
447 :			modrm{mod:2, reg:3, rm:3}
448 :			| reg{opc:5, reg:3}
449 :			| sib{ss:2, index:3, base:3}
450 :			| immed8{imm:8}
451 :
452 :			instruction formats 32 bits
453 :			immed32{imm:32}
454 :
455 :			(*
456 :			* Variable format instructions
457 :			*)
458 :			instruction formats
459 :			immedOpnd{opnd} =
460 :			(case opnd of
461 :			I.Immed i32 => i32
462 :			| I.ImmedLabel le => lexp le
463 :			| I.LabelEA le => lexp le
464 :			| _ => error "immedOpnd"
465 :			)
466 :			| extension{opc, opnd} = (* generate an extension *)
467 :			(case opnd of
468 :			I.Direct r => modrm{mod=3, reg=opc, rm=r}
469 :			| I.MemReg _ => extension{opc,opnd=memReg opnd}
470 :			| I.FDirect _ => extension{opc,opnd=memReg opnd}
471 :			| I.Displace{base, disp, ...} =>
472 :			let val immed = immedOpnd{opnd=disp}
473 :			in () (* XXX *)
474 :			end
475 :			| I.Indexed{base=NONE, index, scale, disp, ...} => ()
476 :			| I.Indexed{base=SOME b, index, scale, disp, ...} => ()
477 :			| _ => error "immedExt"
478 :			)
479 :
480 :			instruction formats 16 bits
481 :			encodeST{prefix:8, opc:5, st: $FP 3}
482 :
483 :			instruction formats
484 :			encodeReg{prefix:8, reg: $GP 3, opnd} =
485 :			(emit prefix; immedExt{opc=reg, opnd=opnd})
486 :			| arith{opc1,opc2,src,dst} =
487 :			(case (src, dst) of
488 :			(I.ImmedLabel le, dst) => arith{opc1,opc2,src=I.Immed(lexp le),dst}
489 :			| (I.LabelEA le, dst) => arith{opc1,opc2,src=I.Immed(lexp le),dst}
490 :			| (I.Immed i,dst) => ()
491 :			| (src, I.Direct r) => encodeReg{prefix=opc1+op3,reg,opnd=src}
492 :			| (I.Direct r,dst) => encodeReg{prefix=opc1+0w1,reg,opnd=dst}
493 :			| _ => error "arith"
494 :			)
495 :
496 :			(*------------------------------------------------------------------------
497 :			* A bunch of routines for emitting assembly on the x86.
498 :			* This is a headache because the syntax is quite non-orthorgonal.
499 :			* So we have to write some code to help out the md tool
500 :			* Assembly note:
501 :			* Note: we are using the AT&T syntax (for Linux) and not the intel syntax
502 :			* memory operands have the form:
503 :			* section:disp(base, index, scale)
504 :			* Most of the complication is actually in emiting the correct
505 :			* operand syntax.
506 :			*------------------------------------------------------------------------*)
507 :
508 :			functor Assembly
509 :	george	823	(structure MemRegs : MEMORY_REGISTERS where I = Instr
510 :	george	889	val memRegBase : CellsBasis.cell option) =
511 :	leunga	746	struct
512 :	george	823	fun memReg r = MemRegs.memReg {reg=r, base=Option.valOf memRegBase}
513 :	leunga	746	fun emitInt32 i =
514 :			let val s = Int32.toString i
515 :			val s = if i >= 0 then s else "-"^String.substring(s,1,size s-1)
516 :			in emit s end
517 :
518 :	george	889	val {low=SToffset, ...} = C.cellRange CellsBasis.FP
519 :	leunga	746
520 :			fun emitScale 0 = emit "1"
521 :			| emitScale 1 = emit "2"
522 :			| emitScale 2 = emit "4"
523 :			| emitScale 3 = emit "8"
524 :			| emitScale _ = error "emitScale"
525 :
526 :			and eImmed(I.Immed (i)) = emitInt32 i
527 :			| eImmed(I.ImmedLabel lexp) = emit_labexp lexp
528 :			| eImmed _ = error "eImmed"
529 :
530 :	george	951
531 :	leunga	746	and emit_operand opn =
532 :			case opn of
533 :			I.Immed i => (emit "$"; emitInt32 i)
534 :			| I.ImmedLabel lexp => (emit "$"; emit_labexp lexp)
535 :			| I.LabelEA le => emit_labexp le
536 :			| I.Relative _ => error "emit_operand"
537 :			| I.Direct r => emitCell r
538 :			| I.MemReg r => emit_operand(memReg opn)
539 :			| I.ST f => emitCell f
540 :	george	889	| I.FPR f => (emit "%f"; emit(Int.toString(CellsBasis.registerNum f)))
541 :	leunga	746	| I.FDirect f => emit_operand(memReg opn)
542 :			| I.Displace{base,disp,mem,...} =>
543 :			(emit_disp disp; emit "("; emitCell base; emit ")";
544 :			emit_region mem)
545 :			| I.Indexed{base,index,scale,disp,mem,...} =>
546 :			(emit_disp disp; emit "(";
547 :			case base of
548 :			NONE => ()
549 :			| SOME base => emitCell base;
550 :			comma();
551 :			emitCell index; comma();
552 :			emitScale scale; emit ")"; emit_region mem)
553 :
554 :	george	889	and emit_operand8(I.Direct r) = emit(CellsBasis.toStringWithSize(r,8))
555 :	leunga	746	| emit_operand8 opn = emit_operand opn
556 :
557 :			and emit_disp(I.Immed 0) = ()
558 :			| emit_disp(I.Immed i) = emitInt32 i
559 :			| emit_disp(I.ImmedLabel lexp) = emit_labexp lexp
560 :			| emit_disp _ = error "emit_disp"
561 :
562 :			(* The gas assembler does not like the "$" prefix for immediate
563 :			* labels in certain instructions.
564 :			*)
565 :			fun stupidGas(I.ImmedLabel lexp) = emit_labexp lexp
566 :			| stupidGas opnd = (emit "*"; emit_operand opnd)
567 :
568 :			(* Display the floating point binary opcode *)
569 :			fun isMemOpnd(I.MemReg _) = true
570 :			| isMemOpnd(I.FDirect f) = true
571 :			| isMemOpnd(I.LabelEA _) = true
572 :			| isMemOpnd(I.Displace _) = true
573 :			| isMemOpnd(I.Indexed _) = true
574 :			| isMemOpnd _ = false
575 :			fun chop fbinOp =
576 :			let val n = size fbinOp
577 :			in case Char.toLower(String.sub(fbinOp,n-1)) of
578 :			(#"s" | #"l") => String.substring(fbinOp,0,n-1)
579 :			| _ => fbinOp
580 :			end
581 :
582 :	george	889	fun isST0 (I.ST r) = CellsBasis.registerNum r = 0
583 :	leunga	815	| isST0 _ = false
584 :	leunga	746
585 :			(* Special syntax for binary operators *)
586 :			fun emit_fbinaryOp(binOp,src,dst) =
587 :			if isMemOpnd src then
588 :			(emit_fbinOp binOp; emit "\t"; emit_operand src)
589 :			else (emit(chop(asm_fbinOp binOp)); emit "\t";
590 :	leunga	815	case (isST0 src, isST0 dst) of
591 :	leunga	746	(_, true) => (emit_operand src; emit ", %st")
592 :			| (true, _) => (emit "%st, "; emit_operand dst)
593 :			| _ => error "emit_fbinaryOp"
594 :			)
595 :
596 :			val emit_dst = emit_operand
597 :			val emit_src = emit_operand
598 :			val emit_opnd = emit_operand
599 :			val emit_opnd8 = emit_operand8
600 :			val emit_rsrc = emit_operand
601 :			val emit_lsrc = emit_operand
602 :			val emit_addr = emit_operand
603 :			val emit_src1 = emit_operand
604 :			val emit_ea = emit_operand
605 :			end (* Assembly *)
606 :
607 :
608 :			(*------------------------------------------------------------------------
609 :			*
610 :			* Reservation tables and pipeline definitions for scheduling.
611 :			* Faked for now as I don't have to time to look up the definitions
612 :			* from the Intel doc.
613 :			*
614 :			*------------------------------------------------------------------------*)
615 :
616 :			(* Function units *)
617 :			resource issue and mem and alu and falu and fmul and fdiv and branch
618 :
619 :			(* Different implementations of cpus *)
620 :			cpu default 2 [2 issue, 2 mem, 1 alu, 1 falu, 1 fmul] (* 2 issue machine *)
621 :
622 :			(* Definitions of various reservation tables *)
623 :			pipeline NOP _ = [issue]
624 :			and ARITH _ = [issue^^alu]
625 :			and LOAD _ = [issue^^mem]
626 :			and STORE _ = [issue^^mem,mem,mem]
627 :			and FARITH _ = [issue^^falu]
628 :			and FMUL _ = [issue^^fmul,fmul]
629 :			and FDIV _ = [issue^^fdiv,fdiv*50]
630 :			and BRANCH _ = [issue^^branch]
631 :
632 :			(*------------------------------------------------------------------------
633 :			*
634 :			* Compiler representation of the instruction set.
635 :			*
636 :			*------------------------------------------------------------------------*)
637 :			instruction
638 :			NOP
639 :			asm: ``nop''
640 :			rtl: ``NOP''
641 :
642 :			| JMP of operand * Label.label list
643 :			asm: ``jmp\t<stupidGas operand>''
644 :			rtl: ``JMP''
645 :
646 :			| JCC of {cond:cond, opnd:operand}
647 :			asm: ``j<cond>\t<stupidGas opnd>''
648 :			rtl: ``J<cond>''
649 :
650 :	leunga	815	| CALL of {opnd: operand, defs: $cellset, uses: $cellset,
651 :	blume	839	return: $cellset, cutsTo: Label.label list, mem: Region.region,
652 :			pops:Int32.int}
653 :	leunga	796	asm: ``call\t<stupidGas opnd><mem><
654 :			emit_defs(defs)><
655 :			emit_uses(uses)><
656 :	leunga	815	emit_cellset("return",return)><
657 :	leunga	796	emit_cutsTo cutsTo>''
658 :	leunga	746	rtl: ``CALL''
659 :
660 :			| ENTER of {src1:operand, src2:operand}
661 :			asm: ``enter\t<emit_operand src1>, <emit_operand src2>''
662 :
663 :			| LEAVE
664 :			asm: ``leave''
665 :
666 :			| RET of operand option
667 :			asm: ``ret<case option of NONE => ()
668 :			| SOME e => (emit "\t"; emit_operand e)>''
669 :
670 :			(* integer *)
671 :			| MOVE of {mvOp:move, src:operand, dst:operand}
672 :			asm: ``<mvOp>\t<src>, <dst>''
673 :			rtl: ``<mvOp>''
674 :
675 :			| LEA of {r32: $GP, addr: operand}
676 :			asm: ``leal\t<addr>, <r32>''
677 :			rtl: ``LEA''
678 :
679 :			| CMPL of {lsrc: operand, rsrc: operand}
680 :			asm: ``cmpl\t<rsrc>, <lsrc>''
681 :
682 :			| CMPW of {lsrc: operand, rsrc: operand}
683 :			``cmpb\t<rsrc>, <lsrc>''
684 :
685 :			| CMPB of {lsrc: operand, rsrc: operand}
686 :			``cmpb\t<rsrc>, <lsrc>''
687 :
688 :			| TESTL of {lsrc: operand, rsrc: operand}
689 :			asm: ``testl\t<rsrc>, <lsrc>''
690 :			rtl: ``TESTL''
691 :
692 :			| TESTW of {lsrc: operand, rsrc: operand}
693 :			asm: ``testw\t<rsrc>, <lsrc>''
694 :			rtl: ``TESTW''
695 :
696 :			| TESTB of {lsrc: operand, rsrc: operand}
697 :			asm: ``testb\t<rsrc>, <lsrc>''
698 :			rtl: ``TESTB''
699 :
700 :			| BITOP of {bitOp:bitOp, lsrc: operand, rsrc: operand}
701 :			``<bitOp>\t<rsrc>, <lsrc>''
702 :
703 :			| BINARY of {binOp:binaryOp, src:operand, dst:operand}
704 :			asm: (case (src,binOp) of
705 :			(I.Direct _, (* tricky business here for shifts *)
706 :			(I.SARL | I.SHRL | I.SHLL |
707 :			I.SARW | I.SHRW | I.SHLW |
708 :			I.SARB | I.SHRB | I.SHLB)) => ``<binOp>\t%cl, <dst>''
709 :			| _ => ``<binOp>\t<src>, <dst>''
710 :			)
711 :	leunga	815	(*rtl: ``<binOp>''*)
712 :	leunga	746
713 :	leunga	797	| CMPXCHG of {lock:bool, sz:isize, src: operand, dst:operand}
714 :			asm: (if lock then ``lock\n\t'' else ();
715 :			``cmpxchg'';
716 :			case sz of
717 :			I.I8 => ``b''
718 :			| I.I16 => ``w''
719 :			| I.I32 => ``l'';
720 :			``\t<src>, <dst>''
721 :			)
722 :
723 :	leunga	746	| MULTDIV of {multDivOp:multDivOp, src:operand}
724 :			asm: ``<multDivOp>\t<src>''
725 :
726 :	leunga	815	| MUL3 of {dst: $GP, src2: Int32.int, src1:operand}
727 :	leunga	746	(* Fermin: constant operand must go first *)
728 :	leunga	815	asm: ``imul\t$<emitInt32 src2>, <src1>, <dst>''
729 :	leunga	746
730 :			| UNARY of {unOp:unaryOp, opnd:operand}
731 :			asm: ``<unOp>\t<opnd>''
732 :			rtl: ``<unOp>''
733 :
734 :			(* set byte on condition code; note that
735 :			* this only sets the low order byte, so it also
736 :			* uses its operand.
737 :			*)
738 :			| SET of {cond:cond, opnd:operand}
739 :			asm: ``set<cond>\t<emit_opnd8 opnd>''
740 :			rtl: ``SET<cond>''
741 :
742 :			(* conditional move; Pentium Pro or higher only
743 :			* Destination must be a register.
744 :			*)
745 :			| CMOV of {cond:cond, src:operand, dst: $GP}
746 :			asm: ``cmov<cond>\t<src>, <dst>''
747 :			rtl: ``CMOV<cond>''
748 :
749 :			| PUSHL of operand
750 :			asm: ``pushl\t<operand>''
751 :			rtl: ``PUSHL''
752 :
753 :			| PUSHW of operand
754 :			asm: ``pushw\t<operand>''
755 :			rtl: ``PUSHW''
756 :
757 :			| PUSHB of operand
758 :			asm: ``pushb\t<operand>''
759 :			rtl: ``PUSHB''
760 :
761 :	leunga	815	| PUSHFD (* push $eflags onto stack *)
762 :			``pushfd''
763 :
764 :			| POPFD (* pop $eflags onto stack *)
765 :			``popfd''
766 :
767 :	leunga	746	| POP of operand
768 :			asm: ``popl\t<operand>''
769 :			rtl: ``POP''
770 :
771 :			| CDQ
772 :			``cdq''
773 :
774 :			| INTO
775 :			``into''
776 :
777 :			(* parallel copies *)
778 :			| COPY of {dst: $GP list, src: $GP list, tmp:operand option}
779 :			asm: emitInstrs (Shuffle.shuffle{tmp,dst,src})
780 :			mc: emitInstrs (Shuffle.shuffle{tmp,dst,src})
781 :
782 :			| FCOPY of {dst: $FP list, src: $FP list, tmp:operand option}
783 :			asm: emitInstrs (Shuffle.shufflefp{tmp,dst,src})
784 :			mc: emitInstrs (Shuffle.shuffle{tmp,dst,src})
785 :
786 :			(* floating *)
787 :			| FBINARY of {binOp:fbinOp, src:operand, dst:operand}
788 :			asm: (emit_fbinaryOp(binOp,src,dst))
789 :
790 :			| FIBINARY of {binOp:fibinOp, src:operand}
791 :			asm: ``<binOp>\t<src>'' (* the implied destination is %ST(0) *)
792 :
793 :			| FUNARY of funOp
794 :			``<funOp>''
795 :
796 :			| FUCOM of operand
797 :			``fucom\t<operand>''
798 :
799 :			| FUCOMP of operand
800 :			``fucomp\t<operand>''
801 :
802 :			| FUCOMPP
803 :			``fucompp''
804 :
805 :			| FCOMPP
806 :			``fcompp''
807 :
808 :			| FXCH of {opnd: $FP}
809 :			``fxch\t<opnd>''
810 :
811 :			| FSTPL of operand
812 :			asm: (case operand of
813 :			I.ST _ => ``fstp\t<operand>''
814 :			| _ => ``fstpl\t<operand>''
815 :			)
816 :
817 :			| FSTPS of operand
818 :			``fstps\t<operand>''
819 :
820 :			| FSTPT of operand
821 :			``fstps\t<operand>''
822 :
823 :			| FSTL of operand
824 :			asm: (case operand of
825 :			I.ST _ => ``fst\t<operand>''
826 :			| _ => ``fstl\t<operand>''
827 :			)
828 :
829 :			| FSTS of operand
830 :			``fsts\t<operand>''
831 :
832 :			| FLD1
833 :			``fld1''
834 :
835 :			| FLDL2E
836 :			``fldl2e''
837 :
838 :			| FLDL2T
839 :			``fldl2t''
840 :
841 :			| FLDLG2
842 :			``fldlg2''
843 :
844 :			| FLDLN2
845 :			``fldln2''
846 :
847 :			| FLDPI
848 :			``fldpi''
849 :
850 :			| FLDZ
851 :			``fldz''
852 :
853 :			| FLDL of operand
854 :			asm: (case operand of
855 :			I.ST _ => ``fld\t<operand>''
856 :			| _ => ``fldl\t<operand>''
857 :			)
858 :
859 :			| FLDS of operand
860 :			``flds\t<operand>''
861 :
862 :			| FLDT of operand
863 :			``fldt\t<operand>''
864 :
865 :			| FILD of operand
866 :			``fild\t<operand>''
867 :
868 :			| FILDL of operand
869 :			``fildl\t<operand>''
870 :
871 :			| FILDLL of operand
872 :			``fildll\t<operand>''
873 :
874 :			| FNSTSW
875 :			``fnstsw''
876 :
877 :			| FENV of {fenvOp:fenvOp, opnd:operand} (* load/store environment *)
878 :			``<fenvOp>\t<opnd>''
879 :
880 :			(* pseudo floating ops *)
881 :			| FMOVE of {fsize:fsize, src:operand, dst:operand}
882 :			``fmove<fsize>\t<src>, <dst>''
883 :
884 :			| FILOAD of {isize:isize, ea:operand, dst:operand}
885 :			``fiload<isize>\t<ea>, <dst>''
886 :
887 :			| FBINOP of {fsize:fsize,
888 :			binOp:fbinOp, lsrc:operand, rsrc:operand, dst:operand}
889 :			``<binOp><fsize>\t<lsrc>, <rsrc>, <dst>''
890 :			(* rtl: ``<binOp><fsize>'' *)
891 :
892 :			| FIBINOP of {isize:isize,
893 :			binOp:fibinOp, lsrc:operand, rsrc:operand, dst:operand}
894 :			``<binOp><isize>\t<lsrc>, <rsrc>, <dst>''
895 :			(* rtl: ``<binOp><isize>'' *)
896 :
897 :			| FUNOP of {fsize:fsize, unOp:funOp, src:operand, dst:operand}
898 :			``<unOp><fsize>\t<src>, <dst>''
899 :			(* rtl: [[unOp fsize]] *)
900 :
901 :			| FCMP of {fsize:fsize, lsrc:operand, rsrc:operand}
902 :			``fcmp<fsize>\t<lsrc>, <rsrc>''
903 :			(* rtl: [["FCMP" fsize]] *)
904 :
905 :			(* misc *)
906 :	leunga	815	| SAHF (* %flags -> %ah *)
907 :	leunga	746	``sahf''
908 :
909 :	leunga	815	| LAHF (* %ah -> %flags *)
910 :			``lahf''
911 :
912 :	leunga	746	(* annotations *)
913 :			| ANNOTATION of {i:instruction, a:Annotations.annotation}
914 :			asm: (comment(Annotations.toString a); nl(); emitInstr i)
915 :
916 :			| SOURCE of {}
917 :			asm: ``source''
918 :			mc: ()
919 :
920 :			| SINK of {}
921 :			asm: ``sink''
922 :			mc: ()
923 :
924 :			| PHI of {}
925 :			asm: ``phi''
926 :			mc: ()
927 :
928 :			(*------------------------------------------------------------------------
929 :			* Some helper routines for the SSA optimizer.
930 :			* These should go away soon.
931 :			*------------------------------------------------------------------------*)
932 :			structure SSA =
933 :			struct
934 :	leunga	775	fun operand(ty, I.Immed i) = T.LI(T.I.fromInt32(32,i))
935 :	leunga	746	(*| operand(ty, I.ImmedLabel le) = T.LABEL le*)
936 :			| operand(ty, I.Direct r) = T.REG(ty, r)
937 :			| operand _ = error "operand"
938 :			end
939 :			(*------------------------------------------------------------------------
940 :			* Some helper routines for the rewriting module.
941 :			* These should go away soon.
942 :			*------------------------------------------------------------------------*)
943 :			structure Rewrite =
944 :			struct
945 :			fun rewriteOperandUse (rs,rt,opnd) =
946 :			(case opnd
947 :			of I.Direct r => if C.sameColor(r,rs) then I.Direct rt else opnd
948 :			| I.Displace{base, disp, mem} =>
949 :			if C.sameColor(base,rs)
950 :			then I.Displace{base=rt, disp=disp, mem=mem}
951 :			else opnd
952 :			| I.Indexed{base as SOME b, index, scale, disp, mem} => let
953 :			val base'= if C.sameColor(b,rs) then SOME rt else base
954 :			val index'=if C.sameColor(index,rs) then rt else index
955 :			in I.Indexed{base=base', index=index', scale=scale,
956 :			disp=disp, mem=mem}
957 :			end
958 :			| I.Indexed{base, index, scale, disp, mem=mem} =>
959 :			if C.sameColor(index,rs) then
960 :			I.Indexed{base=base, index=rt, scale=scale, disp=disp, mem=mem}
961 :			else opnd
962 :			| _ => opnd
963 :			(*esac*))
964 :
965 :			fun rewriteOperandDef (rs,rt,opnd as I.Direct r) =
966 :			if C.sameColor(r,rs) then I.Direct rt else opnd
967 :
968 :			fun frewriteOperandDef(fs,ft,opnd as I.FDirect f) =
969 :			if C.sameColor(f,fs) then I.FDirect ft else opnd
970 :			| frewriteOperandDef(fs,ft,opnd as I.FPR f) =
971 :			if C.sameColor(f,fs) then I.FPR ft else opnd
972 :			| frewriteOperandDef opnd = opnd
973 :
974 :			fun frewriteOperandUse(fs,ft,opnd as I.FDirect r) =
975 :			if C.sameColor(r,fs) then I.FDirect ft else opnd
976 :			| frewriteOperandUse(fs,ft,opnd as I.FPR r) =
977 :			if C.sameColor(r,fs) then I.FPR ft else opnd
978 :			| frewriteOperandUse(fs,ft, opnd) = opnd
979 :			end
980 :
981 :			end
982 :

---

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