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

Annotation of /MLRISC/trunk/amd64/amd64.mdl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2638 - (view) (download)

1 : mrainey 2619
2 :     architecture AMD64 =
3 :     struct
4 :    
5 :     superscalar (* superscalar machine *)
6 :    
7 :     little endian (* little endian architecture *)
8 :    
9 :     lowercase assembly (* print assembly in lower case *)
10 :    
11 :     storage
12 :     GP = $r[16] of 64 bits
13 :     asm: (fn (0,8) => "%al" | (4, 8) => "%ah"
14 :     | (1,8) => "%cl" | (5, 8) => "%ch"
15 :     | (2,8) => "%dl" | (6, 8) => "%dh"
16 :     | (3,8) => "%bl" | (7, 8) => "%bh"
17 :     | (r,8) => "%r"^Int.toString r^"b"
18 :    
19 :     | (0,16) => "%ax" | (4,16) => "%sp"
20 :     | (1,16) => "%cx" | (5,16) => "%bp"
21 :     | (2,16) => "%dx" | (6,16) => "%si"
22 :     | (3,16) => "%bx" | (7,16) => "%di"
23 :     | (r,16) => "%r"^Int.toString r^"w"
24 :    
25 :     | (0,32) => "%eax" | (4,32) => "%esp"
26 :     | (1,32) => "%ecx" | (5,32) => "%ebp"
27 :     | (2,32) => "%edx" | (6,32) => "%esi"
28 :     | (3,32) => "%ebx" | (7,32) => "%edi"
29 :     | (r,32) => "%r"^Int.toString r^"d"
30 :    
31 :     | (0,64) => "%rax" | (4,64) => "%rsp"
32 :     | (1,64) => "%rcx" | (5,64) => "%rbp"
33 :     | (2,64) => "%rdx" | (6,64) => "%rsi"
34 :     | (3,64) => "%rbx" | (7,64) => "%rdi"
35 :     | (r,64) => "%r"^Int.toString r
36 :    
37 :     | (r,_) => "%"^Int.toString r
38 :     )
39 :     | FP = $f[16] of 64 bits
40 :     asm: (fn (f, _) =>
41 :     if f < 16
42 :     then "%xmm"^Int.toString f
43 :     else "%f"^Int.toString f )
44 :     | CC = $cc[] of 32 bits aliasing GP asm: "cc"
45 :     | EFLAGS = $eflags[1] of 32 bits asm: "$eflags"
46 :     | FFLAGS = $fflags[1] of 32 bits asm: "$fflags"
47 :     | MEM = $m[] of 8 aggregable bits asm: "mem"
48 :     | CTRL = $ctrl[] asm: "ctrl"
49 :    
50 :     locations
51 :     rax = $r[0]
52 :     and rcx = $r[1]
53 :     and rdx = $r[2]
54 :     and rbx = $r[3]
55 :     and rsp = $r[4]
56 :     and rbp = $r[5]
57 :     and rsi = $r[6]
58 :     and rdi = $r[7]
59 :     and stackptrR = $r[4]
60 :     and asmTmpR = $r[0] (* not used *)
61 :     and fasmTmp = $f[0] (* not used *)
62 :     and eflags = $eflags[0]
63 :    
64 :     (*------------------------------------------------------------------------
65 :     *
66 :     * Representation for various opcodes.
67 :     *
68 :     *------------------------------------------------------------------------*)
69 :     structure Instruction =
70 :     struct
71 :     (* An effective address can be any combination of
72 :     * base + index*scale + disp
73 :     * or
74 :     * B + I*SCALE + DISP
75 :     *
76 :     * where any component is optional. The operand datatype captures
77 :     * all these combinations.
78 :     *
79 :     * DISP == Immed | ImmedLabel | Const
80 :     * B == Displace{base=B, disp=0}
81 :     * B+DISP == Displace{base=B, disp=DISP}
82 :     * I*SCALE+DISP == Indexed{base=NONE,index=I,scale=SCALE,disp=D}
83 :     * B+I*SCALE+DISP == Indexed{base=SOME B,index=I,scale=SCALE,disp=DISP}
84 :     * Note1: The index register cannot be EBP.
85 :     * The disp field must be one of Immed, ImmedLabel, or Const.
86 :     *)
87 :    
88 :     (* Note: Relative is only generated after sdi resolution *)
89 :     datatype operand =
90 :     Immed of Int32.int rtl: int
91 :     | ImmedLabel of T.labexp rtl: labexp
92 :     | Relative of int (* no semantics given *)
93 :     | LabelEA of T.labexp rtl: labexp (* XXX *)
94 :     | Direct of (int * $GP) rtl: $r[GP]
95 :     | FDirect of $FP rtl: $f[FP]
96 :     | Displace of {base: $GP, disp:operand, mem:Region.region}
97 :     rtl: $m[$r[base] + disp : mem]
98 :     | Indexed of {base: $GP option, index: $GP, scale:int,
99 :     disp:operand, mem:Region.region}
100 :     rtl: $m[$r[base] + $r[index] << scale + disp : mem]
101 :    
102 :     type addressing_mode = operand
103 :    
104 :     type ea = operand
105 :    
106 :     datatype cond! =
107 :     EQ "e" 0w4 | NE 0w5 | LT "l" 0w12 | LE 0w14 | GT "g" 0w15 | GE 0w13
108 :     | B 0w2 | BE (* below *) 0w6 | A 0w7 | AE (* above *) 0w3
109 :     | C 0w2 | NC (* if carry *) 0w3 | P 0wxa | NP (* if parity *) 0wxb
110 :     | O 0w0 | NO (* overflow *) 0w1
111 :    
112 :     (* LOCK can only be used in front of
113 :     * (Intel ordering, not gasm ordering)
114 :     * ADC, ADD, AND, BT mem, reg/imm
115 :     * BTS, BTR, BTC, OR mem, reg/imm
116 :     * SBB, SUB, XOR mem, reg/imm
117 :     * XCHG reg, mem
118 :     * XCHG mem, reg
119 :     * DEC, INC, NEG, NOT mem
120 :     *)
121 :    
122 :     datatype binaryOp! =
123 :     ADDQ | SUBQ | ANDQ | ORQ | XORQ | SHLQ | SARQ | SHRQ | MULQ | IMULQ
124 :     | ADCQ | SBBQ
125 :     | ADDL | SUBL | ANDL | ORL | XORL | SHLL | SARL | SHRL | MULL | IMULL
126 :     | ADCL | SBBL
127 :     | ADDW | SUBW | ANDW | ORW | XORW | SHLW | SARW | SHRW | MULW | IMULW
128 :     | ADDB | SUBB | ANDB | ORB | XORB | SHLB | SARB | SHRB | MULB | IMULB
129 :     | BTSW | BTCW | BTRW | BTSL | BTCL | BTRL
130 :     | ROLW | RORW | ROLL | RORL
131 :     | XCHGB | XCHGW | XCHGL
132 :     | LOCK_ADCW "lock\n\tadcw"
133 :     | LOCK_ADCL "lock\n\tadcl"
134 :     | LOCK_ADDW "lock\n\taddw"
135 :     | LOCK_ADDL "lock\n\taddl"
136 :     | LOCK_ANDW "lock\n\tandw"
137 :     | LOCK_ANDL "lock\n\tandl"
138 :     | LOCK_BTSW "lock\n\tbtsw"
139 :     | LOCK_BTSL "lock\n\tbtsl"
140 :     | LOCK_BTRW "lock\n\tbtrw"
141 :     | LOCK_BTRL "lock\n\tbtrl"
142 :     | LOCK_BTCW "lock\n\tbtcw"
143 :     | LOCK_BTCL "lock\n\tbtcl"
144 :     | LOCK_ORW "lock\n\torw"
145 :     | LOCK_ORL "lock\n\torl"
146 :     | LOCK_SBBW "lock\n\tsbbw"
147 :     | LOCK_SBBL "lock\n\tsbbl"
148 :     | LOCK_SUBW "lock\n\tsubw"
149 :     | LOCK_SUBL "lock\n\tsubl"
150 :     | LOCK_XORW "lock\n\txorw"
151 :     | LOCK_XORL "lock\n\txorl"
152 :     | LOCK_XADDB "lock\n\txaddb"
153 :     | LOCK_XADDW "lock\n\txaddw"
154 :     | LOCK_XADDL "lock\n\txaddl"
155 :    
156 :     (* One operand opcodes *)
157 :     datatype multDivOp! =
158 :     IMULL1 "imull" | MULL1 "mull" | IDIVL1 "idivl" | DIVL1 "divl"
159 :     | IMULQ1 "imulq" | MULQ1 "mulq" | IDIVQ1 "idivq" | DIVQ1 "divq"
160 :    
161 :     datatype unaryOp! = DECQ | INCQ | NEGQ | NOTQ
162 :     | DECL | INCL | NEGL | NOTL
163 :     | DECW | INCW | NEGW | NOTW
164 :     | DECB | INCB | NEGB | NOTB
165 :     | LOCK_DECQ "lock\n\tdecq"
166 :     | LOCK_INCQ "lock\n\tincq"
167 :     | LOCK_NEGQ "lock\n\tnegq"
168 :     | LOCK_NOTQ "lock\n\tnotq"
169 :    
170 :     datatype shiftOp! = SHLDL | SHRDL
171 :    
172 :     datatype bitOp! = BTW
173 :     | BTL
174 :     | BTQ
175 :     | LOCK_BTW "lock\n\tbtw"
176 :     | LOCK_BTL "lock\n\tbtl"
177 :    
178 :     datatype move! = MOVQ
179 :     | MOVL (* zx(long) -> qword *)
180 :     | MOVB
181 :     | MOVW
182 :     | MOVSWQ (* sx(word) -> qword *)
183 :     | MOVZWQ (* zx(word) -> qword *)
184 :     | MOVSWL (* sx(word) -> long *)
185 :     | MOVZWL (* zx(word) -> long *)
186 :     | MOVSBQ (* sx(byte) -> qword *)
187 :     | MOVZBQ (* zx(byte) -> qword *)
188 :     | MOVSBL (* sx(byte) -> long *)
189 :     | MOVZBL (* zx(byte) -> long *)
190 :     | MOVSLQ (* sx(long) -> qword *)
191 :    
192 :     datatype fbin_op! =
193 :     ADDSS | ADDSD
194 :     | SUBSS | SUBSD
195 :     | MULSS | MULSD
196 :     | DIVSS | DIVSD
197 :    
198 :     datatype fcom_op! =
199 :     COMISS | COMISD (* ordered *)
200 :     | UCOMISS | UCOMISD (* unordered *)
201 :    
202 :     datatype fmove_op! =
203 :     MOVSS | MOVSD
204 :     (* conversion *)
205 :     | CVTSS2SD | CVTSD2SS
206 :     | CVTSS2SI | CVTSS2SIQ | CVTSD2SI | CVTSD2SIQ
207 :     | CVTSI2SS | CVTSI2SSQ | CVTSI2SD | CVTSI2SDQ
208 :    
209 :     (* Intel floating point precision *)
210 :     datatype fsize = FP32 "s" | FP64 "l"
211 :    
212 :     (* Intel integer precision *)
213 :     datatype isize = I8 "8" | I16 "16" | I32 "32" | I64 "64"
214 :    
215 :     end (* Instruction *)
216 :    
217 :     (*------------------------------------------------------------------------
218 :     *
219 :     * Here, I'm going to define the semantics of the instructions
220 :     *
221 :     *------------------------------------------------------------------------*)
222 :     structure RTL =
223 :     struct
224 :    
225 :     (* Get the basis *)
226 :     include "Tools/basis.mdl"
227 :     open Basis
228 :     infix 1 || (* parallel effects *)
229 :     infix 2 := (* assignment *)
230 :    
231 :     (* Some type abbreviations *)
232 :     fun byte x = (x : #8 bits)
233 :     fun word x = (x : #16 bits)
234 :     fun long x = (x : #32 bits)
235 :     fun qword x = (x: #64 bits)
236 :     fun float x = (x : #32 bits)
237 :     fun double x = (x : #64 bits)
238 :     fun real80 x = (x : #80 bits)
239 :    
240 :     (* Intel register abbreviations *)
241 :     val rax = $r[0] and rcx = $r[1] and rdx = $r[2] and rbx = $r[3]
242 :     and rsp = $r[4] and rbp = $r[5] and rsi = $r[6] and rdi = $r[7]
243 :    
244 :     (* Condition codes bits in eflag.
245 :     * Let's give symbolic name for each bit as per the Intel doc.
246 :     *)
247 :     rtl setFlag : #n bits -> #n bits
248 :     fun flag b = andb($eflags[0] >> b, 1)
249 :     val CF = flag 0 and PF = flag 2
250 :     and ZF = flag 6 and SF = flag 7 and OF = flag 11
251 :    
252 :     (* Now gets use the bits to express the conditions. Again from Intel. *)
253 :     (* conditions *) (* aliases *)
254 :     val B = CF == 1 val C = B and NAE = B
255 :     val BE = CF == 1 orelse ZF == 1 val NA = BE
256 :     val E = ZF == 1 val Z = E
257 :     val L = SF <> OF val NGE = L
258 :     val LE = SF <> OF orelse ZF == 1 val NG = LE
259 :     val NB = CF == 0 val AE = NB and NC = NB
260 :     val NBE = CF == 0 andalso ZF == 0 val A = NBE
261 :     val NE = ZF == 0 val NZ = NE
262 :     val NL = SF == OF val GE = NL
263 :     val NLE = ZF == 0 andalso SF == OF val G = NLE
264 :     val NO = OF == 0
265 :     val NP = PF == 0 val PO = NP
266 :     val NS = SF == 0
267 :     val O = OF == 1
268 :     val P = PF == 1 val PE = P
269 :     val S = SF == 1
270 :    
271 :     rtl NOP{} = () (* duh! *)
272 :     rtl LEAL{addr, r32} = $r[r32] := addr (* this is completely wrong! XXX *)
273 :     rtl LEAQ{addr, r64} = $r[r32] := addr (* this is completely wrong! XXX *)
274 :    
275 :     (* moves with type conversion *)
276 :     rtl MOVQ{src,dst} = dst := qword src
277 :     rtl MOVL{src,dst} = dst := long src
278 :     rtl MOVW{src,dst} = dst := word src
279 :     rtl MOVB{src,dst} = dst := byte src
280 :     rtl MOVSWL{src,dst} = dst := long(sx(word src))
281 :     rtl MOVZWL{src,dst} = dst := long(zx(word src))
282 :     rtl MOVSBL{src,dst} = dst := long(sx(byte src))
283 :     rtl MOVZBL{src,dst} = dst := long(zx(byte src))
284 :     rtl MOVSWQ{src,dst} = dst := qword(sx(word src))
285 :     rtl MOVZWQ{src,dst} = dst := qword(zx(word src))
286 :     rtl MOVSBQ{src,dst} = dst := qword(sx(byte src))
287 :     rtl MOVZBQ{src,dst} = dst := qword(zx(byte src))
288 :     rtl MOVZLQ{src,dst} = dst := qword(zx(long src))
289 :    
290 :     (* semantics of integer arithmetic;
291 :     * all instructions sets the condition code
292 :     *)
293 :     fun binop typ oper {dst,src} = dst := typ(oper(dst,src))
294 :     fun arith typ oper {dst,src} = dst := typ(oper(dst,src))
295 :     || $eflags[0] := ??? (* XXX *)
296 :     fun unary typ oper {opnd} = opnd := typ(oper opnd)
297 :    
298 :     fun inc x = x + 1
299 :     fun dec x = x - 1
300 :    
301 :     (* I'm too lazy to specify the semantics of these for now *)
302 :     rtl adc sbb bts btc btr rol ror xchg xadd cmpxchg
303 :     : #n bits * #n bits -> #n bits
304 :    
305 :     rtl [ADD,SUB,AND,OR,XOR]^^B = map (arith byte) [(+),(-),andb,orb,xorb]
306 :     rtl [ADD,SUB,AND,OR,XOR]^^W = map (arith word) [(+),(-),andb,orb,xorb]
307 :     rtl [ADD,SUB,AND,OR,XOR]^^L = map (arith long) [(+),(-),andb,orb,xorb]
308 :     rtl [ADD,SUB,AND,OR,XOR]^^Q = map (arith qword) [(+),(-),andb,orb,xorb]
309 :     rtl [SHR,SHL,SAR]^^B = map (binop byte) [(>>),(<<),(~>>)]
310 :     rtl [SHR,SHL,SAR]^^W = map (binop word) [(>>),(<<),(~>>)]
311 :     rtl [SHR,SHL,SAR]^^L = map (binop long) [(>>),(<<),(~>>)]
312 :     rtl [SHR,SHL,SAR]^^Q = map (binop qword) [(>>),(<<),(~>>)]
313 :     rtl [NEG,NOT,INC,DEC]^^B = map (unary byte) [(~),notb,inc,dec]
314 :     rtl [NEG,NOT,INC,DEC]^^W = map (unary word) [(~),notb,inc,dec]
315 :     rtl [NEG,NOT,INC,DEC]^^L = map (unary long) [(~),notb,inc,dec]
316 :     rtl [NEG,NOT,INC,DEC]^^Q = map (unary qword) [(~),notb,inc,dec]
317 :    
318 :    
319 :     rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^B =
320 :     map (arith byte) [adc,sbb,bts,btc,btr,rol,ror,xchg]
321 :     rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^W =
322 :     map (arith word) [adc,sbb,bts,btc,btr,rol,ror,xchg]
323 :     rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^L =
324 :     map (arith long) [adc,sbb,bts,btc,btr,rol,ror,xchg]
325 :     rtl [ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^Q =
326 :     map (arith qword) [adc,sbb,bts,btc,btr,rol,ror,xchg]
327 :    
328 :     fun lockarith typ oper {src,dst}=
329 :     dst := typ(oper(dst,src))
330 :     || Kill $eflags[0] (* XXX *)
331 :     fun lockunary typ oper {opnd} =
332 :     opnd := typ(oper(opnd))
333 :     || Kill $eflags[0] (* XXX *)
334 :    
335 :     rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^B =
336 :     map (lockarith byte) [(+),(-),andb,orb,xorb,xadd]
337 :     rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^W =
338 :     map (lockarith word) [(+),(-),andb,orb,xorb,xadd]
339 :     rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^L =
340 :     map (lockarith long) [(+),(-),andb,orb,xorb,xadd]
341 :     rtl LOCK_^^[ADD,SUB,AND,OR,XOR,XADD]^^Q =
342 :     map (lockarith qword) [(+),(-),andb,orb,xorb,xadd]
343 :     rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^B =
344 :     map (lockarith byte) [adc,sbb,bts,btc,btr,rol,ror,xchg]
345 :     rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^W =
346 :     map (lockarith word) [adc,sbb,bts,btc,btr,rol,ror,xchg]
347 :     rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^L =
348 :     map (lockarith long) [adc,sbb,bts,btc,btr,rol,ror,xchg]
349 :     rtl LOCK_^^[ADC,SBB,BTS,BTC,BTR,ROL,ROR,XCHG]^^Q =
350 :     map (lockarith qword) [adc,sbb,bts,btc,btr,rol,ror,xchg]
351 :     rtl LOCK_^^[DEC,INC,NEG,NOT]^^L =
352 :     map (lockunary long) [dec,inc,(~),notb]
353 :     rtl LOCK_^^[DEC,INC,NEG,NOT]^^Q =
354 :     map (lockunary qword) [dec,inc,(~),notb]
355 :     rtl LOCK_^^[CMPXCHG]^^B = map (lockarith byte) [cmpxchg]
356 :     rtl LOCK_^^[CMPXCHG]^^W = map (lockarith word) [cmpxchg]
357 :     rtl LOCK_^^[CMPXCHG]^^L = map (lockarith long) [cmpxchg]
358 :     rtl LOCK_^^[CMPXCHG]^^Q = map (lockarith qword) [cmpxchg]
359 :    
360 :     (* Multiplication/division *)
361 :     rtl upperMultiply : #n bits * #n bits -> #n bits
362 :     rtl MULL1{src} = eax := muls(eax, src) ||
363 :     edx := upperMultiply(eax, src) ||
364 :     $eflags[0] := ???
365 :     rtl IDIVL1{src} = eax := divs(eax, src) ||
366 :     edx := rems(eax, src) ||
367 :     $eflags[0] := ???
368 :     rtl DIVL1{src} = edx := divu(eax, src) ||
369 :     edx := remu(eax, src) ||
370 :     $eflags[0] := ???
371 :    
372 :     (* test[b,w,l] *)
373 :     rtl TESTB {lsrc,rsrc} = $eflags[0] := setFlag(andb(byte lsrc, rsrc))
374 :     rtl TESTW {lsrc,rsrc} = $eflags[0] := setFlag(andb(word lsrc, rsrc))
375 :     rtl TESTL {lsrc,rsrc} = $eflags[0] := setFlag(andb(long lsrc, rsrc))
376 :     rtl TESTQ {lsrc,rsrc} = $eflags[0] := setFlag(andb(qword lsrc, rsrc))
377 :    
378 :     (* setcc *)
379 :     fun set cc {opnd} = opnd := byte(cond(cc, 0xff, 0x0))
380 :     rtl SET^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
381 :     map set [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
382 :    
383 :     (* conditional move *)
384 :     fun cmov cc {src,dst} = if cc then $r[dst] := long src else ()
385 :     rtl CMOV^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
386 :     map cmov [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
387 :     rtl CMOVQ^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
388 :     map cmov [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
389 :    
390 :     (* push and pops *)
391 :     rtl PUSHQ {operand} = $m[rsp - 8] := qword(operand) || rsp := rsp - 8
392 :     rtl PUSHL {operand} = $m[esp - 4] := long(operand) || esp := esp - 4
393 :     rtl PUSHW {operand} = $m[esp - 2] := word(operand) || esp := esp - 2
394 :     rtl PUSHB {operand} = $m[esp - 1] := byte(operand) || esp := esp - 1
395 :     rtl POP {operand} = operand := long($m[esp]) || esp := esp + 4
396 :    
397 :     (* semantics of branches and jumps *)
398 :     rtl JMP{operand} = Jmp(long operand)
399 :     fun jcc cc {opnd} = if cc then Jmp(long opnd) else ()
400 :     rtl J^^ [EQ,NE,LT,LE,GT,GE,B,BE,A,AE,C,NC,P,NP,O,NO] =
401 :     map jcc [E ,NE,L, LE,G ,GE,B,BE,A,AE,C,NC,P,NP,O,NO]
402 :     rtl CALL{opnd,defs,uses} =
403 :     Call(long opnd) ||
404 :     Kill $cellset[defs] ||
405 :     Use $cellset[uses]
406 :     rtl CALLQ{opnd,defs,uses} =
407 :     Call(long opnd) ||
408 :     Kill $cellset[defs] ||
409 :     Use $cellset[uses]
410 :    
411 :    
412 :     end (* RTL *)
413 :    
414 :     (*------------------------------------------------------------------------
415 :     * Machine Instruction encoding on the x86
416 :     * Because of variable width instructions.
417 :     * We decompose each byte field into a seperate format first, then combine
418 :     * then to form the real instructions
419 :     *------------------------------------------------------------------------*)
420 :     instruction formats 8 bits
421 :     modrm{mod:2, reg:3, rm:3}
422 :     | reg{opc:5, reg:3}
423 :     | sib{ss:2, index:3, base:3}
424 :     | immed8{imm:8}
425 :    
426 :     instruction formats 32 bits
427 :     immed32{imm:32}
428 :    
429 :     (*
430 :     * Variable format instructions
431 :     *)
432 :     instruction formats
433 :     immedOpnd{opnd} =
434 :     (case opnd of
435 :     I.Immed i32 => i32
436 :     | I.ImmedLabel le => lexp le
437 :     | I.LabelEA le => lexp le
438 :     | _ => error "immedOpnd"
439 :     )
440 :     | extension{opc, opnd} = (* generate an extension *)
441 :     (case opnd of
442 :     I.Direct (_, r) => modrm{mod=3, reg=opc, rm=r}
443 :     | I.FDirect _ => raise Fail "todo"
444 :     | I.Displace{base, disp, ...} =>
445 :     let val immed = immedOpnd{opnd=disp}
446 :     in () (* XXX *)
447 :     end
448 :     | I.Indexed{base=NONE, index, scale, disp, ...} => ()
449 :     | I.Indexed{base=SOME b, index, scale, disp, ...} => ()
450 :     | _ => error "immedExt"
451 :     )
452 :    
453 :     instruction formats 16 bits
454 :     encodeST{prefix:8, opc:5, st: $FP 3}
455 :    
456 :     instruction formats
457 :     encodeReg{prefix:8, reg: $GP 3, opnd} =
458 :     (emit prefix; immedExt{opc=reg, opnd=opnd})
459 :     | arith{opc1,opc2,src,dst} =
460 :     (case (src, dst) of
461 :     (I.ImmedLabel le, dst) => arith{opc1,opc2,src=I.Immed(lexp le),dst}
462 :     | (I.LabelEA le, dst) => arith{opc1,opc2,src=I.Immed(lexp le),dst}
463 :     | (I.Immed i,dst) => ()
464 :     | (src, I.Direct (_,r)) => encodeReg{prefix=opc1+op3,reg,opnd=src}
465 :     | (I.Direct (_,r),dst) => encodeReg{prefix=opc1+0w1,reg,opnd=dst}
466 :     | _ => error "arith"
467 :     )
468 :    
469 :     structure Assembly =
470 :     struct
471 :     fun emitInt32 i = let val s = Int32.toString i
472 :     val s = if i >= 0 then s else "-"^String.substring(s,1,size s-1)
473 :     in
474 :     emit s
475 :     end
476 :    
477 :     val {low=SToffset, ...} = C.cellRange CellsBasis.FP
478 :    
479 :     fun emitScale 0 = emit "1"
480 :     | emitScale 1 = emit "2"
481 :     | emitScale 2 = emit "4"
482 :     | emitScale 3 = emit "8"
483 :     | emitScale _ = error "emitScale"
484 :    
485 :     and eImmed(I.Immed (i)) = emitInt32 i
486 :     | eImmed(I.ImmedLabel lexp) = emit_labexp lexp
487 :     | eImmed _ = error "eImmed"
488 :    
489 :     and emit_operand opn = (case opn
490 :     of I.Immed i => (emit "$"; emitInt32 i)
491 :     | I.ImmedLabel lexp => (emit "$"; emit_labexp lexp)
492 :     | I.LabelEA le => emit_labexp le
493 :     | I.Relative _ => error "emit_operand"
494 :     | I.Direct (ty, r) => emit(CellsBasis.toStringWithSize(r,ty))
495 :     | I.FDirect f => emit(CellsBasis.toString f)
496 :     | I.Displace{base,disp,mem,...} =>
497 :     (emit_disp disp; emit "("; emitCell base; emit ")";
498 :     emit_region mem)
499 :     | I.Indexed{base,index,scale,disp,mem,...} =>
500 :     (emit_disp disp; emit "(";
501 :     case base of
502 :     NONE => ()
503 :     | SOME base => emitCell base;
504 :     comma();
505 :     emitCell index; comma();
506 :     emitScale scale; emit ")"; emit_region mem)
507 :     (* end case *))
508 :    
509 :     and emit_operand8(I.Direct (_, r)) =
510 :     emit(CellsBasis.toStringWithSize(r,8))
511 :     | emit_operand8 opn = emit_operand opn
512 :    
513 :     and emit_cell (r, sz) = emit (CellsBasis.toStringWithSize(r,sz))
514 :    
515 :     and emit_disp(I.Immed 0) = ()
516 :     | emit_disp(I.Immed i) = emitInt32 i
517 :     | emit_disp(I.ImmedLabel lexp) = emit_labexp lexp
518 :     | emit_disp _ = error "emit_disp"
519 :    
520 :     (* The gas assembler does not like the "$" prefix for immediate
521 :     * labels in certain instructions.
522 :     *)
523 :     fun stupidGas(I.ImmedLabel lexp) = emit_labexp lexp
524 :     | stupidGas opnd = (emit "*"; emit_operand opnd)
525 :    
526 :     (* Display the floating point binary opcode *)
527 :     fun isMemOpnd(I.FDirect f) = true
528 :     | isMemOpnd(I.LabelEA _) = true
529 :     | isMemOpnd(I.Displace _) = true
530 :     | isMemOpnd(I.Indexed _) = true
531 :     | isMemOpnd _ = false
532 :     fun chop fbinOp =
533 :     let val n = size fbinOp
534 :     in case Char.toLower(String.sub(fbinOp,n-1)) of
535 :     (#"s" | #"l") => String.substring(fbinOp,0,n-1)
536 :     | _ => fbinOp
537 :     end
538 :    
539 :     val emit_dst = emit_operand
540 :     val emit_src = emit_operand
541 :     val emit_opnd = emit_operand
542 :     val emit_opnd8 = emit_operand8
543 :     val emit_rsrc = emit_operand
544 :     val emit_lsrc = emit_operand
545 :     val emit_addr = emit_operand
546 :     val emit_src1 = emit_operand
547 :     val emit_ea = emit_operand
548 :     val emit_count = emit_operand
549 :     end (* Assembly *)
550 :    
551 :    
552 :     (*------------------------------------------------------------------------
553 :     *
554 :     * Reservation tables and pipeline definitions for scheduling.
555 :     * Faked for now as I don't have to time to look up the definitions
556 :     * from the Intel doc.
557 :     *
558 :     *------------------------------------------------------------------------*)
559 :    
560 :     (* Function units *)
561 :     resource issue and mem and alu and falu and fmul and fdiv and branch
562 :    
563 :     (* Different implementations of cpus *)
564 :     cpu default 2 [2 issue, 2 mem, 1 alu, 1 falu, 1 fmul] (* 2 issue machine *)
565 :    
566 :     (* Definitions of various reservation tables *)
567 :     pipeline NOP _ = [issue]
568 :     and ARITH _ = [issue^^alu]
569 :     and LOAD _ = [issue^^mem]
570 :     and STORE _ = [issue^^mem,mem,mem]
571 :     and BRANCH _ = [issue^^branch]
572 :    
573 :     (*------------------------------------------------------------------------
574 :     *
575 :     * Compiler representation of the instruction set.
576 :     *
577 :     *------------------------------------------------------------------------*)
578 :     instruction
579 :     NOP
580 :     asm: ``nop''
581 :     rtl: ``NOP''
582 :    
583 :     | JMP of operand * Label.label list
584 :     asm: ``jmp\t<stupidGas operand>''
585 :     rtl: ``JMP''
586 :    
587 :     | JCC of {cond:cond, opnd:operand}
588 :     asm: ``j<cond>\t<stupidGas opnd>''
589 :     rtl: ``J<cond>''
590 :    
591 :     | CALL of {opnd: operand, defs: $cellset, uses: $cellset,
592 :     return: $cellset, cutsTo: Label.label list, mem: Region.region,
593 :     pops:Int32.int}
594 :     asm: ``call\t<stupidGas opnd><mem><
595 :     emit_defs(defs)><
596 :     emit_uses(uses)><
597 :     emit_cellset("return",return)><
598 :     emit_cutsTo cutsTo>''
599 :     rtl: ``CALL''
600 :    
601 :     | CALLQ of {opnd: operand, defs: $cellset, uses: $cellset,
602 :     return: $cellset, cutsTo: Label.label list, mem: Region.region,
603 :     pops:Int32.int}
604 :     asm: ``call\t<stupidGas opnd><mem><
605 :     emit_defs(defs)><
606 :     emit_uses(uses)><
607 :     emit_cellset("return",return)><
608 :     emit_cutsTo cutsTo>''
609 :     rtl: ``CALLQ''
610 :    
611 :     | ENTER of {src1:operand, src2:operand}
612 :     asm: ``enter\t<emit_operand src1>, <emit_operand src2>''
613 :    
614 :     | LEAVE
615 :     asm: ``leave''
616 :    
617 :     | RET of operand option
618 :     asm: ``ret<case option of NONE => ()
619 :     | SOME e => (emit "\t"; emit_operand e)>''
620 :    
621 :     (* integer *)
622 :     | MOVE of {mvOp:move, src:operand, dst:operand}
623 :     asm: ``<mvOp>\t<src>, <dst>''
624 :     rtl: ``<mvOp>''
625 :    
626 :     | LEAL of {r32: $GP, addr: operand}
627 :     asm: ``leal\t<addr>, <emit_cell (r32, 32)>''
628 :     rtl: ``LEAL''
629 :    
630 :     | LEAQ of {r64: $GP, addr: operand}
631 :     asm: ``leaq\t<addr>, <emit_cell (r64, 64)>''
632 :     rtl: ``LEAQ''
633 :    
634 :     | CMPQ of {lsrc: operand, rsrc: operand}
635 :     asm: ``cmpq\t<rsrc>, <lsrc>''
636 :    
637 :     | CMPL of {lsrc: operand, rsrc: operand}
638 :     asm: ``cmpl\t<rsrc>, <lsrc>''
639 :    
640 :     | CMPW of {lsrc: operand, rsrc: operand}
641 :     ``cmpb\t<rsrc>, <lsrc>''
642 :    
643 :     | CMPB of {lsrc: operand, rsrc: operand}
644 :     ``cmpb\t<rsrc>, <lsrc>''
645 :    
646 :     | TESTQ of {lsrc: operand, rsrc: operand}
647 :     asm: ``testq\t<rsrc>, <lsrc>''
648 :     rtl: ``TESTQ''
649 :    
650 :     | TESTL of {lsrc: operand, rsrc: operand}
651 :     asm: ``testl\t<rsrc>, <lsrc>''
652 :     rtl: ``TESTL''
653 :    
654 :     | TESTW of {lsrc: operand, rsrc: operand}
655 :     asm: ``testw\t<rsrc>, <lsrc>''
656 :     rtl: ``TESTW''
657 :    
658 :     | TESTB of {lsrc: operand, rsrc: operand}
659 :     asm: ``testb\t<rsrc>, <lsrc>''
660 :     rtl: ``TESTB''
661 :    
662 :     | BITOP of {bitOp:bitOp, lsrc: operand, rsrc: operand}
663 :     ``<bitOp>\t<rsrc>, <lsrc>''
664 :    
665 :     | BINARY of {binOp:binaryOp, src:operand, dst:operand}
666 :     asm: (case (src,binOp) of
667 :     (I.Direct _, (* tricky business here for shifts *)
668 :     (I.SARQ | I.SHRQ | I.SHLQ |
669 :     I.SARL | I.SHRL | I.SHLL |
670 :     I.SARW | I.SHRW | I.SHLW |
671 :     I.SARB | I.SHRB | I.SHLB)) => ``<binOp>\t%cl, <dst>''
672 :     | _ => ``<binOp>\t<src>, <dst>''
673 :     )
674 :     (*rtl: ``<binOp>''*)
675 :     | SHIFT of {shiftOp:shiftOp, src:operand, dst:operand, count:operand}
676 :     asm: (case count of (* must be %ecx if it is a register *)
677 :     I.Direct (ty, ecx) => ``<shiftOp>\t<src>, <dst>''
678 :     | _ => ``<shiftOp>\t<src>, <count>, <dst>''
679 :     )
680 :    
681 :     | CMPXCHG of {lock:bool, sz:isize, src: operand, dst:operand}
682 :     asm: (if lock then ``lock\n\t'' else ();
683 :     ``cmpxchg'';
684 :     case sz of
685 :     I.I8 => ``b''
686 :     | I.I16 => ``w''
687 :     | I.I32 => ``l''
688 :     | I.I64 => ``q'';
689 :     ``\t<src>, <dst>''
690 :     )
691 :    
692 :     | MULTDIV of {multDivOp:multDivOp, src:operand}
693 :     asm: ``<multDivOp>\t<src>''
694 :    
695 :     | MUL3 of {dst: $GP, src2: Int32.int, src1:operand}
696 :     (* Fermin: constant operand must go first *)
697 :     asm: ``imull\t$<emitInt32 src2>, <src1>, <emit_cell (dst, 32)>''
698 :    
699 :     | MULQ3 of {dst: $GP, src2: Int32.int, src1:operand}
700 :     (* Fermin: constant operand must go first *)
701 :     asm: ``imulq\t$<emitInt32 src2>, <src1>, <emit_cell (dst, 64)>''
702 :    
703 :     | UNARY of {unOp:unaryOp, opnd:operand}
704 :     asm: ``<unOp>\t<opnd>''
705 :     rtl: ``<unOp>''
706 :    
707 :     (* set byte on condition code; note that
708 :     * this only sets the low order byte, so it also
709 :     * uses its operand.
710 :     *)
711 :     | SET of {cond:cond, opnd:operand}
712 :     asm: ``set<cond>\t<emit_opnd8 opnd>''
713 :     rtl: ``SET<cond>''
714 :    
715 :     | CMOV of {cond:cond, src:operand, dst: $GP}
716 :     asm: ``cmov<cond>\t<src>, <dst>''
717 :     rtl: ``CMOV<cond>''
718 :    
719 :     (* FIXME: *)
720 :     | CMOVQ of {cond:cond, src:operand, dst: $GP}
721 :     asm: ``cmov<cond>\t<src>, <dst>''
722 :     rtl: ``CMOVQ<cond>''
723 :    
724 :     | PUSHQ of operand
725 :     asm: ``pushq\t<operand>''
726 :     rtl: ``PUSHQ''
727 :    
728 :     | PUSHL of operand
729 :     asm: ``pushl\t<operand>''
730 :     rtl: ``PUSHL''
731 :    
732 :     | PUSHW of operand
733 :     asm: ``pushw\t<operand>''
734 :     rtl: ``PUSHW''
735 :    
736 :     | PUSHB of operand
737 :     asm: ``pushb\t<operand>''
738 :     rtl: ``PUSHB''
739 :    
740 :     | PUSHFD (* push $eflags onto stack *)
741 :     ``pushfd''
742 :    
743 :     | POPFD (* pop $eflags onto stack *)
744 :     ``popfd''
745 :    
746 :     | POP of operand
747 :     asm: ``popq\t<operand>''
748 :     rtl: ``POP''
749 :    
750 :     | CDQ
751 :     ``cdq''
752 :    
753 :     (* the INTO instruction is deprecated in 64-bit mode. *)
754 :     | INTO
755 :     ``int $4''
756 :    
757 :     (* floating-point operations (SSE scalar instructions) *)
758 :     | FMOVE of {fmvOp : fmove_op, dst : operand, src : operand}
759 :     ``<fmvOp>\t <src>, <dst>''
760 :    
761 :     | FBINOP of {binOp : fbin_op, dst : $FP, src : $FP}
762 :     ``<binOp>\t <src>, <dst>''
763 :    
764 :     | FCOM of {comOp : fcom_op, dst : $FP, src : operand}
765 :     ``<comOp>\t <src>, <dst>''
766 :    
767 : mrainey 2638 | FSQRTS of {dst : operand, src : operand}
768 :     ``sqrtss\t <src>, <dst>''
769 :    
770 :     | FSQRTD of {dst : operand, src : operand}
771 :     ``sqrtsd\t <src>, <dst>''
772 :    
773 : mrainey 2619 (* misc *)
774 :     | SAHF (* %flags -> %ah *)
775 :     ``sahf''
776 :    
777 :     | LAHF (* %ah -> %flags *)
778 :     ``lahf''
779 :    
780 :     | SOURCE of {}
781 :     asm: ``source''
782 :     mc: ()
783 :    
784 :     | SINK of {}
785 :     asm: ``sink''
786 :     mc: ()
787 :    
788 :     | PHI of {}
789 :     asm: ``phi''
790 :     mc: ()
791 :    
792 :     end
793 :    

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