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/cpscompile/callgc.sml
ViewVC logotype

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

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

revision 283, Wed May 19 08:20:58 1999 UTC revision 284, Wed May 19 23:31:25 1999 UTC
# Line 89  Line 89 
89           boxed : T.rexp list,   (* locations with boxed objects *)           boxed : T.rexp list,   (* locations with boxed objects *)
90           int32 : T.rexp list,   (* locations with int32 objects *)           int32 : T.rexp list,   (* locations with int32 objects *)
91           float: T.fexp list,    (* locations with float objects *)           float: T.fexp list,    (* locations with float objects *)
92             regfmls: T.mlrisc list,(* all live registers *)
93           ret: T.stm}            (* how to return *)           ret: T.stm}            (* how to return *)
94      | MODULE of      | MODULE of
95          {info: gcInfo,          {info: gcInfo,
# Line 145  Line 146 
146        | maskList(T.GPR r::rl, t::tl, b, i, f) =        | maskList(T.GPR r::rl, t::tl, b, i, f) =
147          (case t          (case t
148            of CPS.INT32t => maskList(rl, tl, b, r::i, f)            of CPS.INT32t => maskList(rl, tl, b, r::i, f)
149               | CPS.FLTt => error "checkLimit.maskList: T.GPR"
150             | _ => maskList(rl, tl, r::b, i, f)             | _ => maskList(rl, tl, r::b, i, f)
151          (*esac*))          (*esac*))
152        | maskList(T.FPR r::rl, CPS.FLTt::tl, b, i, f) =        | maskList(T.FPR r::rl, CPS.FLTt::tl, b, i, f) =
# Line 160  Line 162 
162                  boxed=boxed,                  boxed=boxed,
163                  int32=int32,                  int32=int32,
164                  float=float,                  float=float,
165                    regfmls=regfmls,
166                  ret=return} :: (!clusterRef)                  ret=return} :: (!clusterRef)
167      end      end
168    in    in
# Line 171  Line 174 
174    val T.REG allocptrR = C.allocptr    val T.REG allocptrR = C.allocptr
175    
176    fun invokeGC (external, regmap) gcInfo = let    fun invokeGC (external, regmap) gcInfo = let
177      val {known, boxed, int32, float, ret, lab} =      val {known, boxed, int32, float, regfmls, ret, lab} =
178        (case gcInfo        (case gcInfo
179          of GCINFO info => info          of GCINFO info => info
180           | MODULE {info=GCINFO info, ...} => info           | MODULE {info=GCINFO info, ...} => info
# Line 203  Line 206 
206        val liveMem = map Mem liveM        val liveMem = map Mem liveM
207        val gcMem = map Mem gcM        val gcMem = map Mem gcM
208    
209        fun doMem(liveRoots, gcRoots, tbl, dst, src, undo) = let        fun doMem(liveRoots, gcRoots, tbl, dst, src) = let
210          fun move(src::live, dst::gc, tbl) =          fun move(src::live, dst::gc, tbl) =
211               (assign(dst, src); move(live, gc, {loc=dst, value=src}::tbl))               (assign(dst, src); move(live, gc, {loc=dst, value=src}::tbl))
212            | move([], [], tbl) = (undo, tbl)            | move([], [], tbl) = tbl
213            | move([], dst::gc, tbl) = (assign(dst, None); move([], gc, tbl))            | move([], dst::gc, tbl) = (assign(dst, None); move([], gc, tbl))
214        in        in
215          copy(dst, src); move(liveRoots, gcRoots, tbl)          copy(dst, src);
216            (dst, src, move(liveRoots, gcRoots, tbl))
217        end        end
218    
219        fun doRecord(liveMem, gcRoots, tbl, dst, src, undo) =        fun doRecord(live, gcRoots, tbl, dst, src) =
220          (case record          (case record
221           of NONE => doMem(liveMem, gcRoots, tbl, dst, src, undo)           of NONE => doMem(live, gcRoots, tbl, dst, src)
222            | SOME(recd as Record{reg, ...}) =>            | SOME(recd as Record{reg, ...}) =>
223               (case gcRoots               (case gcRoots
224                 of Reg r::rest =>                 of Reg r::rest =>
225                     doMem(liveMem, rest, {loc=Reg r, value=recd}::tbl,                    (emit(T.COPY([r], [reg]));
226                           r::dst, reg::src, undo)                     doMem(live, rest, {loc=Reg r, value=recd}::tbl, dst, src))
227                  | Mem i::rest =>                  | Mem i::rest =>
228                     (emit(T.STORE32(stackEA i, T.REG reg, R.STACK));                     (emit(T.STORE32(stackEA i, T.REG reg, R.STACK));
229                      doMem(liveMem, rest,                      doMem(live, rest, {loc=Mem i, value=recd}::tbl, dst, src))
                           {loc=Mem i, value=recd}::tbl, dst, src, undo))  
230               (*esac*))               (*esac*))
231          (*esac*))          (*esac*))
232    
233        fun doRaw(liveMem, gcRoots, dst, src, undo) =        fun doRaw(live, gcRoots, dst, src) =
234         (case raw         (case raw
235          of NONE => doRecord(liveMem, gcRoots, [], dst, src, undo)          of NONE => doRecord(live, gcRoots, [], dst, src)
236           | SOME(rw as Raw{reg, ...}) =>           | SOME(rw as Raw{reg, ...}) =>
237             (case gcRoots             (case gcRoots
238              of Reg r::rest =>              of Reg r::rest =>
239                  doRecord(liveMem, rest,                  (emit(T.COPY([r], [reg]));
240                           [{loc=Reg r, value=rw}], r::dst, reg::src, undo)                   doRecord(live, rest, [{loc=Reg r, value=rw}], dst, src))
241               | Mem i::rest =>               | Mem i::rest =>
242                  (emit(T.STORE32(stackEA i, T.REG reg, R.STACK));                  (emit(T.STORE32(stackEA i, T.REG reg, R.STACK));
243                   doRecord(liveMem, rest,                   doRecord(live, rest, [{loc=Mem i, value=rw}], dst, src))
                           [{loc=Mem i, value=rw}], dst, src, undo))  
244               | _ => error "doRaw"               | _ => error "doRaw"
245            (*esac*))            (*esac*))
246         (*esac*))         (*esac*))
247    
248        fun copyRegs(r::liveR, g::gcR, dst, src) =        fun copyRegs(r::liveR, g::gcR, dst, src) =
249              copyRegs(liveR, gcR, g::dst, r::src)              copyRegs(liveR, gcR, g::dst, r::src)
250          | copyRegs([], [], dst, src) =          | copyRegs(liveR, gcR, dst, src) = let
251              doRaw(liveMem, gcMem, dst, src, (src,dst))             val liveRegs = mapOnto(Reg, liveR, liveMem)
252          | copyRegs([], gcR, dst, src) =             val gcRoots = mapOnto(Reg, gcR, gcMem)
253              doRaw([], mapOnto(Reg, gcR, gcMem), dst, src, (src,dst))            in doRaw(liveRegs, gcRoots, dst, src)
254          | copyRegs(liveR, [], dst, src) =            end
             doRaw(mapOnto(Reg, liveR, liveMem), gcMem, dst, src, (src,dst))  
255      in      in
256        copyRegs(liveR, gcR, [], [])        copyRegs(liveR, gcR, [], [])
257      end (* assignGcRoots *)      end (* assignGcRoots *)
# Line 259  Line 260 
260       * We are conservative (read lazy) about memory disambiguation       * We are conservative (read lazy) about memory disambiguation
261       * information and mark all regions as RW_MEM, which will mean       * information and mark all regions as RW_MEM, which will mean
262       * that none of these memory operations can be reordered.       * that none of these memory operations can be reordered.
263         * Probably doesn't matter anyway.
264       *)       *)
265      fun zip() = let      fun zip() = let
266        fun mkRaw64Array() = 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()  
267          fun storefields() = let          fun storefields() = let
268            fun storefloat(f, offset) =            fun storefloat(f, offset) =
269              (emit(T.STORED(T.ADD(C.allocptr, T.LI offset), f, R.RW_MEM));              (emit(T.STORED(T.ADD(C.allocptr, T.LI offset), f, R.RW_MEM));
# Line 275  Line 274 
274          in          in
275            List.foldl storeint32 (List.foldl storefloat 4 float) int32            List.foldl storeint32 (List.foldl storefloat 4 float) int32
276          end (*storefields*)          end (*storefields*)
277            val len = length float + (length int32 + 1) div 2
278            val desc = dtoi(D.makeDesc(len + len, D.tag_raw64))
279            val ans = Cells.newReg()
280        in        in
281          emit(T.MV(allocptrR, T.ORB(C.allocptr, T.LI 4))); (* align *)          emit(T.MV(allocptrR, T.ORB(C.allocptr, T.LI 4))); (* align *)
282          emit(T.STORE32(C.allocptr, T.LI desc, R.RW_MEM));          emit(T.STORE32(C.allocptr, T.LI desc, R.RW_MEM));
# Line 285  Line 287 
287        end (* mkRaw64Array *)        end (* mkRaw64Array *)
288    
289        fun mkRecord(fields) = let        fun mkRecord(fields) = let
         val len = length fields  
         val desc = T.LI(dtoi(D.makeDesc(length fields, D.tag_record)))  
         val ans = Cells.newReg()  
290          fun getReg boxed = let          fun getReg boxed = let
291            fun f(Reg r) =  r            fun f(Reg r) =  r
292              | f(Raw{reg, ...}) = reg              | f(Raw{reg, ...}) = reg
# Line 300  Line 299 
299          in (T.REG(f boxed), offp0)          in (T.REG(f boxed), offp0)
300          end          end
301          val vl = map getReg fields          val vl = map getReg fields
302            val len = length fields
303            val desc = T.LI(dtoi(D.makeDesc(len, D.tag_record)))
304            val ans = Cells.newReg()
305        in        in
306          MkRecord.record{desc=desc, fields=vl, ans=ans, mem=R.RW_MEM, hp=0};          MkRecord.record{desc=desc, fields=vl, ans=ans, mem=R.RW_MEM, hp=0};
307          emit(T.MV(allocptrR, T.ADD(C.allocptr, T.LI (len*4+4))));          emit(T.MV(allocptrR, T.ADD(C.allocptr, T.LI (len*4+4))));
# Line 327  Line 329 
329              (*esac*))              (*esac*))
330          in assignGcRoots(empty, NONE, SOME recd, {regs=[aroot],mem=[]})          in assignGcRoots(empty, NONE, SOME recd, {regs=[aroot],mem=[]})
331          end          end
332        else let        else let (* nLiveRegs > nGcRoots *)
333            fun split(0, regs, mem, raw, acc) =            fun split(0, regs, mem, raw, fields) =
334                 (mkRecord acc, {regs=regs, mem=mem}, raw)                (fields, {regs=regs,mem=mem}, raw)
335              | split(n, r::regs, mem, raw, acc) =              | split(n, r::regs, mem, raw, fields) =
336                 split(n-1, regs, mem, raw, Reg r::acc)                 split(n-1, regs, mem, raw, Reg r::fields)
337              | split(n, [], m::mem, raw, acc) =              | split(n, regs, m::mem, raw, fields) =
338                 split(n-1, [], mem, raw, Mem m::acc)                 split(n-1, regs, mem, raw, Mem m::fields)
339              | split(n, [], [], SOME raw, acc) =              | split(n, [], [], SOME raw, fields) =
340                 split(n-1, [], [], NONE, raw::acc)                 split(n-1, [], [], NONE, raw::fields)
341              | split(n, [], [], NONE, acc) = error "zip.split"              | split(n, [], [], NONE, _) = error "zip.split"
342    
343            val {regs, mem} = liveRegs            val {regs, mem} = liveRegs
344            val (recd, live, raw) =            val (fields, live, raw) =
345              split(nLiveRegs-nGcRoots+1, regs, mem, raw, [])              split(nLiveRegs-nGcRoots+1, regs, mem, raw, [])
346          in assignGcRoots(live, raw, SOME recd, gcRoots)          in assignGcRoots(live, raw, SOME(mkRecord fields), gcRoots)
347          end          end
348      end (*zip *)      end (*zip *)
349    
350      fun unzip(undo, tbl) = let      fun unzip(dst, src, tbl) = let
351        fun move {loc, value=Raw{orig, ...}} = let        fun move {loc, value=Raw{orig, ...}} = let
352             val tmp = Cells.newReg()             val tmp = Cells.newReg()
353             fun srcAddr i = T.ADD(T.REG tmp, T.LI i)             fun srcAddr i = T.ADD(T.REG tmp, T.LI i)
# Line 368  Line 371 
371              fun srcValue i = T.LOAD32(T.ADD(T.REG tmp, T.LI i), R.RO_MEM)              fun srcValue i = T.LOAD32(T.ADD(T.REG tmp, T.LI i), R.RO_MEM)
372              fun unbundle(elem, offset) =              fun unbundle(elem, offset) =
373                (case elem                (case elem
374                 of Raw{reg, ...} =>                 of Raw{reg, ...} => let
375                     (emit(T.MV(reg, srcValue offset));                      val tmp = Cells.newReg()
376                      move{loc=Reg reg, value=elem};                    in
377                       (emit(T.MV(tmp, srcValue offset));
378                        move{loc=Reg tmp, value=elem};
379                      offset+4)                      offset+4)
380                      end
381                  | Reg r =>                  | Reg r =>
382                     (emit(T.MV(r, srcValue(offset))); offset+4)                     (emit(T.MV(r, srcValue(offset))); offset+4)
383                  | Mem m =>                  | Mem m =>
# Line 382  Line 388 
388              assign(Reg tmp, loc);  List.foldl unbundle 0 orig; ()              assign(Reg tmp, loc);  List.foldl unbundle 0 orig; ()
389            end            end
390          | move{loc, value} = assign(value, loc)          | move{loc, value} = assign(value, loc)
391      in copy undo; app move tbl      in
392          app move tbl;  copy(src, dst)
393      end (* unzip *)      end (* unzip *)
394    
395      fun callGc() = let      fun callGc() = let
# Line 412  Line 419 
419        else ()        else ()
420      end      end
421      fun gcReturn () = let      fun gcReturn () = let
422        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'  
423      in emit ret; comp(T.ESCAPEBLOCK live)      in emit ret; comp(T.ESCAPEBLOCK live)
424      end      end
425    in    in
# Line 445  Line 451 
451              | eqF(T.LOADD(ea1, _), T.LOADD(ea2, _)) = eqEA(ea1, ea2)              | eqF(T.LOADD(ea1, _), T.LOADD(ea2, _)) = eqEA(ea1, ea2)
452              | eqF _ = false              | eqF _ = false
453    
454            val eqRexp = ListPair.all eqR            fun all pred = let
455                fun allp (a::r1, b::r2) = pred(a,b) andalso (allp (r1, r2))
456                  | allp ([], []) = true
457                  | allp _ = false
458              in allp
459              end
460    
461              val eqRexp = all eqR
462          in          in
463            eqRexp (b1, b2) andalso  eqRexp (ret1::i1, ret2::i2)            eqRexp (b1, b2) andalso  eqRexp (ret1::i1, ret2::i2)
464              andalso ListPair.all eqF (f1, f2)              andalso all eqF (f1, f2)
465          end          end
466        | equal _ = false        | equal _ = false
467    

Legend:
Removed from v.283  
changed lines
  Added in v.284

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