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/c-call/test/c-sparc-test.sml
ViewVC logotype

Annotation of /MLRISC/trunk/c-call/test/c-sparc-test.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3173 - (view) (download)

1 : mrainey 3173 local
2 :    
3 :     (*---------------------------------------------------------------------------
4 :     * First, some front-end dependent stuff. Typically, you only need
5 :     * one instance of these things for each source language.
6 :     *---------------------------------------------------------------------------*)
7 :    
8 :     (*
9 :     * User defined constant type. Dummy for now.
10 :     * In practice, you'll want to use this type to implement constants with
11 :     * values that cannot be determined until final code generation, e.g.
12 :     * stack frame offset.
13 :     *)
14 :     structure UserConst =
15 :     struct
16 :     type const = unit
17 :     fun toString() = ""
18 :     fun hash() = 0w0
19 :     fun valueOf _ = 0
20 :     fun == _ = true
21 :     end
22 :    
23 :     (*
24 :     * Instantiate label expressions with respect to user defined constants.
25 :     * This type is somewhat misnamed; it is used to represent constant
26 :     * expressions.
27 :     *)
28 :     (* structure LabelExp = LabelExp(UserConst) *)
29 :    
30 :     (*
31 :     * User defined datatype for representing aliasing. Dummy for now.
32 :     * You'll need this to represent aliasing information.
33 :     *)
34 :     structure UserRegion =
35 :     struct
36 :     type region = unit
37 :     fun toString () = ""
38 :     val memory = ()
39 :     val stack = ()
40 :     val readonly = ()
41 :     val spill = ()
42 :     end
43 :    
44 :     (*
45 :     * User defined datatype for representing pseudo assembly operators.
46 :     * Dummy for now.
47 :     *
48 :     * You'll need this to represent assembler directives.
49 :     *)
50 :     structure UserPseudoOps =
51 :     struct
52 :     type pseudo_op = unit
53 :     fun toString () = ""
54 :     fun emitValue _ = ()
55 :     fun sizeOf _ = 0
56 :     fun adjustLabels _ = true
57 :     end
58 :    
59 :    
60 :     (*
61 :     * Instruction stream datatype.
62 :     * This is just a simple record type used by MLRISC to represent
63 :     * instruction streams.
64 :     *)
65 :     (*structure Stream = InstructionStream(UserPseudoOps)*)
66 :    
67 :     (*
68 :     * Client defined extensions. None for now.
69 :     * You'll need this only if you need to extend the set of MLTREE operators
70 :     *)
71 :     structure UserExtension =
72 :     struct
73 :    
74 :     type ('s,'r,'f,'c) sx = ('s,'r,'f,'c) SparcInstrExt.sext
75 :     type ('s,'r,'f,'c) rx = unit
76 :     type ('s,'r,'f,'c) fx = unit
77 :     type ('s,'r,'f,'c) ccx = unit
78 :    
79 :     end
80 :    
81 :     structure SparcMLTree =
82 :     MLTreeF (structure Constant = UserConst
83 :     structure Region = UserRegion
84 :     structure Extension = UserExtension)
85 :    
86 :     (*
87 :     * This module controls how we handle user extensions. Since we don't
88 :     * have any yet. This is just a bunch of dummy routines.
89 :     *)
90 :     functor SparcMLTreeExtComp
91 :     (structure T : MLTREE
92 :     where Extension = UserExtension
93 :     structure I : SPARCINSTR
94 :     where T = T
95 :     structure Stream : MLTREE_STREAM
96 :     where T = I.T
97 :     structure CFG : CONTROL_FLOW_GRAPH
98 :     where I = I
99 :     and P = Stream.S.P
100 :     ) : MLTREE_EXTENSION_COMP =
101 :     struct
102 :     structure TS = Stream
103 :     structure I = I
104 :     structure T = I.T
105 :     structure C = I.C
106 :     structure Ext = UserExtension
107 :     structure CFG = CFG
108 :     structure SparcCompInstrExt =
109 :     SparcCompInstrExt(structure I = I structure CFG = CFG structure TS=Stream)
110 :    
111 :     type reducer =
112 :     (I.instruction,C.cellset,I.operand,I.addressing_mode, CFG.cfg) TS.reducer
113 :    
114 :     fun unimplemented _ = MLRiscErrorMsg.impossible "SparcMLTreeExtComp"
115 :    
116 :     val compileSext = SparcCompInstrExt.compileSext
117 :     val compileRext = unimplemented
118 :     val compileCCext = unimplemented
119 :     val compileFext = unimplemented
120 :     end
121 :    
122 :     (*---------------------------------------------------------------------------
123 :     * Backend specific stuff. You'll need one instance of these things
124 :     * for each architecture.
125 :     *---------------------------------------------------------------------------*)
126 :    
127 :     (*
128 :     * The Sparc instruction set, specialized with respect to the
129 :     * user constant and region types.
130 :     *)
131 :     structure SparcInstr = SparcInstr
132 :     (SparcMLTree
133 :     )
134 :    
135 :     (*
136 :     * How to serialize parallel copies
137 :     *)
138 :     structure SparcShuffle = SparcShuffle(SparcInstr)
139 :    
140 :     structure SparcMLTreeEval =
141 :     MLTreeEval (structure T = SparcMLTree
142 :     fun eq _ _ = false
143 :     val eqRext = eq val eqFext = eq
144 :     val eqCCext = eq val eqSext = eq)
145 :    
146 :     functor SparcPseudoOpsFn (
147 :     structure T : MLTREE
148 :     structure MLTreeEval : MLTREE_EVAL where T = T
149 :     ) : PSEUDO_OPS_BASIS = SparcGasPseudoOps (
150 :     structure T = SparcMLTree
151 :     structure MLTreeEval = SparcMLTreeEval)
152 :    
153 :     structure SparcPseudoOps = SparcPseudoOpsFn(
154 :     structure T = SparcMLTree
155 :     structure MLTreeEval = SparcMLTreeEval)
156 :    
157 :     structure PseudoOps =
158 :     struct
159 :    
160 :     structure Client =
161 :     struct
162 :     structure AsmPseudoOps = SparcPseudoOps
163 :     type pseudo_op = unit
164 :    
165 :     fun toString () = ""
166 :    
167 :     fun emitValue _ = raise Fail "todo"
168 :     fun sizeOf _ = raise Fail "todo"
169 :     fun adjustLabels _ = raise Fail "todo"
170 :     end (* Client *)
171 :    
172 :     structure PseudoOps = PseudoOps (structure Client = Client)
173 :     end
174 :    
175 :     structure Stream = InstructionStream(PseudoOps.PseudoOps)
176 :    
177 :     (*
178 :     * The assembler
179 :     *)
180 :     structure SparcAsm = SparcAsmEmitter
181 :     (structure Instr = SparcInstr
182 :     structure Stream = Stream
183 :     structure Shuffle = SparcShuffle
184 :     structure S = Stream
185 :     structure MLTreeEval = SparcMLTreeEval
186 :     val V9 = false (* we'll generate V8 instructions for now *)
187 :     )
188 :    
189 :     (*
190 :     * Because of various Sparc related ugliness. Pseudo instructions
191 :     * related to integer multiplication/division are handled via callbacks.
192 :     * Here we can decide what actual code to generate. Here we only
193 :     * handle a subset of of the pseudo instructions.
194 :     *)
195 :     structure SparcPseudoInstrs =
196 :     struct
197 :     structure I = SparcInstr
198 :     structure C = SparcInstr.C
199 :    
200 :     type format1 =
201 :     {r:CellsBasis.cell, i:I.operand, d:CellsBasis.cell} *
202 :     (I.operand -> CellsBasis.cell) -> I.instruction list
203 :    
204 :     type format2 =
205 :     {i:I.operand, d:CellsBasis.cell} *
206 :     (I.operand -> CellsBasis.cell) -> I.instruction list
207 :    
208 :     fun error msg = MLRiscErrorMsg.impossible ("SparcPseudoInstrs."^msg)
209 :    
210 :     fun umul32({r, i, d}, reduceOpnd) = [I.ARITH{a=I.UMUL,r=r,i=i,d=d}]
211 :     fun smul32({r, i, d}, reduceOpnd) = [I.ARITH{a=I.SMUL,r=r,i=i,d=d}]
212 :     fun udiv32({r,i,d},reduceOpnd) =
213 :     [I.WRY{r=C.r0,i=I.REG(C.r0)},I.ARITH{a=I.UDIV,r=r,i=i,d=d}]
214 :    
215 :     fun sdiv32({r,i,d},reduceOpnd) =
216 :     let val t1 = C.newReg()
217 :     in [I.SHIFT{s=I.SRA,r=r,i=I.IMMED 31,d=t1},
218 :     I.WRY{r=t1,i=I.REG(C.r0)},
219 :     I.ARITH{a=I.SDIV,r=r,i=i,d=d}
220 :     ]
221 :     end
222 :    
223 :     fun cvti2d({i,d},reduceOpnd) = error "cvti2d"
224 :     (* There is no data path between integer and floating point registers.
225 :     So we actually have to use some memory location for temporary
226 :     This is commented out for now.
227 :     *)
228 :     (*
229 :     [I.STORE{s=I.ST,r=C.stackptrR,i=floatTmpOffset,d=reduceOpnd i,mem=stack},
230 :     I.FLOAD{l=I.LDF,r=C.stackptrR,i=floatTmpOffset,d=d,mem=stack},
231 :     I.FPop1{a=I.FiTOd,r=d,d=d}
232 :     ]
233 :     *)
234 :     fun cvti2s _ = error "cvti2s"
235 :     fun cvti2q _ = error "cvti2q"
236 :    
237 :     fun smul32trap _ = error "smul32trap"
238 :     fun sdiv32trap _ = error "sdiv32trap"
239 :    
240 :     val overflowtrap32 = [] (* not needed *)
241 :     val overflowtrap64 = [] (* not needed *)
242 :     end
243 :    
244 :     structure SparcMLTreeHash =
245 :     MLTreeHash
246 :     (structure T = SparcMLTree
247 :     fun h _ _ = 0w0
248 :     val hashRext = h val hashFext = h
249 :     val hashCCext = h val hashSext = h)
250 :    
251 :     structure SparcProps =
252 :     SparcProps
253 :     (structure SparcInstr = SparcInstr
254 :     structure MLTreeEval = SparcMLTreeEval
255 :     structure MLTreeHash = SparcMLTreeHash)
256 :    
257 :     structure SparcAsmEmitter =
258 :     SparcAsmEmitter(structure Instr=SparcInstr
259 :     structure Shuffle=SparcShuffle
260 :     structure S = Stream
261 :     structure MLTreeEval=SparcMLTreeEval
262 :     val V9 = false)
263 :    
264 :    
265 :     structure SparcCFG =
266 :     ControlFlowGraph
267 :     (structure I = SparcInstr
268 :     structure PseudoOps = SparcPseudoOps
269 :     structure GraphImpl = DirectedGraph
270 :     structure InsnProps = SparcProps
271 :     structure Asm = SparcAsmEmitter)
272 :    
273 :     (*
274 :     structure MLTreeComp=
275 :     Sparc(structure SparcInstr = SparcInstr
276 :     structure SparcMLTree = SparcMLTree
277 :     structure PseudoInstrs = SparcPseudoInstrs
278 :     structure ExtensionComp = SparcMLTreeExtComp
279 :     (structure I = SparcInstr
280 :     structure T = SparcMLTree
281 :     structure Stream = Stream
282 :     structure CFG = SparcCFG
283 :     )
284 :     val V9 = false
285 :     val muluCost = ref 5
286 :     val multCost = ref 3
287 :     val divuCost = ref 5
288 :     val divtCost = ref 5
289 :     val registerwindow = ref false
290 :     val useBR = ref false
291 :     )
292 :     *)
293 :     (*
294 :     (*---------------------------------------------------------------------------
295 :     * Okay. Finally, we can tie the front-end and back-end together.
296 :     *---------------------------------------------------------------------------*)
297 :     structure SparcBackEnd =
298 :     BackEnd
299 :     (structure Flowgraph = SparcFlowGraph
300 :     structure MLTreeComp = SparcMLTreeComp
301 :     structure Asm = SparcAsm
302 :    
303 :     structure RA =
304 :     RISC_RA
305 :     (structure I = SparcInstr
306 :     structure Flowgraph = Flowgraph
307 :     structure Asm = Asm
308 :     structure InsnProps = InsnProps
309 :     structure Spill = RASpill(structure Asm = Asm
310 :     structure InsnProps = InsnProps)
311 :     structure Rewrite = SparcRewrite(SparcInstr)
312 :     structure SpillHeur = ChaitinSpillHeur
313 :     structure C = I.C
314 :    
315 :     val sp = C.stackptrR
316 :     val spill = UserRegion.spill
317 :    
318 :     structure SpillTable = SpillTable
319 :     (val initialSpillOffset = 0 (* This is probably wrong!!!!! *)
320 :     val spillAreaSz = 4000
321 :     val architecture = "Sparc"
322 :     )
323 :     open SpillTable
324 :    
325 :     fun pure(I.ANNOTATION{i,...}) = pure i
326 :     | pure(I.LOAD _) = true
327 :     | pure(I.FLOAD _) = true
328 :     | pure(I.SETHI _) = true
329 :     | pure(I.SHIFT _) = true
330 :     | pure(I.FPop1 _) = true
331 :     | pure(I.FPop2 _) = true
332 :     | pure _ = false
333 :    
334 :     (* I'm assuming only r0 and the stack pointer is dedicated *)
335 :     structure Int =
336 :     struct
337 :     val dedicated = [I.C.stackptrR, I.C.GPReg 0]
338 :     val avail =
339 :     C.SortedCells.return
340 :     (C.SortedCells.difference(
341 :     C.SortedCells.uniq(
342 :     C.Regs C.GP {from=0, to=31, step=1}),
343 :     C.SortedCells.uniq dedicated)
344 :     )
345 :    
346 :     fun copy((rds as [_], rss as [_]), _) =
347 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=NONE}
348 :     | copy((rds, rss), I.COPY{tmp, ...}) =
349 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
350 :    
351 :     (* spill copy temp *)
352 :     fun spillCopyTmp(_,I.COPY{dst,src,tmp,impl},loc) =
353 :     I.COPY{dst=dst, src=src, impl=impl,
354 :     tmp=SOME(I.Displace{base=sp, disp=get loc})}
355 :    
356 :     (* spill register *)
357 :     fun spillInstr{an,src,spilledCell,spillLoc} =
358 :     [I.STORE{s=I.ST, r=sp, i=I.IMMED(get spillLoc), d=src,
359 :     mem=spill}]
360 :    
361 :     (* reload register *)
362 :     fun reloadInstr{an,dst,spilledCell,spillLoc} =
363 :     [I.LOAD{l=I.LD, r=sp, i=I.IMMED(get spillLoc), d=dst,
364 :     mem=spill}]
365 :     end
366 :    
367 :     structure Float =
368 :     struct
369 :     val dedicated = []
370 :     val avail = C.Regs C.FP {from=0, to=31, step=2}
371 :    
372 :     fun copy((fds as [_], fss as [_]), _) =
373 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=NONE}
374 :     | copy((fds, fss), I.FCOPY{tmp, ...}) =
375 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
376 :    
377 :     fun spillCopyTmp(_,I.FCOPY{dst,src,tmp,impl},loc) =
378 :     I.FCOPY{dst=dst, src=src, impl=impl,
379 :     tmp=SOME(I.Displace{base=sp, disp=getF loc})}
380 :    
381 :     fun spillInstr(_, d,loc) =
382 :     [I.FSTORE{s=I.STDF, r=sp, i=I.IMMED(getF loc), d=d, mem=spill}]
383 :    
384 :     fun reloadInstr(_,d,loc) =
385 :     [I.FLOAD{l=I.LDDF, r=sp, i=I.IMMED(getF loc), d=d, mem=spill}]
386 :     end
387 :     )
388 :     )
389 :     *)
390 :     in
391 :     structure SparcTest = struct end
392 :     end

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