Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/compiler/CodeGen/main/mlriscGen.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/compiler/CodeGen/main/mlriscGen.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 247, Sat Apr 17 18:47:13 1999 UTC revision 418, Fri Sep 3 23:51:27 1999 UTC
# Line 18  Line 18 
18         and T.BNames = FunctionNames         and T.BNames = FunctionNames
19         and T.PseudoOp = PseudoOp         and T.PseudoOp = PseudoOp
20      structure Cells     : CELLS      structure Cells     : CELLS
21      structure MLTreeComp : MLTREECOMP where T = C.T      structure MLTreeComp : MLTREECOMP
22           where T = C.T
23        structure Flowgen : FLOWGRAPH_GEN
24           where T = MLTreeComp.T
25             and I = MLTreeComp.I
26             and S = MLTreeComp.S
27    ): MLRISCGEN =    ): MLRISCGEN =
28  struct  struct
29    structure M : MLTREE = C.T    structure M : MLTREE = C.T
# Line 31  Line 36 
36    structure D = MS.ObjDesc    structure D = MS.ObjDesc
37    val dtoi = LargeWord.toInt    (* convert object descriptor to int *)    val dtoi = LargeWord.toInt    (* convert object descriptor to int *)
38    
   
39    structure ArgP =    structure ArgP =
40      ArgPassing(structure Cells=Cells      ArgPassing(structure Cells=Cells
41                 structure C=C                 structure C=C
# Line 39  Line 43 
43    
44    structure Frag = Frag(M)    structure Frag = Frag(M)
45    
46    structure MemDisambiguate = MemDisambiguate(structure Cells=Cells)    structure MemAliasing = MemAliasing(Cells)
47    
48    structure MkRecord =    structure MkRecord = MkRecord(C)
     MkRecord(structure C=C  
              structure MLTreeComp=MLTreeComp)  
49    
50    structure CallGc =    structure CallGc =
51      CallGC(structure MLTreeComp=MLTreeComp      CallGC(structure Cells=Cells
            structure Cells=Cells  
52             structure MS=MachineSpec             structure MS=MachineSpec
53             structure C=C             structure C=C
54             structure MkRecord=MkRecord)             structure MkRecord = MkRecord
55               )
56    
57    fun error msg = ErrorMsg.impossible ("MLRiscGen." ^ msg)    fun error msg = ErrorMsg.impossible ("MLRiscGen." ^ msg)
58    
59    val emit = MLTreeComp.mlriscComp    val pty = (* C.pointerSize *) 32
60    val comp = MLTreeComp.mltreeComp    val ity = (* C.intSize   *) 32
61      val fty = (* C.floatSize *) 64
62    
63    val newReg = Cells.newReg    val newReg = Cells.newReg
64    val newFreg = Cells.newFreg    val newFreg = Cells.newFreg
65    
66    val M.REG allocptrR = C.allocptr    val M.REG(_,allocptrR) = C.allocptr
67    
68    val dedicated' =    val dedicated' =
69      map (M.GPR o M.REG) C.dedicatedR @ map (M.FPR o M.FREG) C.dedicatedF      map (fn r => M.GPR(M.REG(ity,r))) C.dedicatedR @
70        map (fn f => M.FPR(M.FREG(fty,f))) C.dedicatedF
71    val dedicated =    val dedicated =
72      case C.exhausted of NONE => dedicated' | SOME cc => M.CCR cc :: dedicated'      case C.exhausted of NONE => dedicated' | SOME cc => M.CCR cc :: dedicated'
73    
74    
75    fun codegen(funcs : CPS.function list, limits:CPS.lvar -> (int*int), err) = let    fun codegen(funcs : CPS.function list, limits:CPS.lvar -> (int*int), err) = let
76        val {mlriscComp=emit,mltreeComp=comp,...} =
77              MLTreeComp.selectInstructions(Flowgen.newStream())
78      val maxAlloc  = #1 o limits      val maxAlloc  = #1 o limits
79      val instructionCount = #2 o limits      val instructionCount = #2 o limits
80    
# Line 105  Line 112 
112        val gpRegTbl : M.rexp Intmap.intmap = Intmap.new(32, RegMap)        val gpRegTbl : M.rexp Intmap.intmap = Intmap.new(32, RegMap)
113        fun clearTables() =(Intmap.clear fpRegTbl; Intmap.clear gpRegTbl)        fun clearTables() =(Intmap.clear fpRegTbl; Intmap.clear gpRegTbl)
114        val addExpBinding = Intmap.add gpRegTbl        val addExpBinding = Intmap.add gpRegTbl
115        fun addRegBinding(x,r) = addExpBinding (x, M.REG r)        fun addRegBinding(x,r) = addExpBinding(x,M.REG(ity,r))
116        val addFregBinding = Intmap.add fpRegTbl        val addFregBinding = Intmap.add fpRegTbl
117    
118          val gcTest = M.CMP(32, if C.signedGCTest then M.GT else M.GTU,
119                                 C.allocptr, C.limitptr)
120    
121        val treeify = CpsTreeify.usage cluster        val treeify = CpsTreeify.usage cluster
122    
123        (* memDisambiguation uses the new register counters,        (* memDisambiguation uses the new register counters,
124         * so this must be reset here.         * so this must be reset here.
125         *)         *)
126        val regmap = Cells.resetRegs()        val _ = Cells.reset()
127          val regmap = Cells.regmap()
128    
129        val memDisambig =        val memDisambig = MemAliasing.analyze(cluster)
130          if !CG.memDisambiguate then MemDisambiguate.build(cluster)  
131          else (fn _ => R.RW_MEM)        fun pi(x as ref(R.PT.TOP _),_) = x
132            | pi(x as ref(R.PT.NAMED _),_) = x
133        fun getRegion(CPS.VAR v, i) =          | pi(x,i) = R.PT.pi(x,i)
134             (case memDisambig v  
135              of R.RECORD vl => #1 (List.nth(vl, i+1))        fun getRegion(CPS.VAR v, i) = pi(memDisambig v,i)
136               | R.OFFSET(j, vl) => #1 (List.nth(vl, i+j+1))          | getRegion _ = R.readonly
              | r => r  
             (*esac*))  
         | getRegion _ = R.RO_MEM  
137    
138        (* pre-align allocptr *)        (* pre-align allocptr *)
139        val align = Alignment.build cluster        val align = Alignment.build cluster
140        fun alignAllocptr f =        fun alignAllocptr f =
141          if align f then emit(M.MV(allocptrR, M.ORB(C.allocptr, M.LI 4)))          if align f then
142               emit(M.MV(pty,allocptrR, M.ORB(pty,C.allocptr, M.LI 4)))
143          else ()          else ()
144    
145        fun grabty(CPS.VAR v) = typmap v        fun grabty(CPS.VAR v) = typmap v
# Line 143  Line 151 
151    
152        (* The baseptr contains the start address of the entire compilation unit *)        (* The baseptr contains the start address of the entire compilation unit *)
153        fun laddr(lab, k) =        fun laddr(lab, k) =
154          M.ADD(C.baseptr,          M.ADD(pty,C.baseptr,
155                M.LABEL(LE.PLUS(LE.LABEL lab,                M.LABEL(LE.PLUS(LE.LABEL lab,
156                               LE.CONST(k-MachineSpec.constBaseRegOffset))))                               LE.CONST(k-MachineSpec.constBaseRegOffset))))
157    
158        (* a CPS register may be implemented as a physical        (* a CPS register may be implemented as a physical
159         * register or a memory location.         * register or a memory location.
160         *)         *)
161        fun assign(M.REG r, v) = M.MV(r, v)        fun assign(M.REG(ty,r), v) = M.MV(ty, r, v)
162          | assign(r as M.LOAD32(ea, region), v) = M.STORE32(ea, v, region)          | assign(r as M.LOAD(ty, ea, region), v) = M.STORE(ty, ea, v, region)
163          | assign _ = error "assign"          | assign _ = error "assign"
164    
165        fun regbind(CPS.VAR v) =        fun regbind(CPS.VAR v) =
166              ((Intmap.map gpRegTbl v) handle e =>              ((Intmap.map gpRegTbl v) handle e =>
167                 (print ("\n* can't find a register for lvar " ^                 (print ("\n* can't find a register for lvar " ^ (Int.toString v) ^ "\n");
                        (Int.toString v) ^ "\n");  
168                  raise e))                  raise e))
169          | regbind(CPS.INT i) = M.LI (i+i+1)          | regbind(CPS.INT i) = M.LI (i+i+1)
170          | regbind(CPS.INT32 w) = M.LI32 w          | regbind(CPS.INT32 w) = M.LI32 w
# Line 166  Line 173 
173    
174        fun fregbind(CPS.VAR v) =        fun fregbind(CPS.VAR v) =
175               ((Intmap.map fpRegTbl v) handle e =>               ((Intmap.map fpRegTbl v) handle e =>
176                 (print ("\n* can't find a fpregister for lvar " ^                 (print ("\n* can't find a fpregister for lvar " ^ (Int.toString v) ^ "\n");
                        (Int.toString v) ^ "\n");  
177                  raise e))                  raise e))
178          | fregbind _ = error "fregbind"          | fregbind _ = error "fregbind"
179    
# Line 199  Line 205 
205         * interferences.         * interferences.
206         *)         *)
207        fun initialRegBindingsEscaping(vl, rl, tl) = let        fun initialRegBindingsEscaping(vl, rl, tl) = let
208          fun eCopy(x::xs, M.GPR(M.REG r)::rl, rds, rss, xs', rl') = let          fun eCopy(x::xs, M.GPR(M.REG(_,r))::rl, rds, rss, xs', rl') = let
209                val t = newReg()                val t = newReg()
210              in addRegBinding(x, t); eCopy(xs, rl, t::rds, r::rss, xs', rl')              in addRegBinding(x, t); eCopy(xs, rl, t::rds, r::rss, xs', rl')
211              end              end
# Line 207  Line 213 
213                eCopy(xs, rl, rds, rss, x::xs', r::rl')                eCopy(xs, rl, rds, rss, x::xs', r::rl')
214            | eCopy([], [], [], [], xs', rl') = (xs', rl')            | eCopy([], [], [], [], xs', rl') = (xs', rl')
215            | eCopy([], [], rds, rss, xs', rl') =            | eCopy([], [], rds, rss, xs', rl') =
216               (emit(M.COPY(rds, rss)); (xs', rl'))               (emit(M.COPY(ity, rds, rss)); (xs', rl'))
217    
218          fun eOther(x::xs, M.GPR(r)::rl, xs', rl') = let          fun eOther(x::xs, M.GPR(r)::rl, xs', rl') = let
219                val t = newReg()                val t = newReg()
220              in addRegBinding(x, t); emit(M.MV(t, r)); eOther(xs, rl, xs', rl')              in addRegBinding(x, t); emit(M.MV(ity, t, r));
221                   eOther(xs, rl, xs', rl')
222              end              end
223            | eOther(x::xs, (M.FPR(M.FREG f))::rl, xs', rl') =            | eOther(x::xs, (M.FPR(M.FREG(_,f)))::rl, xs', rl') =
224                eOther(xs, rl, x::xs', f::rl')                eOther(xs, rl, x::xs', f::rl')
225            | eOther([], [], xs, rl) = (xs, rl)            | eOther([], [], xs, rl) = (xs, rl)
226    
# Line 221  Line 228 
228            | eFcopy(xs, rl) = let            | eFcopy(xs, rl) = let
229                val fs = map (fn _ => newFreg()) xs                val fs = map (fn _ => newFreg()) xs
230              in              in
231                ListPair.app (fn (x,f) => addFregBinding(x, M.FREG f)) (xs, fs);                ListPair.app (fn (x,f) => addFregBinding(x,M.FREG(fty,f))) (xs,fs);
232                emit(M.FCOPY(fs, rl))                emit(M.FCOPY(fty, fs, rl))
233              end              end
234          val (vl', rl') = eCopy(vl, rl, [], [], [], [])          val (vl', rl') = eCopy(vl, rl, [], [], [], [])
235        in        in
# Line 231  Line 238 
238        end        end
239    
240        fun initialRegBindingsKnown(vl, rl, tl) = let        fun initialRegBindingsKnown(vl, rl, tl) = let
241          fun f(v, M.GPR(M.REG r)) = addRegBinding(v, r)          fun f(v, M.GPR(reg as M.REG _)) = addExpBinding(v, reg)
242            | f(v, M.FPR(f as M.FREG _)) = addFregBinding(v, f)            | f(v, M.FPR(freg as M.FREG _)) = addFregBinding(v, freg)
243            | f _ = error "initialRegBindingsKnown.f"            | f _ = error "initialRegBindingsKnown.f"
244        in        in
245          ListPair.app f (vl, rl);          ListPair.app f (vl, rl);
# Line 240  Line 247 
247        end        end
248    
249        fun updtHeapPtr(hp) = let        fun updtHeapPtr(hp) = let
250          fun advBy hp = emit(M.MV(allocptrR, M.ADD(C.allocptr, M.LI hp)))          fun advBy hp = emit(M.MV(pty, allocptrR,
251                                     M.ADD(pty, C.allocptr, M.LI hp)))
252        in        in
253          (* Keep allocation pointer aligned on odd boundary *)          (* Keep allocation pointer aligned on odd boundary *)
254          (* Note: We have accounted for the extra space this eats up in          (* Note: We have accounted for the extra space this eats up in
# Line 253  Line 261 
261    
262        fun testLimit hp = let        fun testLimit hp = let
263          fun assignCC(M.CC cc, v) = emit(M.CCMV(cc, v))          fun assignCC(M.CC cc, v) = emit(M.CCMV(cc, v))
           | assignCC(M.LOADCC(ea,region), v) = emit(M.STORECC(ea, v, region))  
264            | assignCC _ = error "testLimit.assign"            | assignCC _ = error "testLimit.assign"
265        in        in
266          updtHeapPtr(hp);          updtHeapPtr(hp);
267          case C.exhausted          case C.exhausted
268          of NONE => ()          of NONE => ()
269           | SOME cc => assignCC(cc, M.CMP(M.GTU, C.allocptr, C.limitptr, M.LR))           | SOME cc => assignCC(cc, gcTest)
270          (*esac*)          (*esac*)
271        end        end
272    
273        (* Int 31 tag optimization *)        (* Int 31 tag optimization *)
274        fun addTag e = M.ADD(e, M.LI 1)        val one  = M.LI 1
275        fun stripTag e = M.SUB(e, M.LI 1, M.LR)        val two  = M.LI 2
276        fun orTag e = M.ORB(e, M.LI 1)  
277          fun addTag e = M.ADD(ity, e, one)
278          fun stripTag e = M.SUB(ity, e, one)
279          fun orTag e = M.ORB(ity, e, one)
280        fun tag(signed, e) = let          (* true if signed *)        fun tag(signed, e) = let          (* true if signed *)
281          fun double r = if signed then M.ADDT(r,r) else M.ADD(r,r)          fun double r = if signed then M.ADDT(ity,r,r) else M.ADD(ity, r,r)
282        in        in
283          case e          case e
284           of M.REG _ => addTag(double e)           of M.REG _ => addTag(double e)
285            | _ => let            | _ => let
286                 val tmp = newReg()                 val tmp = newReg()
287               in M.SEQ(M.MV(tmp, e), addTag(double (M.REG tmp)))               in M.SEQ(M.MV(ity, tmp, e), addTag(double (M.REG(ity,tmp))))
288               end               end
289        end        end
290        val mlZero = tag(false, M.LI 0)        val mlZero = tag(false, M.LI 0)
291        fun untag(_, CPS.INT i) = M.LI(i)        fun untag(_, CPS.INT i) = M.LI i
292          | untag(true, v) = M.SRA(regbind v, M.LI 1, M.LR)          | untag(true, v) = M.SRA(ity, regbind v, one)
293          | untag(false, v) = M.SRL(regbind v, M.LI 1, M.LR)          | untag(false, v) = M.SRL(ity, regbind v, one)
294    
295        fun int31add(addOp, [CPS.INT k, w]) = addOp(M.LI(k+k), regbind w)        fun int31add(addOp, [CPS.INT k, w]) = addOp(ity, M.LI(k+k), regbind w)
296          | int31add(addOp, [w, v as CPS.INT _]) = int31add(addOp, [v,w])          | int31add(addOp, [w, v as CPS.INT _]) = int31add(addOp, [v,w])
297          | int31add(addOp, [v,w]) = addOp(regbind v, stripTag(regbind w))          | int31add(addOp, [v,w]) = addOp(ity, regbind v, stripTag(regbind w))
298    
299        fun int31sub(subOp, [CPS.INT k,w]) = subOp(M.LI (k+k+2), regbind w, M.LR)        fun int31sub(subOp, [CPS.INT k,w]) = subOp(ity, M.LI(k+k+2), regbind w)
300          | int31sub(subOp, [v, CPS.INT k]) = subOp(regbind v, M.LI(k+k), M.LR)          | int31sub(subOp, [v, CPS.INT k]) = subOp(ity, regbind v, M.LI(k+k))
301          | int31sub(subOp, [v,w]) = addTag(subOp(regbind v, regbind w, M.LR))          | int31sub(subOp, [v,w]) = addTag(subOp(ity, regbind v, regbind w))
302    
303        fun int31xor([CPS.INT k, w]) = M.XORB(M.LI(k+k), regbind w)        fun int31xor([CPS.INT k, w]) = M.XORB(ity, M.LI(k+k), regbind w)
304          | int31xor([w,v as CPS.INT _]) = int31xor [v,w]          | int31xor([w,v as CPS.INT _]) = int31xor [v,w]
305          | int31xor([v,w]) = addTag (M.XORB(regbind v, regbind w))          | int31xor([v,w]) = addTag (M.XORB(ity, regbind v, regbind w))
306    
307        fun int31mul(signed, args) = let        fun int31mul(signed, args) = let
308          val mulOp = if signed then M.MULT else M.MULU          val mulOp = if signed then M.MULT else M.MULU
309          fun f [CPS.INT k, CPS.INT j] = addTag(mulOp(M.LI (k+k), M.LI j))          fun f [CPS.INT k, CPS.INT j] = addTag(mulOp(ity, M.LI(k+k), M.LI(j)))
310            | f [CPS.INT k, w] = addTag(mulOp(untag(signed, w), M.LI(k+k)))            | f [CPS.INT k, w] = addTag(mulOp(ity,untag(signed, w), M.LI(k+k)))
311            | f [v, w as CPS.INT _] = f ([w, v])            | f [v, w as CPS.INT _] = f ([w, v])
312            | f [v, w] = addTag(mulOp(stripTag(regbind v), untag(signed, w)))            | f [v, w] = addTag(mulOp(ity,stripTag(regbind v), untag(signed, w)))
313        in f args        in f args
314        end        end
315    
316        fun int31div(signed, args) = let        fun int31div(signed, args) = let
317          val divOp = if signed then M.DIVT else M.DIVU          val divOp = if signed then M.DIVT else M.DIVU
318          fun f [CPS.INT k, CPS.INT j] = divOp(M.LI k, M.LI j, M.LR)          fun f [CPS.INT k, CPS.INT j] = divOp(ity,M.LI k, M.LI j)
319            | f [CPS.INT k, w] = divOp(M.LI k, untag(signed, w), M.LR)            | f [CPS.INT k, w] = divOp(ity,M.LI k, untag(signed, w))
320            | f [v, CPS.INT k] = divOp(untag(signed, v), M.LI k, M.LR)            | f [v, CPS.INT k] = divOp(ity,untag(signed, v), M.LI(k))
321            | f [v, w] = divOp(untag(signed, v), untag(signed, w), M.LR)            | f [v, w] = divOp(ity,untag(signed, v), untag(signed, w))
322        in tag(signed, f args)        in tag(signed, f args)
323        end        end
324    
325        fun int31lshift [CPS.INT k, w] =        fun int31lshift [CPS.INT k, w] =
326              addTag (M.SLL(M.LI(k+k), untag(false, w), M.LR))              addTag (M.SLL(ity, M.LI(k+k), untag(false, w)))
327          | int31lshift [v, CPS.INT k] =          | int31lshift [v, CPS.INT k] =
328              addTag(M.SLL(stripTag(regbind v), M.LI k, M.LR))              addTag(M.SLL(ity,stripTag(regbind v), M.LI(k)))
329          | int31lshift [v,w] =          | int31lshift [v,w] =
330              addTag(M.SLL(stripTag(regbind v), untag(false, w), M.LR))              addTag(M.SLL(ity,stripTag(regbind v), untag(false, w)))
331    
332        fun int31rshift(rshiftOp, [v, CPS.INT k]) =        fun int31rshift(rshiftOp, [v, CPS.INT k]) =
333              orTag(rshiftOp(regbind v, M.LI k, M.LR))              orTag(rshiftOp(ity, regbind v, M.LI(k)))
334          | int31rshift(rshiftOp, [v,w]) =          | int31rshift(rshiftOp, [v,w]) =
335              orTag(rshiftOp(regbind v, untag(false, w), M.LR))              orTag(rshiftOp(ity, regbind v, untag(false, w)))
336    
337        fun getObjDescriptor(v) =        fun getObjDescriptor(v) =
338          M.LOAD32(M.SUB(regbind v, M.LI 4, M.LR), getRegion(v, ~1))          M.LOAD(ity, M.SUB(pty, regbind v, M.LI(4)), getRegion(v, ~1))
339    
340        fun getObjLength(v) =        fun getObjLength(v) =
341          M.SRL(getObjDescriptor(v), M.LI(D.tagWidth -1), M.LR)          M.SRL(ity, getObjDescriptor(v), M.LI(D.tagWidth -1))
342    
343        (* Note: because formals are moved into fresh temporaries,        (* Note: because formals are moved into fresh temporaries,
344         * (formals intersection actuals) is empty.         * (formals intersection actuals) is empty.
345         *)         *)
346        fun callSetup(formals, actuals) = let        fun callSetup(formals, actuals) = let
347          fun gather([], [], cpRd, cpRs, fcopies, moves) =          fun gather([], [], cpRd, cpRs, fcopies, moves) =
348               (case (cpRd,cpRs) of ([],[]) => () | _ => emit(M.COPY(cpRd, cpRs));               (case (cpRd,cpRs) of ([],[]) => () | _ =>
349                      emit(M.COPY(ity, cpRd, cpRs));
350                case fcopies                case fcopies
351                  of [] => ()                  of [] => ()
352                   | _ => emit(M.FCOPY(map #1 fcopies, map #2 fcopies));                   | _ => emit(M.FCOPY(fty, map #1 fcopies, map #2 fcopies));
353                app emit moves)                app emit moves)
354            | gather(M.GPR(M.REG rd)::fmls, act::acts, cpRd, cpRs, f, m) =            | gather(M.GPR(M.REG(ty,rd))::fmls, act::acts, cpRd, cpRs, f, m) =
355               (case regbind act               (case regbind act
356                 of M.REG rs => gather(fmls, acts, rd::cpRd, rs::cpRs, f, m)                 of M.REG(_,rs) => gather(fmls, acts, rd::cpRd, rs::cpRs, f, m)
357                  | e => gather(fmls, acts, cpRd, cpRs, f, M.MV(rd, e)::m)                  | e => gather(fmls, acts, cpRd, cpRs, f, M.MV(ty, rd, e)::m)
358               (*esac*))               (*esac*))
359            | gather(M.GPR(M.LOAD32(ea,r))::fmls, act::acts, cpRd, cpRs, f, m) =            | gather(M.GPR(M.LOAD(ty,ea,r))::fmls, act::acts, cpRd, cpRs, f, m) =
360               gather(fmls, acts, cpRd, cpRs, f, M.STORE32(ea, regbind act, r)::m)               gather(fmls, acts, cpRd, cpRs, f, M.STORE(ty,ea,regbind act,r)::m)
361            | gather(M.FPR(M.FREG fd)::fmls, act::acts, cpRd, cpRs, f, m) =            | gather(M.FPR(M.FREG(ty,fd))::fmls, act::acts, cpRd, cpRs, f, m) =
362               (case fregbind act               (case fregbind act
363                 of M.FREG fs => gather(fmls, acts, cpRd, cpRs, (fd, fs)::f, m)                 of M.FREG(_,fs) => gather(fmls, acts, cpRd, cpRs, (fd, fs)::f, m)
364                  | e => gather(fmls, acts, cpRd, cpRs, f, M.FMV(fd, e)::m)                  | e => gather(fmls, acts, cpRd, cpRs, f, M.FMV(ty, fd, e)::m)
365               (*esac*))               (*esac*))
366            | gather _ = error "callSetup.gather"            | gather _ = error "callSetup.gather"
367        in        in
# Line 359  Line 370 
370    
371        (* scale-and-add *)        (* scale-and-add *)
372        fun scale1(a, CPS.INT 0) = a        fun scale1(a, CPS.INT 0) = a
373          | scale1(a, CPS.INT k) = M.ADD(a, M.LI k)          | scale1(a, CPS.INT k) = M.ADD(ity, a, M.LI(k))
374          | scale1(a, i) = M.ADD(a, untag(true, i))          | scale1(a, i) = M.ADD(ity, a, untag(true, i))
375    
376        fun scale4(a, CPS.INT 0) = a        fun scale4(a, CPS.INT 0) = a
377          | scale4(a, CPS.INT i) = M.ADD(a, M.LI(i*4))          | scale4(a, CPS.INT i) = M.ADD(ity, a, M.LI(i*4))
378          | scale4(a, i) = M.ADD(a, M.SLL(stripTag(regbind i), M.LI 1, M.LR))          | scale4(a, i) = M.ADD(ity, a, M.SLL(ity, untag(true,i), two))
379    
380    
381        fun scale8(a, CPS.INT 0) = a        fun scale8(a, CPS.INT 0) = a
382          | scale8(a, CPS.INT i) = M.ADD(a, M.LI(i*8))          | scale8(a, CPS.INT i) = M.ADD(ity, a, M.LI(i*8))
383          | scale8(a, i) = M.ADD(a, M.SLL(stripTag(regbind i), M.LI 2, M.LR))          | scale8(a, i) = M.ADD(ity, a, M.SLL(ity, stripTag(regbind i),
384                                                  M.LI(2)))
385    
386        (* add to storelist, the address where a boxed update has occured *)        (* add to storelist, the address where a boxed update has occured *)
387        fun recordStore(tmp, hp) =        fun recordStore(tmp, hp) =
388          (emit(M.STORE32(M.ADD(C.allocptr, M.LI hp), tmp, R.STORELIST));          (emit(M.STORE(pty, M.ADD(pty, C.allocptr, M.LI(hp)), tmp, R.storelist));
389           emit(M.STORE32(M.ADD(C.allocptr, M.LI(hp+4)), C.storeptr, R.STORELIST));           emit(M.STORE(pty, M.ADD(pty, C.allocptr, M.LI(hp+4)), C.storeptr, R.storelist));
390           emit(assign(C.storeptr, M.ADD(C.allocptr, M.LI hp))))           emit(assign(C.storeptr, M.ADD(pty, C.allocptr, M.LI(hp)))))
391    
392        fun unsignedCmp oper = case oper        fun unsignedCmp oper = case oper
393          of P.>   => M.GTU | P.>=  => M.GEU | P.<   => M.LTU | P.<=  => M.LEU          of P.>   => M.GTU | P.>=  => M.GEU | P.<   => M.LTU | P.<=  => M.LEU
394           | P.eql => M.EQ  | P.neq => M.NEQ           | P.eql => M.EQ  | P.neq => M.NE
395    
396        fun signedCmp oper = case oper        fun signedCmp oper = case oper
397          of P.> => M.GT    | P.>= => M.GE   | P.< => M.LT    | P.<= => M.LE          of P.> => M.GT    | P.>= => M.GE   | P.< => M.LT    | P.<= => M.LE
398           | P.neq => M.NEQ | P.eql => M.EQ           | P.neq => M.NE | P.eql => M.EQ
399    
400        fun branchToLabel(lab) = M.JMP(M.LABEL(LE.LABEL(lab)), [lab])        fun branchToLabel(lab) = M.JMP(M.LABEL(LE.LABEL(lab)), [lab])
401    
# Line 396  Line 409 
409          val r = newReg()          val r = newReg()
410        in        in
411          addRegBinding(x, r);          addRegBinding(x, r);
412          emit(M.MV(r, e));          emit(M.MV(ity, r, e));
413          gen(rest, hp)          gen(rest, hp)
414        end        end
415    
# Line 407  Line 420 
420            | CpsTreeify.COMPUTE => let            | CpsTreeify.COMPUTE => let
421                val f = newFreg()                val f = newFreg()
422              in              in
423                addFregBinding(x, M.FREG f);                addFregBinding(x, M.FREG(fty, f));
424                emit(M.FMV(f, e));                emit(M.FMV(fty, f, e));
425                gen(rest, hp)                gen(rest, hp)
426              end              end
427         (*esac*))         (*esac*))
# Line 420  Line 433 
433        in        in
434          addRegBinding(x, dst);          addRegBinding(x, dst);
435          case regbind v          case regbind v
436           of M.REG src => emit(M.COPY([dst], [src]))           of M.REG(_,src) => emit(M.COPY(ity, [dst], [src]))
437            | e => emit(M.MV(dst, e))            | e => emit(M.MV(ity, dst, e))
438          (*esac*);          (*esac*);
439          gen(rest, hp)          gen(rest, hp)
440        end        end
# Line 430  Line 443 
443          val trueLab = Label.newLabel""          val trueLab = Label.newLabel""
444        in        in
445          (* is single assignment great or what! *)          (* is single assignment great or what! *)
446          emit(M.BCC(cmp, M.CMP(cmp, regbind v, regbind w, M.LR), trueLab));          emit(M.BCC(cmp, M.CMP(32, cmp, regbind v, regbind w), trueLab));
447          gen(e, hp);          gen(e, hp);
448          genlab(trueLab, d, hp)          genlab(trueLab, d, hp)
449        end        end
450    
451        and arith(oper, v, w, x, e, hp) =        and arith(oper, v, w, x, e, hp) =
452          alloc(x, oper(regbind v, regbind w), e, hp)          alloc(x, oper(ity, regbind v, regbind w), e, hp)
453    
454        and orderedArith(oper, v, w, x, order, e, hp) =        and orderedArith(oper, v, w, x, order, e, hp) =
455          alloc(x, oper(regbind v, regbind w, order), e, hp)          alloc(x, oper(ity, regbind v, regbind w, order), e, hp)
456    
457        and logical(oper, v, w, x, e, hp) =        and logical(oper, v, w, x, e, hp) =
458          alloc(x, oper(regbind v, untag(false, w), M.LR), e, hp)          alloc(x, oper(ity, regbind v, untag(false, w)), e, hp)
459    
460        and genlab(lab, e, hp) = (comp (M.DEFINELABEL lab); gen(e, hp))        and genlab(lab, e, hp) = (comp (M.DEFINELABEL lab); gen(e, hp))
461    
# Line 469  Line 482 
482            in            in
483              addRegBinding(w, ptr);              addRegBinding(w, ptr);
484              MkRecord.frecord              MkRecord.frecord
485                {desc=M.LI desc, fields=vl', ans=ptr, mem=memDisambig w, hp=hp};                {desc=M.LI desc, fields=vl', ans=ptr, mem=memDisambig w,
486                   hp=hp, emit=emit};
487              gen(e, hp + 4 + len*8)              gen(e, hp + 4 + len*8)
488            end            end
489          | gen(RECORD(CPS.RK_VECTOR, vl, w, e), hp) = let          | gen(RECORD(CPS.RK_VECTOR, vl, w, e), hp) = let
# Line 480  Line 494 
494              val dataPtr = newReg()              val dataPtr = newReg()
495              val hdrPtr = newReg()              val hdrPtr = newReg()
496              val hdrM = memDisambig w              val hdrM = memDisambig w
497              val dataM = (case hdrM              val dataM = hdrM (* Allen *)
                    of R.RECORD[_, (_, dataM, _), _] => dataM  
                     | R.RO_MEM => R.RO_MEM  
                     | R.RW_MEM => R.RW_MEM  
                     | r => error("gen(RK_VECTOR): hdrM = " ^ R.toString r)  
                   (* end case *))  
498              in              in
499                addRegBinding(w, hdrPtr);                addRegBinding(w, hdrPtr);
500                MkRecord.record {                MkRecord.record {
501                    desc = M.LI dataDesc, fields = contents,                    desc = M.LI(dataDesc), fields = contents,
502                    ans = dataPtr,                    ans = dataPtr,
503                    mem = dataM, hp = hp                    mem = dataM, hp = hp, emit=emit
504                  };                  };
505                MkRecord.record {                MkRecord.record {
506                    desc = M.LI hdrDesc,                    desc = M.LI hdrDesc,
507                    fields = [                    fields = [
508                        (M.REG dataPtr, offp0),                        (M.REG(ity,dataPtr), offp0),
509                        (tag(false, M.LI len), offp0)                        (tag(false, M.LI len), offp0)
510                      ],                      ],
511                    ans = hdrPtr,                    ans = hdrPtr,
512                    mem = hdrM, hp = hp + 4 + len*4                    mem = hdrM, hp = hp + 4 + len*4, emit=emit
513                  };                  };
514                gen (e, hp + 16 + len*4)                gen (e, hp + 16 + len*4)
515              end              end
# Line 515  Line 524 
524            in            in
525              addRegBinding(w, ptr);              addRegBinding(w, ptr);
526              MkRecord.record              MkRecord.record
527                {desc=M.LI desc, fields=contents, ans=ptr, mem=memDisambig w, hp=hp};                {desc=M.LI desc,
528                   fields=contents, ans=ptr, mem=memDisambig w, hp=hp, emit=emit};
529              gen(e, hp + 4 + len*4 )              gen(e, hp + 4 + len*4 )
530            end            end
531    
# Line 526  Line 536 
536                   if unboxedfloat then (case t of FLTt => true | _ => false)                   if unboxedfloat then (case t of FLTt => true | _ => false)
537                   else false                   else false
538                 fun fallocSp(x,e,hp) =                 fun fallocSp(x,e,hp) =
539                   (addFregBinding(x,M.FREG(newFreg()));gen(e, hp))                   (addFregBinding(x,M.FREG(fty,newFreg()));gen(e, hp))
540                (* warning: the following generated code should never be                (* warning: the following generated code should never be
541                   executed; its semantics is completely screwed up !                   executed; its semantics is completely screwed up !
542                 *)                 *)
# Line 534  Line 544 
544                 else alloc(x, M.LI k, e, hp)(* BOGUS *)                 else alloc(x, M.LI k, e, hp)(* BOGUS *)
545             end             end
546          | gen(SELECT(i,v,x,FLTt,e), hp) =          | gen(SELECT(i,v,x,FLTt,e), hp) =
547             falloc(x, M.LOADD(scale8(regbind v, INT i), R.REAL), e, hp)              falloc(x, M.FLOAD(fty, scale8(regbind v, INT i), R.real), e, hp)
548          | gen(SELECT(i,v,x,_,e), hp) = let          | gen(SELECT(i,v,x,_,e), hp) = let
549              val select = M.LOAD32(scale4(regbind v, INT i), getRegion(v, i))              val select = M.LOAD(ity,scale4(regbind v, INT i), getRegion(v, i))
550            in            in
551              (* This business is only done with SELECTs because it is              (* This business is only done with SELECTs because it is
552                 where I think it has the most benefit. [Lal]                 where I think it has the most benefit. [Lal]
# Line 546  Line 556 
556                | CpsTreeify.TREEIFY => (addExpBinding(x, select); gen(e, hp))                | CpsTreeify.TREEIFY => (addExpBinding(x, select); gen(e, hp))
557                | CpsTreeify.DEAD => gen(e, hp)                | CpsTreeify.DEAD => gen(e, hp)
558            end            end
559    
560          | gen(OFFSET(i,v,x,e), hp) = alloc(x, scale4(regbind v, INT i), e, hp)          | gen(OFFSET(i,v,x,e), hp) = alloc(x, scale4(regbind v, INT i), e, hp)
561    
562          (*** APP ***)          (*** APP ***)
# Line 592  Line 603 
603                   emit(branchToLabel(lab));                   emit(branchToLabel(lab));
604                   comp(M.DEFINELABEL lab);                   comp(M.DEFINELABEL lab);
605                   comp(M.BLOCK_NAME(Int.toString f));                   comp(M.BLOCK_NAME(Int.toString f));
606                   CallGc.knwCheckLimit                   CallGc.knwCheckLimit {emit=emit,comp=comp}
607                     {maxAlloc=4*maxAlloc f, regfmls=formals, regtys=tl,                     {maxAlloc=4*maxAlloc f, regfmls=formals, regtys=tl,
608                      return=branchToLabel(lab)};                      return=branchToLabel(lab)};
609                   alignAllocptr f;                   alignAllocptr f;
# Line 617  Line 628 
628          | gen(SWITCH(v, _, l), hp) = let          | gen(SWITCH(v, _, l), hp) = let
629              val lab = Label.newLabel""              val lab = Label.newLabel""
630              val labs = map (fn _ => Label.newLabel"") l              val labs = map (fn _ => Label.newLabel"") l
631              val tmpR = newReg() val tmp = M.REG tmpR              val tmpR = newReg() val tmp = M.REG(ity,tmpR)
632            in            in
633              emit(M.MV(tmpR, laddr(lab, 0)));              emit(M.MV(ity, tmpR, laddr(lab, 0)));
634              emit(M.JMP(M.ADD(tmp, M.LOAD32 (scale4(tmp, v), R.RO_MEM)), labs));              emit(M.JMP(M.ADD(pty, tmp, M.LOAD(pty, scale4(tmp, v), R.readonly)), labs));
635              comp(M.PSEUDO_OP(PseudoOp.JUMPTABLE{base=lab, targets=labs}));              comp(M.PSEUDO_OP(PseudoOp.JUMPTABLE{base=lab, targets=labs}));
636              ListPair.app (fn (lab, e) => genlab(lab, e, hp)) (labs, l)              ListPair.app (fn (lab, e) => genlab(lab, e, hp)) (labs, l)
637            end            end
638    
639          (*** PURE ***)          (*** PURE ***)
640          | gen(PURE(P.pure_arith{oper=P.orb, ...}, [v,w], x, _, e), hp) =          | gen(PURE(P.pure_arith{oper=P.orb, ...}, [v,w], x, _, e), hp) =
641              alloc(x, M.ORB(regbind v, regbind w), e, hp)              alloc(x, M.ORB(ity, regbind v, regbind w), e, hp)
642          | gen(PURE(P.pure_arith{oper=P.andb, ...}, [v,w], x, _, e), hp) =          | gen(PURE(P.pure_arith{oper=P.andb, ...}, [v,w], x, _, e), hp) =
643              alloc(x, M.ANDB(regbind v, regbind w), e, hp)              alloc(x, M.ANDB(ity, regbind v, regbind w), e, hp)
644          | gen(PURE(P.pure_arith{oper, kind}, args as [v,w], x, ty, e), hp) =          | gen(PURE(P.pure_arith{oper, kind}, args as [v,w], x, ty, e), hp) =
645            (case kind            (case kind
646              of P.INT 31 => (case oper              of P.INT 31 => (case oper
# Line 660  Line 671 
671                  (*esac*))                  (*esac*))
672               | P.UINT 32 => (case oper               | P.UINT 32 => (case oper
673                   of P.+     => arith(M.ADD, v, w, x, e, hp)                   of P.+     => arith(M.ADD, v, w, x, e, hp)
674                    | P.-     => orderedArith(M.SUB, v, w, x, M.LR, e, hp)                    | P.-     => arith(M.SUB, v, w, x, e, hp)
675                    | P.*     => arith(M.MULU, v, w, x, e, hp)                    | P.*     => arith(M.MULU, v, w, x, e, hp)
676                    | P./     => (updtHeapPtr hp;                    | P./     => (updtHeapPtr hp;
677                                  orderedArith(M.DIVU, v, w, x, M.LR, e, 0))                                  arith(M.DIVU, v, w, x, e, 0))
678                    | P.xorb  => arith(M.XORB, v, w, x, e, hp)                    | P.xorb  => arith(M.XORB, v, w, x, e, hp)
679                    | P.lshift => logical(M.SLL, v, w, x, e, hp)                    | P.lshift => logical(M.SLL, v, w, x, e, hp)
680                    | P.rshift => logical(M.SRA, v, w, x, e, hp)                    | P.rshift => logical(M.SRA, v, w, x, e, hp)
# Line 673  Line 684 
684            (*esac*))            (*esac*))
685          | gen(PURE(P.pure_arith{oper=P.notb, kind}, [v], x, _, e), hp) =          | gen(PURE(P.pure_arith{oper=P.notb, kind}, [v], x, _, e), hp) =
686            (case kind            (case kind
687              of P.UINT 32 => alloc(x, M.XORB(regbind v, M.LI32 0wxFFFFFFFF), e, hp)              of P.UINT 32 => alloc(x, M.XORB(ity, regbind v, M.LI32 0wxFFFFFFFF), e, hp)
688               | P.INT 32 => alloc(x, M.XORB(regbind v, M.LI32 0wxFFFFFFFF), e, hp)               | P.INT 32 => alloc(x, M.XORB(ity, regbind v, M.LI32 0wxFFFFFFFF), e, hp)
689               | P.UINT 31 => alloc(x, M.SUB(M.LI 0, regbind v, M.LR), e, hp)               | P.UINT 31 => alloc(x, M.SUB(ity, M.LI 0, regbind v), e, hp)
690               | P.INT 31 => alloc(x, M.SUB(M.LI 0, regbind v, M.LR), e, hp)               | P.INT 31 => alloc(x, M.SUB(ity, M.LI 0, regbind v), e, hp)
691            (*esac*))            (*esac*))
692          | gen(PURE(P.copy ft, [v], x, _, e), hp) =          | gen(PURE(P.copy ft, [v], x, _, e), hp) =
693             (case ft             (case ft
694              of (31, 32) => alloc(x, M.SRL(regbind v, M.LI 1, M.LR), e, hp)              of (31, 32) => alloc(x, M.SRL(ity, regbind v, one), e, hp)
695               | (8, 31) => copy(x, v, e, hp)               | (8, 31) => copy(x, v, e, hp)
696               | (8, 32) => alloc(x, M.SRL(regbind v, M.LI 1, M.LR), e, hp)               | (8, 32) => alloc(x, M.SRL(ity, regbind v, one), e, hp)
697               | (n,m) => if n = m then copy(x, v, e, hp) else error "gen:PURE:copy"               | (n,m) => if n = m then copy(x, v, e, hp) else error "gen:PURE:copy"
698             (*esac*))             (*esac*))
699          | gen(PURE(P.extend ft, [v], x, _ ,e), hp) =          | gen(PURE(P.extend ft, [v], x, _ ,e), hp) =
700            (case ft            (case ft
701             of (8,31) =>             of (8,31) =>
702                  alloc(x, M.SRA(M.SLL(regbind v,M.LI 23,M.LR), M.LI 23, M.LR),                  alloc(x, M.SRA(ity, M.SLL(ity, regbind v,M.LI 23), M.LI 23),
703                        e, hp)                        e, hp)
704              | (8,32) =>              | (8,32) =>
705                  alloc(x, M.SRA(M.SLL(regbind v, M.LI 23, M.LR), M.LI 24, M.LR),                  alloc(x, M.SRA(ity, M.SLL(ity, regbind v, M.LI 23), M.LI 24),
706                        e, hp)                        e, hp)
707              | (31,32) => alloc(x, M.SRA(regbind v, M.LI 1, M.LR), e, hp)              | (31,32) => alloc(x, M.SRA(ity, regbind v, one), e, hp)
708              | (n, m) =>              | (n, m) =>
709                  if n = m then copy(x, v, e, hp) else error "gen:PURE:extend"                  if n = m then copy(x, v, e, hp) else error "gen:PURE:extend"
710              (*esac*))              (*esac*))
711          | gen(PURE(P.trunc ft, [v], x, _, e), hp) =          | gen(PURE(P.trunc ft, [v], x, _, e), hp) =
712            (case ft            (case ft
713             of (32, 31) =>             of (32, 31) =>
714                  alloc(x, M.ORB(M.SLL(regbind v, M.LI 1, M.LR), M.LI 1), e, hp)                  alloc(x, M.ORB(ity, M.SLL(ity, regbind v, one), one), e, hp)
715              | (31, 8) => alloc(x, M.ANDB(regbind v, M.LI 0x1ff), e, hp)              | (31, 8) => alloc(x, M.ANDB(ity, regbind v, M.LI 0x1ff), e, hp)
716              | (32, 8) => alloc(x, tag(false, M.ANDB(regbind v, M.LI 0xff)), e, hp)              | (32, 8) => alloc(x, tag(false, M.ANDB(ity, regbind v, M.LI 0xff)), e, hp)
717              | (n, m) => if n = m then copy(x, v, e, hp) else error "gen:PURE:trunc"              | (n, m) => if n = m then copy(x, v, e, hp) else error "gen:PURE:trunc"
718             (*esac*))             (*esac*))
719          | gen(PURE(P.real{fromkind=P.INT 31, tokind}, [v], x, _, e), hp) =          | gen(PURE(P.real{fromkind=P.INT 31, tokind}, [v], x, _, e), hp) =
720            (case tokind            (case tokind
721              of P.FLOAT 64 => (case v              of P.FLOAT 64 => (case v
722                   of INT n => falloc(x, M.CVTI2D(M.LI n), e, hp)                   of INT n => falloc(x, M.CVTI2F(fty,M.SIGN_EXTEND,M.LI n), e, hp)
723                    | _ => falloc(x, M.CVTI2D(untag(true, v)), e, hp)                    | _ => falloc(x, M.CVTI2F(fty,M.SIGN_EXTEND,untag(true, v)), e, hp)
724                  (*esac*))                  (*esac*))
725               | _ => error "gen:PURE:P.real"               | _ => error "gen:PURE:P.real"
726            (*esac*))            (*esac*))
# Line 717  Line 728 
728              val r = fregbind v              val r = fregbind v
729            in            in
730              case oper              case oper
731               of P.~ => falloc(x, M.FNEGD(r), e, hp)               of P.~ => falloc(x, M.FNEG(fty,r), e, hp)
732                | P.abs => falloc(x, M.FABSD(r), e, hp)                | P.abs => falloc(x, M.FABS(fty,r), e, hp)
733            end            end
734          | gen(PURE(P.objlength, [v], x, _, e), hp) =          | gen(PURE(P.objlength, [v], x, _, e), hp) =
735              alloc(x, orTag(getObjLength(v)), e, hp)              alloc(x, orTag(getObjLength(v)), e, hp)
# Line 727  Line 738 
738              gen(SELECT(1, v, x, t, e), hp)              gen(SELECT(1, v, x, t, e), hp)
739          | gen(PURE(P.subscriptv, [v, INT i], x, t, e), hp) = let          | gen(PURE(P.subscriptv, [v, INT i], x, t, e), hp) = let
740              val region = getRegion(v, 0)              val region = getRegion(v, 0)
741              val a = M.LOAD32(regbind v, region)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, region)  (* get data pointer *)
742              val region' = (case region              val region' = region (* Allen *)
                    of (R.RECORD vl) => #1(List.nth(vl, i+1))  
                     | _ => R.RO_MEM  
                   (* end case *))  
743              in              in
744                alloc(x, M.LOAD32(scale4(a, INT i), region'), e, hp)                alloc(x, M.LOAD(ity, scale4(a, INT i), region'), e, hp)
745              end              end
746          | gen(PURE(P.subscriptv, [v, w], x, _, e), hp) = let          | gen(PURE(P.subscriptv, [v, w], x, _, e), hp) = let
747              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, R.readonly)  (* get data pointer *)
748              in              in
749                alloc (x, M.LOAD32(scale4(a, w), R.RO_MEM), e, hp)                alloc (x, M.LOAD(ity, scale4(a, w), R.readonly), e, hp)
750              end              end
751          | gen(PURE(P.pure_numsubscript{kind=P.INT 8}, [v,i], x, _, e), hp) = let          | gen(PURE(P.pure_numsubscript{kind=P.INT 8}, [v,i], x, _, e), hp) = let
752              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, R.readonly)  (* get data pointer *)
753              in              in
754                alloc(x, tag(false,M.LOAD8(scale1(a, i), R.RW_MEM)), e, hp)                alloc(x, tag(false,M.LOAD(8,scale1(a, i), R.memory)), e, hp)
755              end              end
756          | gen(PURE(P.gettag, [v], x, _, e), hp) =          | gen(PURE(P.gettag, [v], x, _, e), hp) =
757              alloc(x,              alloc(x,
758                    tag(false, M.ANDB(getObjDescriptor(v), M.LI(D.powTagWidth-1))),                    tag(false, M.ANDB(ity,
759                            getObjDescriptor(v), M.LI(D.powTagWidth-1))),
760                    e, hp)                    e, hp)
761          | gen(PURE(P.mkspecial, [i, v], x, _, e), hp) = let          | gen(PURE(P.mkspecial, [i, v], x, _, e), hp) = let
762              val desc = case i              val desc = case i
763                of INT n => M.LI(dtoi(D.makeDesc(n, D.tag_special)))                of INT n => M.LI(dtoi(D.makeDesc(n, D.tag_special)))
764                 | _ => M.ORB(M.SLL(untag(true, i), M.LI D.tagWidth, M.LR),                 | _ => M.ORB(ity, M.SLL(ity, untag(true, i), M.LI D.tagWidth),
765                             M.LI(dtoi D.desc_special))                             M.LI(dtoi D.desc_special))
766              val ptr = newReg()              val ptr = newReg()
767            in            in
768              MkRecord.record{desc=desc, fields=[(regbind v, offp0)],              MkRecord.record{desc=desc, fields=[(regbind v, offp0)],
769                              ans=ptr, mem=memDisambig x, hp=hp};                              ans=ptr, mem=memDisambig x, hp=hp, emit=emit};
770              addRegBinding(x, ptr);              addRegBinding(x, ptr);
771              gen(e, hp+8)              gen(e, hp+8)
772            end            end
# Line 766  Line 775 
775              val tag = M.LI(dtoi D.desc_ref)              val tag = M.LI(dtoi D.desc_ref)
776              val mem = memDisambig x              val mem = memDisambig x
777            in            in
778              emit(M.STORE32(M.ADD(C.allocptr, M.LI hp), tag, mem));              emit(M.STORE(ity, M.ADD(pty, C.allocptr, M.LI hp), tag, mem));
779              emit(M.STORE32(M.ADD(C.allocptr, M.LI(hp+4)), regbind v, mem));              emit(M.STORE(ity, M.ADD(pty, C.allocptr, M.LI(hp+4)), regbind v, mem));
780              emit(M.MV(ptr, M.ADD(C.allocptr, M.LI(hp+4))));              emit(M.MV(pty, ptr, M.ADD(pty, C.allocptr, M.LI(hp+4))));
781              addRegBinding(x, ptr);              addRegBinding(x, ptr);
782              gen(e, hp+8)              gen(e, hp+8)
783            end            end
# Line 789  Line 798 
798          | gen(PURE(P.recsubscript, [v, INT w], x, t, e), hp) =          | gen(PURE(P.recsubscript, [v, INT w], x, t, e), hp) =
799              gen(SELECT(w, v, x, t, e), hp)              gen(SELECT(w, v, x, t, e), hp)
800          | gen(PURE(P.recsubscript, [v, w], x, _, e), hp) =          | gen(PURE(P.recsubscript, [v, w], x, _, e), hp) =
801              alloc(x, M.LOAD32(scale4(regbind v, w), R.RO_MEM), e, hp)              alloc(x, M.LOAD(ity, scale4(regbind v, w), R.readonly), e, hp)
802          | gen(PURE(P.raw64subscript, [v, INT i], x, _, e), hp) =          | gen(PURE(P.raw64subscript, [v, INT i], x, _, e), hp) =
803              gen(SELECT(i, v, x, FLTt, e), hp)              gen(SELECT(i, v, x, FLTt, e), hp)
804          | gen(PURE(P.raw64subscript, [v, i], x, _, e), hp) =          | gen(PURE(P.raw64subscript, [v, i], x, _, e), hp) =
805              falloc(x, M.LOADD(scale8(regbind v, i),R.RO_MEM), e, hp)              falloc(x, M.FLOAD(fty,scale8(regbind v, i),R.readonly), e, hp)
806          | gen(PURE(P.newarray0, [_], x, t, e), hp) = let          | gen(PURE(P.newarray0, [_], x, t, e), hp) = let
807              val hdrDesc = dtoi(D.desc_polyarr)              val hdrDesc = dtoi(D.desc_polyarr)
808              val dataDesc = dtoi D.desc_ref              val dataDesc = dtoi D.desc_ref
809              val dataPtr = newReg()              val dataPtr = newReg()
810              val hdrPtr = newReg()              val hdrPtr = newReg()
811              val hdrM = memDisambig x              val hdrM = memDisambig x
812              val (tagM, valM) = (case hdrM              val (tagM, valM) = (hdrM, hdrM) (* Allen *)
                    of R.RECORD[  
                         _, (_, R.RECORD[(tagM, _, _), (valM, _, _)], _), _  
                       ] => (tagM, valM)  
                     | R.RW_MEM => (R.RW_MEM, R.RW_MEM)  
                     | r => error("gen(newarray0): hdrM = " ^ R.toString r)  
                   (* end case *))  
813              in              in
814                addRegBinding(x, hdrPtr);                addRegBinding(x, hdrPtr);
815              (* gen code to allocate "ref()" for array data *)              (* gen code to allocate "ref()" for array data *)
816                emit(M.STORE32(M.ADD(C.allocptr, M.LI hp), M.LI dataDesc, tagM));                emit(M.STORE(ity, M.ADD(pty, C.allocptr, M.LI hp), M.LI dataDesc, tagM));
817                emit(M.STORE32(M.ADD(C.allocptr, M.LI(hp+4)), mlZero, valM));                emit(M.STORE(ity, M.ADD(pty, C.allocptr, M.LI(hp+4)), mlZero, valM));
818                emit(M.MV(dataPtr, M.ADD(C.allocptr, M.LI(hp+4))));                emit(M.MV(pty, dataPtr, M.ADD(pty, C.allocptr, M.LI(hp+4))));
819              (* gen code to allocate array header *)              (* gen code to allocate array header *)
820                MkRecord.record {                MkRecord.record {
821                    desc = M.LI hdrDesc,                    desc = M.LI hdrDesc,
822                    fields = [(M.REG dataPtr, offp0), (mlZero, offp0)],                    fields = [(M.REG(ity,dataPtr), offp0), (mlZero, offp0)],
823                    ans = hdrPtr,                    ans = hdrPtr,
824                    mem = hdrM, hp = hp + 8                    mem = hdrM, hp = hp + 8, emit=emit
825                  };                  };
826                gen (e, hp + 20)                gen (e, hp + 20)
827              end              end
# Line 830  Line 833 
833               | P.- => alloc(x, int31sub(M.SUBT, args), e, 0)               | P.- => alloc(x, int31sub(M.SUBT, args), e, 0)
834               | P.* => alloc(x, int31mul(true, args), e, 0)               | P.* => alloc(x, int31mul(true, args), e, 0)
835               | P./ => alloc(x, int31div(true, args), e, 0)               | P./ => alloc(x, int31div(true, args), e, 0)
836               | P.~ => alloc(x, M.SUBT(M.LI 2, regbind(hd args), M.LR), e, 0)               | P.~ => alloc(x, M.SUBT(ity, M.LI 2, regbind(hd args)), e, 0)
837               | _ => error "gen:ARITH INT 31"               | _ => error "gen:ARITH INT 31"
838            (*esac*))            (*esac*))
839          | gen(ARITH(P.arith{kind=P.INT 32, oper}, [v,w], x, _, e), hp) =          | gen(ARITH(P.arith{kind=P.INT 32, oper}, [v,w], x, _, e), hp) =
840            (updtHeapPtr hp;            (updtHeapPtr hp;
841             case oper             case oper
842              of P.+     => arith(M.ADDT, v, w, x, e, 0)              of P.+     => arith(M.ADDT, v, w, x, e, 0)
843               | P.-     => orderedArith(M.SUBT, v, w, x, M.LR, e, 0)               | P.-     => arith(M.SUBT, v, w, x, e, 0)
844               | P.*     => arith(M.MULT, v, w, x, e, 0)               | P.*     => arith(M.MULT, v, w, x, e, 0)
845               | P./     => orderedArith(M.DIVT, v, w, x, M.LR, e, 0)               | P./     => arith(M.DIVT, v, w, x, e, 0)
846               | _ => error "P.arith{kind=INT 32, oper}, [v,w], ..."               | _ => error "P.arith{kind=INT 32, oper}, [v,w], ..."
847            (*esac*))            (*esac*))
848          | gen(ARITH(P.arith{kind=P.INT 32, oper=P.~ }, [v], x, _, e), hp) =          | gen(ARITH(P.arith{kind=P.INT 32, oper=P.~ }, [v], x, _, e), hp) =
849              (updtHeapPtr hp;              (updtHeapPtr hp;
850               alloc(x, M.SUBT(M.LI 0, regbind v, M.LR), e, 0))               alloc(x, M.SUBT(ity, M.LI 0, regbind v), e, 0))
851    
852            (* Note: for testu operations we use a somewhat arcane method            (* Note: for testu operations we use a somewhat arcane method
853             * to generate traps on overflow conditions. A better approach             * to generate traps on overflow conditions. A better approach
# Line 856  Line 859 
859               val vreg = regbind v               val vreg = regbind v
860            in            in
861              updtHeapPtr hp;              updtHeapPtr hp;
862              emit(M.MV(xreg, M.ADDT(vreg, regbind(INT32 0wx80000000))));              emit(M.MV(ity,xreg,M.ADDT(ity, vreg, regbind(INT32 0wx80000000))));
863              alloc(x, vreg, e, 0)              alloc(x, vreg, e, 0)
864            end            end
865          | gen(ARITH(P.testu(31, 31), [v], x, _, e), hp) = let          | gen(ARITH(P.testu(31, 31), [v], x, _, e), hp) = let
# Line 864  Line 867 
867               val vreg = regbind v               val vreg = regbind v
868            in            in
869              updtHeapPtr hp;              updtHeapPtr hp;
870              emit(M.MV(xreg, M.ADDT(vreg, regbind(INT32 0wx80000000))));              emit(M.MV(ity,xreg,M.ADDT(ity, vreg, regbind(INT32 0wx80000000))));
871              alloc(x, vreg, e, 0)              alloc(x, vreg, e, 0)
872            end            end
873          | gen(ARITH(P.testu(32,31), [v], x, _, e), hp) = let          | gen(ARITH(P.testu(32,31), [v], x, _, e), hp) = let
874              val vreg = regbind v              val vreg = regbind v
875              val tmp = newReg()              val tmp = newReg()
876              val tmpR = M.REG tmp              val tmpR = M.REG(ity,tmp)
877              val lab = Label.newLabel ""              val lab = Label.newLabel ""
878            in            in
879              emit(M.MV(tmp, regbind(INT32 0wx3fffffff)));              emit(M.MV(ity, tmp, regbind(INT32 0wx3fffffff)));
880              emit(M.BCC(M.LEU, M.CMP(M.LEU, vreg, tmpR, M.LR), lab));              emit(M.BCC(M.LEU, M.CMP(32, M.LEU, vreg, tmpR), lab));
881              updtHeapPtr hp;              updtHeapPtr hp;
882              emit(M.MV(tmp, M.SLL(tmpR, M.LI 1, M.LR)));              emit(M.MV(ity, tmp, M.SLL(ity, tmpR, one)));
883              emit(M.MV(tmp, M.ADDT(tmpR, tmpR)));              emit(M.MV(ity, tmp, M.ADDT(ity, tmpR, tmpR)));
884              comp(M.DEFINELABEL lab);              comp(M.DEFINELABEL lab);
885              alloc(x, tag(false, vreg), e, hp)              alloc(x, tag(false, vreg), e, hp)
886            end            end
# Line 887  Line 890 
890             if n = m then copy(x, v, e, hp) else error "gen:ARITH:test"             if n = m then copy(x, v, e, hp) else error "gen:ARITH:test"
891          | gen(ARITH(P.arith{oper, kind=P.FLOAT 64}, vl, x, _, e), hp) = let          | gen(ARITH(P.arith{oper, kind=P.FLOAT 64}, vl, x, _, e), hp) = let
892              fun binary(oper, [v,w]) =              fun binary(oper, [v,w]) =
893                falloc(x, oper(fregbind v, fregbind w), e, hp)                falloc(x, oper(fty, fregbind v, fregbind w), e, hp)
             fun ordBinary(oper, [v,w]) =  
               falloc(x, oper(fregbind v, fregbind w, M.LR), e, hp)  
894            in            in
895              case oper              case oper
896               of P.+ => binary(M.FADDD, vl)               of P.+ => binary(M.FADD, vl)
897                | P.* => binary(M.FMULD, vl)                | P.* => binary(M.FMUL, vl)
898                | P.- => ordBinary(M.FSUBD, vl)                | P.- => binary(M.FSUB, vl)
899                | P./ => ordBinary(M.FDIVD, vl)                | P./ => binary(M.FDIV, vl)
900            end            end
901          (*** LOOKER ***)          (*** LOOKER ***)
902          | gen(LOOKER(P.!, [v], x, _, e), hp) =          | gen(LOOKER(P.!, [v], x, _, e), hp) =
903              alloc (x, M.LOAD32(regbind v, R.RW_MEM), e, hp)              alloc (x, M.LOAD(ity, regbind v, R.memory), e, hp)
904          | gen(LOOKER(P.subscript, [v,w], x, _, e), hp) = let          | gen(LOOKER(P.subscript, [v,w], x, _, e), hp) = let
905              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, R.readonly)  (* get data pointer *)
906              in              in
907                alloc (x, M.LOAD32(scale4(a, w), R.RW_MEM), e, hp)                alloc (x, M.LOAD(ity, scale4(a, w), R.memory), e, hp)
908              end              end
909          | gen(LOOKER(P.numsubscript{kind=P.INT 8},[v,i],x,_,e), hp) = let          | gen(LOOKER(P.numsubscript{kind=P.INT 8},[v,i],x,_,e), hp) = let
910              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, R.readonly)  (* get data pointer *)
911              in              in
912                alloc(x, tag(false, M.LOAD8(scale1(a, i),R.RW_MEM)), e, hp)                alloc(x, tag(false, M.LOAD(8,scale1(a, i),R.memory)), e, hp)
913              end              end
914          | gen(LOOKER(P.numsubscript{kind=P.FLOAT 64}, [v,i], x, _, e), hp) = let          | gen(LOOKER(P.numsubscript{kind=P.FLOAT 64}, [v,i], x, _, e), hp) = let
915              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity,regbind v, R.readonly)  (* get data pointer *)
916              in              in
917                falloc(x, M.LOADD(scale8(a, i),R.RW_MEM), e, hp)                falloc(x, M.FLOAD(fty,scale8(a, i),R.memory), e, hp)
918              end              end
919          | gen(LOOKER(P.gethdlr,[],x,_,e), hp) = alloc(x, C.exnptr, e, hp)          | gen(LOOKER(P.gethdlr,[],x,_,e), hp) = alloc(x, C.exnptr, e, hp)
920          | gen(LOOKER(P.getvar, [], x, _, e), hp) = alloc(x, C.varptr, e, hp)          | gen(LOOKER(P.getvar, [], x, _, e), hp) = alloc(x, C.varptr, e, hp)
921          | gen(LOOKER(P.deflvar, [], x, _, e), hp) = alloc(x, M.LI 0, e, hp)          | gen(LOOKER(P.deflvar, [], x, _, e), hp) = alloc(x, M.LI 0, e, hp)
922          | gen(LOOKER(P.getspecial, [v], x, _, e), hp) =          | gen(LOOKER(P.getspecial, [v], x, _, e), hp) =
923              alloc(x,              alloc(x,
924                    orTag(M.SRA(getObjDescriptor(v),                    orTag(M.SRA(ity, getObjDescriptor(v),
925                                M.LI (D.tagWidth-1),                                     M.LI (D.tagWidth-1))),
                               M.LR)),  
926                    e, hp)                    e, hp)
927          | gen(LOOKER(P.getpseudo, [i], x, _, e), hp) =          | gen(LOOKER(P.getpseudo, [i], x, _, e), hp) =
928              (print "getpseudo not implemented\n"; nop(x, i, e, hp))              (print "getpseudo not implemented\n"; nop(x, i, e, hp))
# Line 931  Line 931 
931              val ea = regbind a              val ea = regbind a
932              in              in
933                recordStore(ea, hp);                recordStore(ea, hp);
934                emit(M.STORE32(ea, regbind v, memDisambig arr));                emit(M.STORE(ity, ea, regbind v, memDisambig arr));
935                gen(e, hp+8)                gen(e, hp+8)
936              end              end
937          | gen(SETTER(P.unboxedassign, [a, v], e), hp) =          | gen(SETTER(P.unboxedassign, [a, v], e), hp) =
938             (emit(M.STORE32(regbind a, regbind v, R.RW_MEM));             (emit(M.STORE(ity, regbind a, regbind v, R.memory));
939              gen(e, hp))              gen(e, hp))
940          | gen(SETTER(P.update, [v,i,w], e), hp) = let          | gen(SETTER(P.update, [v,i,w], e), hp) = let
941              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, R.readonly)  (* get data pointer *)
942              val tmpR = newReg()              val tmpR = newReg()
943              val tmp = M.REG tmpR              val tmp = M.REG(ity, tmpR)
944              val ea = scale4(a, i)  (* address of updated cell *)              val ea = scale4(a, i)  (* address of updated cell *)
945              in              in
946                emit(M.MV(tmpR, ea));                emit(M.MV(ity, tmpR, ea));
947                recordStore(tmp, hp);                recordStore(tmp, hp);
948                emit(M.STORE32(tmp, regbind w, R.RW_MEM));                emit(M.STORE(ity, tmp, regbind w, R.memory));
949                gen(e, hp+8)                gen(e, hp+8)
950              end              end
951          | gen(SETTER(P.boxedupdate, args, e), hp) =          | gen(SETTER(P.boxedupdate, args, e), hp) =
952              gen(SETTER(P.update, args, e), hp)              gen(SETTER(P.update, args, e), hp)
953          | gen(SETTER(P.unboxedupdate, [v, i, w], e), hp) = let          | gen(SETTER(P.unboxedupdate, [v, i, w], e), hp) = let
954              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, R.readonly)  (* get data pointer *)
955              in              in
956                emit(M.STORE32(scale4(a, i), regbind w, R.RW_MEM));                emit(M.STORE(ity, scale4(a, i), regbind w, R.memory));
957                gen(e, hp)                gen(e, hp)
958              end              end
959          | gen(SETTER(P.numupdate{kind=P.INT 8}, [s,i,v], e), hp) = let          | gen(SETTER(P.numupdate{kind=P.INT 8}, [s,i,v], e), hp) = let
960              val a = M.LOAD32(regbind s, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind s, R.readonly)  (* get data pointer *)
961              val ea = scale1(a, i)              val ea = scale1(a, i)
962              in              in
963                emit(M.STORE8(ea, untag(false, v), R.RW_MEM));                emit(M.STORE(8,ea, untag(false, v), R.memory));
964                gen(e, hp)                gen(e, hp)
965              end              end
966          | gen(SETTER(P.numupdate{kind=P.FLOAT 64},[v,i,w],e), hp) = let          | gen(SETTER(P.numupdate{kind=P.FLOAT 64},[v,i,w],e), hp) = let
967              val a = M.LOAD32(regbind v, R.RO_MEM)  (* get data pointer *)              val a = M.LOAD(ity, regbind v, R.readonly)  (* get data pointer *)
968              in              in
969                emit(M.STORED(scale8(a, i), fregbind w, R.RW_MEM));                emit(M.FSTORE(fty,scale8(a, i), fregbind w, R.memory));
970                gen(e, hp)                gen(e, hp)
971              end              end
972          | gen(SETTER(P.setspecial, [v, i], e), hp) = let          | gen(SETTER(P.setspecial, [v, i], e), hp) = let
973              val ea = M.SUB(regbind v, M.LI 4, M.LR)              val ea = M.SUB(ity, regbind v, M.LI 4)
974              val i' = case i              val i' = case i
975                of INT k => M.LI(dtoi(D.makeDesc(k, D.tag_special)))                of INT k => M.LI(dtoi(D.makeDesc(k, D.tag_special)))
976                 | _ => M.ORB(M.SLL(untag(true, i), M.LI D.tagWidth, M.LR),                 | _ => M.ORB(ity, M.SLL(ity, untag(true, i), M.LI D.tagWidth),
977                              M.LI(dtoi D.desc_special))                              M.LI(dtoi D.desc_special))
978            in            in
979              emit(M.STORE32(ea, i',R.RW_MEM));              emit(M.STORE(ity, ea, i',R.memory));
980              gen(e, hp)              gen(e, hp)
981            end            end
982          | gen(SETTER(P.sethdlr,[x],e), hp) =          | gen(SETTER(P.sethdlr,[x],e), hp) =
# Line 1042  Line 1042 
1042                 | P.fULT => M.?< | P.fULE => M.?<=                 | P.fULT => M.?< | P.fULE => M.?<=
1043                 | P.fLG => M.<>  | P.fUE  => M.?=                 | P.fLG => M.<>  | P.fUE  => M.?=
1044    
1045              val cmp = M.FCMP(fcond, fregbind v, fregbind w, M.LR)              val cmp = M.FCMP(64, fcond, fregbind v, fregbind w)
1046            in            in
1047              emit(M.FBCC(fcond, cmp, trueLab));              emit(M.FBCC(fcond, cmp, trueLab));
1048              gen(e, hp);              gen(e, hp);
1049              genlab(trueLab, d, hp)              genlab(trueLab, d, hp)
1050            end            end
1051          | gen(BRANCH(P.peql, vw, _,e,d), hp) = branch(M.EQ, vw, e, d, hp)          | gen(BRANCH(P.peql, vw, _,e,d), hp) = branch(M.EQ, vw, e, d, hp)
1052          | gen(BRANCH(P.pneq, vw, _, e, d), hp) = branch(M.NEQ, vw, e, d, hp)          | gen(BRANCH(P.pneq, vw, _, e, d), hp) = branch(M.NE, vw, e, d, hp)
1053          | gen(BRANCH(P.strneq, [n,v,w],c,d,e), hp) =          | gen(BRANCH(P.strneq, [n,v,w],c,d,e), hp) =
1054              gen(BRANCH(P.streq, [n,v,w],c,e,d), hp)              gen(BRANCH(P.streq, [n,v,w],c,e,d), hp)
1055          | gen(BRANCH(P.streq, [INT n,v,w],_,d,e), hp) = let          | gen(BRANCH(P.streq, [INT n,v,w],_,d,e), hp) = let
# Line 1058  Line 1058 
1058              val r1 = newReg()              val r1 = newReg()
1059              val r2 = newReg()              val r2 = newReg()
1060              fun cmpWord(i) =              fun cmpWord(i) =
1061                M.CMP(M.NEQ, M.LOAD32(M.ADD(M.REG r1,i),R.RO_MEM),                M.CMP(32, M.NE, M.LOAD(ity,M.ADD(ity,M.REG(ity, r1),i),R.readonly),
1062                             M.LOAD32(M.ADD(M.REG r2,i),R.RO_MEM), M.LR)                            M.LOAD(ity,M.ADD(ity,M.REG(ity, r2),i),R.readonly))
1063              fun unroll i =              fun unroll i =
1064                if i=n' then ()                if i=n' then ()
1065                else (emit(M.BCC(M.NEQ, cmpWord(M.LI(i)), false_lab));                else (emit(M.BCC(M.NE, cmpWord(M.LI(i)), false_lab));
1066                      unroll (i+4))                      unroll (i+4))
1067            in            in
1068                emit(M.MV(r1, M.LOAD32(regbind v, R.RO_MEM)));                emit(M.MV(ity, r1, M.LOAD(ity, regbind v, R.readonly)));
1069                emit(M.MV(r2, M.LOAD32(regbind w, R.RO_MEM)));                emit(M.MV(ity, r2, M.LOAD(ity, regbind w, R.readonly)));
1070                unroll 0;                unroll 0;
1071                gen(d, hp);                gen(d, hp);
1072                genlab(false_lab, e, hp)                genlab(false_lab, e, hp)
1073            end            end
1074          | gen(BRANCH(P.boxed, [x], _, a, b), hp) = let          | gen(BRANCH(P.boxed, [x], _, a, b), hp) = let
1075              val lab = Label.newLabel""              val lab = Label.newLabel""
1076              val cmp = M.CMP(M.NEQ, M.ANDB(regbind x, M.LI 1), M.LI 0, M.LR)              val cmp = M.CMP(32, M.NE, M.ANDB(ity, regbind x, one), M.LI 0)
1077            in            in
1078              emit(M.BCC(M.NEQ, cmp, lab));              emit(M.BCC(M.NE, cmp, lab));
1079              gen(a, hp);              gen(a, hp);
1080              genlab(lab, b, hp)              genlab(lab, b, hp)
1081            end            end
# Line 1089  Line 1089 
1089            | fcomp(SOME(_, Frag.KNOWNFUN _)) = continue ()            | fcomp(SOME(_, Frag.KNOWNFUN _)) = continue ()
1090            | fcomp(SOME(_, Frag.KNOWNCHK _)) = continue ()            | fcomp(SOME(_, Frag.KNOWNCHK _)) = continue ()
1091            | fcomp(SOME(_, Frag.STANDARD{func=ref NONE, ...})) = continue ()            | fcomp(SOME(_, Frag.STANDARD{func=ref NONE, ...})) = continue ()
1092            | fcomp(SOME(lab, Frag.STANDARD arg)) = let            | fcomp(SOME(lab, Frag.STANDARD{func as ref(SOME (zz as (_,f,vl,tl,e))),
1093                val {func as ref(SOME (zz as (_,f,vl,tl,e))), ...} = arg                                            ...})) = let
1094                val regfmls as (M.GPR linkreg::_) = ArgP.standard(typmap f, tl)                val regfmls as (M.GPR linkreg::_) = ArgP.standard(typmap f, tl)
1095                val baseval =                val baseval =
1096                  M.ADD(linkreg,                  M.ADD(pty,linkreg,
1097                        M.LABEL(LE.MINUS(LE.CONST MachineSpec.constBaseRegOffset,                        M.LABEL(LE.MINUS(LE.CONST MachineSpec.constBaseRegOffset,
1098                                        LE.LABEL lab)))                                        LE.LABEL lab)))
1099              in              in
1100                func := NONE;                func := NONE;
1101                comp(M.ORDERED[M.PSEUDO_OP PseudoOp.ALIGN4, M.ENTRYLABEL lab]);                comp(M.PSEUDO_OP PseudoOp.ALIGN4);
1102                  comp(M.ENTRYLABEL lab);
1103                comp(M.BLOCK_NAME(Int.toString f));                comp(M.BLOCK_NAME(Int.toString f));
1104                alignAllocptr f;                alignAllocptr f;
1105                emit(assign(C.baseptr, baseval));                emit(assign(C.baseptr, baseval));
1106                CallGc.stdCheckLimit                CallGc.stdCheckLimit {emit=emit,comp=comp}
1107                   {maxAlloc=4 * maxAlloc f, regfmls=regfmls,  regtys=tl,                    {maxAlloc=4 * maxAlloc f, regfmls=regfmls,
1108                    return=M.JMP(linkreg,[])};                     regtys=tl, return=M.JMP(linkreg,[])};
1109                clearTables();                clearTables();
1110                initialRegBindingsEscaping(vl, regfmls, tl);                initialRegBindingsEscaping(vl, regfmls, tl);
1111                initTypBindings e;                initTypBindings e;
# Line 1133  Line 1134 
1134        initFrags cluster;        initFrags cluster;
1135        comp(M.BEGINCLUSTER);        comp(M.BEGINCLUSTER);
1136        fragComp();        fragComp();
1137        CallGc.emitLongJumpsToGCInvocation(regmap);        CallGc.emitLongJumpsToGCInvocation {emit=emit,comp=comp} (regmap);
1138        comp(M.ENDCLUSTER regmap)        comp(M.ENDCLUSTER(regmap,[]))
1139      end (* genCluster *)      end (* genCluster *)
1140    
1141      and emitMLRiscUnit(f) = let      and emitMLRiscUnit(f) = let
1142        val regmap = Cells.resetRegs()        val _ = Cells.reset()
1143          val regmap = Cells.regmap()
1144      in      in
1145        comp (M.BEGINCLUSTER);        comp (M.BEGINCLUSTER);
1146        f regmap;        f regmap;
1147        comp (M.ENDCLUSTER regmap)        comp (M.ENDCLUSTER(regmap,[]))
1148      end      end
1149    in    in
1150      app mkGlobalTables funcs;      app mkGlobalTables funcs;
1151      app genCluster (Cluster.cluster funcs);      app genCluster (Cluster.cluster funcs);
1152      emitMLRiscUnit (CallGc.emitModuleGC)      emitMLRiscUnit (CallGc.emitModuleGC {emit=emit,comp=comp})
1153    end (* codegen *)    end (* codegen *)
1154  end (* MLRiscGen *)  end (* MLRiscGen *)
1155    
 (*  
  * $Log: mlriscGen.sml,v $  
  * Revision 1.14  1999/03/22 17:22:32  george  
  *   Changes to support new GC API  
  *  
  * Revision 1.13  1999/02/23 20:22:06  george  
  *   bug fix to do with zero length arrays  
  *  
  * Revision 1.12  1999/01/18 15:49:29  george  
  *   support of interactive loading of MLRISC optimizer  
  *  
  * Revision 1.11  1998/11/23 20:09:42  jhr  
  *   Fixed length field of raw64 objects (should be in words); new raw64Subscript  
  *   primop.  
  *  
  * Revision 1.10  1998/11/18 03:53:11  jhr  
  *  New array representations.  
  *  
  * Revision 1.9  1998/10/28 18:20:49  jhr  
  *   Removed code generator support for STRING/REAL constants.  
  *  
  * Revision 1.8  1998/10/19 13:28:18  george  
  *   Known functions once again move their arguments to fresh temporaries.  
  *   The problem has to do with spilling and adjusting the regmask.  
  *  
  * Revision 1.7  1998/10/15 17:56:54  george  
  *   known functions do not move formals to fresh temps  
  *  
  * Revision 1.6  1998/09/30 18:56:35  dbm  
  * removed sharing/defspec conflict, using where structure  
  *  
  * Revision 1.5  1998/08/28 12:58:27  george  
  *   Fix for bug1422: Core dump on Sparc when using lazy features  
  *  
  * Revision 1.4  1998/07/25 03:05:36  george  
  *   changes to support block names in MLRISC  
  *  
  * Revision 1.3  1998/05/23 14:09:26  george  
  *   Fixed RCS keyword syntax  
  *  
  *)  

Legend:
Removed from v.247  
changed lines
  Added in v.418

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