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 /sml/trunk/src/MLRISC/sparc/mltree/sparc.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/sparc/mltree/sparc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1117 - (view) (download)

1 : jhr 1117 (* sparc.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *
5 : monnier 411 * This is a new instruction selection module for Sparc,
6 :     * using the new instruction representation and the new MLTREE representation.
7 :     * Support for V9 has been added.
8 : monnier 245 *
9 : monnier 411 * The cc bit in arithmetic op are now embedded within the arithmetic
10 :     * opcode. This should save some space.
11 : monnier 245 *
12 : monnier 411 * -- Allen
13 : monnier 245 *)
14 :    
15 :     functor Sparc
16 :     (structure SparcInstr : SPARCINSTR
17 : monnier 411 structure PseudoInstrs : SPARC_PSEUDO_INSTR
18 : george 933 where I = SparcInstr
19 : george 555 structure ExtensionComp : MLTREE_EXTENSION_COMP
20 : george 933 where I = SparcInstr
21 :     and T = SparcInstr.T
22 :    
23 :    
24 : monnier 411 (*
25 :     * The client should also specify these parameters.
26 :     * These are the estimated cost of these instructions.
27 :     * The code generator will use alternative sequences that are
28 :     * cheaper when their costs are lower.
29 :     *)
30 : george 545 val muluCost : int ref (* cost of unsigned multiplication in cycles *)
31 : monnier 411 val divuCost : int ref (* cost of unsigned division in cycles *)
32 :     val multCost : int ref (* cost of trapping/signed multiplication in cycles *)
33 :     val divtCost : int ref (* cost of trapping/signed division in cycles *)
34 :    
35 :     (*
36 :     * If you don't want to use register windows at all, set this to false.
37 :     *)
38 :     val registerwindow : bool ref (* should we use register windows? *)
39 :    
40 :     val V9 : bool (* should we use V9 instruction set? *)
41 :     val useBR : bool ref
42 :     (* should we use the BR instruction (when in V9)?
43 :     * I think it is a good idea to use it.
44 :     *)
45 : monnier 245 ) : MLTREECOMP =
46 :     struct
47 : leunga 775 structure I = SparcInstr
48 :     structure T = I.T
49 : george 984 structure TS = ExtensionComp.TS
50 : leunga 775 structure R = T.Region
51 : monnier 411 structure C = I.C
52 : george 889 structure CB = CellsBasis
53 : monnier 245 structure W = Word32
54 :     structure P = PseudoInstrs
55 : george 545 structure A = MLRiscAnnotations
56 : george 909 structure CFG = ExtensionComp.CFG
57 : monnier 245
58 : george 984 type instrStream = (I.instruction, C.cellset, CFG.cfg) TS.stream
59 :     type mltreeStream = (T.stm, T.mlrisc list, CFG.cfg) TS.stream
60 : george 545
61 : george 761 val int_0 = T.I.int_0
62 :     fun toInt n = T.I.toInt(32, n)
63 :     fun LI i = T.LI(T.I.fromInt(32, i))
64 :     fun LT (n,m) = T.I.LT(32, n, m)
65 :     fun LE (n,m) = T.I.LE(32, n, m)
66 : george 1009 fun COPY{dst, src, tmp} =
67 :     I.COPY{k=CB.GP, sz=32, dst=dst, src=src, tmp=tmp}
68 :     fun FCOPY{dst, src, tmp} =
69 :     I.COPY{k=CB.FP, sz=64, dst=dst, src=src, tmp=tmp}
70 : george 761
71 : leunga 624 val intTy = if V9 then 64 else 32
72 : monnier 411 structure Gen = MLTreeGen(structure T = T
73 : jhr 1117 structure Cells = C
74 : leunga 624 val intTy = intTy
75 : monnier 411 val naturalWidths = if V9 then [32,64] else [32]
76 : monnier 429 datatype rep = SE | ZE | NEITHER
77 :     val rep = NEITHER
78 : monnier 411 )
79 : monnier 245
80 : monnier 411 functor Multiply32 = MLTreeMult
81 :     (structure I = I
82 :     structure T = T
83 : george 889 structure CB = CellsBasis
84 :     type arg = {r1:CB.cell,r2:CB.cell,d:CB.cell}
85 :     type argi = {r:CB.cell,i:int,d:CB.cell}
86 : monnier 411
87 :     val intTy = 32
88 : george 1009 fun mov{r,d} = COPY{dst=[d],src=[r],tmp=NONE}
89 : george 1003 fun add{r1,r2,d} = I.arith{a=I.ADD,r=r1,i=I.REG r2,d=d}
90 :     fun slli{r,i,d} = [I.shift{s=I.SLL,r=r,i=I.IMMED i,d=d}]
91 :     fun srli{r,i,d} = [I.shift{s=I.SRL,r=r,i=I.IMMED i,d=d}]
92 :     fun srai{r,i,d} = [I.shift{s=I.SRA,r=r,i=I.IMMED i,d=d}]
93 : monnier 411 )
94 : monnier 245
95 : monnier 411 functor Multiply64 = MLTreeMult
96 :     (structure I = I
97 :     structure T = T
98 : george 889 structure CB = CellsBasis
99 :     type arg = {r1:CB.cell,r2:CB.cell,d:CB.cell}
100 :     type argi = {r:CB.cell,i:int,d:CB.cell}
101 : monnier 411
102 :     val intTy = 64
103 : george 1009 fun mov{r,d} = COPY{dst=[d],src=[r],tmp=NONE}
104 : george 1003 fun add{r1,r2,d} = I.arith{a=I.ADD,r=r1,i=I.REG r2,d=d}
105 :     fun slli{r,i,d} = [I.shift{s=I.SLLX,r=r,i=I.IMMED i,d=d}]
106 :     fun srli{r,i,d} = [I.shift{s=I.SRLX,r=r,i=I.IMMED i,d=d}]
107 :     fun srai{r,i,d} = [I.shift{s=I.SRAX,r=r,i=I.IMMED i,d=d}]
108 : monnier 411 )
109 : monnier 245
110 : monnier 411 (* signed, trapping version of multiply and divide *)
111 :     structure Mult32 = Multiply32
112 :     (val trapping = true
113 :     val multCost = multCost
114 :     fun addv{r1,r2,d} =
115 : george 1003 I.arith{a=I.ADDCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap32
116 : monnier 411 fun subv{r1,r2,d} =
117 : george 1003 I.arith{a=I.SUBCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap32
118 : monnier 411 val sh1addv = NONE
119 :     val sh2addv = NONE
120 :     val sh3addv = NONE
121 :     )
122 : monnier 429 (val signed = true)
123 : monnier 245
124 : monnier 411 (* unsigned, non-trapping version of multiply and divide *)
125 : leunga 657 functor Mul32 = Multiply32
126 : monnier 411 (val trapping = false
127 :     val multCost = muluCost
128 : george 1003 fun addv{r1,r2,d} = [I.arith{a=I.ADD,r=r1,i=I.REG r2,d=d}]
129 :     fun subv{r1,r2,d} = [I.arith{a=I.SUB,r=r1,i=I.REG r2,d=d}]
130 : monnier 411 val sh1addv = NONE
131 :     val sh2addv = NONE
132 :     val sh3addv = NONE
133 :     )
134 : leunga 657 structure Mulu32 = Mul32(val signed = false)
135 : monnier 245
136 : leunga 657 structure Muls32 = Mul32(val signed = true)
137 :    
138 : monnier 411 (* signed, trapping version of multiply and divide *)
139 :     structure Mult64 = Multiply64
140 :     (val trapping = true
141 :     val multCost = multCost
142 :     fun addv{r1,r2,d} =
143 : george 1003 I.arith{a=I.ADDCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap64
144 : monnier 411 fun subv{r1,r2,d} =
145 : george 1003 I.arith{a=I.SUBCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap64
146 : monnier 411 val sh1addv = NONE
147 :     val sh2addv = NONE
148 :     val sh3addv = NONE
149 :     )
150 : monnier 429 (val signed = true)
151 : monnier 245
152 : monnier 411 (* unsigned, non-trapping version of multiply and divide *)
153 : leunga 657 functor Mul64 = Multiply64
154 : monnier 411 (val trapping = false
155 :     val multCost = muluCost
156 : george 1003 fun addv{r1,r2,d} = [I.arith{a=I.ADD,r=r1,i=I.REG r2,d=d}]
157 :     fun subv{r1,r2,d} = [I.arith{a=I.SUB,r=r1,i=I.REG r2,d=d}]
158 : monnier 411 val sh1addv = NONE
159 :     val sh2addv = NONE
160 :     val sh3addv = NONE
161 :     )
162 : leunga 657 structure Mulu64 = Mul64(val signed = false)
163 : monnier 245
164 : leunga 657 structure Muls64 = Mul64(val signed = true)
165 :    
166 : monnier 411 datatype commutative = COMMUTE | NOCOMMUTE
167 :     datatype cc = REG (* write to register *)
168 :     | CC (* set condition code *)
169 :     | CC_REG (* do both *)
170 : monnier 245
171 : monnier 411 fun error msg = MLRiscErrorMsg.error("Sparc",msg)
172 : monnier 245
173 : leunga 744
174 :    
175 : monnier 411 fun selectInstructions
176 : george 545 (instrStream as
177 : george 1003 TS.S.STREAM{emit=emitInstruction,defineLabel,entryLabel,pseudoOp,annotation,getAnnotations,
178 : leunga 744 beginCluster,endCluster,exitBlock,comment,...}) =
179 : monnier 411 let
180 : george 1003 val emit = emitInstruction o I.INSTR
181 : monnier 411 (* Flags *)
182 :     val useBR = !useBR
183 :     val registerwindow = !registerwindow
184 : monnier 245
185 : leunga 744 val trap32 = PseudoInstrs.overflowtrap32
186 :     val trap64 = PseudoInstrs.overflowtrap64
187 :     val zeroR = C.r0
188 :     val newReg = C.newReg
189 : monnier 411 val newFreg = C.newFreg
190 : george 761 val int_m4096 = T.I.fromInt(32, ~4096)
191 :     val int_4096 = T.I.fromInt(32, 4096)
192 :     fun immed13 n = LE(int_m4096, n) andalso LT(n, int_4096)
193 : monnier 411 fun immed13w w = let val x = W.~>>(w,0w12)
194 :     in x = 0w0 orelse (W.notb x) = 0w0 end
195 :     fun splitw w = {hi=W.toInt(W.>>(w,0w10)),lo=W.toInt(W.andb(w,0wx3ff))}
196 : george 761 fun split n = splitw(T.I.toWord32(32, n))
197 : monnier 245
198 : monnier 411
199 : leunga 744 val zeroOpn = I.REG zeroR (* zero value operand *)
200 : monnier 245
201 : monnier 411 fun cond T.LT = I.BL
202 :     | cond T.LTU = I.BCS
203 :     | cond T.LE = I.BLE
204 :     | cond T.LEU = I.BLEU
205 :     | cond T.EQ = I.BE
206 :     | cond T.NE = I.BNE
207 :     | cond T.GE = I.BGE
208 :     | cond T.GEU = I.BCC
209 :     | cond T.GT = I.BG
210 :     | cond T.GTU = I.BGU
211 : leunga 744 | cond _ = error "cond"
212 : monnier 245
213 : monnier 411 fun rcond T.LT = I.RLZ
214 :     | rcond T.LE = I.RLEZ
215 :     | rcond T.EQ = I.RZ
216 :     | rcond T.NE = I.RNZ
217 :     | rcond T.GE = I.RGEZ
218 :     | rcond T.GT = I.RGZ
219 :     | rcond _ = error "rcond"
220 : monnier 245
221 : monnier 411 fun signedCmp(T.LT | T.LE | T.EQ | T.NE | T.GE | T.GT) = true
222 :     | signedCmp _ = false
223 : monnier 245
224 : monnier 411 fun fcond T.== = I.FBE
225 :     | fcond T.?<> = I.FBNE
226 :     | fcond T.? = I.FBU
227 :     | fcond T.<=> = I.FBO
228 :     | fcond T.> = I.FBG
229 :     | fcond T.>= = I.FBGE
230 :     | fcond T.?> = I.FBUG
231 :     | fcond T.?>= = I.FBUGE
232 :     | fcond T.< = I.FBL
233 :     | fcond T.<= = I.FBLE
234 :     | fcond T.?< = I.FBUL
235 :     | fcond T.?<= = I.FBULE
236 :     | fcond T.<> = I.FBLG
237 :     | fcond T.?= = I.FBUE
238 : george 545 | fcond fc = error("fcond "^T.Basis.fcondToString fc)
239 : monnier 245
240 : george 1009 fun annotate(i,[]) = i
241 :     | annotate(i,a::an) = annotate(I.ANNOTATION{i=i,a=a},an)
242 :     fun mark'(i,an) = emitInstruction(annotate(i,an))
243 :     fun mark(i,an) = emitInstruction(annotate(I.INSTR i,an))
244 : monnier 245
245 : monnier 411 (* convert an operand into a register *)
246 :     fun reduceOpn(I.REG r) = r
247 : leunga 744 | reduceOpn(I.IMMED 0) = zeroR
248 : monnier 411 | reduceOpn i =
249 :     let val d = newReg()
250 : leunga 744 in emit(I.ARITH{a=I.OR,r=zeroR,i=i,d=d}); d end
251 : monnier 245
252 : monnier 411 (* emit parallel copies *)
253 :     fun copy(dst,src,an) =
254 : george 1009 mark'(COPY{dst=dst,src=src,
255 : monnier 411 tmp=case dst of [_] => NONE
256 :     | _ => SOME(I.Direct(newReg()))},an)
257 :     fun fcopy(dst,src,an) =
258 : george 1009 mark'(FCOPY{dst=dst,src=src,
259 : monnier 411 tmp=case dst of [_] => NONE
260 :     | _ => SOME(I.FDirect(newFreg()))},an)
261 : monnier 245
262 : monnier 411 (* move register s to register d *)
263 :     fun move(s,d,an) =
264 : george 889 if CB.sameColor(s,d) orelse CB.registerId d = 0 then ()
265 : george 1009 else mark'(COPY{dst=[d],src=[s],tmp=NONE},an)
266 : monnier 411
267 :     (* move floating point register s to register d *)
268 :     fun fmoved(s,d,an) =
269 : george 889 if CB.sameColor(s,d) then ()
270 : george 1009 else mark'(FCOPY{dst=[d],src=[s],tmp=NONE},an)
271 : monnier 475 fun fmoves(s,d,an) = fmoved(s,d,an) (* error "fmoves" for now!!! XXX *)
272 : monnier 411 fun fmoveq(s,d,an) = error "fmoveq"
273 :    
274 :     (* load immediate *)
275 :     and loadImmed(n,d,cc,an) =
276 :     let val or = if cc <> REG then I.ORCC else I.OR
277 : george 761 in if immed13 n then mark(I.ARITH{a=or,r=zeroR,i=I.IMMED(toInt n),d=d},an)
278 : monnier 411 else let val {hi,lo} = split n
279 :     in if lo = 0 then
280 :     (mark(I.SETHI{i=hi,d=d},an); genCmp0(cc,d))
281 :     else let val t = newReg()
282 :     in emit(I.SETHI{i=hi,d=t});
283 :     mark(I.ARITH{a=or,r=t,i=I.IMMED lo,d=d},an)
284 :     end
285 :     end
286 :     end
287 : monnier 245
288 : monnier 411 (* load label expression *)
289 :     and loadLabel(lab,d,cc,an) =
290 :     let val or = if cc <> REG then I.ORCC else I.OR
291 : leunga 744 in mark(I.ARITH{a=or,r=zeroR,i=I.LAB lab,d=d},an) end
292 : monnier 245
293 : monnier 411 (* emit an arithmetic op *)
294 :     and arith(a,acc,e1,e2,d,cc,comm,trap,an) =
295 :     let val (a,d) = case cc of
296 :     REG => (a,d)
297 : leunga 744 | CC => (acc,zeroR)
298 : monnier 411 | CC_REG => (acc,d)
299 :     in case (opn e1,opn e2,comm) of
300 :     (i,I.REG r,COMMUTE)=> mark(I.ARITH{a=a,r=r,i=i,d=d},an)
301 :     | (I.REG r,i,_) => mark(I.ARITH{a=a,r=r,i=i,d=d},an)
302 :     | (r,i,_) => mark(I.ARITH{a=a,r=reduceOpn r,i=i,d=d},an)
303 :     ;
304 : george 1003 case trap of [] => () | _ => app emitInstruction trap
305 : monnier 411 end
306 : monnier 245
307 : monnier 411 (* emit a shift op *)
308 :     and shift(s,e1,e2,d,cc,an) =
309 :     (mark(I.SHIFT{s=s,r=expr e1,i=opn e2,d=d},an);
310 :     genCmp0(cc,d)
311 :     )
312 : monnier 245
313 : monnier 411 (* emit externally defined multiply or division operation (V8) *)
314 :     and extarith(gen,genConst,e1,e2,d,cc,comm) =
315 :     let fun nonconst(e1,e2) =
316 :     case (opn e1,opn e2,comm) of
317 :     (i,I.REG r,COMMUTE) => gen({r=r,i=i,d=d},reduceOpn)
318 :     | (I.REG r,i,_) => gen({r=r,i=i,d=d},reduceOpn)
319 :     | (r,i,_) => gen({r=reduceOpn r,i=i,d=d},reduceOpn)
320 :     fun const(e,i) =
321 :     let val r = expr e
322 : george 761 in genConst{r=r,i=toInt i,d=d}
323 : monnier 411 handle _ => gen({r=r,i=opn(T.LI i),d=d},reduceOpn)
324 :     end
325 :     val instrs =
326 :     case (comm,e1,e2) of
327 :     (_,e1,T.LI i) => const(e1,i)
328 :     | (COMMUTE,T.LI i,e2) => const(e2,i)
329 :     | _ => nonconst(e1,e2)
330 : george 1003 in app emitInstruction instrs;
331 : monnier 411 genCmp0(cc,d)
332 :     end
333 : monnier 245
334 : monnier 411 (* emit 64-bit multiply or division operation (V9) *)
335 :     and muldiv64(a,genConst,e1,e2,d,cc,comm,an) =
336 :     let fun nonconst(e1,e2) =
337 : george 1009 [annotate(
338 : monnier 411 case (opn e1,opn e2,comm) of
339 : george 1003 (i,I.REG r,COMMUTE) => I.arith{a=a,r=r,i=i,d=d}
340 :     | (I.REG r,i,_) => I.arith{a=a,r=r,i=i,d=d}
341 :     | (r,i,_) => I.arith{a=a,r=reduceOpn r,i=i,d=d},an)
342 : monnier 411 ]
343 :     fun const(e,i) =
344 :     let val r = expr e
345 : george 761 in genConst{r=r,i=toInt i,d=d}
346 : george 1009 handle _ => [annotate(I.arith{a=a,r=r,i=opn(T.LI i),d=d},an)]
347 : monnier 411 end
348 :     val instrs =
349 :     case (comm,e1,e2) of
350 :     (_,e1,T.LI i) => const(e1,i)
351 :     | (COMMUTE,T.LI i,e2) => const(e2,i)
352 :     | _ => nonconst(e1,e2)
353 : george 1003 in app emitInstruction instrs;
354 : monnier 411 genCmp0(cc,d)
355 :     end
356 :    
357 :     (* divisions *)
358 : george 545 and divu32 x = Mulu32.divide{mode=T.TO_ZERO,stm=doStmt} x
359 : leunga 657 and divs32 x = Muls32.divide{mode=T.TO_ZERO,stm=doStmt} x
360 : george 545 and divt32 x = Mult32.divide{mode=T.TO_ZERO,stm=doStmt} x
361 :     and divu64 x = Mulu64.divide{mode=T.TO_ZERO,stm=doStmt} x
362 : leunga 657 and divs64 x = Muls64.divide{mode=T.TO_ZERO,stm=doStmt} x
363 : george 545 and divt64 x = Mult64.divide{mode=T.TO_ZERO,stm=doStmt} x
364 : monnier 411
365 :     (* emit an unary floating point op *)
366 :     and funary(a,e,d,an) = mark(I.FPop1{a=a,r=fexpr e,d=d},an)
367 :    
368 :     (* emit a binary floating point op *)
369 :     and farith(a,e1,e2,d,an) =
370 :     mark(I.FPop2{a=a,r1=fexpr e1,r2=fexpr e2,d=d},an)
371 :    
372 :     (* convert an expression into an addressing mode *)
373 : blume 841 and addr(T.ADD(ty, (T.ADD (_, e, T.LI n)|
374 :     T.ADD (_, T.LI n, e)), T.LI n')) =
375 :     addr(T.ADD (ty, e, T.LI (T.I.ADD (ty, n, n'))))
376 :     | addr(T.ADD(ty, T.SUB (_, e, T.LI n), T.LI n')) =
377 :     addr(T.ADD (ty, e, T.LI (T.I.SUB (ty, n', n))))
378 :     | addr(T.ADD(_,e,T.LI n)) =
379 : george 761 if immed13 n then (expr e,I.IMMED(toInt n))
380 : monnier 411 else let val d = newReg()
381 :     in loadImmed(n,d,REG,[]); (d,opn e) end
382 : leunga 775 | addr(T.ADD(_,e,x as T.CONST c)) = (expr e,I.LAB x)
383 :     | addr(T.ADD(_,e,x as T.LABEL l)) = (expr e,I.LAB x)
384 :     | addr(T.ADD(_,e,T.LABEXP x)) = (expr e,I.LAB x)
385 : monnier 411 | addr(T.ADD(ty,i as T.LI _,e)) = addr(T.ADD(ty,e,i))
386 : leunga 775 | addr(T.ADD(_,x as T.CONST c,e)) = (expr e,I.LAB x)
387 :     | addr(T.ADD(_,x as T.LABEL l,e)) = (expr e,I.LAB x)
388 :     | addr(T.ADD(_,T.LABEXP x,e)) = (expr e,I.LAB x)
389 : monnier 411 | addr(T.ADD(_,e1,e2)) = (expr e1,I.REG(expr e2))
390 : george 761 | addr(T.SUB(ty,e,T.LI n)) = addr(T.ADD(ty,e,T.LI(T.I.NEG(32,n))))
391 : leunga 775 | addr(x as T.LABEL l) = (zeroR,I.LAB x)
392 :     | addr(T.LABEXP x) = (zeroR,I.LAB x)
393 : monnier 411 | addr a = (expr a,zeroOpn)
394 :    
395 :     (* emit an integer load *)
396 :     and load(l,a,d,mem,cc,an) =
397 :     let val (r,i) = addr a
398 :     in mark(I.LOAD{l=l,r=r,i=i,d=d,mem=mem},an);
399 :     genCmp0(cc,d)
400 :     end
401 :    
402 :     (* emit an integer store *)
403 :     and store(s,a,d,mem,an) =
404 :     let val (r,i) = addr a
405 :     in mark(I.STORE{s=s,r=r,i=i,d=expr d,mem=mem},an) end
406 :    
407 :     (* emit a floating point load *)
408 :     and fload(l,a,d,mem,an) =
409 :     let val (r,i) = addr a
410 :     in mark(I.FLOAD{l=l,r=r,i=i,d=d,mem=mem},an) end
411 :    
412 :     (* emit a floating point store *)
413 :     and fstore(s,a,d,mem,an) =
414 :     let val (r,i) = addr a
415 :     in mark(I.FSTORE{s=s,r=r,i=i,d=fexpr d,mem=mem},an) end
416 :    
417 :     (* emit a jump *)
418 :     and jmp(a,labs,an) =
419 :     let val (r,i) = addr a
420 :     in mark(I.JMP{r=r,i=i,labs=labs,nop=true},an) end
421 :    
422 : george 545 (* convert mlrisc to cellset *)
423 :     and cellset mlrisc =
424 :     let fun g([],set) = set
425 : george 901 | g(T.GPR(T.REG(_,r))::regs,set) = g(regs,CB.CellSet.add(r,set))
426 :     | g(T.FPR(T.FREG(_,f))::regs,set) = g(regs,CB.CellSet.add(f,set))
427 :     | g(T.CCR(T.CC(_,cc))::regs,set) = g(regs,CB.CellSet.add(cc,set))
428 : george 545 | g(_::regs, set) = g(regs,set)
429 :     in g(mlrisc, C.empty) end
430 :    
431 : monnier 411 (* emit a function call *)
432 : blume 839 and call(a,flow,defs,uses,mem,cutsTo,an,0) =
433 :     let val (r,i) = addr a
434 :     val defs=cellset(defs)
435 :     val uses=cellset(uses)
436 : george 889 in case (CB.registerId r,i) of
437 : blume 839 (0,I.LAB(T.LABEL l)) =>
438 :     mark(I.CALL{label=l,defs=C.addReg(C.linkReg,defs),uses=uses,
439 :     cutsTo=cutsTo,mem=mem,nop=true},an)
440 :     | _ => mark(I.JMPL{r=r,i=i,d=C.linkReg,defs=defs,uses=uses,
441 :     cutsTo=cutsTo,mem=mem,nop=true},an)
442 :     end
443 :     | call _ = error "pops<>0 not implemented"
444 : monnier 245
445 : monnier 411 (* emit an integer branch instruction *)
446 : leunga 744 and branch(T.CMP(ty,cond,a,b),lab,an) =
447 : monnier 411 let val (cond,a,b) =
448 :     case a of
449 : george 761 (T.LI _ | T.CONST _ | T.LABEL _) =>
450 : george 545 (T.Basis.swapCond cond,b,a)
451 : monnier 411 | _ => (cond,a,b)
452 :     in if V9 then
453 :     branchV9(cond,a,b,lab,an)
454 :     else
455 :     (doExpr(T.SUB(ty,a,b),newReg(),CC,[]); br(cond,lab,an))
456 :     end
457 : leunga 744 | branch(T.CC(cond,r),lab,an) =
458 : george 889 if CB.sameCell(r, C.psr) then br(cond,lab,an)
459 : leunga 744 else (genCmp0(CC,r); br(cond,lab,an))
460 :     | branch(T.FCMP(fty,cond,a,b),lab,an) =
461 : george 545 let val cmp = case fty of
462 :     32 => I.FCMPs
463 :     | 64 => I.FCMPd
464 :     | _ => error "fbranch"
465 :     in emit(I.FCMP{cmp=cmp,r1=fexpr a,r2=fexpr b,nop=true});
466 :     mark(I.FBfcc{b=fcond cond,a=false,label=lab,nop=true},an)
467 :     end
468 : monnier 411 | branch _ = error "branch"
469 : monnier 245
470 : monnier 411 and branchV9(cond,a,b,lab,an) =
471 : leunga 624 let val size = Gen.Size.size a
472 : monnier 411 in if useBR andalso signedCmp cond then
473 :     let val r = newReg()
474 :     in doExpr(T.SUB(size,a,b),r,REG,[]);
475 :     brcond(cond,r,lab,an)
476 :     end
477 :     else
478 :     let val cc = case size of 32 => I.ICC
479 :     | 64 => I.XCC
480 :     | _ => error "branchV9"
481 :     in doExpr(T.SUB(size,a,b),newReg(),CC,[]);
482 :     bp(cond,cc,lab,an)
483 :     end
484 :     end
485 : monnier 245
486 : monnier 411 and br(c,lab,an) = mark(I.Bicc{b=cond c,a=true,label=lab,nop=true},an)
487 : monnier 245
488 : monnier 411 and brcond(c,r,lab,an) =
489 :     mark(I.BR{rcond=rcond c,r=r,p=I.PT,a=true,label=lab,nop=true},an)
490 : monnier 245
491 : monnier 411 and bp(c,cc,lab,an) =
492 :     mark(I.BP{b=cond c,cc=cc,p=I.PT,a=true,label=lab,nop=true},an)
493 : monnier 245
494 : monnier 411 (* generate code for a statement *)
495 :     and stmt(T.MV(_,d,e),an) = doExpr(e,d,REG,an)
496 :     | stmt(T.FMV(_,d,e),an) = doFexpr(e,d,an)
497 :     | stmt(T.CCMV(d,e),an) = doCCexpr(e,d,an)
498 :     | stmt(T.COPY(_,dst,src),an) = copy(dst,src,an)
499 : monnier 475 | stmt(T.FCOPY(_,dst,src),an) = fcopy(dst,src,an)
500 : leunga 775 | stmt(T.JMP(T.LABEL l,_),an) =
501 : monnier 411 mark(I.Bicc{b=I.BA,a=true,label=l,nop=false},an)
502 : leunga 744 | stmt(T.JMP(e,labs),an) = jmp(e,labs,an)
503 : blume 839 | stmt(T.CALL{funct,targets,defs,uses,region,pops,...},an) =
504 :     call(funct,targets,defs,uses,region,[],an,pops)
505 : leunga 796 | stmt(T.FLOW_TO
506 : blume 839 (T.CALL{funct,targets,defs,uses,region,pops,...},cutsTo),an) =
507 :     call(funct,targets,defs,uses,region,cutsTo,an,pops)
508 : george 545 | stmt(T.RET _,an) = mark(I.RET{leaf=not registerwindow,nop=true},an)
509 : monnier 411 | stmt(T.STORE(8,a,d,mem),an) = store(I.STB,a,d,mem,an)
510 :     | stmt(T.STORE(16,a,d,mem),an) = store(I.STH,a,d,mem,an)
511 :     | stmt(T.STORE(32,a,d,mem),an) = store(I.ST,a,d,mem,an)
512 :     | stmt(T.STORE(64,a,d,mem),an) =
513 :     store(if V9 then I.STX else I.STD,a,d,mem,an)
514 :     | stmt(T.FSTORE(32,a,d,mem),an) = fstore(I.STF,a,d,mem,an)
515 :     | stmt(T.FSTORE(64,a,d,mem),an) = fstore(I.STDF,a,d,mem,an)
516 : leunga 744 | stmt(T.BCC(cc,lab),an) = branch(cc,lab,an)
517 : george 545 | stmt(T.DEFINE l,_) = defineLabel l
518 : monnier 411 | stmt(T.ANNOTATION(s,a),an) = stmt(s,a::an)
519 : george 555 | stmt(T.EXT s,an) = ExtensionComp.compileSext(reducer()) {stm=s, an=an}
520 : george 545 | stmt(s,an) = doStmts(Gen.compileStm s)
521 : monnier 245
522 : monnier 411 and doStmt s = stmt(s,[])
523 : monnier 245
524 : george 545 and doStmts ss = app doStmt ss
525 : monnier 245
526 : monnier 411 (* convert an expression into a register *)
527 : george 761 and expr e = let
528 :     fun comp() = let
529 :     val d = newReg()
530 :     in doExpr(e, d, REG, []); d
531 :     end
532 :     in case e
533 :     of T.REG(_,r) => r
534 :     | T.LI z => if T.I.isZero z then zeroR else comp()
535 :     | _ => comp()
536 :     end
537 : monnier 245
538 : monnier 411 (* compute an integer expression and put the result in register d
539 :     * If cc is set then set the condition code with the result.
540 :     *)
541 :     and doExpr(e,d,cc,an) =
542 :     case e of
543 :     T.REG(_,r) => (move(r,d,an); genCmp0(cc,r))
544 :     | T.LI n => loadImmed(n,d,cc,an)
545 : leunga 775 | T.LABEL l => loadLabel(e,d,cc,an)
546 :     | T.CONST c => loadLabel(e,d,cc,an)
547 :     | T.LABEXP x => loadLabel(x,d,cc,an)
548 : monnier 245
549 : monnier 411 (* generic 32/64 bit support *)
550 :     | T.ADD(_,a,b) => arith(I.ADD,I.ADDCC,a,b,d,cc,COMMUTE,[],an)
551 : george 761 | T.SUB(_,a,b) => let
552 :     fun default() = arith(I.SUB,I.SUBCC,a,b,d,cc,NOCOMMUTE,[],an)
553 :     in
554 :     case b
555 :     of T.LI z =>
556 :     if T.I.isZero(z) then doExpr(a,d,cc,an) else default()
557 :     | _ => default()
558 :     (*esac*)
559 :     end
560 :    
561 : monnier 411 | T.ANDB(_,a,T.NOTB(_,b)) =>
562 :     arith(I.ANDN,I.ANDNCC,a,b,d,cc,NOCOMMUTE,[],an)
563 :     | T.ORB(_,a,T.NOTB(_,b)) =>
564 :     arith(I.ORN,I.ORNCC,a,b,d,cc,NOCOMMUTE,[],an)
565 :     | T.XORB(_,a,T.NOTB(_,b)) =>
566 :     arith(I.XNOR,I.XNORCC,a,b,d,cc,COMMUTE,[],an)
567 :     | T.ANDB(_,T.NOTB(_,a),b) =>
568 :     arith(I.ANDN,I.ANDNCC,b,a,d,cc,NOCOMMUTE,[],an)
569 :     | T.ORB(_,T.NOTB(_,a),b) =>
570 :     arith(I.ORN,I.ORNCC,b,a,d,cc,NOCOMMUTE,[],an)
571 :     | T.XORB(_,T.NOTB(_,a),b) =>
572 :     arith(I.XNOR,I.XNORCC,b,a,d,cc,COMMUTE,[],an)
573 :     | T.NOTB(_,T.XORB(_,a,b)) =>
574 :     arith(I.XNOR,I.XNORCC,a,b,d,cc,COMMUTE,[],an)
575 : monnier 245
576 : monnier 411 | T.ANDB(_,a,b) => arith(I.AND,I.ANDCC,a,b,d,cc,COMMUTE,[],an)
577 :     | T.ORB(_,a,b) => arith(I.OR,I.ORCC,a,b,d,cc,COMMUTE,[],an)
578 :     | T.XORB(_,a,b) => arith(I.XOR,I.XORCC,a,b,d,cc,COMMUTE,[],an)
579 : george 761 | T.NOTB(_,a) => arith(I.XNOR,I.XNORCC,a,LI 0,d,cc,COMMUTE,[],an)
580 : monnier 245
581 : monnier 411 (* 32 bit support *)
582 :     | T.SRA(32,a,b) => shift(I.SRA,a,b,d,cc,an)
583 :     | T.SRL(32,a,b) => shift(I.SRL,a,b,d,cc,an)
584 :     | T.SLL(32,a,b) => shift(I.SLL,a,b,d,cc,an)
585 :     | T.ADDT(32,a,b)=>
586 :     arith(I.ADDCC,I.ADDCC,a,b,d,CC_REG,COMMUTE,trap32,an)
587 :     | T.SUBT(32,a,b)=>
588 :     arith(I.SUBCC,I.SUBCC,a,b,d,CC_REG,NOCOMMUTE,trap32,an)
589 : leunga 657 | T.MULU(32,a,b) => extarith(P.umul32,
590 :     Mulu32.multiply,a,b,d,cc,COMMUTE)
591 :     | T.MULS(32,a,b) => extarith(P.smul32,
592 :     Muls32.multiply,a,b,d,cc,COMMUTE)
593 :     | T.MULT(32,a,b) => extarith(P.smul32trap,
594 :     Mult32.multiply,a,b,d,cc,COMMUTE)
595 :     | T.DIVU(32,a,b) => extarith(P.udiv32,divu32,a,b,d,cc,NOCOMMUTE)
596 :     | T.DIVS(32,a,b) => extarith(P.sdiv32,divs32,a,b,d,cc,NOCOMMUTE)
597 :     | T.DIVT(32,a,b) => extarith(P.sdiv32trap,divt32,a,b,d,cc,NOCOMMUTE)
598 : monnier 245
599 : monnier 411 (* 64 bit support *)
600 :     | T.SRA(64,a,b) => shift(I.SRAX,a,b,d,cc,an)
601 :     | T.SRL(64,a,b) => shift(I.SRLX,a,b,d,cc,an)
602 :     | T.SLL(64,a,b) => shift(I.SLLX,a,b,d,cc,an)
603 :     | T.ADDT(64,a,b)=>
604 :     arith(I.ADDCC,I.ADDCC,a,b,d,CC_REG,COMMUTE,trap64,an)
605 :     | T.SUBT(64,a,b)=>
606 :     arith(I.SUBCC,I.SUBCC,a,b,d,CC_REG,NOCOMMUTE,trap64,an)
607 :     | T.MULU(64,a,b) =>
608 :     muldiv64(I.MULX,Mulu64.multiply,a,b,d,cc,COMMUTE,an)
609 : leunga 657 | T.MULS(64,a,b) =>
610 :     muldiv64(I.MULX,Muls64.multiply,a,b,d,cc,COMMUTE,an)
611 : monnier 411 | T.MULT(64,a,b) =>
612 :     (muldiv64(I.MULX,Mult64.multiply,a,b,d,CC_REG,COMMUTE,an);
613 : george 1003 app emitInstruction trap64)
614 : monnier 411 | T.DIVU(64,a,b) => muldiv64(I.UDIVX,divu64,a,b,d,cc,NOCOMMUTE,an)
615 : leunga 657 | T.DIVS(64,a,b) => muldiv64(I.SDIVX,divs64,a,b,d,cc,NOCOMMUTE,an)
616 : monnier 411 | T.DIVT(64,a,b) => muldiv64(I.SDIVX,divt64,a,b,d,cc,NOCOMMUTE,an)
617 : monnier 245
618 : monnier 411 (* loads *)
619 :     | T.LOAD(8,a,mem) => load(I.LDUB,a,d,mem,cc,an)
620 : leunga 744 | T.SX(_,_,T.LOAD(8,a,mem)) => load(I.LDSB,a,d,mem,cc,an)
621 : monnier 411 | T.LOAD(16,a,mem) => load(I.LDUH,a,d,mem,cc,an)
622 : leunga 744 | T.SX(_,_,T.LOAD(16,a,mem)) => load(I.LDSH,a,d,mem,cc,an)
623 : monnier 411 | T.LOAD(32,a,mem) => load(I.LD,a,d,mem,cc,an)
624 : george 545 | T.LOAD(64,a,mem) =>
625 :     load(if V9 then I.LDX else I.LDD,a,d,mem,cc,an)
626 : monnier 245
627 : monnier 411 (* conditional expression *)
628 : george 545 | T.COND exp => doStmts (Gen.compileCond{exp=exp,rd=d,an=an})
629 : monnier 411
630 :     (* misc *)
631 : george 545 | T.LET(s,e) => (doStmt s; doExpr(e, d, cc, an))
632 :     | T.MARK(e,A.MARKREG f) => (f d; doExpr(e,d,cc,an))
633 :     | T.MARK(e,a) => doExpr(e,d,cc,a::an)
634 :     | T.PRED(e,c) => doExpr(e,d,cc,A.CTRLUSE c::an)
635 : george 555 | T.REXT e => ExtensionComp.compileRext (reducer()) {e=e, rd=d, an=an}
636 : george 545 | e => doExpr(Gen.compileRexp e,d,cc,an)
637 : monnier 411
638 :     (* generate a comparison with zero *)
639 :     and genCmp0(REG,_) = ()
640 : leunga 744 | genCmp0(_,d) = emit(I.ARITH{a=I.SUBCC,r=d,i=zeroOpn,d=zeroR})
641 : monnier 411
642 :     (* convert an expression into a floating point register *)
643 :     and fexpr(T.FREG(_,r)) = r
644 :     | fexpr e = let val d = newFreg() in doFexpr(e,d,[]); d end
645 :    
646 :     (* compute a floating point expression and put the result in d *)
647 :     and doFexpr(e,d,an) =
648 :     case e of
649 :     (* single precision *)
650 :     T.FREG(32,r) => fmoves(r,d,an)
651 :     | T.FLOAD(32,ea,mem) => fload(I.LDF,ea,d,mem,an)
652 :     | T.FADD(32,a,b) => farith(I.FADDs,a,b,d,an)
653 :     | T.FSUB(32,a,b) => farith(I.FSUBs,a,b,d,an)
654 :     | T.FMUL(32,a,b) => farith(I.FMULs,a,b,d,an)
655 :     | T.FDIV(32,a,b) => farith(I.FDIVs,a,b,d,an)
656 :     | T.FABS(32,a) => funary(I.FABSs,a,d,an)
657 :     | T.FNEG(32,a) => funary(I.FNEGs,a,d,an)
658 :     | T.FSQRT(32,a) => funary(I.FSQRTs,a,d,an)
659 :    
660 :     (* double precision *)
661 :     | T.FREG(64,r) => fmoved(r,d,an)
662 :     | T.FLOAD(64,ea,mem) => fload(I.LDDF,ea,d,mem,an)
663 :     | T.FADD(64,a,b) => farith(I.FADDd,a,b,d,an)
664 :     | T.FSUB(64,a,b) => farith(I.FSUBd,a,b,d,an)
665 :     | T.FMUL(64,a,b) => farith(I.FMULd,a,b,d,an)
666 :     | T.FDIV(64,a,b) => farith(I.FDIVd,a,b,d,an)
667 :     | T.FABS(64,a) => funary(I.FABSd,a,d,an)
668 :     | T.FNEG(64,a) => funary(I.FNEGd,a,d,an)
669 :     | T.FSQRT(64,a) => funary(I.FSQRTd,a,d,an)
670 :    
671 :     (* quad precision *)
672 :     | T.FREG(128,r) => fmoveq(r,d,an)
673 :     | T.FADD(128,a,b) => farith(I.FADDq,a,b,d,an)
674 :     | T.FSUB(128,a,b) => farith(I.FSUBq,a,b,d,an)
675 :     | T.FMUL(128,a,b) => farith(I.FMULq,a,b,d,an)
676 :     | T.FDIV(128,a,b) => farith(I.FDIVq,a,b,d,an)
677 :     | T.FABS(128,a) => funary(I.FABSq,a,d,an)
678 :     | T.FNEG(128,a) => funary(I.FNEGq,a,d,an)
679 :     | T.FSQRT(128,a) => funary(I.FSQRTq,a,d,an)
680 :    
681 :     (* floating point to floating point *)
682 : george 545 | T.CVTF2F(ty,ty',e) =>
683 : monnier 475 (case (ty,ty') of
684 :     (32,32) => doFexpr(e,d,an)
685 :     | (64,32) => funary(I.FsTOd,e,d,an)
686 : monnier 411 | (128,32) => funary(I.FsTOq,e,d,an)
687 : monnier 475 | (32,64) => funary(I.FdTOs,e,d,an)
688 :     | (64,64) => doFexpr(e,d,an)
689 : monnier 411 | (128,64) => funary(I.FdTOq,e,d,an)
690 :     | (32,128) => funary(I.FqTOs,e,d,an)
691 :     | (64,128) => funary(I.FqTOd,e,d,an)
692 :     | (128,128) => doFexpr(e,d,an)
693 :     | _ => error "CVTF2F"
694 :     )
695 :    
696 :     (* integer to floating point *)
697 : george 1003 | T.CVTI2F(32,32,e) => app emitInstruction (P.cvti2s({i=opn e,d=d},reduceOpn))
698 :     | T.CVTI2F(64,32,e) => app emitInstruction (P.cvti2d({i=opn e,d=d},reduceOpn))
699 :     | T.CVTI2F(128,32,e) => app emitInstruction (P.cvti2q({i=opn e,d=d},reduceOpn))
700 : monnier 411
701 : george 545 | T.FMARK(e,A.MARKREG f) => (f d; doFexpr(e,d,an))
702 :     | T.FMARK(e,a) => doFexpr(e,d,a::an)
703 :     | T.FPRED(e,c) => doFexpr(e,d,A.CTRLUSE c::an)
704 : george 555 | T.FEXT e => ExtensionComp.compileFext (reducer()) {e=e, fd=d, an=an}
705 : george 545 | e => doFexpr(Gen.compileFexp e,d,an)
706 : monnier 411
707 : leunga 744 and doCCexpr(T.CMP(ty,cond,e1,e2),cc,an) =
708 : george 889 if CB.sameCell(cc,C.psr) then
709 : leunga 744 doExpr(T.SUB(ty,e1,e2),newReg(),CC,an)
710 :     else error "doCCexpr"
711 :     | doCCexpr(T.CC(_,r),d,an) =
712 : george 889 if CB.sameColor(r,C.psr) then error "doCCexpr"
713 : leunga 744 else move(r,d,an)
714 : george 545 | doCCexpr(T.CCMARK(e,A.MARKREG f),d,an) = (f d; doCCexpr(e,d,an))
715 :     | doCCexpr(T.CCMARK(e,a),d,an) = doCCexpr(e,d,a::an)
716 :     | doCCexpr(T.CCEXT e,d,an) =
717 : george 555 ExtensionComp.compileCCext (reducer()) {e=e, ccd=d, an=an}
718 : monnier 411 | doCCexpr e = error "doCCexpr"
719 :    
720 :     and ccExpr e = let val d = newReg() in doCCexpr(e,d,[]); d end
721 :    
722 :     (* convert an expression into an operand *)
723 : leunga 775 and opn(x as T.CONST c) = I.LAB x
724 :     | opn(x as T.LABEL l) = I.LAB x
725 :     | opn(T.LABEXP x) = I.LAB x
726 : george 761 | opn(e as T.LI n) =
727 :     if T.I.isZero(n) then zeroOpn
728 :     else if immed13 n then I.IMMED(toInt n)
729 :     else I.REG(expr e)
730 : monnier 411 | opn e = I.REG(expr e)
731 :    
732 : george 545 and reducer() =
733 : george 984 TS.REDUCER{reduceRexp = expr,
734 : george 545 reduceFexp = fexpr,
735 :     reduceCCexp = ccExpr,
736 :     reduceStm = stmt,
737 :     operand = opn,
738 :     reduceOperand = reduceOpn,
739 :     addressOf = addr,
740 : george 1009 emit = emitInstruction o annotate,
741 : george 545 instrStream = instrStream,
742 :     mltreeStream = self()
743 :     }
744 :     and self() =
745 : george 984 TS.S.STREAM
746 : leunga 815 { beginCluster = beginCluster,
747 :     endCluster = endCluster,
748 :     emit = doStmt,
749 :     pseudoOp = pseudoOp,
750 :     defineLabel = defineLabel,
751 :     entryLabel = entryLabel,
752 :     comment = comment,
753 :     annotation = annotation,
754 :     getAnnotations = getAnnotations,
755 :     exitBlock = fn regs => exitBlock(cellset regs)
756 : george 545 }
757 :     in self()
758 : monnier 245 end
759 :    
760 :     end
761 :    
762 : monnier 411 (*
763 :     * Machine code generator for SPARC.
764 : monnier 245 *
765 : monnier 411 * The SPARC architecture has 32 general purpose registers (%g0 is always 0)
766 :     * and 32 single precision floating point registers.
767 : monnier 245 *
768 : monnier 411 * Some Ugliness: double precision floating point registers are
769 :     * register pairs. There are no double precision moves, negation and absolute
770 :     * values. These require two single precision operations. I've created
771 :     * composite instructions FMOVd, FNEGd and FABSd to stand for these.
772 : monnier 245 *
773 : monnier 411 * All integer arithmetic instructions can optionally set the condition
774 :     * code register. We use this to simplify certain comparisons with zero.
775 : monnier 245 *
776 : monnier 411 * Integer multiplication, division and conversion from integer to floating
777 :     * go thru the pseudo instruction interface, since older sparcs do not
778 :     * implement these instructions in hardware.
779 : monnier 245 *
780 : monnier 411 * In addition, the trap instruction for detecting overflow is a parameter.
781 :     * This allows different trap vectors to be used.
782 : monnier 245 *
783 : monnier 411 * -- Allen
784 :     *)

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