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 2990 - (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 :     functor AMD64PseudoOpsFn (
42 :     structure T : MLTREE
43 :     structure MLTreeEval : MLTREE_EVAL where T = T
44 :     ) : PSEUDO_OPS_BASIS = AMD64DarwinPseudoOps (
45 :     structure T = T
46 :     structure MLTreeEval = MLTreeEval)
47 :    
48 :    
49 :     structure AMD64PseudoOps = AMD64PseudoOpsFn(
50 :     structure T = AMD64MLTree
51 :     structure MLTreeEval = AMD64MLTreeEval)
52 :    
53 :     structure PseudoOps =
54 :     struct
55 :    
56 :     structure Client =
57 :     struct
58 :     structure AsmPseudoOps = AMD64PseudoOps
59 :     type pseudo_op = unit
60 :    
61 :     fun toString () = ""
62 :    
63 :     fun emitValue _ = raise Fail "todo"
64 :     fun sizeOf _ = raise Fail "todo"
65 :     fun adjustLabels _ = raise Fail "todo"
66 :     end (* Client *)
67 :    
68 :     structure PseudoOps = PseudoOps (structure Client = Client)
69 :     end
70 :    
71 :     (*structure PS = PseudoOps (structure Client = AMD64PseudoOps.Client)*)
72 :     structure AMD64Stream = InstructionStream(PseudoOps.PseudoOps)
73 :     structure AMD64Instr = AMD64Instr (AMD64MLTree)
74 :     structure AMD64Shuffle = AMD64Shuffle(AMD64Instr)
75 :    
76 :     structure AMD64MLTreeHash =
77 :     MLTreeHash (structure T = AMD64MLTree
78 :     fun h _ _ = 0w0
79 :     val hashRext = h val hashFext = h
80 :     val hashCCext = h val hashSext = h)
81 :    
82 :     structure AMD64Asm = AMD64AsmEmitter
83 :     (structure Instr = AMD64Instr
84 :     structure S = AMD64Stream
85 :     structure MLTreeEval = AMD64MLTreeEval
86 :     structure Shuffle = AMD64Shuffle
87 :     )
88 :    
89 :     structure AMD64InsnProps = AMD64Props
90 :     (structure Instr = AMD64Instr
91 :     structure MLTreeHash = AMD64MLTreeHash
92 :     structure MLTreeEval = AMD64MLTreeEval)
93 :    
94 :     structure AMD64CFG = ControlFlowGraph (
95 :     structure I = AMD64Asm.I
96 :     structure GraphImpl = DirectedGraph
97 :     structure InsnProps = AMD64InsnProps
98 :     structure Asm = AMD64Asm)
99 :    
100 :     (*structure AMD64Stream = InstructionStream(AMD64PseudoOps)*)
101 :     structure AMD64MLTStream = MLTreeStream (
102 :     structure T = AMD64MLTree
103 :     structure S = AMD64Stream)
104 :    
105 :     structure CompInstrExt = AMD64CompInstrExt (
106 :     structure I = AMD64Instr
107 :     structure TS = AMD64MLTStream
108 :     structure CFG = AMD64CFG)
109 :    
110 :     structure AMD64MTC = struct
111 :     structure T = AMD64MLTree
112 :     structure TS = AMD64MLTStream
113 :     structure I = AMD64Instr
114 :     structure CFG = AMD64CFG
115 :     structure C = I.C
116 :     type reducer =
117 :     (I.instruction,C.cellset,I.operand,I.addressing_mode,AMD64CFG.cfg) TS.reducer
118 :     fun unimplemented _ = MLRiscErrorMsg.impossible "UserMLTreeExtComp"
119 :     val compileSext = CompInstrExt.compileSext
120 :     val compileRext = unimplemented
121 :     val compileFext = unimplemented
122 :     val compileCCext = unimplemented
123 :    
124 :     structure AMD64MLTreeUtils : MLTREE_UTILS =
125 :     struct
126 :     structure T = AMD64MLTree
127 :     structure IX = AMD64InstrExt
128 :     structure U = MLTreeUtils (
129 :     structure T = T
130 :     fun hashSext _ _ = 0w0
131 :     fun hashRext _ _ = 0w0
132 :     fun hashFext _ _ = 0w0
133 :     fun hashCCext _ _ = 0w0
134 :     fun eqSext _ _ = raise Fail "eqSext"
135 :     fun eqRext _ _ = raise Fail "eqRext"
136 :     fun eqFext _ _ = raise Fail "eqFext"
137 :     fun eqCCext _ _ = raise Fail "eqCCext"
138 :     fun showSext (prt : T.printer) ext = raise Fail "todo"
139 :     fun showRext _ _ = raise Fail "showRext"
140 :     fun showFext _ _ = raise Fail "showFext"
141 :     fun showCCext _ _ = raise Fail "showCCext")
142 :     open U
143 :     end
144 :     end
145 :    
146 :     structure AMD64 = AMD64Gen (
147 :     structure I = AMD64Instr
148 :     structure MLTreeUtils = AMD64MTC.AMD64MLTreeUtils
149 :     structure ExtensionComp = AMD64MTC
150 :     val floats16ByteAligned = floats16ByteAligned
151 :     fun signBit _ = raise Fail "todo"
152 :     fun negateSignBit _ = raise Fail "todo"
153 :     )
154 :    
155 :     structure AMD64Emit = CFGEmit (
156 :     structure CFG = AMD64CFG
157 :     structure E = AMD64Asm)
158 :    
159 :    
160 :     structure AMD64FlowGraph = BuildFlowgraph
161 :     (structure Props = AMD64InsnProps
162 :     structure Stream = AMD64Stream
163 :     structure CFG = AMD64CFG)
164 :    
165 :     structure AMD64Expand = CFGExpandCopies (structure CFG=AMD64CFG
166 :     structure Shuffle = AMD64Shuffle)
167 :     structure AMD64BlockPlacement = DefaultBlockPlacement(AMD64CFG)
168 :    
169 :     structure RASpill = RASpillWithRenaming (
170 :     structure Asm = AMD64Asm
171 :     structure InsnProps = AMD64InsnProps
172 :     val max_dist = ref 4
173 :     val keep_multiple_values = ref false)
174 :    
175 :     structure C = AMD64Cells
176 :    
177 :     datatype spill_operand_kind = SPILL_LOC
178 :     | CONST_VAL
179 :    
180 :     datatype ra_phase = SPILL_PROPAGATION
181 :     | SPILL_COLORING
182 :    
183 :     structure IntRA =
184 :     struct
185 :     val dedicated = [C.rsp, C.rbp]
186 :     val allRegs = C.Regs CellsBasis.GP {from=0, to=15, step=1}
187 :     val allRegsSet = foldl C.addReg C.empty allRegs
188 :     val avail = let
189 :     val availSet = foldl C.rmvReg allRegsSet dedicated
190 :     in
191 :     C.getReg availSet
192 :     end
193 :     fun spillInit _ = ()
194 :     fun spillLoc {info=frame, an, cell, id=loc} =
195 :     {opnd = AMD64Instr.Immed 0, kind = SPILL_LOC}
196 :     val phases = [SPILL_PROPAGATION, SPILL_COLORING]
197 :     end (* IntRA *)
198 :    
199 :     structure FloatRA =
200 :     struct
201 :     val avail = C.Regs CellsBasis.FP {from=0, to=15, step=1}
202 :     val dedicated = []
203 :     fun spillInit _ = ()
204 :     fun spillLoc (info, ans, id) = AMD64Instr.Immed 0
205 :     val phases = [SPILL_PROPAGATION, SPILL_COLORING]
206 :     end (* FloatRA *)
207 :    
208 :     (* register allocation *)
209 :     structure AMD64RA = AMD64RegAlloc (
210 :     structure I = AMD64Instr
211 :     structure CFG = AMD64CFG
212 :     structure Asm = AMD64Asm
213 :     structure SpillHeur = ChowHennessySpillHeur
214 :     structure Spill = RASpill
215 :     structure Props = AMD64InsnProps
216 :     val floats16ByteAligned = floats16ByteAligned
217 :     type spill_info = unit
218 :     fun beforeRA (Graph.GRAPH graph) = ()
219 :     datatype spill_operand_kind = datatype spill_operand_kind
220 :     datatype ra_phase = datatype ra_phase
221 :     structure Int = IntRA
222 :     structure Float = FloatRA)
223 :    
224 :     structure AMD64Expand = CFGExpandCopies (
225 :     structure CFG=AMD64CFG
226 :     structure Shuffle = AMD64Shuffle)
227 :    
228 :     structure CCalls = AMD64SVID (
229 :     structure T = AMD64MLTree
230 :     val frameAlign = 16)

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