SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/compiler/CodeGen/cpscompile/callgc.sml

[smlnj] / sml / branches / SMLNJ / src / compiler / CodeGen / cpscompile / callgc.sml

Diff of /sml/branches/SMLNJ/src/compiler/CodeGen/cpscompile/callgc.sml

-revision 283, Wed May 19 08:20:58 1999 UTC
+revision 284, Wed May 19 23:31:25 1999 UTC
 Line 89
           boxed : T.rexp list,   (* locations with boxed objects *)
           int32 : T.rexp list,   (* locations with int32 objects *)
           float: T.fexp list,    (* locations with float objects *)
+          regfmls: T.mlrisc list,(* all live registers *)
           ret: T.stm}            (* how to return *)
      | MODULE of
          {info: gcInfo,
-Line 145
+Line 146
        | maskList(T.GPR r::rl, t::tl, b, i, f) =
          (case t
            of CPS.INT32t => maskList(rl, tl, b, r::i, f)
+            | CPS.FLTt => error "checkLimit.maskList: T.GPR"
             | _ => maskList(rl, tl, r::b, i, f)
          (*esac*))
        | maskList(T.FPR r::rl, CPS.FLTt::tl, b, i, f) =
-Line 160
+Line 162
                  boxed=boxed,
                  int32=int32,
                  float=float,
+                 regfmls=regfmls,
                  ret=return} :: (!clusterRef)
      end
    in
-Line 171
+Line 174
    val T.REG allocptrR = C.allocptr
    fun invokeGC (external, regmap) gcInfo = let
-     val {known, boxed, int32, float, ret, lab} =
+     val {known, boxed, int32, float, regfmls, ret, lab} =
        (case gcInfo
          of GCINFO info => info
           | MODULE {info=GCINFO info, ...} => info
-Line 203
+Line 206
        val liveMem = map Mem liveM
        val gcMem = map Mem gcM
-       fun doMem(liveRoots, gcRoots, tbl, dst, src, undo) = let
+       fun doMem(liveRoots, gcRoots, tbl, dst, src) = let
          fun move(src::live, dst::gc, tbl) =
               (assign(dst, src); move(live, gc, {loc=dst, value=src}::tbl))
-           | move([], [], tbl) = (undo, tbl)
+           | move([], [], tbl) = tbl
            | move([], dst::gc, tbl) = (assign(dst, None); move([], gc, tbl))
        in
-         copy(dst, src); move(liveRoots, gcRoots, tbl)
+         copy(dst, src);
+         (dst, src, move(liveRoots, gcRoots, tbl))
        end
-       fun doRecord(liveMem, gcRoots, tbl, dst, src, undo) =
+       fun doRecord(live, gcRoots, tbl, dst, src) =
          (case record
-          of NONE => doMem(liveMem, gcRoots, tbl, dst, src, undo)
+          of NONE => doMem(live, gcRoots, tbl, dst, src)
            | SOME(recd as Record{reg, ...}) =>
               (case gcRoots
                 of Reg r::rest =>
-                    doMem(liveMem, rest, {loc=Reg r, value=recd}::tbl,
+                   (emit(T.COPY([r], [reg]));
-                          r::dst, reg::src, undo)
+                    doMem(live, rest, {loc=Reg r, value=recd}::tbl, dst, src))
                  | Mem i::rest =>
                     (emit(T.STORE32(stackEA i, T.REG reg, R.STACK));
-                     doMem(liveMem, rest,
+                     doMem(live, rest, {loc=Mem i, value=recd}::tbl, dst, src))
-                           {loc=Mem i, value=recd}::tbl, dst, src, undo))
               (*esac*))
          (*esac*))
-       fun doRaw(liveMem, gcRoots, dst, src, undo) =
+       fun doRaw(live, gcRoots, dst, src) =
         (case raw
-         of NONE => doRecord(liveMem, gcRoots, [], dst, src, undo)
+         of NONE => doRecord(live, gcRoots, [], dst, src)
           | SOME(rw as Raw{reg, ...}) =>
             (case gcRoots
              of Reg r::rest =>
-                 doRecord(liveMem, rest,
+                 (emit(T.COPY([r], [reg]));
-                          [{loc=Reg r, value=rw}], r::dst, reg::src, undo)
+                  doRecord(live, rest, [{loc=Reg r, value=rw}], dst, src))
               | Mem i::rest =>
                  (emit(T.STORE32(stackEA i, T.REG reg, R.STACK));
-                  doRecord(liveMem, rest,
+                  doRecord(live, rest, [{loc=Mem i, value=rw}], dst, src))
-                           [{loc=Mem i, value=rw}], dst, src, undo))
               | _ => error "doRaw"
            (*esac*))
         (*esac*))
        fun copyRegs(r::liveR, g::gcR, dst, src) =
              copyRegs(liveR, gcR, g::dst, r::src)
-         | copyRegs([], [], dst, src) =
+         | copyRegs(liveR, gcR, dst, src) = let
-             doRaw(liveMem, gcMem, dst, src, (src,dst))
+            val liveRegs = mapOnto(Reg, liveR, liveMem)
-         | copyRegs([], gcR, dst, src) =
+            val gcRoots = mapOnto(Reg, gcR, gcMem)
-             doRaw([], mapOnto(Reg, gcR, gcMem), dst, src, (src,dst))
+           in doRaw(liveRegs, gcRoots, dst, src)
-         | copyRegs(liveR, [], dst, src) =
+           end
-             doRaw(mapOnto(Reg, liveR, liveMem), gcMem, dst, src, (src,dst))
      in
        copyRegs(liveR, gcR, [], [])
      end (* assignGcRoots *)
-Line 259
+Line 260
       * We are conservative (read lazy) about memory disambiguation
       * information and mark all regions as RW_MEM, which will mean
       * that none of these memory operations can be reordered.
+      * Probably doesn't matter anyway.
       *)
      fun zip() = let
        fun mkRaw64Array() = let
-         val len = length float + (length int32 + 1) div 2
-         val desc = dtoi(D.makeDesc(len + len, D.tag_raw64))
-         val ans = Cells.newReg()
          fun storefields() = let
            fun storefloat(f, offset) =
              (emit(T.STORED(T.ADD(C.allocptr, T.LI offset), f, R.RW_MEM));
-Line 275
+Line 274
          in
            List.foldl storeint32 (List.foldl storefloat 4 float) int32
          end (*storefields*)
+         val len = length float + (length int32 + 1) div 2
+         val desc = dtoi(D.makeDesc(len + len, D.tag_raw64))
+         val ans = Cells.newReg()
        in
          emit(T.MV(allocptrR, T.ORB(C.allocptr, T.LI 4))); (* align *)
          emit(T.STORE32(C.allocptr, T.LI desc, R.RW_MEM));
-Line 285
+Line 287
        end (* mkRaw64Array *)
        fun mkRecord(fields) = let
-         val len = length fields
-         val desc = T.LI(dtoi(D.makeDesc(length fields, D.tag_record)))
-         val ans = Cells.newReg()
          fun getReg boxed = let
            fun f(Reg r) =  r
              | f(Raw{reg, ...}) = reg
-Line 300
+Line 299
          in (T.REG(f boxed), offp0)
          end
          val vl = map getReg fields
+         val len = length fields
+         val desc = T.LI(dtoi(D.makeDesc(len, D.tag_record)))
+         val ans = Cells.newReg()
        in
          MkRecord.record{desc=desc, fields=vl, ans=ans, mem=R.RW_MEM, hp=0};
          emit(T.MV(allocptrR, T.ADD(C.allocptr, T.LI (len*4+4))));
-Line 327
+Line 329
              (*esac*))
          in assignGcRoots(empty, NONE, SOME recd, {regs=[aroot],mem=[]})
          end
-       else let
+       else let (* nLiveRegs > nGcRoots *)
-           fun split(0, regs, mem, raw, acc) =
+           fun split(0, regs, mem, raw, fields) =
-                (mkRecord acc, {regs=regs, mem=mem}, raw)
+               (fields, {regs=regs,mem=mem}, raw)
-             | split(n, r::regs, mem, raw, acc) =
+             | split(n, r::regs, mem, raw, fields) =
-                split(n-1, regs, mem, raw, Reg r::acc)
+                split(n-1, regs, mem, raw, Reg r::fields)
-             | split(n, [], m::mem, raw, acc) =
+             | split(n, regs, m::mem, raw, fields) =
-                split(n-1, [], mem, raw, Mem m::acc)
+                split(n-1, regs, mem, raw, Mem m::fields)
-             | split(n, [], [], SOME raw, acc) =
+             | split(n, [], [], SOME raw, fields) =
-                split(n-1, [], [], NONE, raw::acc)
+                split(n-1, [], [], NONE, raw::fields)
-             | split(n, [], [], NONE, acc) = error "zip.split"
+             | split(n, [], [], NONE, _) = error "zip.split"
            val {regs, mem} = liveRegs
-           val (recd, live, raw) =
+           val (fields, live, raw) =
              split(nLiveRegs-nGcRoots+1, regs, mem, raw, [])
-         in assignGcRoots(live, raw, SOME recd, gcRoots)
+         in assignGcRoots(live, raw, SOME(mkRecord fields), gcRoots)
          end
      end (*zip *)
-     fun unzip(undo, tbl) = let
+     fun unzip(dst, src, tbl) = let
        fun move {loc, value=Raw{orig, ...}} = let
             val tmp = Cells.newReg()
             fun srcAddr i = T.ADD(T.REG tmp, T.LI i)
-Line 368
+Line 371
              fun srcValue i = T.LOAD32(T.ADD(T.REG tmp, T.LI i), R.RO_MEM)
              fun unbundle(elem, offset) =
                (case elem
-                of Raw{reg, ...} =>
+                of Raw{reg, ...} => let
-                    (emit(T.MV(reg, srcValue offset));
+                     val tmp = Cells.newReg()
-                     move{loc=Reg reg, value=elem};
+                   in
+                    (emit(T.MV(tmp, srcValue offset));
+                     move{loc=Reg tmp, value=elem};
                      offset+4)
+                   end
                  | Reg r =>
                     (emit(T.MV(r, srcValue(offset))); offset+4)
                  | Mem m =>
-Line 382
+Line 388
              assign(Reg tmp, loc);  List.foldl unbundle 0 orig; ()
            end
          | move{loc, value} = assign(value, loc)
-     in copy undo; app move tbl
+     in
+       app move tbl;  copy(src, dst)
      end (* unzip *)
      fun callGc() = let
-Line 412
+Line 419
        else ()
      end
      fun gcReturn () = let
-       val live' = map T.GPR allregs
+       val live = case C.exhausted of NONE => regfmls | SOME cc => T.CCR cc::regfmls
-       val live = case C.exhausted of NONE => live' | SOME cc => T.CCR cc::live'
      in emit ret; comp(T.ESCAPEBLOCK live)
      end
    in
-Line 445
+Line 451
              | eqF(T.LOADD(ea1, _), T.LOADD(ea2, _)) = eqEA(ea1, ea2)
              | eqF _ = false
-           val eqRexp = ListPair.all eqR
+           fun all pred = let
+             fun allp (a::r1, b::r2) = pred(a,b) andalso (allp (r1, r2))
+               | allp ([], []) = true
+               | allp _ = false
+           in allp
+           end
+           val eqRexp = all eqR
          in
            eqRexp (b1, b2) andalso  eqRexp (ret1::i1, ret2::i2)
-             andalso ListPair.all eqF (f1, f2)
+             andalso all eqF (f1, f2)
          end
        | equal _ = false

 Legend:



Removed from v.283
 


changed lines


 
Added in v.284
 Legend:



Removed from v.283
 


changed lines


 
Added in v.284
-Removed from v.283
+Added in v.284

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