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 166, Sat Nov 7 20:11:41 1998 UTC revision 167, Sat Nov 7 20:11:41 1998 UTC
# Line 4  Line 4 
4   *   *
5   *)   *)
6  functor CallGc  functor CallGc
7    (structure MLTreeComp : MLTREECOMP    (structure Cells : CELLS
    structure Cells : CELLS  
8     structure C : CPSREGS where T.Region=CPSRegions     structure C : CPSREGS where T.Region=CPSRegions
9     structure MS: MACH_SPEC     structure MS: MACH_SPEC
10     structure ConstType : CONST_TYPE     structure ConstType : CONST_TYPE where type const = C.T.Constant.const
11       sharing MLTreeComp.T = C.T     structure MLTreeComp : MLTREECOMP where T = C.T
12       sharing type C.T.Constant.const = ConstType.const) : CALLGC =  (*     sharing MLTreeComp.T = C.T
13         sharing type C.T.Constant.const = ConstType.const *)) : CALLGC =
14  struct  struct
15    structure T : MLTREE = MLTreeComp.T    structure T : MLTREE = MLTreeComp.T
16    structure Const = ConstType    structure Const = ConstType
# Line 143  Line 143 
143    (* allocptr must always be in a registe *)    (* allocptr must always be in a registe *)
144    val T.REG allocptrR = C.allocptr    val T.REG allocptrR = C.allocptr
145    
146    fun invokeGC regmap (GCINFO{lab, maskRegs, fRegs, i32Regs, ret}) = let    fun invokeGC (external, regmap) (GCINFO{lab, maskRegs, fRegs, i32Regs, ret}) = let
147      fun assign(T.REG r, v) = T.MV(r, v)      fun assign(T.REG r, v) = T.MV(r, v)
148        | assign(T.LOAD32(ea, region), v) = T.STORE32(ea, v, region)        | assign(T.LOAD32(ea, region), v) = T.STORE32(ea, v, region)
149        | assign _ = error "assign"        | assign _ = error "assign"
# Line 186  Line 186 
186      in emit ret; comp(T.ESCAPEBLOCK live)      in emit ret; comp(T.ESCAPEBLOCK live)
187      end      end
188    in    in
189      comp (T.ENTRYLABEL(!lab));      comp ((if external then T.ENTRYLABEL else T.DEFINELABEL)(!lab));
190      case fRegs      case fRegs
191       of [] => (callGC(); gcReturn())       of [] => (callGC(); gcReturn())
192        | _ => let        | _ => let
# Line 264  Line 264 
264        comp(T.ESCAPEBLOCK(liveOut @ dedicated))        comp(T.ESCAPEBLOCK(liveOut @ dedicated))
265      end      end
266    in    in
267      (app (invokeGC regmap) (!knownGcBlocks)) before knownGcBlocks:=[];      (app (invokeGC (false,regmap)) (!knownGcBlocks)) before knownGcBlocks:=[];
268      app emitLongJumps (collapse(!clusterGcBlocks, []))      app emitLongJumps (collapse(!clusterGcBlocks, []))
269                                  before clusterGcBlocks:=[]                                  before clusterGcBlocks:=[]
270    end (*emitLongJumpsToGC*)    end (*emitLongJumpsToGC*)
271    
272    fun emitInvokeGC regmap =    fun emitInvokeGC regmap =
273      (app (invokeGC regmap) (!moduleGcBlocks)) before moduleGcBlocks:=[]      (app (invokeGC (true,regmap)) (!moduleGcBlocks)) before moduleGcBlocks:=[]
274  end  end
275    
276    
277    
278    
279  (*  (*
280   * $Log$   * $Log: callgc.sml,v $
281     * Revision 1.7  1998/09/30 18:53:20  dbm
282     * removed sharing/defspec conflict
283     *
284     * Revision 1.6  1998/05/23 14:09:16  george
285     *   Fixed RCS keyword syntax
286     *
287   *)   *)

Legend:
Removed from v.166  
changed lines
  Added in v.167

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