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

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