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/trunk/src/compiler/CodeGen/cpscompile/invokegc.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/CodeGen/cpscompile/invokegc.sml

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

revision 983, Wed Nov 21 18:44:55 2001 UTC revision 984, Wed Nov 21 19:00:08 2001 UTC
# Line 6  Line 6 
6   * in the presence of GC.   * in the presence of GC.
7   *   *
8   * -- Allen   * -- Allen
  *  
9   *)   *)
10    
11  functor InvokeGC  functor InvokeGC
12     (structure Cells : CELLS     (
     structure C     : CPSREGS where T.Region=CPSRegions  
     structure CFG   : CONTROL_FLOW_GRAPH  
13      structure MS    : MACH_SPEC      structure MS    : MACH_SPEC
14        structure C     : CPSREGS
15                            where T.Region=CPSRegions
16        structure TS    : MLTREE_STREAM
17                            where T = C.T
18        structure CFG   : CONTROL_FLOW_GRAPH
19                            where P = TS.S.P
20     ) : INVOKE_GC =     ) : INVOKE_GC =
21  struct  struct
22       structure CB = CellsBasis
23       structure S  = CB.SortedCells
24     structure T  = C.T     structure T  = C.T
25     structure D  = MS.ObjDesc     structure D  = MS.ObjDesc
26     structure R  = CPSRegions     structure R  = CPSRegions
    structure St = T.Stream  
27     structure SL = SortedList     structure SL = SortedList
28     structure GC = SMLGCType     structure GC = SMLGCType
29     structure Cells = Cells     structure Cells = C.C
    structure A  = Array  
30     structure CFG = CFG     structure CFG = CFG
31     structure CB = CellsBasis     structure TS = TS
    structure S  = CB.SortedCells  
32    
33     fun error msg = ErrorMsg.impossible("InvokeGC."^msg)     fun error msg = ErrorMsg.impossible("InvokeGC."^msg)
34    
# Line 37  Line 38 
38                return   : T.stm                return   : T.stm
39              }              }
40    
41     type stream = (T.stm, T.mlrisc list, CFG.cfg) T.stream     type stream = (T.stm, T.mlrisc list, CFG.cfg) TS.stream
42    
43     val debug = Control.MLRISC.getFlag "debug-gc";     val debug = Control.MLRISC.getFlag "debug-gc";
44    
# Line 263  Line 264 
264       | split(T.FPR r::rl, CPS.FLTt::tl, b, i, f) = split(rl,tl,b,i,r::f)       | split(T.FPR r::rl, CPS.FLTt::tl, b, i, f) = split(rl,tl,b,i,r::f)
265       | split _ = error "split"       | split _ = error "split"
266    
267     fun genGcInfo (clusterRef,known,optimized) (St.STREAM{emit,...} : stream)     fun genGcInfo (clusterRef,known,optimized) (TS.S.STREAM{emit,...} : stream)
268                   {maxAlloc, regfmls, regtys, return} =                   {maxAlloc, regfmls, regtys, return} =
269     let (* partition the root set into the appropriate classes *)     let (* partition the root set into the appropriate classes *)
270         val {boxed, int32, float} = split(regfmls, regtys, [], [], [])         val {boxed, int32, float} = split(regfmls, regtys, [], [], [])
# Line 304  Line 305 
305         val N = 1 + foldr (fn (r,n) => Int.max(CB.registerNum r,n))         val N = 1 + foldr (fn (r,n) => Int.max(CB.registerNum r,n))
306                           0 (#regs gcrootSet)                           0 (#regs gcrootSet)
307     in     in
308         val clientRoots = A.array(N, ~1)         val clientRoots = Array.array(N, ~1)
309         val stamp       = ref 0         val stamp       = ref 0
310     end     end
311    
# Line 343  Line 344 
344         val st     = !stamp         val st     = !stamp
345         val cyclic = st + 1         val cyclic = st + 1
346         val _      = if st > 100000 then stamp := 0 else stamp := st + 2         val _      = if st > 100000 then stamp := 0 else stamp := st + 2
347         val N = A.length clientRoots         val N = Array.length clientRoots
348         fun markClients [] = ()         fun markClients [] = ()
349           | markClients(T.REG(_, r)::rs) =           | markClients(T.REG(_, r)::rs) =
350             let val rx = CB.registerNum r             let val rx = CB.registerNum r
351             in  if rx < N then A.update(clientRoots, rx, st) else ();             in  if rx < N then Array.update(clientRoots, rx, st) else ();
352                 markClients rs                 markClients rs
353             end             end
354           | markClients(_::rs) = markClients rs           | markClients(_::rs) = markClients rs
355         fun markGCRoots [] = ()         fun markGCRoots [] = ()
356           | markGCRoots(T.REG(_, r)::rs) =           | markGCRoots(T.REG(_, r)::rs) =
357             let val rx = CB.registerNum r             let val rx = CB.registerNum r
358             in  if A.sub(clientRoots, rx) = st then             in  if Array.sub(clientRoots, rx) = st then
359                    A.update(clientRoots, rx, cyclic)                    Array.update(clientRoots, rx, cyclic)
360                 else ();                 else ();
361                 markGCRoots rs                 markGCRoots rs
362             end             end
# Line 517  Line 518 
518                 fun disp n = T.ADD(addrTy, record, LI n)                 fun disp n = T.ADD(addrTy, record, LI n)
519                 fun sel n = T.LOAD(32, disp n, R.memory)                 fun sel n = T.LOAD(32, disp n, R.memory)
520                 fun fsel n = T.FLOAD(64, disp n, R.memory)                 fun fsel n = T.FLOAD(64, disp n, R.memory)
521                 val N = A.length clientRoots                 val N = Array.length clientRoots
522                 (* unpack normal fields *)                 (* unpack normal fields *)
523                 fun unpackFields(n, [], rds, rss) = (rds, rss)                 fun unpackFields(n, [], rds, rss) = (rds, rss)
524                   | unpackFields(n, Freg r::bs, rds, rss) =                   | unpackFields(n, Freg r::bs, rds, rss) =
# Line 531  Line 532 
532                        unpackFields(n+4, bs, rds, rss))                        unpackFields(n+4, bs, rds, rss))
533                   | unpackFields(n, Reg rd::bs, rds, rss) =                   | unpackFields(n, Reg rd::bs, rds, rss) =
534                     let val rdx = CB.registerNum rd                     let val rdx = CB.registerNum rd
535                     in  if rdx < N andalso A.sub(clientRoots, rdx) = cyclic then                     in  if rdx < N andalso Array.sub(clientRoots, rdx) = cyclic then
536                         let val tmpR = Cells.newReg()                         let val tmpR = Cells.newReg()
537                         in  (* print "WARNING: CYCLE\n"; *)                         in  (* print "WARNING: CYCLE\n"; *)
538                             emit(T.MV(32, tmpR, sel n));                             emit(T.MV(32, tmpR, sel n));
# Line 567  Line 568 
568      * It packages up the roots into the appropriate      * It packages up the roots into the appropriate
569      * records, call the GC routine, then unpack the roots from the record.      * records, call the GC routine, then unpack the roots from the record.
570      *)      *)
571     fun emitCallGC{stream=St.STREAM{emit, annotation, defineLabel, ...},     fun emitCallGC{stream=TS.S.STREAM{emit, annotation, defineLabel, ...},
572                    known, boxed, int32, float, ret } =                    known, boxed, int32, float, ret } =
573     let fun setToMLTree{regs,mem} =     let fun setToMLTree{regs,mem} =
574             map (fn r => T.REG(32,r)) regs @             map (fn r => T.REG(32,r)) regs @
# Line 654  Line 655 
655      * GC calling code, with entry labels and return information.      * GC calling code, with entry labels and return information.
656      *)      *)
657     fun invokeGC(stream as     fun invokeGC(stream as
658                 St.STREAM{emit,defineLabel,entryLabel,exitBlock,annotation,...},                 TS.S.STREAM{emit,defineLabel,entryLabel,exitBlock,annotation,...},
659                  externalEntry) gcInfo =                  externalEntry) gcInfo =
660     let val {known, optimized, boxed, int32, float, regfmls, ret, lab} =     let val {known, optimized, boxed, int32, float, regfmls, ret, lab} =
661             case gcInfo of             case gcInfo of
# Line 720  Line 721 
721      * The actual GC invocation code is not generated yet.      * The actual GC invocation code is not generated yet.
722      *)      *)
723     fun emitLongJumpsToGCInvocation     fun emitLongJumpsToGCInvocation
724         (stream as St.STREAM{emit,defineLabel,exitBlock,...}) =         (stream as TS.S.STREAM{emit,defineLabel,exitBlock,...}) =
725     let (* GC code can be shared if the calling convention is the same     let (* GC code can be shared if the calling convention is the same
726          * Use linear search to find the gc subroutine.          * Use linear search to find the gc subroutine.
727          *)          *)

Legend:
Removed from v.983  
changed lines
  Added in v.984

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