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 797 - (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 :     ADDL | SUBL | ANDL | ORL | XORL | SHLL | SARL | SHRL | ADCL | SBBL
140 :     | ADDW | SUBW | ANDW | ORW | XORW | SHLW | SARW | SHRW
141 :     | ADDB | SUBB | ANDB | ORB | XORB | SHLB | SARB | SHRB
142 :     | BTSW | BTCW | BTRW | BTSL | BTCL | BTRL
143 :     | ROLW | RORW | ROLL | RORL
144 :     | XCHGB | XCHGW | XCHGL
145 :    
146 :     (* Moby need these but I'm not going to handle them in the optimzer
147 :     * until Moby starts generating these things
148 :     *)
149 :     | LOCK_ADCW "lock\n\tadcw"
150 :     | LOCK_ADCL "lock\n\tadcl"
151 :     | LOCK_ADDW "lock\n\taddw"
152 :     | LOCK_ADDL "lock\n\taddl"
153 :     | LOCK_ANDW "lock\n\tandw"
154 :     | LOCK_ANDL "lock\n\tandl"
155 :     | LOCK_BTSW "lock\n\tbtsw"
156 :     | LOCK_BTSL "lock\n\tbtsl"
157 :     | LOCK_BTRW "lock\n\tbtrw"
158 :     | LOCK_BTRL "lock\n\tbtrl"
159 :     | LOCK_BTCW "lock\n\tbtcw"
160 :     | LOCK_BTCL "lock\n\tbtcl"
161 :     | LOCK_ORW "lock\n\torw"
162 :     | LOCK_ORL "lock\n\torl"
163 :     | LOCK_SBBW "lock\n\tsbbw"
164 :     | LOCK_SBBL "lock\n\tsbbl"
165 :     | LOCK_SUBW "lock\n\tsubw"
166 :     | LOCK_SUBL "lock\n\tsubl"
167 :     | LOCK_XORW "lock\n\txorw"
168 :     | LOCK_XORL "lock\n\txorl"
169 :     | LOCK_XADDB "lock\n\txaddb"
170 :     | LOCK_XADDW "lock\n\txaddw"
171 :     | LOCK_XADDL "lock\n\txaddl"
172 :    
173 :     datatype multDivOp! = MULL | IDIVL | DIVL
174 :    
175 : leunga 797 datatype unaryOp! = DECL | INCL | NEGL | NOTL
176 :     | DECW | INCW | NEGW | NOTW
177 :     | DECB | INCB | NEGB | NOTB
178 : leunga 746 | LOCK_DECL "lock\n\tdecl"
179 :     | LOCK_INCL "lock\n\tincl"
180 :     | LOCK_NEGL "lock\n\tnegl"
181 :     | LOCK_NOTL "lock\n\tnotl"
182 :    
183 :     datatype bitOp! = BTW
184 :     | BTL
185 :     | LOCK_BTW "lock\n\tbtw"
186 :     | LOCK_BTL "lock\n\tbtl"
187 :    
188 :     datatype move! = MOVL
189 :     | MOVB
190 :     | MOVW
191 :     | MOVSWL
192 :     | MOVZWL (* word -> long *)
193 :     | MOVSBL
194 :     | MOVZBL (* byte -> long *)
195 :    
196 :     (* The Intel manual is incorrect on the description of FDIV and FDIVR *)
197 :     datatype fbinOp! =
198 :     FADDP | FADDS
199 :     | FMULP | FMULS
200 :     | FCOMS
201 :     | FCOMPS
202 :     | FSUBP | FSUBS (* ST(1) := ST-ST(1); [pop] *)
203 :     | FSUBRP | FSUBRS (* ST(1) := ST(1)-ST; [pop] *)
204 :     | FDIVP | FDIVS (* ST(1) := ST/ST(1); [pop] *)
205 :     | FDIVRP | FDIVRS (* ST(1) := ST(1)/ST; [pop] *)
206 :     | FADDL
207 :     | FMULL
208 :     | FCOML
209 :     | FCOMPL
210 :     | FSUBL (* ST(1) := ST-ST(1); [pop] *)
211 :     | FSUBRL (* ST(1) := ST(1)-ST; [pop] *)
212 :     | FDIVL (* ST(1) := ST/ST(1); [pop] *)
213 :     | FDIVRL (* ST(1) := ST(1)/ST; [pop] *)
214 :    
215 :     datatype fibinOp! =
216 :     FIADDS (0wxde,0) | FIMULS (0wxde,1)
217 :     | FICOMS (0wxde,2) | FICOMPS (0wxde,3)
218 :     | FISUBS (0wxde,4) | FISUBRS (0wxde,5)
219 :     | FIDIVS (0wxde,6) | FIDIVRS (0wxde,7)
220 :     | FIADDL (0wxda,0) | FIMULL (0wxda,1)
221 :     | FICOML (0wxda,2) | FICOMPL (0wxda,3)
222 :     | FISUBL (0wxda,4) | FISUBRL (0wxda,5)
223 :     | FIDIVL (0wxda,6) | FIDIVRL (0wxda,7)
224 :    
225 :     datatype funOp! =
226 :     (* the first byte is always d9; the second byte is listed *)
227 :     FCHS 0wxe0
228 :     | FABS 0wxe1
229 :     | FTST 0wxe4
230 :     | FXAM 0wxe5
231 :     | FPTAN 0wxf2
232 :     | FPATAN 0wxf3
233 :     | FXTRACT 0wxf4
234 :     | FPREM1 0wxf5
235 :     | FDECSTP 0wxf6
236 :     | FINCSTP 0wxf7
237 :     | FPREM 0wxf8
238 :     | FYL2XP1 0wxf9
239 :     | FSQRT 0wxfa
240 :     | FSINCOS 0wxfb
241 :     | FRNDINT 0wxfc
242 :     | FSCALE 0wxfd
243 :     | FSIN 0wxfe
244 :     | FCOS 0wxff
245 :    
246 :     datatype fenvOp! = FLDENV | FNLDENV | FSTENV | FNSTENV
247 :    
248 :     (* Intel floating point precision *)
249 :     datatype fsize = FP32 "s" | FP64 "l" | FP80 "t"
250 :    
251 :     (* Intel integer precision *)
252 :     datatype isize = I8 "8" | I16 "16" | I32 "32" | I64 "64"
253 :    
254 :     end (* Instruction *)
255 :    
256 :     (*------------------------------------------------------------------------
257 :     *
258 :     * Here, I'm going to define the semantics of the instructions
259 :     *
260 :     *------------------------------------------------------------------------*)
261 :     structure RTL =
262 :     struct
263 :    
264 :     (* Get the basis *)
265 :     include "Tools/basis.mdl"
266 :     open Basis
267 :     infix 1 || (* parallel effects *)
268 :     infix 2 := (* assignment *)
269 :    
270 :     (* Some type abbreviations *)
271 :     fun byte x = (x : #8 bits)
272 :     fun word x = (x : #16 bits)
273 :     fun long x = (x : #32 bits)
274 :     fun float x = (x : #32 bits)
275 :     fun double x = (x : #64 bits)
276 :     fun real80 x = (x : #80 bits)
277 :    
278 :     (* Intel register abbreviations *)
279 :     val eax = $r[0] and ecx = $r[1] and edx = $r[2] and ebx = $r[3]
280 :     and esp = $r[4] and ebp = $r[5] and esi = $r[6] and edi = $r[7]
281 :    
282 :     (* Condition codes bits in eflag.
283 :     * Let's give symbolic name for each bit as per the Intel doc.
284 :     *)
285 :     rtl setFlag : #n bits -> #n bits
286 :     fun flag b = andb($eflags[0] >> b, 1)
287 :     val CF = flag 0 and PF = flag 2
288 :     and ZF = flag 6 and SF = flag 7 and OF = flag 11
289 :    
290 :     (* Now gets use the bits to express the conditions. Again from Intel. *)
291 :     (* conditions *) (* aliases *)
292 :     val B = CF == 1 val C = B and NAE = B
293 :     val BE = CF == 1 orelse ZF == 1 val NA = BE
294 :     val E = ZF == 1 val Z = E
295 :     val L = SF <> OF val NGE = L
296 :     val LE = SF <> OF orelse ZF == 1 val NG = LE
297 :     val NB = CF == 0 val AE = NB and NC = NB
298 :     val NBE = CF == 0 andalso ZF == 0 val A = NBE
299 :     val NE = ZF == 0 val NZ = NE
300 :     val NL = SF == OF val GE = NL
301 :     val NLE = ZF == 0 andalso SF == OF val G = NLE
302 :     val NO = OF == 0
303 :     val NP = PF == 0 val PO = NP
304 :     val NS = SF == 0
305 :     val O = OF == 1
306 :     val P = PF == 1 val PE = P
307 :     val S = SF == 1
308 :    
309 :     rtl NOP{} = () (* duh! *)
310 :     rtl LEA{addr, r32} = $r[r32] := addr (* this is completely wrong! XXX *)
311 :    
312 :     (* moves with type conversion *)
313 :     rtl MOVL{src,dst} = dst := long src
314 :     rtl MOVW{src,dst} = dst := word src
315 :     rtl MOVB{src,dst} = dst := byte src
316 :     rtl MOVSWL{src,dst} = dst := long(sx(word src))
317 :     rtl MOVZWL{src,dst} = dst := long(zx(word src))
318 :     rtl MOVSBL{src,dst} = dst := long(sx(byte src))
319 :     rtl MOVZBL{src,dst} = dst := long(zx(byte src))
320 :    
321 :     (* semantics of integer arithmetic;
322 :     * all instructions sets the condition code
323 :     *)
324 :     fun binop typ oper {dst,src} = dst := typ(oper(dst,src))
325 :     fun arith typ oper {dst,src} = dst := typ(oper(dst,src))
326 :     || $eflags[0] := ??? (* XXX *)
327 :     fun unary typ oper {opnd} = opnd := typ(oper opnd)
328 :    
329 :     fun inc x = x + 1
330 :     fun dec x = x - 1
331 :    
332 :     (* I'm too lazy to specify the semantics of these for now *)
333 :     rtl adc sbb bts btc btr rol ror xchg xadd cmpxchg
334 :     : #n bits * #n bits -> #n bits
335 :    
336 :     rtl [ADD,SUB,AND,OR,XOR]^^B = map (arith byte) [(+),(-),andb,orb,xorb]
337 :     rtl [ADD,SUB,AND,OR,XOR]^^W = map (arith word) [(+),(-),andb,orb,xorb]
338 :     rtl [ADD,SUB,AND,OR,XOR]^^L = map (arith long) [(+),(-),andb,orb,xorb]
339 :     rtl [SHR,SHL,SAR]^^B = map (binop byte) [(>>),(<<),(~>>)]
340 :     rtl [SHR,SHL,SAR]^^W = map (binop word) [(>>),(<<),(~>>)]
341 :     rtl [SHR,SHL,SAR]^^L = map (binop long) [(>>),(<<),(~>>)]
342 :     rtl [NEG,NOT,INC,DEC]^^B = map (unary byte) [(~),notb,inc,dec]
343 :     rtl [NEG,NOT,INC,DEC]^^W = map (unary word) [(~),notb,inc,dec]
344 :     rtl [NEG,NOT,INC,DEC]^^L = map (unary long) [(~),notb,inc,dec]
345 :    
346 :    
347 :     rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^B =
348 :     map (arith byte) [adc,sbb,bts,btc,btr,rol,ror,xchg]
349 :     rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^W =
350 :     map (arith word) [adc,sbb,bts,btc,btr,rol,ror,xchg]
351 :     rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^L =
352 :     map (arith long) [adc,sbb,bts,btc,btr,rol,ror,xchg]
353 :    
354 :     fun lockarith typ oper {src,dst}=
355 :     dst := typ(oper(dst,src))
356 :     || Kill $eflags[0] (* XXX *)
357 :     fun lockunary typ oper {opnd} =
358 :     opnd := typ(oper(opnd))
359 :     || Kill $eflags[0] (* XXX *)
360 :    
361 :     rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^B =
362 :     map (lockarith byte) [(+),(-),andb,orb,xorb,xadd]
363 :     rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^W =
364 :     map (lockarith word) [(+),(-),andb,orb,xorb,xadd]
365 :     rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^L =
366 :     map (lockarith long) [(+),(-),andb,orb,xorb,xadd]
367 :     rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^B =
368 :     map (lockarith byte) [adc,sbb,bts,btc,btr,rol,ror,xchg]
369 :     rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^W =
370 :     map (lockarith word) [adc,sbb,bts,btc,btr,rol,ror,xchg]
371 :     rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^L =
372 :     map (lockarith long) [adc,sbb,bts,btc,btr,rol,ror,xchg]
373 :     rtl LOCK_^^[DEC,INC,NEG,NOT]^^L =
374 :     map (lockunary long) [dec,inc,(~),notb]
375 :     rtl LOCK_^^[CMPXCHG]^^B = map (lockarith byte) [cmpxchg]
376 :     rtl LOCK_^^[CMPXCHG]^^W = map (lockarith word) [cmpxchg]
377 :     rtl LOCK_^^[CMPXCHG]^^L = map (lockarith long) [cmpxchg]
378 :    
379 :     (* Multiplication/division *)
380 :     rtl upperMultiply : #n bits * #n bits -> #n bits
381 :     rtl MULL{src} = eax := muls(eax, src) ||
382 :     edx := upperMultiply(eax, src) ||
383 :     $eflags[0] := ???
384 :     rtl IDIVL{src} = eax := divs(eax, src) ||
385 :     edx := rems(eax, src) ||
386 :     $eflags[0] := ???
387 :     rtl DIVL{src} = edx := divu(eax, src) ||
388 :     edx := remu(eax, src) ||
389 :     $eflags[0] := ???
390 :    
391 :     (* test[b,w,l] *)
392 :     rtl TESTB {lsrc,rsrc} = $eflags[0] := setFlag(andb(byte lsrc, rsrc))
393 :     rtl TESTW {lsrc,rsrc} = $eflags[0] := setFlag(andb(word lsrc, rsrc))
394 :     rtl TESTL {lsrc,rsrc} = $eflags[0] := setFlag(andb(long lsrc, rsrc))
395 :    
396 :     (* setcc *)
397 :     fun set cc {opnd} = opnd := byte(cond(cc, 0xff, 0x0))
398 :     rtl SET^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
399 :     map set [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
400 :    
401 :     (* conditional move *)
402 :     fun cmov cc {src,dst} = if cc then $r[dst] := long src else ()
403 :     rtl CMOV^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
404 :     map cmov [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
405 :    
406 :     (* push and pops *)
407 :     rtl PUSHL {operand} = $m[esp - 4] := long(operand) || esp := esp - 4
408 :     rtl PUSHW {operand} = $m[esp - 2] := word(operand) || esp := esp - 2
409 :     rtl PUSHB {operand} = $m[esp - 1] := byte(operand) || esp := esp - 1
410 :     rtl POP {operand} = operand := long($m[esp]) || esp := esp + 4
411 :    
412 :     (* semantics of branches and jumps *)
413 :     rtl JMP{operand} = Jmp(long operand)
414 :     fun jcc cc {opnd} = if cc then Jmp(long opnd) else ()
415 :     rtl J^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
416 :     map jcc [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
417 : leunga 796 rtl CALL{opnd,defs,uses} =
418 :     Call(long opnd) ||
419 :     Kill $cellset[defs] ||
420 :     Use $cellset[uses]
421 : leunga 746
422 :     (* semantics of floating point operators
423 :     * The 3-address fake operators first.
424 :     *)
425 :     fun fbinop typ oper {lsrc, rsrc, dst} = dst := typ(oper(lsrc, rsrc))
426 :     fun funary typ oper {src, dst} = dst := typ(oper src)
427 :     rtl F^^[ADD,SUB,MUL,DIV]^^L = map (fbinop double) f^^[add,sub,mul,div]
428 :     rtl F^^[ADD,SUB,MUL,DIV]^^S = map (fbinop float) f^^[add,sub,mul,div]
429 :     rtl F^^[ADD,SUB,MUL,DIV]^^T = map (fbinop real80) f^^[add,sub,mul,div]
430 :    
431 :     (* semantics of trig/transendental functions are abstract *)
432 :     rtl fsqrt fsin fcos ftan fasin facos fatan fln fexp : #n bits -> #n bits
433 :     rtl F^^[CHS,ABS,SQRT,SIN,COS,TAN,ASIN,ACOS,ATAN,LN,EXP] =
434 :     map (funary real80)
435 :     f^^[neg,abs,sqrt,sin,cos,tan,asin,acos,atan,ln,exp]
436 :     end (* RTL *)
437 :    
438 :     (*------------------------------------------------------------------------
439 :     * Machine Instruction encoding on the x86
440 :     * Because of variable width instructions.
441 :     * We decompose each byte field into a seperate format first, then combine
442 :     * then to form the real instructions
443 :     *------------------------------------------------------------------------*)
444 :     instruction formats 8 bits
445 :     modrm{mod:2, reg:3, rm:3}
446 :     | reg{opc:5, reg:3}
447 :     | sib{ss:2, index:3, base:3}
448 :     | immed8{imm:8}
449 :    
450 :     instruction formats 32 bits
451 :     immed32{imm:32}
452 :    
453 :     (*
454 :     * Variable format instructions
455 :     *)
456 :     instruction formats
457 :     immedOpnd{opnd} =
458 :     (case opnd of
459 :     I.Immed i32 => i32
460 :     | I.ImmedLabel le => lexp le
461 :     | I.LabelEA le => lexp le
462 :     | _ => error "immedOpnd"
463 :     )
464 :     | extension{opc, opnd} = (* generate an extension *)
465 :     (case opnd of
466 :     I.Direct r => modrm{mod=3, reg=opc, rm=r}
467 :     | I.MemReg _ => extension{opc,opnd=memReg opnd}
468 :     | I.FDirect _ => extension{opc,opnd=memReg opnd}
469 :     | I.Displace{base, disp, ...} =>
470 :     let val immed = immedOpnd{opnd=disp}
471 :     in () (* XXX *)
472 :     end
473 :     | I.Indexed{base=NONE, index, scale, disp, ...} => ()
474 :     | I.Indexed{base=SOME b, index, scale, disp, ...} => ()
475 :     | _ => error "immedExt"
476 :     )
477 :    
478 :     instruction formats 16 bits
479 :     encodeST{prefix:8, opc:5, st: $FP 3}
480 :    
481 :     instruction formats
482 :     encodeReg{prefix:8, reg: $GP 3, opnd} =
483 :     (emit prefix; immedExt{opc=reg, opnd=opnd})
484 :     | arith{opc1,opc2,src,dst} =
485 :     (case (src, dst) of
486 :     (I.ImmedLabel le, dst) => arith{opc1,opc2,src=I.Immed(lexp le),dst}
487 :     | (I.LabelEA le, dst) => arith{opc1,opc2,src=I.Immed(lexp le),dst}
488 :     | (I.Immed i,dst) => ()
489 :     | (src, I.Direct r) => encodeReg{prefix=opc1+op3,reg,opnd=src}
490 :     | (I.Direct r,dst) => encodeReg{prefix=opc1+0w1,reg,opnd=dst}
491 :     | _ => error "arith"
492 :     )
493 :    
494 :     (*------------------------------------------------------------------------
495 :     * A bunch of routines for emitting assembly on the x86.
496 :     * This is a headache because the syntax is quite non-orthorgonal.
497 :     * So we have to write some code to help out the md tool
498 :     * Assembly note:
499 :     * Note: we are using the AT&T syntax (for Linux) and not the intel syntax
500 :     * memory operands have the form:
501 :     * section:disp(base, index, scale)
502 :     * Most of the complication is actually in emiting the correct
503 :     * operand syntax.
504 :     *------------------------------------------------------------------------*)
505 :    
506 :     functor Assembly
507 :     (structure MemRegs : MEMORY_REGISTERS where I = Instr) =
508 :     struct
509 :     val memReg = MemRegs.memReg
510 :     fun emitInt32 i =
511 :     let val s = Int32.toString i
512 :     val s = if i >= 0 then s else "-"^String.substring(s,1,size s-1)
513 :     in emit s end
514 :    
515 :     val {low=SToffset, ...} = C.cellRange C.FP
516 :    
517 :     fun emitScale 0 = emit "1"
518 :     | emitScale 1 = emit "2"
519 :     | emitScale 2 = emit "4"
520 :     | emitScale 3 = emit "8"
521 :     | emitScale _ = error "emitScale"
522 :    
523 :     and eImmed(I.Immed (i)) = emitInt32 i
524 :     | eImmed(I.ImmedLabel lexp) = emit_labexp lexp
525 :     | eImmed _ = error "eImmed"
526 :    
527 :     and emit_operand opn =
528 :     case opn of
529 :     I.Immed i => (emit "$"; emitInt32 i)
530 :     | I.ImmedLabel lexp => (emit "$"; emit_labexp lexp)
531 :     | I.LabelEA le => emit_labexp le
532 :     | I.Relative _ => error "emit_operand"
533 :     | I.Direct r => emitCell r
534 :     | I.MemReg r => emit_operand(memReg opn)
535 :     | I.ST f => emitCell f
536 :     | I.FPR f => (emit "%f"; emit(Int.toString(C.registerNum f)))
537 :     | I.FDirect f => emit_operand(memReg opn)
538 :     | I.Displace{base,disp,mem,...} =>
539 :     (emit_disp disp; emit "("; emitCell base; emit ")";
540 :     emit_region mem)
541 :     | I.Indexed{base,index,scale,disp,mem,...} =>
542 :     (emit_disp disp; emit "(";
543 :     case base of
544 :     NONE => ()
545 :     | SOME base => emitCell base;
546 :     comma();
547 :     emitCell index; comma();
548 :     emitScale scale; emit ")"; emit_region mem)
549 :    
550 :     and emit_operand8(I.Direct r) = emit(C.toStringWithSize(r,8))
551 :     | emit_operand8 opn = emit_operand opn
552 :    
553 :     and emit_disp(I.Immed 0) = ()
554 :     | emit_disp(I.Immed i) = emitInt32 i
555 :     | emit_disp(I.ImmedLabel lexp) = emit_labexp lexp
556 :     | emit_disp _ = error "emit_disp"
557 :    
558 :     (* The gas assembler does not like the "$" prefix for immediate
559 :     * labels in certain instructions.
560 :     *)
561 :     fun stupidGas(I.ImmedLabel lexp) = emit_labexp lexp
562 :     | stupidGas opnd = (emit "*"; emit_operand opnd)
563 :    
564 :     (* Display the floating point binary opcode *)
565 :     fun isMemOpnd(I.MemReg _) = true
566 :     | isMemOpnd(I.FDirect f) = true
567 :     | isMemOpnd(I.LabelEA _) = true
568 :     | isMemOpnd(I.Displace _) = true
569 :     | isMemOpnd(I.Indexed _) = true
570 :     | isMemOpnd _ = false
571 :     fun chop fbinOp =
572 :     let val n = size fbinOp
573 :     in case Char.toLower(String.sub(fbinOp,n-1)) of
574 :     (#"s" | #"l") => String.substring(fbinOp,0,n-1)
575 :     | _ => fbinOp
576 :     end
577 :    
578 :     fun isST32 (I.ST r) = C.registerNum r = 32
579 :     | isST32 _ = false
580 :    
581 :     (* Special syntax for binary operators *)
582 :     fun emit_fbinaryOp(binOp,src,dst) =
583 :     if isMemOpnd src then
584 :     (emit_fbinOp binOp; emit "\t"; emit_operand src)
585 :     else (emit(chop(asm_fbinOp binOp)); emit "\t";
586 :     case (isST32 src, isST32 dst) of
587 :     (_, true) => (emit_operand src; emit ", %st")
588 :     | (true, _) => (emit "%st, "; emit_operand dst)
589 :     | _ => error "emit_fbinaryOp"
590 :     )
591 :    
592 :     val emit_dst = emit_operand
593 :     val emit_src = emit_operand
594 :     val emit_opnd = emit_operand
595 :     val emit_opnd8 = emit_operand8
596 :     val emit_rsrc = emit_operand
597 :     val emit_lsrc = emit_operand
598 :     val emit_addr = emit_operand
599 :     val emit_src1 = emit_operand
600 :     val emit_ea = emit_operand
601 :     end (* Assembly *)
602 :    
603 :    
604 :     (*------------------------------------------------------------------------
605 :     *
606 :     * Reservation tables and pipeline definitions for scheduling.
607 :     * Faked for now as I don't have to time to look up the definitions
608 :     * from the Intel doc.
609 :     *
610 :     *------------------------------------------------------------------------*)
611 :    
612 :     (* Function units *)
613 :     resource issue and mem and alu and falu and fmul and fdiv and branch
614 :    
615 :     (* Different implementations of cpus *)
616 :     cpu default 2 [2 issue, 2 mem, 1 alu, 1 falu, 1 fmul] (* 2 issue machine *)
617 :    
618 :     (* Definitions of various reservation tables *)
619 :     pipeline NOP _ = [issue]
620 :     and ARITH _ = [issue^^alu]
621 :     and LOAD _ = [issue^^mem]
622 :     and STORE _ = [issue^^mem,mem,mem]
623 :     and FARITH _ = [issue^^falu]
624 :     and FMUL _ = [issue^^fmul,fmul]
625 :     and FDIV _ = [issue^^fdiv,fdiv*50]
626 :     and BRANCH _ = [issue^^branch]
627 :    
628 :     (*------------------------------------------------------------------------
629 :     *
630 :     * Compiler representation of the instruction set.
631 :     *
632 :     *------------------------------------------------------------------------*)
633 :     instruction
634 :     NOP
635 :     asm: ``nop''
636 :     rtl: ``NOP''
637 :    
638 :     | JMP of operand * Label.label list
639 :     asm: ``jmp\t<stupidGas operand>''
640 :     rtl: ``JMP''
641 :    
642 :     | JCC of {cond:cond, opnd:operand}
643 :     asm: ``j<cond>\t<stupidGas opnd>''
644 :     rtl: ``J<cond>''
645 :    
646 : leunga 796 | CALL of {opnd: operand, defs: $cellset,uses: $cellset,
647 :     cutsTo: Label.label list, mem: Region.region}
648 :     asm: ``call\t<stupidGas opnd><mem><
649 :     emit_defs(defs)><
650 :     emit_uses(uses)><
651 :     emit_cutsTo cutsTo>''
652 : leunga 746 rtl: ``CALL''
653 :    
654 :     | ENTER of {src1:operand, src2:operand}
655 :     asm: ``enter\t<emit_operand src1>, <emit_operand src2>''
656 :    
657 :     | LEAVE
658 :     asm: ``leave''
659 :    
660 :     | RET of operand option
661 :     asm: ``ret<case option of NONE => ()
662 :     | SOME e => (emit "\t"; emit_operand e)>''
663 :    
664 :     (* integer *)
665 :     | MOVE of {mvOp:move, src:operand, dst:operand}
666 :     asm: ``<mvOp>\t<src>, <dst>''
667 :     rtl: ``<mvOp>''
668 :    
669 :     | LEA of {r32: $GP, addr: operand}
670 :     asm: ``leal\t<addr>, <r32>''
671 :     rtl: ``LEA''
672 :    
673 :     | CMPL of {lsrc: operand, rsrc: operand}
674 :     asm: ``cmpl\t<rsrc>, <lsrc>''
675 :    
676 :     | CMPW of {lsrc: operand, rsrc: operand}
677 :     ``cmpb\t<rsrc>, <lsrc>''
678 :    
679 :     | CMPB of {lsrc: operand, rsrc: operand}
680 :     ``cmpb\t<rsrc>, <lsrc>''
681 :    
682 :     | TESTL of {lsrc: operand, rsrc: operand}
683 :     asm: ``testl\t<rsrc>, <lsrc>''
684 :     rtl: ``TESTL''
685 :    
686 :     | TESTW of {lsrc: operand, rsrc: operand}
687 :     asm: ``testw\t<rsrc>, <lsrc>''
688 :     rtl: ``TESTW''
689 :    
690 :     | TESTB of {lsrc: operand, rsrc: operand}
691 :     asm: ``testb\t<rsrc>, <lsrc>''
692 :     rtl: ``TESTB''
693 :    
694 :     | BITOP of {bitOp:bitOp, lsrc: operand, rsrc: operand}
695 :     ``<bitOp>\t<rsrc>, <lsrc>''
696 :    
697 :     | BINARY of {binOp:binaryOp, src:operand, dst:operand}
698 :     asm: (case (src,binOp) of
699 :     (I.Direct _, (* tricky business here for shifts *)
700 :     (I.SARL | I.SHRL | I.SHLL |
701 :     I.SARW | I.SHRW | I.SHLW |
702 :     I.SARB | I.SHRB | I.SHLB)) => ``<binOp>\t%cl, <dst>''
703 :     | _ => ``<binOp>\t<src>, <dst>''
704 :     )
705 :     rtl: ``<binOp>''
706 :    
707 : leunga 797 | CMPXCHG of {lock:bool, sz:isize, src: operand, dst:operand}
708 :     asm: (if lock then ``lock\n\t'' else ();
709 :     ``cmpxchg'';
710 :     case sz of
711 :     I.I8 => ``b''
712 :     | I.I16 => ``w''
713 :     | I.I32 => ``l'';
714 :     ``\t<src>, <dst>''
715 :     )
716 :    
717 : leunga 746 | MULTDIV of {multDivOp:multDivOp, src:operand}
718 :     asm: ``<multDivOp>\t<src>''
719 :    
720 :     | MUL3 of {dst: $GP, src2: Int32.int option, src1:operand}
721 :     (* Fermin: constant operand must go first *)
722 :     asm: (case src2 of
723 :     NONE => ``imul\t<src1>, <dst>''
724 :     | SOME i => ``imul\t$<emitInt32 i>, <src1>, <dst>''
725 :     )
726 :    
727 :     | UNARY of {unOp:unaryOp, opnd:operand}
728 :     asm: ``<unOp>\t<opnd>''
729 :     rtl: ``<unOp>''
730 :    
731 :     (* set byte on condition code; note that
732 :     * this only sets the low order byte, so it also
733 :     * uses its operand.
734 :     *)
735 :     | SET of {cond:cond, opnd:operand}
736 :     asm: ``set<cond>\t<emit_opnd8 opnd>''
737 :     rtl: ``SET<cond>''
738 :    
739 :     (* conditional move; Pentium Pro or higher only
740 :     * Destination must be a register.
741 :     *)
742 :     | CMOV of {cond:cond, src:operand, dst: $GP}
743 :     asm: ``cmov<cond>\t<src>, <dst>''
744 :     rtl: ``CMOV<cond>''
745 :    
746 :     | PUSHL of operand
747 :     asm: ``pushl\t<operand>''
748 :     rtl: ``PUSHL''
749 :    
750 :     | PUSHW of operand
751 :     asm: ``pushw\t<operand>''
752 :     rtl: ``PUSHW''
753 :    
754 :     | PUSHB of operand
755 :     asm: ``pushb\t<operand>''
756 :     rtl: ``PUSHB''
757 :    
758 :     | POP of operand
759 :     asm: ``popl\t<operand>''
760 :     rtl: ``POP''
761 :    
762 :     | CDQ
763 :     ``cdq''
764 :    
765 :     | INTO
766 :     ``into''
767 :    
768 :     (* parallel copies *)
769 :     | COPY of {dst: $GP list, src: $GP list, tmp:operand option}
770 :     asm: emitInstrs (Shuffle.shuffle{tmp,dst,src})
771 :     mc: emitInstrs (Shuffle.shuffle{tmp,dst,src})
772 :    
773 :     | FCOPY of {dst: $FP list, src: $FP list, tmp:operand option}
774 :     asm: emitInstrs (Shuffle.shufflefp{tmp,dst,src})
775 :     mc: emitInstrs (Shuffle.shuffle{tmp,dst,src})
776 :    
777 :     (* floating *)
778 :     | 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 :     | SAHF
898 :     ``sahf''
899 :    
900 :     (* annotations *)
901 :     | ANNOTATION of {i:instruction, a:Annotations.annotation}
902 :     asm: (comment(Annotations.toString a); nl(); emitInstr i)
903 :    
904 :     | SOURCE of {}
905 :     asm: ``source''
906 :     mc: ()
907 :    
908 :     | SINK of {}
909 :     asm: ``sink''
910 :     mc: ()
911 :    
912 :     | PHI of {}
913 :     asm: ``phi''
914 :     mc: ()
915 :    
916 :     (*------------------------------------------------------------------------
917 :     * Some helper routines for the SSA optimizer.
918 :     * These should go away soon.
919 :     *------------------------------------------------------------------------*)
920 :     structure SSA =
921 :     struct
922 : leunga 775 fun operand(ty, I.Immed i) = T.LI(T.I.fromInt32(32,i))
923 : leunga 746 (*| operand(ty, I.ImmedLabel le) = T.LABEL le*)
924 :     | operand(ty, I.Direct r) = T.REG(ty, r)
925 :     | operand _ = error "operand"
926 :     end
927 :     (*------------------------------------------------------------------------
928 :     * Some helper routines for the rewriting module.
929 :     * These should go away soon.
930 :     *------------------------------------------------------------------------*)
931 :     structure Rewrite =
932 :     struct
933 :     fun rewriteOperandUse (rs,rt,opnd) =
934 :     (case opnd
935 :     of I.Direct r => if C.sameColor(r,rs) then I.Direct rt else opnd
936 :     | I.Displace{base, disp, mem} =>
937 :     if C.sameColor(base,rs)
938 :     then I.Displace{base=rt, disp=disp, mem=mem}
939 :     else opnd
940 :     | I.Indexed{base as SOME b, index, scale, disp, mem} => let
941 :     val base'= if C.sameColor(b,rs) then SOME rt else base
942 :     val index'=if C.sameColor(index,rs) then rt else index
943 :     in I.Indexed{base=base', index=index', scale=scale,
944 :     disp=disp, mem=mem}
945 :     end
946 :     | I.Indexed{base, index, scale, disp, mem=mem} =>
947 :     if C.sameColor(index,rs) then
948 :     I.Indexed{base=base, index=rt, scale=scale, disp=disp, mem=mem}
949 :     else opnd
950 :     | _ => opnd
951 :     (*esac*))
952 :    
953 :     fun rewriteOperandDef (rs,rt,opnd as I.Direct r) =
954 :     if C.sameColor(r,rs) then I.Direct rt else opnd
955 :    
956 :     fun frewriteOperandDef(fs,ft,opnd as I.FDirect f) =
957 :     if C.sameColor(f,fs) then I.FDirect ft else opnd
958 :     | frewriteOperandDef(fs,ft,opnd as I.FPR f) =
959 :     if C.sameColor(f,fs) then I.FPR ft else opnd
960 :     | frewriteOperandDef opnd = opnd
961 :    
962 :     fun frewriteOperandUse(fs,ft,opnd as I.FDirect r) =
963 :     if C.sameColor(r,fs) then I.FDirect ft else opnd
964 :     | frewriteOperandUse(fs,ft,opnd as I.FPR r) =
965 :     if C.sameColor(r,fs) then I.FPR ft else opnd
966 :     | frewriteOperandUse(fs,ft, opnd) = opnd
967 :     end
968 :    
969 :     end
970 :    

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