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/MLRISC/gc-safety/gc-gen.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/gc-safety/gc-gen.sml

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

revision 427, Wed Sep 8 09:40:08 1999 UTC revision 499, Tue Dec 7 15:44:50 1999 UTC
# Line 8  Line 8 
8  functor GCGen  functor GCGen
9     (structure MLTreeComp : MLTREECOMP     (structure MLTreeComp : MLTREECOMP
10      structure IR         : MLRISC_IR      structure IR         : MLRISC_IR
11      structure GC         : GC_TYPE      structure GCMap      : GC_MAP
12      structure InsnProps  : INSN_PROPERTIES      structure InsnProps  : INSN_PROPERTIES
13         sharing MLTreeComp.T.Constant = IR.I.Constant         sharing MLTreeComp.T.Constant = IR.I.Constant
14         sharing MLTreeComp.T.PseudoOp = IR.CFG.P         sharing MLTreeComp.T.PseudoOp = IR.CFG.P
        sharing MLTreeComp.T.BNames   = IR.CFG.B  
15         sharing IR.I = InsnProps.I = MLTreeComp.I         sharing IR.I = InsnProps.I = MLTreeComp.I
16     ) : GC_GEN =     ) : GC_GEN =
17  struct  struct
# Line 21  Line 20 
20     structure T   = MLTreeComp.T     structure T   = MLTreeComp.T
21     structure IR  = IR     structure IR  = IR
22     structure CFG = IR.CFG     structure CFG = IR.CFG
23     structure GC  = GC     structure GC  = GCMap.GC
24     structure G   = Graph     structure G   = Graph
25     structure A   = Array     structure A   = Array
26     structure Liveness =     structure Liveness =
27        GCLiveness(structure IR = IR        GCLiveness(structure IR = IR
28                   structure GC = GC                   structure GCMap = GCMap
29                   structure InsnProps = InsnProps)                   structure InsnProps = InsnProps)
30    
31     structure Gen = InstrGen     structure Gen = CFGGen
32        (structure MLTree = T        (structure CFG       = CFG
33         structure I = IR.I         structure MLTree    = T
34           structure InsnProps = InsnProps
35        )        )
36    
37     type callgcCallback =     type callgcCallback =
38          { id     : int,          { id     : int,
39            label  : Label.label,            gcLabel     : Label.label,
40              returnLabel : Label.label,
41            roots  : (C.cell * GC.gctype) list,            roots  : (C.cell * GC.gctype) list,
42            stream : (T.stm,C.regmap) T.stream            stream : (T.stm,C.regmap) T.stream
43          } -> unit          } -> unit
44    
    val debug = MLRiscControl.getFlag "debug-gc-gen"  
   
45     fun gcGen {callgc} (IR as G.GRAPH cfg) =     fun gcGen {callgc} (IR as G.GRAPH cfg) =
46     let (*     let (*
47          * Run gc-typed liveness analysis          * Run gc-typed liveness analysis
48          *)          *)
49         val table = Liveness.liveness IR         val table = Liveness.liveness IR
50           val instrStream = Gen.newStream{compile=fn _ => (), flowgraph=SOME IR}
51         (*         val stream as T.Stream.STREAM{beginCluster, endCluster, ...} =
52          * Check if             MLTreeComp.selectInstructions instrStream
         *)  
        fun isGCPoint [] = false  
          | isGCPoint(BasicAnnotations.CALLGC::_) = true  
          | isGCPoint(_::an) = isGCPoint an  
53    
54         (*         (*
55          * For each gc-point, invoke the callback to generate GC code.          * For each gc-point, invoke the callback to generate GC code.
56          *)          *)
57         fun process(b,b' as CFG.BLOCK{annotations,insns,...}) =         fun process(b,b' as CFG.BLOCK{annotations,insns,...}) =
58             if isGCPoint(!annotations) then             case #get MLRiscAnnotations.CALLGC (!annotations) of
59                let val stream = MLTreeComp.selectInstructions               NONE => ()
60                                   (Gen.newStream insns)             | SOME _ =>
61                    val {liveIn,liveOut} = A.sub(table,b)             let val {liveIn,liveOut} = A.sub(table,b)
62                    val roots = liveIn                    val roots = liveIn
63                in  if !debug then                 val return = #node_info cfg (hd(#succ cfg b))
64                       print("id="^Int.toString b^             in  CFG.changed IR;
                            " roots="^Liveness.GCTypeMap.toString roots^"\n")  
                   else ();  
65                    callgc{id     = b,                    callgc{id     = b,
66                           label  = CFG.defineLabel b',                         gcLabel     = CFG.defineLabel b',
67                           returnLabel = CFG.defineLabel return,
68                           roots  = liveIn,                           roots  = liveIn,
69                           stream = stream}                         stream      = stream
70                         }
71                end                end
            else ()  
72    
73         val _ = #forall_nodes cfg process     in  beginCluster 0;
74     in  IR         #forall_nodes cfg process;
75           endCluster [];
76           IR
77     end     end
78    
79  end  end

Legend:
Removed from v.427  
changed lines
  Added in v.499

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