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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2997 - (view) (download)
Original Path: MLRISC/trunk/staged-allocation/test-staged-allocation-amd64.sml

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 2997 (*
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 : mrainey 2997 *)
49 : mrainey 2993
50 :     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 :    
57 : mrainey 2997
58 : mrainey 2990 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)

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