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/staged-allocation/test-staged-allocation-amd64.sml
ViewVC logotype

Annotation of /MLRISC/trunk/staged-allocation/test-staged-allocation-amd64.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3008 - (view) (download)

1 : mrainey 2990 val floats16ByteAligned = true
2 :    
3 :     structure AMD64MLTree =
4 :     MLTreeF (structure Constant = UserConst
5 :     structure Region = UserRegion
6 :     structure Extension = UserExtension)
7 :    
8 :     structure AMD64MLTreeEval =
9 :     MLTreeEval (structure T = AMD64MLTree
10 :     fun eq _ _ = false
11 :     val eqRext = eq val eqFext = eq
12 :     val eqCCext = eq val eqSext = eq)
13 :    
14 :     (*
15 :     structure AMD64PseudoOps =
16 :     struct
17 :     structure Client =
18 :     struct
19 :     datatype pseudo_op_ext = COMM of (Label.label * int)
20 :     structure AsmPseudoOps = AMD64GasPseudoOps (
21 :     structure T = AMD64MLTree
22 :     structure MLTreeEval = AMD64MLTreeEval)
23 :     type pseudo_op = pseudo_op_ext
24 :     fun toString (COMM(lab, sz)) = concat[
25 :     "\t.comm\t"(*, P.lexpToString(P.T.LABEL lab)*),
26 :     ",", Int.toString sz]
27 :     fun emitValue {pOp, loc, emit} = raise Fail "emitValue"
28 :     fun sizeOf _ = 0
29 :     fun adjustLabels _ = false
30 :     end (* Client *)
31 :    
32 :     structure T = AMD64MLTree
33 :     type pseudo_op = (T.labexp, Client.pseudo_op) PseudoOpsBasisTyp.pseudo_op
34 :     fun toString _ = ""
35 :     fun emitValue _ = ()
36 :     fun sizeOf _ = 0
37 :     fun adjustLabels _ = false
38 :     end (* AMD64PseudoOps *)
39 :     *)
40 :    
41 : mrainey 3000
42 : mrainey 2990 functor AMD64PseudoOpsFn (
43 :     structure T : MLTREE
44 :     structure MLTreeEval : MLTREE_EVAL where T = T
45 : mrainey 2993 ) : PSEUDO_OPS_BASIS = AMD64GasPseudoOps (
46 :     structure T = T
47 :     structure MLTreeEval = MLTreeEval)
48 :    
49 : mrainey 3000 (*
50 : mrainey 2993 functor AMD64PseudoOpsFn (
51 :     structure T : MLTREE
52 :     structure MLTreeEval : MLTREE_EVAL where T = T
53 : mrainey 2990 ) : PSEUDO_OPS_BASIS = AMD64DarwinPseudoOps (
54 :     structure T = T
55 :     structure MLTreeEval = MLTreeEval)
56 : mrainey 3000 *)
57 : mrainey 2990
58 :     structure AMD64PseudoOps = AMD64PseudoOpsFn(
59 :     structure T = AMD64MLTree
60 :     structure MLTreeEval = AMD64MLTreeEval)
61 :    
62 :     structure PseudoOps =
63 :     struct
64 :    
65 :     structure Client =
66 :     struct
67 :     structure AsmPseudoOps = AMD64PseudoOps
68 :     type pseudo_op = unit
69 :    
70 :     fun toString () = ""
71 :    
72 :     fun emitValue _ = raise Fail "todo"
73 :     fun sizeOf _ = raise Fail "todo"
74 :     fun adjustLabels _ = raise Fail "todo"
75 :     end (* Client *)
76 :    
77 :     structure PseudoOps = PseudoOps (structure Client = Client)
78 :     end
79 :    
80 :     structure AMD64Stream = InstructionStream(PseudoOps.PseudoOps)
81 :     structure AMD64Instr = AMD64Instr (AMD64MLTree)
82 :     structure AMD64Shuffle = AMD64Shuffle(AMD64Instr)
83 :    
84 :     structure AMD64MLTreeHash =
85 :     MLTreeHash (structure T = AMD64MLTree
86 :     fun h _ _ = 0w0
87 :     val hashRext = h val hashFext = h
88 :     val hashCCext = h val hashSext = h)
89 :    
90 :     structure AMD64Asm = AMD64AsmEmitter
91 :     (structure Instr = AMD64Instr
92 :     structure S = AMD64Stream
93 :     structure MLTreeEval = AMD64MLTreeEval
94 :     structure Shuffle = AMD64Shuffle
95 :     )
96 :    
97 :     structure AMD64InsnProps = AMD64Props
98 :     (structure Instr = AMD64Instr
99 :     structure MLTreeHash = AMD64MLTreeHash
100 :     structure MLTreeEval = AMD64MLTreeEval)
101 :    
102 :     structure AMD64CFG = ControlFlowGraph (
103 :     structure I = AMD64Asm.I
104 :     structure GraphImpl = DirectedGraph
105 :     structure InsnProps = AMD64InsnProps
106 :     structure Asm = AMD64Asm)
107 :    
108 :     (*structure AMD64Stream = InstructionStream(AMD64PseudoOps)*)
109 :     structure AMD64MLTStream = MLTreeStream (
110 :     structure T = AMD64MLTree
111 :     structure S = AMD64Stream)
112 :    
113 :     structure CompInstrExt = AMD64CompInstrExt (
114 :     structure I = AMD64Instr
115 :     structure TS = AMD64MLTStream
116 :     structure CFG = AMD64CFG)
117 :    
118 :     structure AMD64MTC = struct
119 :     structure T = AMD64MLTree
120 :     structure TS = AMD64MLTStream
121 :     structure I = AMD64Instr
122 :     structure CFG = AMD64CFG
123 :     structure C = I.C
124 :     type reducer =
125 :     (I.instruction,C.cellset,I.operand,I.addressing_mode,AMD64CFG.cfg) TS.reducer
126 :     fun unimplemented _ = MLRiscErrorMsg.impossible "UserMLTreeExtComp"
127 :     val compileSext = CompInstrExt.compileSext
128 :     val compileRext = unimplemented
129 :     val compileFext = unimplemented
130 :     val compileCCext = unimplemented
131 :    
132 :     structure AMD64MLTreeUtils : MLTREE_UTILS =
133 :     struct
134 :     structure T = AMD64MLTree
135 :     structure IX = AMD64InstrExt
136 :     structure U = MLTreeUtils (
137 :     structure T = T
138 :     fun hashSext _ _ = 0w0
139 :     fun hashRext _ _ = 0w0
140 :     fun hashFext _ _ = 0w0
141 :     fun hashCCext _ _ = 0w0
142 :     fun eqSext _ _ = raise Fail "eqSext"
143 :     fun eqRext _ _ = raise Fail "eqRext"
144 :     fun eqFext _ _ = raise Fail "eqFext"
145 :     fun eqCCext _ _ = raise Fail "eqCCext"
146 :     fun showSext (prt : T.printer) ext = raise Fail "todo"
147 :     fun showRext _ _ = raise Fail "showRext"
148 :     fun showFext _ _ = raise Fail "showFext"
149 :     fun showCCext _ _ = raise Fail "showCCext")
150 :     open U
151 :     end
152 :     end
153 :    
154 :     structure AMD64 = AMD64Gen (
155 :     structure I = AMD64Instr
156 :     structure MLTreeUtils = AMD64MTC.AMD64MLTreeUtils
157 :     structure ExtensionComp = AMD64MTC
158 :     val floats16ByteAligned = floats16ByteAligned
159 :     fun signBit _ = raise Fail "todo"
160 :     fun negateSignBit _ = raise Fail "todo"
161 :     )
162 :    
163 :     structure AMD64Emit = CFGEmit (
164 :     structure CFG = AMD64CFG
165 :     structure E = AMD64Asm)
166 :    
167 :    
168 :     structure AMD64FlowGraph = BuildFlowgraph
169 :     (structure Props = AMD64InsnProps
170 :     structure Stream = AMD64Stream
171 :     structure CFG = AMD64CFG)
172 :    
173 :     structure AMD64Expand = CFGExpandCopies (structure CFG=AMD64CFG
174 :     structure Shuffle = AMD64Shuffle)
175 :     structure AMD64BlockPlacement = DefaultBlockPlacement(AMD64CFG)
176 :    
177 :     structure RASpill = RASpillWithRenaming (
178 :     structure Asm = AMD64Asm
179 :     structure InsnProps = AMD64InsnProps
180 :     val max_dist = ref 4
181 :     val keep_multiple_values = ref false)
182 :    
183 :     structure C = AMD64Cells
184 :    
185 :     datatype spill_operand_kind = SPILL_LOC
186 :     | CONST_VAL
187 :    
188 :     datatype ra_phase = SPILL_PROPAGATION
189 :     | SPILL_COLORING
190 :    
191 :     structure IntRA =
192 :     struct
193 :     val dedicated = [C.rsp, C.rbp]
194 :     val allRegs = C.Regs CellsBasis.GP {from=0, to=15, step=1}
195 :     val allRegsSet = foldl C.addReg C.empty allRegs
196 :     val avail = let
197 :     val availSet = foldl C.rmvReg allRegsSet dedicated
198 :     in
199 :     C.getReg availSet
200 :     end
201 :     fun spillInit _ = ()
202 :     fun spillLoc {info=frame, an, cell, id=loc} =
203 : mrainey 2995 raise Fail ""
204 :     (* {opnd = AMD64Instr.Immed 0, kind = SPILL_LOC}*)
205 : mrainey 2990 val phases = [SPILL_PROPAGATION, SPILL_COLORING]
206 :     end (* IntRA *)
207 :    
208 :     structure FloatRA =
209 :     struct
210 :     val avail = C.Regs CellsBasis.FP {from=0, to=15, step=1}
211 :     val dedicated = []
212 :     fun spillInit _ = ()
213 : mrainey 2995 fun spillLoc (info, ans, id) = raise Fail ""
214 : mrainey 2990 val phases = [SPILL_PROPAGATION, SPILL_COLORING]
215 :     end (* FloatRA *)
216 :    
217 :     (* register allocation *)
218 :     structure AMD64RA = AMD64RegAlloc (
219 :     structure I = AMD64Instr
220 :     structure CFG = AMD64CFG
221 :     structure Asm = AMD64Asm
222 :     structure SpillHeur = ChowHennessySpillHeur
223 :     structure Spill = RASpill
224 :     structure Props = AMD64InsnProps
225 :     val floats16ByteAligned = floats16ByteAligned
226 :     type spill_info = unit
227 :     fun beforeRA (Graph.GRAPH graph) = ()
228 :     datatype spill_operand_kind = datatype spill_operand_kind
229 :     datatype ra_phase = datatype ra_phase
230 :     structure Int = IntRA
231 :     structure Float = FloatRA)
232 :    
233 :     structure AMD64Expand = CFGExpandCopies (
234 :     structure CFG=AMD64CFG
235 :     structure Shuffle = AMD64Shuffle)
236 :    
237 :     structure CCalls = AMD64SVID (
238 :     structure T = AMD64MLTree
239 :     val frameAlign = 16)
240 : mrainey 3000
241 :    
242 :     structure RA2 =
243 :     RISC_RA
244 :     (structure I = AMD64Instr
245 :     structure Asm = AMD64Asm
246 :     structure CFG = AMD64CFG
247 :     structure InsnProps = AMD64InsnProps
248 :     structure Rewrite =
249 :     struct
250 :     structure I = AMD64Instr
251 : mrainey 3008 structure C=I.C
252 :     structure CB = CellsBasis
253 :     fun error msg = MLRiscErrorMsg.error("X86Rewrite", msg)
254 :    
255 :     fun operand (rs,rt) opnd =
256 :     (case opnd
257 :     of I.Direct (sz, r) => if CB.sameColor(r,rs) then I.Direct (sz, rt) else opnd
258 :     | I.Displace{base, disp, mem} =>
259 :     if CB.sameColor(base,rs) then I.Displace{base=rt, disp=disp, mem=mem}
260 :     else opnd
261 :     | I.Indexed{base as SOME b, index, scale, disp, mem} => let
262 :     val base'= if CB.sameColor(b,rs) then SOME rt else base
263 :     val index'=if CB.sameColor(index,rs) then rt else index
264 :     in I.Indexed{base=base', index=index', scale=scale, disp=disp, mem=mem}
265 :     end
266 :     | I.Indexed{base, index, scale, disp, mem=mem} =>
267 :     if CB.sameColor(index,rs) then
268 :     I.Indexed{base=base, index=rt, scale=scale, disp=disp, mem=mem}
269 :     else opnd
270 :     | _ => opnd
271 :     (*end case*))
272 :    
273 :    
274 :     fun rewriteDef (instr, rs, rt) = let
275 :     fun operand(opnd as I.Direct (sz, r)) =
276 :     if CB.sameColor(r,rs) then I.Direct (sz, rt) else opnd
277 :     | operand _ = error "operand: not I.Direct"
278 :     fun replace r = if CB.sameColor(r,rs) then rt else r
279 :     fun rewriteX86Def(instr) =
280 :     (case instr
281 :     of I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} =>
282 :     I.CALL{opnd=opnd, cutsTo=cutsTo,
283 :     return=CB.CellSet.map {from=rs,to=rt} return, pops=pops,
284 :     defs=CB.CellSet.map {from=rs,to=rt} defs, uses=uses, mem=mem}
285 :     | I.MOVE{mvOp, src, dst} => I.MOVE{mvOp=mvOp, src=src, dst=operand dst}
286 :     | I.LEAL{r32, addr} => I.LEAL{r32=replace r32, addr=addr}
287 :     | I.LEAQ{r64, addr} => I.LEAQ{r64=replace r64, addr=addr}
288 :     | I.BINARY{binOp, src, dst} =>
289 :     I.BINARY{binOp=binOp, src=src, dst=operand dst}
290 :     | I.SHIFT{shiftOp, src, dst, count} =>
291 :     I.SHIFT{shiftOp=shiftOp, src=src, count=count, dst=operand dst}
292 :     | I.UNARY{unOp, opnd} => I.UNARY{unOp=unOp, opnd=operand opnd}
293 :     | I.SET{cond, opnd} => I.SET{cond=cond, opnd=operand opnd}
294 :     | _ => instr
295 :     (* end case *))
296 :    
297 :     fun f (I.ANNOTATION{a,i}) =
298 :     I.ANNOTATION{i=rewriteDef(i,rs,rt),
299 :     a=(case a of
300 :     CB.DEF_USE{cellkind=CB.GP,defs,uses} =>
301 :     CB.DEF_USE{cellkind=CB.GP,uses=uses,
302 :     defs=map replace defs}
303 :     | _ => a)}
304 :     | f (I.INSTR i) = I.INSTR(rewriteX86Def(i))
305 :     | f (I.COPY{k as CB.GP, sz, dst, src, tmp}) =
306 :     I.COPY{k=k, sz=sz, dst=map replace dst, src=src, tmp=tmp}
307 :     in
308 :     f(instr)
309 :     end
310 :    
311 :    
312 :     fun rewriteUse (instr, rs, rt) = let
313 :     val operand = operand (rs, rt)
314 :     fun replace r = if CB.sameColor(r,rs) then rt else r
315 :     fun rewrite instr = (case instr
316 :     of I.JMP(opnd, labs) => I.JMP(operand opnd, labs)
317 :     | I.JCC{cond, opnd} => I.JCC{cond=cond, opnd = operand opnd}
318 :     | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} =>
319 :     I.CALL{opnd=operand opnd, defs=defs, return=return,
320 :     uses=CB.CellSet.map {from=rs,to=rt} uses, cutsTo=cutsTo,
321 :     mem=mem, pops=pops}
322 :     | I.MOVE{mvOp, src, dst as I.Direct _} =>
323 :     I.MOVE{mvOp=mvOp, src=operand src, dst=dst}
324 :     | I.MOVE{mvOp, src, dst} =>
325 :     I.MOVE{mvOp=mvOp, src=operand src, dst=operand dst}
326 :     | I.LEAL{r32, addr} => I.LEAL{r32=r32, addr=operand addr}
327 :     | I.LEAQ{r64, addr} => I.LEAQ{r64=r64, addr=operand addr}
328 :     | I.CMPL{lsrc, rsrc} => I.CMPL{lsrc=operand lsrc, rsrc=operand rsrc}
329 :     | I.CMPW{lsrc, rsrc} => I.CMPW{lsrc=operand lsrc, rsrc=operand rsrc}
330 :     | I.CMPB{lsrc, rsrc} => I.CMPB{lsrc=operand lsrc, rsrc=operand rsrc}
331 :     | I.TESTL{lsrc, rsrc} => I.TESTL{lsrc=operand lsrc, rsrc=operand rsrc}
332 :     | I.TESTW{lsrc, rsrc} => I.TESTW{lsrc=operand lsrc, rsrc=operand rsrc}
333 :     | I.TESTB{lsrc, rsrc} => I.TESTB{lsrc=operand lsrc, rsrc=operand rsrc}
334 :     | I.BITOP{bitOp, lsrc, rsrc} =>
335 :     I.BITOP{bitOp=bitOp, lsrc=operand lsrc, rsrc=operand rsrc}
336 :     | I.BINARY{binOp, src, dst} =>
337 :     I.BINARY{binOp=binOp, src=operand src, dst=operand dst}
338 :     | I.SHIFT{shiftOp, src, dst, count} =>
339 :     I.SHIFT{shiftOp=shiftOp, src=operand src, dst=operand dst,
340 :     count=operand src}
341 :     (* end case *))
342 :    
343 :     fun f(I.ANNOTATION{a,i}) =
344 :     I.ANNOTATION{i=rewriteUse(i, rs, rt),
345 :     a = case a of
346 :     CB.DEF_USE{cellkind=CB.GP,defs,uses} =>
347 :     CB.DEF_USE{cellkind=CB.GP,uses=map replace uses,
348 :     defs=defs}
349 :     | _ => a}
350 :     | f(I.INSTR i) = I.INSTR(rewrite(i))
351 :     | f(I.COPY{k as CB.GP, sz, dst, src, tmp}) =
352 :     I.COPY{k=k, sz=sz, dst=dst, src=List.map replace src, tmp=tmp}
353 :     in
354 :     f (instr:I.instruction)
355 :     end
356 :    
357 :    
358 : mrainey 3000 fun frewriteDef _ = raise Fail ""
359 :     fun frewriteUse _ = raise Fail ""
360 :     end
361 :     structure SpillInstr = AMD64SpillInstr (
362 :     structure I = I
363 :     structure Props = AMD64InsnProps
364 :     val floats16ByteAligned = true)
365 :     structure SpillHeur = ChaitinSpillHeur
366 :     structure Spill = RASpill (structure InsnProps = AMD64InsnProps
367 :     structure Asm = AMD64Asm)
368 :    
369 :     datatype spillOperandKind = SPILL_LOC | CONST_VAL
370 :     type spill_info = unit
371 : mrainey 3008 fun beforeRA _ = ()
372 : mrainey 3000
373 :     val architecture = "amd64"
374 :     fun pure _ = true
375 :    
376 :     structure Int =
377 :     struct
378 : mrainey 3008 val avail = C.Regs CellsBasis.GP {from=0, to=15, step=1}
379 :     val dedicated = [C.rsp, C.rbp]
380 : mrainey 3000 fun spillLoc _ = raise Fail ""
381 :     val mode = RACore.NO_OPTIMIZATION
382 :     end
383 :     structure Float =
384 :     struct
385 : mrainey 3008 val avail = C.Regs CellsBasis.FP {from=0, to=15, step=1}
386 : mrainey 3000 val dedicated = []
387 :     fun spillLoc _ = raise Fail ""
388 : mrainey 3008 val mode = Word.orb (RACore.HAS_PARALLEL_COPIES, RACore.DEAD_COPY_ELIM)
389 : mrainey 3000 end
390 :    
391 :     )
392 :    

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