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 521, Wed Jan 12 20:44:11 2000 UTC revision 585, Wed Mar 29 23:55:35 2000 UTC
# Line 1  Line 1 
 (* ---------------- compiler/CodeGen/cpscompile/invokegc.sml ------------------- *)  
1  (*  (*
2   * This module is responsible for generating code to invoke the   * This module is responsible for generating code to invoke the
3   * garbage collector.  This new version is derived from the functor CallGC.   * garbage collector.  This new version is derived from the functor CallGC.
# Line 19  Line 18 
18    
19     structure T  = C.T     structure T  = C.T
20     structure D  = MS.ObjDesc     structure D  = MS.ObjDesc
21     structure LE = LabelExp     structure LE = T.LabelExp
22     structure R  = CPSRegions     structure R  = CPSRegions
23     structure S  = SortedList     structure S  = SortedList
24     structure St = T.Stream     structure St = T.Stream
# Line 35  Line 34 
34                return   : T.stm                return   : T.stm
35              }              }
36    
37     type stream = (T.stm,Cells.regmap) T.stream     type stream = (T.stm,Cells.regmap,T.mlrisc list) T.stream
38    
39     val debug = Control.MLRISC.getFlag "debug-gc";     val debug = Control.MLRISC.getFlag "debug-gc";
40    
# Line 104  Line 103 
103            T.ANNOTATION(            T.ANNOTATION(
104            T.CALL(            T.CALL(
105              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),
106                     def, use, R.stack),                   [],  def, use, [], [], R.stack),
107            #create MLRiscAnnotations.COMMENT "call gc")            #create MLRiscAnnotations.COMMENT "call gc")
108    
109         (* val ZERO_FREQ = #create MLRiscAnnotations.EXECUTION_FREQ 0 *)         val ZERO_FREQ = #create MLRiscAnnotations.EXECUTION_FREQ 0
110     end     end
111    
112     val CALLGC = #create MLRiscAnnotations.CALLGC ()     val CALLGC = #create MLRiscAnnotations.CALLGC ()
113       val NO_OPTIMIZATION = #create MLRiscAnnotations.NO_OPTIMIZATION ()
114    
115         (*         (*
116          * record descriptors          * record descriptors
# Line 190  Line 190 
190      *)      *)
191     fun checkLimit(emit, maxAlloc) =     fun checkLimit(emit, maxAlloc) =
192     let val lab = Label.newLabel ""     let val lab = Label.newLabel ""
193         fun gotoGC(cc) = emit(T.ANNOTATION(T.BCC(gcCmp, cc, lab), unlikely))         fun gotoGC(cc) = emit(T.ANNOTATION(T.BCC([], cc, lab), unlikely))
194     in  if maxAlloc < skidPad then     in  if maxAlloc < skidPad then
195            (case C.exhausted of            (case C.exhausted of
196               SOME cc => gotoGC cc               SOME cc => gotoGC cc
# Line 200  Line 200 
200         let val shiftedAllocPtr = T.ADD(addrTy,C.allocptr,T.LI(maxAlloc-skidPad))         let val shiftedAllocPtr = T.ADD(addrTy,C.allocptr,T.LI(maxAlloc-skidPad))
201             val shiftedTestLimit = T.CMP(pty, gcCmp, shiftedAllocPtr, C.limitptr)             val shiftedTestLimit = T.CMP(pty, gcCmp, shiftedAllocPtr, C.limitptr)
202         in  case C.exhausted of         in  case C.exhausted of
203               SOME(cc as T.CC r) =>               SOME(cc as T.CC(_,r)) =>
204                 (emit(T.CCMV(r, shiftedTestLimit)); gotoGC(cc))                 (emit(T.CCMV(r, shiftedTestLimit)); gotoGC(cc))
205             | NONE => gotoGC(shiftedTestLimit)             | NONE => gotoGC(shiftedTestLimit)
206             | _ => error "checkLimit"             | _ => error "checkLimit"
# Line 215  Line 215 
215     let val returnLab = Label.newLabel ""     let val returnLab = Label.newLabel ""
216         val baseExp =         val baseExp =
217             T.ADD(addrTy, C.gcLink,             T.ADD(addrTy, C.gcLink,
218                   T.LABEL(LE.MINUS(LE.CONST MS.constBaseRegOffset,                   T.LABEL(LE.MINUS(LE.INT MS.constBaseRegOffset,
219                                    LE.LABEL returnLab)))                                    LE.LABEL returnLab)))
220     in  defineLabel returnLab;     in  defineLabel returnLab;
221         (* annotation(ZERO_FREQ); *)         annotation(ZERO_FREQ);
222         emit(case C.baseptr of         emit(case C.baseptr of
223                T.REG(ty, bpt) => T.MV(ty, bpt, baseExp)                T.REG(ty, bpt) => T.MV(ty, bpt, baseExp)
224              | T.LOAD(ty, ea, mem) => T.STORE(ty, ea, baseExp, mem)              | T.LOAD(ty, ea, mem) => T.STORE(ty, ea, baseExp, mem)
# Line 572  Line 572 
572         val (gcroots, boxed) =         val (gcroots, boxed) =
573             case (gcroots, int32, float, boxed) of             case (gcroots, int32, float, boxed) of
574               ([], [], [], []) => ([], []) (* it's okay *)               ([], [], [], []) => ([], []) (* it's okay *)
575             | ([], _, _, _) => ([aRootReg], aRootReg::boxed)             | ([], _, _, _) => ([aRootReg], boxed @ [aRootReg])
576                 (* put aRootReg last to reduce register pressure
577                  * during unpacking
578                  *)
579             | _  => (gcroots, boxed)             | _  => (gcroots, boxed)
580    
581         val unpack = pack(emit, gcroots, boxed, int32, float)         val unpack = pack(emit, gcroots, boxed, int32, float)
582     in  annotation(CALLGC);     in  annotation(CALLGC);
583         (* annotation(ZERO_FREQ); *)         annotation(NO_OPTIMIZATION);
584           annotation(ZERO_FREQ);
585         emit(mark(gcCall));         emit(mark(gcCall));
586         if known then computeBasePtr(emit,defineLabel,annotation) else ();         if known then computeBasePtr(emit,defineLabel,annotation) else ();
587           annotation(NO_OPTIMIZATION);
588         unpack();         unpack();
589         emit ret         emit ret
590     end     end
# Line 595  Line 600 
600     end     end
601    
602     (*     (*
603        * This function emits a comment that pretty prints the root set.
604        * This is used for debugging only.
605        *)
606       fun rootSetToString{boxed, int32, float} =
607       let fun extract(T.REG(32, r)) = r
608             | extract _ = error "extract"
609           fun fextract(T.FREG(64, f)) = f
610             | fextract _ = error "fextract"
611           fun listify title f [] = ""
612             | listify title f l  =
613                 title^foldr (fn (x,"") => f x
614                               | (x,y)  => f x ^", "^y) "" (S.uniq l)^" "
615       in  listify "boxed=" (Cells.toString Cells.GP) (map extract boxed)^
616           listify "int32=" (Cells.toString Cells.GP) (map extract int32)^
617           listify "float=" (Cells.toString Cells.FP) (map fextract float)
618       end
619    
620       (*
621      * The following function is responsible for generating actual      * The following function is responsible for generating actual
622      * GC calling code, with entry labels and return information.      * GC calling code, with entry labels and return information.
623      *)      *)
# Line 607  Line 630 
630             | MODULE{info=GCINFO info,...} => info             | MODULE{info=GCINFO info,...} => info
631             | _ => error "invokeGC:gcInfo"             | _ => error "invokeGC:gcInfo"
632    
633         val regfmls = if optimized then [] else regfmls         val liveout = if optimized then [] else regfmls
634    
635     in  if externalEntry then entryLabel (!lab) else defineLabel (!lab);     in  if externalEntry then entryLabel (!lab) else defineLabel (!lab);
636         (* When the known block is optimized, no actual code is generated         (* When the known block is optimized, no actual code is generated
637          * until later.          * until later.
638          *)          *)
639         if optimized then (annotation(CALLGC); emit ret)         if optimized then
640                (annotation(#create MLRiscAnnotations.GCSAFEPOINT
641                    (rootSetToString{boxed=boxed, int32=int32, float=float}));
642                 emit ret
643                )
644         else emitCallGC{stream=stream, known=known,         else emitCallGC{stream=stream, known=known,
645                         boxed=boxed, int32=int32, float=float, ret=ret};                         boxed=boxed, int32=int32, float=float, ret=ret};
646         exitBlock(case C.exhausted of NONE    => regfmls         exitBlock(case C.exhausted of NONE    => liveout
647                                     | SOME cc => T.CCR cc::regfmls)                                     | SOME cc => T.CCR cc::liveout)
648     end     end
649    
650     (*     (*
# Line 625  Line 652 
652      * same calling convention.      * same calling convention.
653      *)      *)
654     fun sameCallingConvention     fun sameCallingConvention
655            (GCINFO{boxed=b1, int32=i1, float=f1, ret=T.JMP(ret1, _), ...},            (GCINFO{boxed=b1, int32=i1, float=f1, ret=T.JMP(_, ret1, _), ...},
656             GCINFO{boxed=b2, int32=i2, float=f2, ret=T.JMP(ret2, _), ...}) =             GCINFO{boxed=b2, int32=i2, float=f2, ret=T.JMP(_, ret2, _), ...}) =
657     let fun eqEA(T.REG(_, r1), T.REG(_, r2)) = r1 = r2     let fun eqEA(T.REG(_, r1), T.REG(_, r2)) = r1 = r2
658           | eqEA(T.ADD(_,T.REG(_,r1),T.LI i), T.ADD(_,T.REG(_,r2),T.LI j)) =           | eqEA(T.ADD(_,T.REG(_,r1),T.LI i), T.ADD(_,T.REG(_,r2),T.LI j)) =
659               r1 = r2 andalso i = j               r1 = r2 andalso i = j
# Line 687  Line 714 
714                 val liveOut   = regRoots @ fregRoots                 val liveOut   = regRoots @ fregRoots
715                 val l         = !lab                 val l         = !lab
716             in  app defineLabel (!addrs) before addrs := [];             in  app defineLabel (!addrs) before addrs := [];
717                 emit(T.JMP(T.LABEL(LE.LABEL l),[l]));                 emit(T.JMP([], T.LABEL(LE.LABEL l), []));
718                 exitBlock liveOut                 exitBlock liveOut
719             end             end
720           | longJumps _ = error "longJumps"           | longJumps _ = error "longJumps"

Legend:
Removed from v.521  
changed lines
  Added in v.585

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