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 475, Wed Nov 10 22:59:58 1999 UTC revision 498, Tue Dec 7 15:44:50 1999 UTC
# Line 24  Line 24 
24     structure S  = SortedList     structure S  = SortedList
25     structure St = T.Stream     structure St = T.Stream
26     structure GC = SMLGCType     structure GC = SMLGCType
27       structure Cells = Cells
28    
29     fun error msg = ErrorMsg.impossible("InvokeGC."^msg)     fun error msg = ErrorMsg.impossible("InvokeGC."^msg)
30    
# Line 45  Line 46 
46     datatype gcInfo =     datatype gcInfo =
47        GCINFO of        GCINFO of
48          {known   : bool,             (* known function ? *)          {known   : bool,             (* known function ? *)
49           lab     : Label.label ref,  (* labels to invoke for GC *)           optimized : bool,             (* optimized? *)
50             lab       : Label.label ref,  (* labels to invoke GC *)
51           boxed   : T.rexp list,      (* locations with boxed objects *)           boxed   : T.rexp list,      (* locations with boxed objects *)
52           int32   : T.rexp list,      (* locations with int32 objects *)           int32   : T.rexp list,      (* locations with int32 objects *)
53           float   : T.fexp list,      (* locations with float objects *)           float   : T.fexp list,      (* locations with float objects *)
# Line 92  Line 94 
94            T.CALL(            T.CALL(
95              T.LOAD(32, T.ADD(addrTy,C.stackptr,T.LI MS.startgcOffset), R.stack),              T.LOAD(32, T.ADD(addrTy,C.stackptr,T.LI MS.startgcOffset), R.stack),
96                     def, use, R.stack),                     def, use, R.stack),
97            #create BasicAnnotations.COMMENT "call gc")            #create MLRiscAnnotations.COMMENT "call gc")
98     end     end
99    
100     val CALLGC = #create BasicAnnotations.CALLGC ()     val CALLGC = #create MLRiscAnnotations.CALLGC ()
101    
102         (*         (*
103          * record descriptors          * record descriptors
# Line 110  Line 112 
112         (* what type of comparison to use for GC test? *)         (* what type of comparison to use for GC test? *)
113     val gcCmp = if C.signedGCTest then T.GT else T.GTU     val gcCmp = if C.signedGCTest then T.GT else T.GTU
114    
115     val unlikely = #create BasicAnnotations.BRANCH_PROB 0     val unlikely = #create MLRiscAnnotations.BRANCH_PROB 0
116    
117     val normalTestLimit = T.CMP(pty, gcCmp, C.allocptr, C.limitptr)     val normalTestLimit = T.CMP(pty, gcCmp, C.allocptr, C.limitptr)
118    
# Line 391  Line 393 
393          moduleGcBlocks  := []          moduleGcBlocks  := []
394         )         )
395    
396     fun genGcInfo (clusterRef,known) (St.STREAM{emit,...} : stream)     (*
397                   {maxAlloc, regfmls, regtys, return} =      * Partition the root set into types
398     let fun split([], [], boxed, int32, float) = (boxed, int32, float)      *)
399       fun split([], [], boxed, int32, float) =
400             {boxed=boxed, int32=int32, float=float}
401           | split(T.GPR r::rl, CPS.INT32t::tl, b, i, f) = split(rl,tl,b,r::i,f)           | split(T.GPR r::rl, CPS.INT32t::tl, b, i, f) = split(rl,tl,b,r::i,f)
402           | split(T.GPR r::rl, CPS.FLTt::tl, b, i, f) = error "split: T.GPR"           | split(T.GPR r::rl, CPS.FLTt::tl, b, i, f) = error "split: T.GPR"
403           | split(T.GPR r::rl, _::tl, b, i, f) = split(rl,tl,r::b,i,f)           | split(T.GPR r::rl, _::tl, b, i, f) = split(rl,tl,r::b,i,f)
404           | 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)
405           | split _ = error "split"           | split _ = error "split"
406    
407         (* partition the root set into the appropriate classes *)     fun genGcInfo (clusterRef,known,optimized) (St.STREAM{emit,...} : stream)
408         val (boxed, int32, float) = split(regfmls, regtys, [], [], [])                   {maxAlloc, regfmls, regtys, return} =
409       let (* partition the root set into the appropriate classes *)
410           val {boxed, int32, float} = split(regfmls, regtys, [], [], [])
411    
412     in  clusterRef :=     in  clusterRef :=
413            GCINFO{ known   = known,            GCINFO{ known   = known,
414                      optimized=optimized,
415                    lab     = ref (checkLimit(emit,maxAlloc)),                    lab     = ref (checkLimit(emit,maxAlloc)),
416                    boxed   = boxed,                    boxed   = boxed,
417                    int32   = int32,                    int32   = int32,
# Line 417  Line 424 
424      * Check-limit for standard functions, i.e.~functions with      * Check-limit for standard functions, i.e.~functions with
425      * external entries.      * external entries.
426      *)      *)
427     val stdCheckLimit = genGcInfo (clusterGcBlocks, false)     val stdCheckLimit = genGcInfo (clusterGcBlocks, false, false)
428    
429     (*     (*
430      * Check-limit for known functions, i.e.~functions with entries from      * Check-limit for known functions, i.e.~functions with entries from
431      * within the same cluster.      * within the same cluster.
432      *)      *)
433     val knwCheckLimit = genGcInfo (knownGcBlocks, true)     val knwCheckLimit = genGcInfo (knownGcBlocks, true, false)
434    
435     (*     (*
436      * The following function is responsible for generating actual      * Check-limit for optimized, known functions.
     * GC calling code.  It packages up the roots into the appropriate  
     * records, call the GC routine, then unpack the roots from the record.  
437      *)      *)
438     fun invokeGC(St.STREAM{emit,defineLabel,entryLabel,exitBlock,annotation,...},     val optimizedKnwCheckLimit = genGcInfo(knownGcBlocks, true, true)
                 externalEntry) gcInfo =  
    let val {known, boxed, int32, float, regfmls, ret, lab} =  
            case gcInfo of  
              GCINFO info => info  
            | MODULE{info=GCINFO info,...} => info  
            | _ => error "invokeGC:gcInfo"  
439    
440         (* IMPORTANT NOTE:     (*
441        * The following auxiliary function generates the actual call gc code.
442        * It packages up the roots into the appropriate
443        * records, call the GC routine, then unpack the roots from the record.
444        *)
445       fun emitCallGC{stream=St.STREAM{emit, annotation, defineLabel, ...},
446                      known, boxed, int32, float, ret} =
447       let (* IMPORTANT NOTE:
448          * If a boxed root happens be in a gc root register, we can remove          * If a boxed root happens be in a gc root register, we can remove
449          * this root since it will be correctly targetted.          * this root since it will be correctly targetted.
450          *          *
# Line 452  Line 458 
458    
459         fun mark(call) =         fun mark(call) =
460             if !debug then             if !debug then
461                T.ANNOTATION(call,#create BasicAnnotations.COMMENT                T.ANNOTATION(call,#create MLRiscAnnotations.COMMENT
462                   ("roots="^setToString gcrootAvail^                   ("roots="^setToString gcrootAvail^
463                    " boxed="^setToString boxedRoots))                    " boxed="^setToString boxedRoots))
464             else call             else call
# Line 470  Line 476 
476             | ([], _, _, _) => ([aRootReg], aRootReg::boxed)             | ([], _, _, _) => ([aRootReg], aRootReg::boxed)
477             | _  => (gcroots, boxed)             | _  => (gcroots, boxed)
478    
        val _ = if externalEntry then entryLabel (!lab) else defineLabel (!lab)  
479         val (extraRoots,unpack) = pack(emit, gcroots, boxed, int32, float)         val (extraRoots,unpack) = pack(emit, gcroots, boxed, int32, float)
   
480     in  initRoots(emit, extraRoots);     in  initRoots(emit, extraRoots);
481         annotation(CALLGC);         annotation(CALLGC);
482         emit(mark(gcCall));         emit(mark(gcCall));
483         if known then computeBasePtr(emit,defineLabel) else ();         if known then computeBasePtr(emit,defineLabel) else ();
484         unpack();         unpack();
485         emit ret;         emit ret
486       end
487    
488       (*
489        * The following function is responsible for generating only the
490        * callGC code.
491        *)
492       fun callGC stream {regfmls, regtys, ret} =
493       let val {boxed, int32, float} = split(regfmls, regtys, [], [], [])
494       in  emitCallGC{stream=stream, known=true,
495                      boxed=boxed, int32=int32, float=float, ret=ret}
496       end
497    
498       (*
499        * The following function is responsible for generating actual
500        * GC calling code, with entry labels and return information.
501        *)
502       fun invokeGC(stream as
503                    St.STREAM{emit,defineLabel,entryLabel,exitBlock,annotation,...},
504                    externalEntry) gcInfo =
505       let val {known, optimized, boxed, int32, float, regfmls, ret, lab} =
506               case gcInfo of
507                 GCINFO info => info
508               | MODULE{info=GCINFO info,...} => info
509               | _ => error "invokeGC:gcInfo"
510    
511           val regfmls = if optimized then [] else regfmls
512    
513       in  if externalEntry then entryLabel (!lab) else defineLabel (!lab);
514           (* When the known block is optimized, no actual code is generated
515            * until later.
516            *)
517           if optimized then (annotation(CALLGC); emit ret)
518           else emitCallGC{stream=stream, known=known,
519                           boxed=boxed, int32=int32, float=float, ret=ret};
520         exitBlock(case C.exhausted of NONE    => regfmls         exitBlock(case C.exhausted of NONE    => regfmls
521                                     | SOME cc => T.CCR cc::regfmls)                                     | SOME cc => T.CCR cc::regfmls)
522     end     end

Legend:
Removed from v.475  
changed lines
  Added in v.498

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