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/MLRISC/x86/x86.mdl
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1009 - (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 : george 1009 (* floating *)
778 : leunga 746 | FBINARY of {binOp:fbinOp, src:operand, dst:operand}
779 :     asm: (emit_fbinaryOp(binOp,src,dst))
780 :    
781 :     | FIBINARY of {binOp:fibinOp, src:operand}
782 :     asm: ``<binOp>\t<src>'' (* the implied destination is %ST(0) *)
783 :    
784 :     | FUNARY of funOp
785 :     ``<funOp>''
786 :    
787 :     | FUCOM of operand
788 :     ``fucom\t<operand>''
789 :    
790 :     | FUCOMP of operand
791 :     ``fucomp\t<operand>''
792 :    
793 :     | FUCOMPP
794 :     ``fucompp''
795 :    
796 :     | FCOMPP
797 :     ``fcompp''
798 :    
799 :     | FXCH of {opnd: $FP}
800 :     ``fxch\t<opnd>''
801 :    
802 :     | FSTPL of operand
803 :     asm: (case operand of
804 :     I.ST _ => ``fstp\t<operand>''
805 :     | _ => ``fstpl\t<operand>''
806 :     )
807 :    
808 :     | FSTPS of operand
809 :     ``fstps\t<operand>''
810 :    
811 :     | FSTPT of operand
812 :     ``fstps\t<operand>''
813 :    
814 :     | FSTL of operand
815 :     asm: (case operand of
816 :     I.ST _ => ``fst\t<operand>''
817 :     | _ => ``fstl\t<operand>''
818 :     )
819 :    
820 :     | FSTS of operand
821 :     ``fsts\t<operand>''
822 :    
823 :     | FLD1
824 :     ``fld1''
825 :    
826 :     | FLDL2E
827 :     ``fldl2e''
828 :    
829 :     | FLDL2T
830 :     ``fldl2t''
831 :    
832 :     | FLDLG2
833 :     ``fldlg2''
834 :    
835 :     | FLDLN2
836 :     ``fldln2''
837 :    
838 :     | FLDPI
839 :     ``fldpi''
840 :    
841 :     | FLDZ
842 :     ``fldz''
843 :    
844 :     | FLDL of operand
845 :     asm: (case operand of
846 :     I.ST _ => ``fld\t<operand>''
847 :     | _ => ``fldl\t<operand>''
848 :     )
849 :    
850 :     | FLDS of operand
851 :     ``flds\t<operand>''
852 :    
853 :     | FLDT of operand
854 :     ``fldt\t<operand>''
855 :    
856 :     | FILD of operand
857 :     ``fild\t<operand>''
858 :    
859 :     | FILDL of operand
860 :     ``fildl\t<operand>''
861 :    
862 :     | FILDLL of operand
863 :     ``fildll\t<operand>''
864 :    
865 :     | FNSTSW
866 :     ``fnstsw''
867 :    
868 :     | FENV of {fenvOp:fenvOp, opnd:operand} (* load/store environment *)
869 :     ``<fenvOp>\t<opnd>''
870 :    
871 :     (* pseudo floating ops *)
872 :     | FMOVE of {fsize:fsize, src:operand, dst:operand}
873 :     ``fmove<fsize>\t<src>, <dst>''
874 :    
875 :     | FILOAD of {isize:isize, ea:operand, dst:operand}
876 :     ``fiload<isize>\t<ea>, <dst>''
877 :    
878 :     | FBINOP of {fsize:fsize,
879 :     binOp:fbinOp, lsrc:operand, rsrc:operand, dst:operand}
880 :     ``<binOp><fsize>\t<lsrc>, <rsrc>, <dst>''
881 :     (* rtl: ``<binOp><fsize>'' *)
882 :    
883 :     | FIBINOP of {isize:isize,
884 :     binOp:fibinOp, lsrc:operand, rsrc:operand, dst:operand}
885 :     ``<binOp><isize>\t<lsrc>, <rsrc>, <dst>''
886 :     (* rtl: ``<binOp><isize>'' *)
887 :    
888 :     | FUNOP of {fsize:fsize, unOp:funOp, src:operand, dst:operand}
889 :     ``<unOp><fsize>\t<src>, <dst>''
890 :     (* rtl: [[unOp fsize]] *)
891 :    
892 :     | FCMP of {fsize:fsize, lsrc:operand, rsrc:operand}
893 :     ``fcmp<fsize>\t<lsrc>, <rsrc>''
894 :     (* rtl: [["FCMP" fsize]] *)
895 :    
896 :     (* misc *)
897 : leunga 815 | SAHF (* %flags -> %ah *)
898 : leunga 746 ``sahf''
899 :    
900 : leunga 815 | LAHF (* %ah -> %flags *)
901 :     ``lahf''
902 :    
903 : leunga 746 | SOURCE of {}
904 :     asm: ``source''
905 :     mc: ()
906 :    
907 :     | SINK of {}
908 :     asm: ``sink''
909 :     mc: ()
910 :    
911 :     | PHI of {}
912 :     asm: ``phi''
913 :     mc: ()
914 :    
915 :     (*------------------------------------------------------------------------
916 :     * Some helper routines for the SSA optimizer.
917 :     * These should go away soon.
918 :     *------------------------------------------------------------------------*)
919 :     structure SSA =
920 :     struct
921 : leunga 775 fun operand(ty, I.Immed i) = T.LI(T.I.fromInt32(32,i))
922 : leunga 746 (*| operand(ty, I.ImmedLabel le) = T.LABEL le*)
923 :     | operand(ty, I.Direct r) = T.REG(ty, r)
924 :     | operand _ = error "operand"
925 :     end
926 :     (*------------------------------------------------------------------------
927 :     * Some helper routines for the rewriting module.
928 :     * These should go away soon.
929 :     *------------------------------------------------------------------------*)
930 :     structure Rewrite =
931 :     struct
932 :     fun rewriteOperandUse (rs,rt,opnd) =
933 :     (case opnd
934 :     of I.Direct r => if C.sameColor(r,rs) then I.Direct rt else opnd
935 :     | I.Displace{base, disp, mem} =>
936 :     if C.sameColor(base,rs)
937 :     then I.Displace{base=rt, disp=disp, mem=mem}
938 :     else opnd
939 :     | I.Indexed{base as SOME b, index, scale, disp, mem} => let
940 :     val base'= if C.sameColor(b,rs) then SOME rt else base
941 :     val index'=if C.sameColor(index,rs) then rt else index
942 :     in I.Indexed{base=base', index=index', scale=scale,
943 :     disp=disp, mem=mem}
944 :     end
945 :     | I.Indexed{base, index, scale, disp, mem=mem} =>
946 :     if C.sameColor(index,rs) then
947 :     I.Indexed{base=base, index=rt, scale=scale, disp=disp, mem=mem}
948 :     else opnd
949 :     | _ => opnd
950 :     (*esac*))
951 :    
952 :     fun rewriteOperandDef (rs,rt,opnd as I.Direct r) =
953 :     if C.sameColor(r,rs) then I.Direct rt else opnd
954 :    
955 :     fun frewriteOperandDef(fs,ft,opnd as I.FDirect f) =
956 :     if C.sameColor(f,fs) then I.FDirect ft else opnd
957 :     | frewriteOperandDef(fs,ft,opnd as I.FPR f) =
958 :     if C.sameColor(f,fs) then I.FPR ft else opnd
959 :     | frewriteOperandDef opnd = opnd
960 :    
961 :     fun frewriteOperandUse(fs,ft,opnd as I.FDirect r) =
962 :     if C.sameColor(r,fs) then I.FDirect ft else opnd
963 :     | frewriteOperandUse(fs,ft,opnd as I.FPR r) =
964 :     if C.sameColor(r,fs) then I.FPR ft else opnd
965 :     | frewriteOperandUse(fs,ft, opnd) = opnd
966 :     end
967 :    
968 :     end
969 :    

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