[MLton-devel] cvs commit: profiling: elimination of currentSource

Stephen Weeks sweeks@users.sourceforge.net
Wed, 22 Jan 2003 19:34:38 -0800


sweeks      03/01/22 19:34:38

  Modified:    include  codegen.h
               mlton/backend allocate-registers.fun backend.fun
                        c-function.fun c-function.sig limit-check.fun
                        machine.fun machine.sig profile.fun rssa.fun
                        rssa.sig runtime.fun runtime.sig ssa-to-rssa.fun
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-generate-transfers.fun
                        x86-mlton-basic.fun x86-mlton-basic.sig
                        x86-translate.fun
               mlton/core-ml lookup-constant.fun
               mlton/main compile.sml
               runtime  gc.c gc.h
  Log:
  Profiling no longer uses gcState.currentSource (which I have
  eliminated) to get the current source.  Instead, it uses the top frame
  on the ML stack.  This necessitates creating a stack frame for all C
  calls when compiling with profiling.  GC_profile{Enter,Inc,Leave} also
  use the top frame on the ML stack to know where they are.
  
  In making this change, I had to tweak similar parts of
  x86-generate-transfers.fun and c-codegen.fun.  Just a thought: maybe
  it would be better to move synchronization of gcState to the backend
  and make it more explicit in the Machine IL (i.e. make FlushStackTop,
  FlushFrontier and friends Machine IL statements)?  This might
  eliminate some duplication of knowledge of when to flush from all the
  codegens.
  
  Added a new field to frameLayouts to indicate whether the frame is
  for calling a C function or an ML function.  The time profiling signal
  handler uses this to decide whether or not to look at the current PC.
  
  Made GC_state more consistent in keeping sizes of all arrays.

Revision  Changes    Path
1.6       +4 -2      mlton/include/codegen.h

Index: codegen.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/codegen.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- codegen.h	18 Jan 2003 19:01:10 -0000	1.5
+++ codegen.h	23 Jan 2003 03:34:36 -0000	1.6
@@ -3,11 +3,11 @@
 
 #define BeginIntInfs static struct GC_intInfInit intInfInits[] = {
 #define IntInf(g, n) { g, n },
-#define EndIntInfs { 0, NULL }};
+#define EndIntInfs };
 
 #define BeginStrings static struct GC_stringInit stringInits[] = {
 #define String(g, s, l) { g, s, l },
-#define EndStrings { 0, NULL, 0 }};
+#define EndStrings };
 
 #define BeginReals static void real_Init() {
 #define Real(c, f) globaldouble[c] = f;
@@ -46,6 +46,7 @@
 	gcState.globals = globalpointer;				\
 	gcState.globalsSize = cardof(globalpointer);			\
 	gcState.intInfInits = intInfInits;				\
+	gcState.intInfInitsSize = cardof(intInfInits);			\
 	gcState.loadGlobals = loadGlobals;				\
 	gcState.magic = mg;						\
 	gcState.maxFrameSize = mfs;					\
@@ -63,6 +64,7 @@
 	gcState.sourceSeqsSize = cardof(sourceSeqs);			\
 	gcState.sourceSuccessors = sourceSuccessors;			\
 	gcState.stringInits = stringInits;				\
+	gcState.stringInitsSize = cardof(stringInits);			\
 	MLton_init (argc, argv, &gcState);				\
 
 #endif /* #ifndef _CODEGEN_H_ */



1.25      +7 -9      mlton/mlton/backend/allocate-registers.fun

Index: allocate-registers.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/allocate-registers.fun,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- allocate-registers.fun	2 Jan 2003 17:45:10 -0000	1.24
+++ allocate-registers.fun	23 Jan 2003 03:34:36 -0000	1.25
@@ -370,16 +370,14 @@
 	  let
 	     val {begin, beginNoFormals, ...} = labelLive label
 	     val _ =
-		case kind of
-		   Kind.Cont _ =>
-		      (Vector.foreach (args, forceStack o #1)
-		       ; List.foreach (beginNoFormals, forceStack))
-		 | Kind.Handler =>
+		case Kind.frameStyle kind of
+		   Kind.None => ()
+		 | Kind.OffsetsAndSize =>
 		      List.foreach (beginNoFormals, forceStack)
-		 | Kind.CReturn {func = CFunction.T {mayGC, ...}} =>
-		      if mayGC
-			 then List.foreach (beginNoFormals, forceStack)
-		      else ()
+		 | Kind.SizeOnly => ()
+	     val _ =
+		case kind of
+		   Kind.Cont _ => Vector.foreach (args, forceStack o #1)
 		 | _ => ()
 	     val _ =
 		Vector.foreach



1.48      +64 -47    mlton/mlton/backend/backend.fun

Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- backend.fun	10 Jan 2003 18:36:08 -0000	1.47
+++ backend.fun	23 Jan 2003 03:34:36 -0000	1.48
@@ -163,11 +163,10 @@
 	  suffix = "rssa",
 	  thunk = fn () => Profile.profile program,
 	  typeCheck = R.Program.typeCheck o #program}
-      val profileStack =
-	 !Control.profile <> Control.ProfileNone
-	 andalso !Control.profileStack
+      val profile = !Control.profile <> Control.ProfileNone
+      val profileStack = profile andalso !Control.profileStack
       val frameProfileIndex =
-	 if profileStack
+	 if profile
 	    then
 	       let
 		  val {get, set, ...} =
@@ -252,7 +251,8 @@
 	    in
 	       (frameLayouts, frameOffsets, frameSources)
 	    end
-	 fun getFrameLayoutsIndex {label: Label.t,
+	 fun getFrameLayoutsIndex {isC: bool,
+				   label: Label.t,
 				   offsets: int list,
 				   size: int}: int =
 	    let
@@ -263,9 +263,10 @@
 		     val _ =
 			List.push (frameLayouts,
 				   {frameOffsetsIndex = foi,
+				    isC = isC,
 				    size = size})
 		     val _ =
-			if profileStack
+			if profile
 			   then List.push (frameSources, profileIndex)
 			else ()
 		  in
@@ -282,22 +283,27 @@
 	       #frameLayoutsIndex
 	       (HashSet.lookupOrInsert
 		(table, Word.fromInt foi,
-		 fn {frameOffsetsIndex = foi',
+		 fn {frameOffsetsIndex = foi', isC = isC',
 		     profileIndex = pi', size = s', ...} =>
-		 foi = foi' andalso profileIndex = pi' andalso size = s',
+		 foi = foi'
+		 andalso isC = isC'
+		 andalso profileIndex = pi'
+		 andalso size = s',
 		 fn () => {frameLayoutsIndex = new (),
 			   frameOffsetsIndex = foi,
+			   isC = isC,
 			   profileIndex = profileIndex,
 			   size = size}))
 	    end
       end
-      val {get = frameInfo: Label.t -> M.FrameInfo.t,
+      val {get = frameInfo: Label.t -> M.FrameInfo.t option,
 	   set = setFrameInfo, ...} = 
 	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("frameInfo", Label.layout))
+			      Property.initConst NONE)
       val setFrameInfo =
 	 Trace.trace2 ("Backend.setFrameInfo",
-		       Label.layout, M.FrameInfo.layout, Unit.layout)
+		       Label.layout, Option.layout M.FrameInfo.layout,
+		       Unit.layout)
 	 setFrameInfo
       (* The global raise operands. *)
       local
@@ -675,29 +681,44 @@
 	    val _ =
 	       Vector.foreach
 	       (blocks, fn R.Block.T {kind, label, ...} =>
-		if not (R.Kind.isFrame kind)
-		   then ()
-		else
-		   let
-		      val {liveNoFormals, size, ...} = labelRegInfo label
-		      val offsets =
-			 Vector.fold
-			 (liveNoFormals, [], fn (oper, ac) =>
-			  case oper of
-			     M.Operand.StackOffset {offset, ty} =>
-				if Type.isPointer ty
-				   then offset :: ac
-				else ac
-			   | _ => ac)
-		      val frameLayoutsIndex =
-			 getFrameLayoutsIndex {label = label,
-					       offsets = offsets,
-					       size = size}
-		   in
-		      setFrameInfo (label,
-				    M.FrameInfo.T
-				    {frameLayoutsIndex = frameLayoutsIndex})
-		   end)
+		let
+		   fun doit (useOffsets: bool): unit =
+		      let
+			 val {liveNoFormals, size, ...} = labelRegInfo label
+			 val offsets =
+			    if useOffsets
+			       then
+				  Vector.fold
+				  (liveNoFormals, [], fn (oper, ac) =>
+				   case oper of
+				      M.Operand.StackOffset {offset, ty} =>
+					 if Type.isPointer ty
+					    then offset :: ac
+					 else ac
+				    | _ => ac)
+			    else
+			       []
+			 val isC =
+			    case kind of
+			       R.Kind.CReturn _ => true
+			     | _ => false
+			 val frameLayoutsIndex =
+			    getFrameLayoutsIndex {isC = isC,
+						  label = label,
+						  offsets = offsets,
+						  size = size}
+		      in
+			 setFrameInfo
+			 (label,
+			  SOME (M.FrameInfo.T
+				{frameLayoutsIndex = frameLayoutsIndex}))
+		      end
+		in
+		   case R.Kind.frameStyle kind of
+		      R.Kind.None => ()
+		    | R.Kind.OffsetsAndSize => doit true
+		    | R.Kind.SizeOnly => doit false
+		end)
 	    (* ------------------------------------------------- *)
 	    (*                    genTransfer                    *)
 	    (* ------------------------------------------------- *)
@@ -720,10 +741,9 @@
 		   | R.Transfer.CCall {args, func, return} =>
 			simple (M.Transfer.CCall
 				{args = translateOperands args,
-				 frameInfo = if CFunction.mayGC func
-						then SOME (frameInfo
-							   (valOf return))
-					     else NONE,
+				 frameInfo = (case return of
+						 NONE => NONE
+					       | SOME l => frameInfo l),
 				 func = func,
 				 return = return})
 		   | R.Transfer.Call {func, args, return} =>
@@ -881,14 +901,14 @@
 			      val srcs = callReturnOperands (args, #2, size)
 			   in
 			      (M.Kind.Cont {args = srcs,
-					    frameInfo = frameInfo label},
+					    frameInfo = valOf (frameInfo label)},
 			       liveNoFormals,
 			       parallelMove
 			       {chunk = chunk,
 				dsts = Vector.map (args, varOperand o #1),
 				srcs = srcs})
 			   end
-		      | R.Kind.CReturn {func as CFunction.T {mayGC, ...}} =>
+		      | R.Kind.CReturn {func, ...} =>
 			   let
 			      val dst =
 				 case Vector.length args of
@@ -896,13 +916,9 @@
 				  | 1 => SOME (varOperand
 					       (#1 (Vector.sub (args, 0))))
 				  | _ => Error.bug "strange CReturn"
-			      val frameInfo =
-				 if mayGC
-				    then SOME (frameInfo label)
-				 else NONE
 			   in
 			      (M.Kind.CReturn {dst = dst,
-					       frameInfo = frameInfo,
+					       frameInfo = frameInfo label,
 					       func = func},
 			       liveNoFormals,
 			       Vector.new0 ())
@@ -917,8 +933,9 @@
 			      val handles =
 				 raiseOperands (Vector.map (dsts, M.Operand.ty))
 			   in
-			      (M.Kind.Handler {frameInfo = frameInfo label,
-					       handles = handles},
+			      (M.Kind.Handler
+			       {frameInfo = valOf (frameInfo label),
+				handles = handles},
 			       liveNoFormals,
 			       M.Statement.moves {dsts = dsts,
 						  srcs = handles})



1.10      +14 -26    mlton/mlton/backend/c-function.fun

Index: c-function.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/c-function.fun,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- c-function.fun	8 Jan 2003 15:19:16 -0000	1.9
+++ c-function.fun	23 Jan 2003 03:34:36 -0000	1.10
@@ -15,13 +15,11 @@
 		   maySwitchThreads: bool,
 		   modifiesFrontier: bool,
 		   modifiesStackTop: bool,
-		   needsCurrentSource: bool,
 		   name: string,
 		   returnTy: Type.t option}
    
 fun layout (T {bytesNeeded, ensuresBytesFree, mayGC, maySwitchThreads,
-	       modifiesFrontier, modifiesStackTop, name, needsCurrentSource,
-	       returnTy}) =
+	       modifiesFrontier, modifiesStackTop, name, returnTy}) =
    Layout.record
    [("bytesNeeded", Option.layout Int.layout bytesNeeded),
     ("ensuresBytesFree", Bool.layout ensuresBytesFree),
@@ -30,7 +28,6 @@
     ("modifiesFrontier", Bool.layout modifiesFrontier),
     ("modifiesStackTop", Bool.layout modifiesStackTop),
     ("name", String.layout name),
-    ("needsCurrentSource", Bool.layout needsCurrentSource),
     ("returnTy", Option.layout Type.layout returnTy)]
 
 local
@@ -43,7 +40,6 @@
    val modifiesFrontier = make #modifiesFrontier
    val modifiesStackTop = make #modifiesStackTop
    val name = make #name
-   val needsCurrentSource = make #needsCurrentSource
    val returnTy = make #returnTy
 end
 
@@ -52,9 +48,10 @@
 fun isOk (T {ensuresBytesFree, mayGC, maySwitchThreads, modifiesFrontier,
 	     modifiesStackTop, returnTy, ...}): bool =
    (if maySwitchThreads
-      then (case returnTy of
-	      NONE => true
-	    | SOME t => false)
+      then (mayGC
+	    andalso (case returnTy of
+			NONE => true
+		      | SOME t => false))
       else true)
    andalso
    (if ensuresBytesFree orelse maySwitchThreads
@@ -79,7 +76,6 @@
 	 modifiesFrontier = true,
 	 modifiesStackTop = true,
 	 name = "GC_gc",
-	 needsCurrentSource = true,
 	 returnTy = NONE}
    val t = make true
    val f = make false
@@ -95,28 +91,20 @@
       modifiesFrontier = false,
       modifiesStackTop = false,
       name = name,
-      needsCurrentSource = false,
       returnTy = returnTy}
 
 val bug = vanilla {name = "MLton_bug",
 		   returnTy = NONE}
 
-val profileEnter = vanilla {name = "GC_profileEnter",
-			    returnTy = NONE}
-
-val profileInc =
-   T {bytesNeeded = NONE,
-      ensuresBytesFree = false,
-      mayGC = false,
-      maySwitchThreads = false,
-      modifiesFrontier = false,
-      modifiesStackTop = false,
-      name = "GC_profileInc",
-      needsCurrentSource = true,
-      returnTy = NONE}
-
-val profileLeave = vanilla {name = "GC_profileLeave",
-			    returnTy = NONE}
+local
+   fun make name =
+      vanilla {name = name,
+	       returnTy = NONE}
+in
+   val profileEnter = make "GC_profileEnter"
+   val profileInc = make "GC_profileInc"
+   val profileLeave = make "GC_profileLeave"
+end
 
 val size = vanilla {name = "MLton_size",
 		    returnTy = SOME Type.int}



1.7       +0 -2      mlton/mlton/backend/c-function.sig

Index: c-function.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/c-function.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- c-function.sig	3 Jan 2003 06:14:15 -0000	1.6
+++ c-function.sig	23 Jan 2003 03:34:36 -0000	1.7
@@ -31,7 +31,6 @@
 			 mayGC: bool,
 			 maySwitchThreads: bool,
 			 name: string,
-			 needsCurrentSource: bool,
 			 returnTy: Type.t option}
 
       val bug: t
@@ -45,7 +44,6 @@
       val maySwitchThreads: t -> bool
       val modifiesFrontier: t -> bool
       val modifiesStackTop: t -> bool
-      val needsCurrentSource: t -> bool
       val name: t -> string
       val profileEnter: t
       val profileInc: t



1.35      +0 -1      mlton/mlton/backend/limit-check.fun

Index: limit-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/limit-check.fun,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- limit-check.fun	3 Jan 2003 06:14:15 -0000	1.34
+++ limit-check.fun	23 Jan 2003 03:34:36 -0000	1.35
@@ -133,7 +133,6 @@
 				     modifiesFrontier = false,
 				     modifiesStackTop = false,
 				     name = "MLton_allocTooLarge",
-				     needsCurrentSource = false,
 				     returnTy = NONE}
 		     val _ =
 			newBlocks :=



1.42      +54 -33    mlton/mlton/backend/machine.fun

Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- machine.fun	20 Jan 2003 20:38:28 -0000	1.41
+++ machine.fun	23 Jan 2003 03:34:36 -0000	1.42
@@ -416,9 +416,12 @@
       in
 	 val frameLayoutsIndex = make #frameLayoutsIndex
       end
-   
+
       fun layout (T {frameLayoutsIndex, ...}) =
 	 Layout.record [("frameLayoutsIndex", Int.layout frameLayoutsIndex)]
+
+      fun equals (T {frameLayoutsIndex = i}, T {frameLayoutsIndex = i'}) =
+	 i = i'
    end
 
 structure Transfer =
@@ -730,6 +733,7 @@
    struct
       datatype t = T of {chunks: Chunk.t list,
 			 frameLayouts: {frameOffsetsIndex: int,
+					isC: bool,
 					size: int} vector,
 			 frameOffsets: int vector vector,
 			 handlesSignals: bool,
@@ -765,9 +769,10 @@
 		     ("frameOffsets",
 		      Vector.layout (Vector.layout Int.layout) frameOffsets),
 		     ("frameLayouts",
-		      Vector.layout (fn {frameOffsetsIndex, size} =>
+		      Vector.layout (fn {frameOffsetsIndex, isC, size} =>
 				     record [("frameOffsetsIndex",
 					      Int.layout frameOffsetsIndex),
+					     ("isC", Bool.layout isC),
 					     ("size", Int.layout size)])
 		      frameLayouts)])
 	    ; output (str "\nProfileInfo:")
@@ -850,7 +855,6 @@
 	       ("frameSources length",
 		fn () => (Vector.length frameSources
 			  = (if !Control.profile <> Control.ProfileNone
-				andalso !Control.profileStack
 				then Vector.length frameLayouts
 			     else 0)),
 		fn () => ProfileInfo.layout profileInfo)
@@ -871,7 +875,7 @@
 	    fun boolToUnitOpt b = if b then SOME () else NONE
 	    val _ =
 	       Vector.foreach
-	       (frameLayouts, fn {frameOffsetsIndex, size} =>
+	       (frameLayouts, fn {frameOffsetsIndex, size, ...} =>
 		Err.check
 		("frameLayouts",
 		 fn () => (0 <= frameOffsetsIndex
@@ -1042,30 +1046,39 @@
 	       let
 		  datatype z = datatype Kind.t
 		  exception No
-		  fun frame (FrameInfo.T {frameLayoutsIndex}): bool =
+		  fun frame (FrameInfo.T {frameLayoutsIndex},
+			     useSlots: bool,
+			     isC: bool): bool =
 		     let
-			val {frameOffsetsIndex, size} =
+			val {frameOffsetsIndex, isC = isC', ...} =
 			   Vector.sub (frameLayouts, frameLayoutsIndex)
 			   handle Subscript => raise No
-			val Alloc.T zs = alloc
-			val liveOffsets =
-			   List.fold
-			   (zs, [], fn (z, liveOffsets) =>
-			    case z of
-			       Operand.StackOffset {offset, ty} =>
-				  if Type.isPointer ty
-				     then offset :: liveOffsets
-				  else liveOffsets
-			     | _ => raise No)
-			val liveOffsets =
-			   Vector.fromArray
-			   (QuickSort.sortArray
-			    (Array.fromList liveOffsets, op <=))
-			val liveOffsets' =
-			   Vector.sub (frameOffsets, frameOffsetsIndex)
-			   handle Subscript => raise No
 		     in
-			liveOffsets = liveOffsets'
+			isC = isC'
+			andalso
+			(not useSlots
+			 orelse
+			 let
+			    val Alloc.T zs = alloc
+			    val liveOffsets =
+			       List.fold
+			       (zs, [], fn (z, liveOffsets) =>
+				case z of
+				   Operand.StackOffset {offset, ty} =>
+				      if Type.isPointer ty
+					 then offset :: liveOffsets
+				      else liveOffsets
+				 | _ => raise No)
+			    val liveOffsets =
+			       Vector.fromArray
+			       (QuickSort.sortArray
+				(Array.fromList liveOffsets, op <=))
+			    val liveOffsets' =
+			       Vector.sub (frameOffsets, frameOffsetsIndex)
+			       handle Subscript => raise No
+			 in
+			    liveOffsets = liveOffsets'
+			 end)
 		     end handle No => false
 		  fun slotsAreInFrame (fi: FrameInfo.t): bool =
 		     let
@@ -1081,24 +1094,30 @@
 	       in
 		  case k of
 		     Cont {args, frameInfo} =>
-			if frame frameInfo
+			if frame (frameInfo, true, false)
 			   andalso slotsAreInFrame frameInfo
 			   then SOME (Vector.fold
 				      (args, alloc, fn (z, alloc) =>
 				       Alloc.define (alloc, z)))
 			else NONE
-		   | CReturn {dst, frameInfo, ...} =>
-			if (case frameInfo of
-			       NONE => true
-			     | SOME fi => (frame fi
-					   andalso slotsAreInFrame fi))
+		   | CReturn {dst, frameInfo, func, ...} =>
+			if (if CFunction.mayGC func
+			       then (case frameInfo of
+					NONE => false
+				      | SOME fi => (frame (fi, true, true)
+						    andalso slotsAreInFrame fi))
+			    else if !Control.profile = Control.ProfileNone
+				    then true
+				 else (case frameInfo of
+					  NONE => false
+					| SOME fi => frame (fi, false, true)))
 			   then SOME (case dst of
 					 NONE => alloc
 				       | SOME z => Alloc.define (alloc, z))
 			else NONE
 		   | Func => SOME alloc
 		   | Handler {frameInfo, ...} =>
-			if frame frameInfo
+			if frame (frameInfo, false, false)
 			   then SOME alloc
 			else NONE
 		   | Jump => SOME alloc
@@ -1345,7 +1364,7 @@
 			   andalso jump (overflow, alloc)
 			   andalso jump (success, alloc)
 			end
-		   | CCall {args, frameInfo, func, return} =>
+		   | CCall {args, frameInfo = fi, func, return} =>
 			let
 			   val _ = checkOperands (args, alloc)
 			in
@@ -1360,8 +1379,10 @@
 				    andalso
 				    case labelKind l of
 				       Kind.CReturn
-				       {dst, func = f, ...} => 
+				       {dst, frameInfo = fi', func = f, ...} => 
 					  CFunction.equals (func, f)
+					  andalso (Option.equals
+						   (fi, fi', FrameInfo.equals))
 					  andalso
 					  (case (dst, CFunction.returnTy f) of
 					      (NONE, _) => true



1.32      +2 -0      mlton/mlton/backend/machine.sig

Index: machine.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.sig,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- machine.sig	20 Jan 2003 20:38:29 -0000	1.31
+++ machine.sig	23 Jan 2003 03:34:36 -0000	1.32
@@ -127,6 +127,7 @@
 	 sig
 	    datatype t = T of {frameLayoutsIndex: int}
 
+	    val equals: t * t -> bool
 	    val layout: t -> Layout.t
 	 end
 
@@ -234,6 +235,7 @@
 	    datatype t =
 	       T of {chunks: Chunk.t list,
 		     frameLayouts: {frameOffsetsIndex: int,
+				    isC: bool,
 				    size: int} vector,
 		     (* Each vector in frame Offsets specifies the offsets
 		      * of live pointers in a stack frame.  A vector is referred



1.21      +71 -116   mlton/mlton/backend/profile.fun

Index: profile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/profile.fun,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- profile.fun	14 Jan 2003 20:05:35 -0000	1.20
+++ profile.fun	23 Jan 2003 03:34:36 -0000	1.21
@@ -157,6 +157,13 @@
       val unknownSourceSeq = sourceSeqIndex [sourceInfoIndex SourceInfo.unknown]
       (* Ensure that [SourceInfo.gc] is index 1. *)
       val gcSourceSeq = sourceSeqIndex [sourceInfoIndex SourceInfo.gc]
+      fun addFrameProfileIndex (label: Label.t,
+				index: int): unit =
+	 List.push (frameProfileIndices, (label, index))
+      fun addFrameProfilePushes (label: Label.t,
+				 pushes: Push.t list): unit =
+	 addFrameProfileIndex (label,
+			       sourceSeqIndex (Push.toSources pushes))
       val {get = labelInfo: Label.t -> {block: Block.t,
 					visited: bool ref},
 	   set = setLabelInfo, ...} =
@@ -284,40 +291,25 @@
 	    val blocks = ref []
 	    datatype z = datatype Statement.t
 	    datatype z = datatype ProfileExp.t
-	    fun setCurrentSource (n: int): Statement.t =
-	       Statement.Move
-	       {dst = Operand.Runtime Runtime.GCField.CurrentSource,
-		src = Operand.word (Word.fromInt n)}
-	    val setCurrentSource =
-	       Trace.trace ("Profile.setCurrentSource",
-			    Int.layout, Statement.layout)
-	       setCurrentSource
-	    val clearCurrentSource = setCurrentSource ~1
 	    fun backward {args,
 			  kind,
 			  label,
-			  needsCurrentSource,
 			  sourceSeq: int list,
 			  statements: Statement.t list,
 			  transfer: Transfer.t}: unit =
 	       let
-		  fun addCurrent (statements, sourceSeq) =
-		     setCurrentSource (sourceSeqIndex sourceSeq) :: statements
-		  val (ncs, npl, sourceSeq, statements) =
+		  val (npl, sourceSeq, statements) =
 		     List.fold
 		     (statements,
-		      (needsCurrentSource, true, sourceSeq, []),
-		      fn (s, (ncs, npl, sourceSeq, ss)) =>
+		      (true, sourceSeq, []),
+		      fn (s, (npl, sourceSeq, ss)) =>
 		      case s of
-			 Object _ => (true, true, sourceSeq, s :: ss)
+			 Object _ => (true, sourceSeq, s :: ss)
 		       | Profile ps =>
 			    let
 			       val (npl, ss) =
 				  if profileAlloc
-				     then if ncs
-					     then (false,
-						   addCurrent (ss, sourceSeq))
-					  else (false, ss)
+				     then (false, ss)
 				  else (* profileTime *)
 				     if npl andalso not (List.isEmpty sourceSeq)
 					then (false,
@@ -334,36 +326,13 @@
 					       else Error.bug "mismatched Enter")
 				   | Leave si => sourceInfoIndex si :: sourceSeq
 			    in
-			       (false, npl, sourceSeq, ss)
+			       (npl, sourceSeq, ss)
 			    end
-		       | _ => (ncs, true, sourceSeq, s :: ss))
+		       | _ => (true, sourceSeq, s :: ss))
 		  val statements =
-		     if profileAlloc
-			then
-			   if ncs
-			      then addCurrent (statements, sourceSeq)
-			   else statements
-		     else (* profileTime *)
-			let
-			   fun pl () = profileLabel sourceSeq
-			in
-			   if (case kind of
-				  Kind.Cont _ => profileStack
-		                | Kind.CReturn {func, ...} => true
-				| Kind.Handler => profileStack
-				| _ => false)
-			      then
-				 (case statements of
-				     (s as Statement.ProfileLabel _) :: ss =>
-					s :: clearCurrentSource :: ss
-				   | _ => 
-					pl ()
-					:: clearCurrentSource
-					:: statements)
-			   else if npl
-				   then pl () :: statements
-				else statements
-			end
+		     if profileTime andalso npl
+			then profileLabel sourceSeq :: statements
+		     else statements
 		  val {args, kind, label} =
 		     if profileStack andalso (case kind of
 						 Kind.Cont _ => true
@@ -373,13 +342,15 @@
 			   let
 			      val func = CFunction.profileLeave
 			      val newLabel = Label.newNoname ()
-			      val index = sourceSeqIndex sourceSeq
-			      val statements =
-				 [setCurrentSource index]
+			      val _ =
+				 addFrameProfileIndex
+				 (newLabel, sourceSeqIndex sourceSeq)
 			      val statements =
 				 if profileTime
-				    then profileLabelIndex index :: statements
-				 else statements
+				    then (Vector.new1
+					  (profileLabelIndex
+					   (sourceSeqIndex sourceSeq)))
+				 else Vector.new0 ()
 			      val _ =
 				 List.push
 				 (blocks,
@@ -387,7 +358,7 @@
 				  {args = args,
 				   kind = kind,
 				   label = label,
-				   statements = Vector.fromList statements,
+				   statements = statements,
 				   transfer = 
 				   Transfer.CCall
 				   {args = Vector.new1 Operand.GCState,
@@ -417,31 +388,29 @@
 			      List.layout Statement.layout statements],
 		Unit.layout)
 	       backward
-	    fun profileEnter (sourceSeq: int list,
-			      transfer: Transfer.t)
-	       : Statement.t * Transfer.t =
+	    fun profileEnter (pushes: Push.t list,
+			      transfer: Transfer.t): Transfer.t =
 	       let
 		  val func = CFunction.profileEnter
 		  val newLabel = Label.newNoname ()
-		  val index = sourceSeqIndex sourceSeq
-		  val statements = [clearCurrentSource]
+		  val index = sourceSeqIndex (Push.toSources pushes)
+		  val _ = addFrameProfileIndex (newLabel, index)
 		  val statements =
 		     if profileTime
-			then profileLabelIndex index :: statements
-		     else statements
+			then Vector.new1 (profileLabelIndex index)
+		     else Vector.new0 ()
 		  val _ =
 		     List.push
 		     (blocks,
 		      Block.T {args = Vector.new0 (),
 			       kind = Kind.CReturn {func = func},
 			       label = newLabel,
-			       statements = Vector.fromList statements,
+			       statements = statements,
 			       transfer = transfer})
 	       in
-		  (setCurrentSource index,
-		   Transfer.CCall {args = Vector.new1 Operand.GCState,
-				   func = func,
-				   return = SOME newLabel})
+		  Transfer.CCall {args = Vector.new1 Operand.GCState,
+				  func = func,
+				  return = SOME newLabel}
 	       end
 	    fun goto (l: Label.t, pushes: Push.t list): unit =
 	       let
@@ -478,12 +447,28 @@
 				   | _ => false)
 			   else statements
 			val _ =
-			   if profileStack andalso Kind.isFrame kind
-			      then List.push (frameProfileIndices,
-					      (label,
-					       sourceSeqIndex
-					       (Push.toSources pushes)))
-			   else ()
+			   let
+			      fun add pushes =
+				 addFrameProfilePushes (label, pushes)
+			      datatype z = datatype Kind.t
+			   in
+			      case kind of
+				 Cont _ => add pushes
+			       | CReturn {func, ...} =>
+				    let
+				       val name = CFunction.name func
+				       val si =
+					  case name of
+					     "GC_gc" => SourceInfo.gc
+					   | "GC_arrayAllocate" =>
+						SourceInfo.gcArrayAllocate
+					   | _ => SourceInfo.fromC name
+				    in
+				       add (#1 (enter (pushes, si)))
+				    end
+			       | Handler => add pushes
+			       | Jump => ()
+			   end
 			fun maybeSplit {args, bytesAllocated, kind, label,
 					pushes: Push.t list,
 					statements} =
@@ -491,6 +476,8 @@
 			      then
 				 let
 				    val newLabel = Label.newNoname ()
+				    val _ =
+				       addFrameProfilePushes (newLabel, pushes)
 				    val func = CFunction.profileInc
 				    val transfer =
 				       Transfer.CCall
@@ -505,7 +492,6 @@
 				       backward {args = args,
 						 kind = kind,
 						 label = label,
-						 needsCurrentSource = true,
 						 sourceSeq = sourceSeq,
 						 statements = statements,
 						 transfer = transfer}
@@ -611,9 +597,6 @@
 				   pushes = pushes,
 				   statements = s :: statements})
 			    )
-			val _ =
-			   Transfer.foreachLabel
-			   (transfer, fn l => goto (l, pushes))
 			val {args, kind, label, statements, ...} =
 			   maybeSplit {args = args,
 				       bytesAllocated = bytesAllocated,
@@ -621,32 +604,12 @@
 				       label = label,
 				       pushes = pushes,
 				       statements = statements}
-			val sourceSeq = Push.toSources pushes
-			val (statements, transfer) =
+			val _ =
+			   Transfer.foreachLabel
+			   (transfer, fn l => goto (l, pushes))
+			val transfer =
 			   case transfer of
-			      Transfer.CCall {func, ...} =>
-				 if (profileAlloc
-				     andalso CFunction.needsCurrentSource func)
-				    orelse profileTime
-				    then
-				       let
-					  val name = CFunction.name func
-					  val si =
-					     case name of
-						"GC_gc" => SourceInfo.gc
-					      | "GC_arrayAllocate" =>
-						   SourceInfo.gcArrayAllocate
-					      | _ => SourceInfo.fromC name
-					  val set =
-					     setCurrentSource
-					     (sourceSeqIndex
-					      (Push.toSources
-					       (#1 (enter (pushes, si)))))
-				       in
-					  (set :: statements, transfer)
-				       end
-				 else (statements, transfer)
-			    | Transfer.Call {func, return, ...} =>
+			      Transfer.Call {func, return, ...} =>
 				 let
 				    val fi as FuncInfo.T {callers, ...} =
 				       funcInfo func
@@ -661,29 +624,21 @@
 						 | SOME n => 
 						      List.push (callers, n)
 					  in
-					      if profileStack
-						 then
-						    let
-						       val (s, t) =
-							  profileEnter
-							  (sourceSeq, transfer)
-						    in
-						       (s :: statements, t)
-						    end
-					      else
-						 (statements, transfer)
+					     if profileStack
+						then profileEnter (pushes,
+								   transfer)
+					     else transfer
 					  end
 				     | _ =>
 					  (List.push (tailCalls, fi)
-					   ; (statements, transfer))
+					   ; transfer)
 				 end
-			    | _ => (statements, transfer)
+			    | _ => transfer
 		     in
 			backward {args = args,
 				  kind = kind,
 				  label = label,
-				  needsCurrentSource = false,
-				  sourceSeq = sourceSeq,
+				  sourceSeq = Push.toSources pushes,
 				  statements = statements,
 				  transfer = transfer}
 		     end



1.29      +11 -5     mlton/mlton/backend/rssa.fun

Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- rssa.fun	11 Jan 2003 00:34:39 -0000	1.28
+++ rssa.fun	23 Jan 2003 03:34:36 -0000	1.29
@@ -430,12 +430,18 @@
 	     | Jump => str "Jump"
 	 end
 
-      fun isFrame (k: t): bool =
+      datatype frameStyle = None | OffsetsAndSize | SizeOnly
+      fun frameStyle (k: t): frameStyle =
 	 case k of
-	    Cont _ => true
-	  | CReturn {func = CFunction.T {mayGC, ...}, ...} => mayGC
-	  | Handler => true
-	  | Jump => false
+	    Cont _ => OffsetsAndSize
+	  | CReturn {func, ...} =>
+	       if CFunction.mayGC func
+		  then OffsetsAndSize
+	       else if !Control.profile = Control.ProfileNone
+		       then None
+		    else SizeOnly
+	  | Handler => SizeOnly
+	  | Jump => None
    end
 
 local



1.24      +2 -1      mlton/mlton/backend/rssa.sig

Index: rssa.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.sig,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- rssa.sig	11 Jan 2003 00:34:39 -0000	1.23
+++ rssa.sig	23 Jan 2003 03:34:36 -0000	1.24
@@ -168,7 +168,8 @@
 	     | Handler
 	     | Jump
 
-	    val isFrame: t -> bool
+	    datatype frameStyle = None | OffsetsAndSize | SizeOnly
+	    val frameStyle: t -> frameStyle
 	 end
 
       structure Block:



1.11      +1 -7      mlton/mlton/backend/runtime.fun

Index: runtime.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/runtime.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- runtime.fun	3 Jan 2003 06:14:15 -0000	1.10
+++ runtime.fun	23 Jan 2003 03:34:36 -0000	1.11
@@ -18,7 +18,6 @@
       datatype t =
 	 CanHandle
        | CardMap
-       | CurrentSource
        | CurrentThread
        | ExnStack
        | Frontier
@@ -35,7 +34,6 @@
       val ty =
 	 fn CanHandle => Type.int
 	  | CardMap => Type.pointer
-	  | CurrentSource => Type.word
 	  | CurrentThread => Type.pointer
 	  | ExnStack => Type.word
 	  | Frontier => Type.pointer
@@ -49,7 +47,6 @@
 
       val canHandleOffset: int ref = ref 0
       val cardMapOffset: int ref = ref 0
-      val currentSourceOffset: int ref = ref 0
       val currentThreadOffset: int ref = ref 0
       val frontierOffset: int ref = ref 0
       val limitOffset: int ref = ref 0
@@ -60,12 +57,11 @@
       val stackLimitOffset: int ref = ref 0
       val stackTopOffset: int ref = ref 0
 
-      fun setOffsets {canHandle, cardMap, currentSource, currentThread, frontier,
+      fun setOffsets {canHandle, cardMap, currentThread, frontier,
 		      limit, limitPlusSlop, maxFrameSize, signalIsPending,
 		      stackBottom, stackLimit, stackTop} =
 	 (canHandleOffset := canHandle
 	  ; cardMapOffset := cardMap
-	  ; currentSourceOffset := currentSource
 	  ; currentThreadOffset := currentThread
 	  ; frontierOffset := frontier
 	  ; limitOffset := limit
@@ -79,7 +75,6 @@
       val offset =
 	 fn CanHandle => !canHandleOffset
 	  | CardMap => !cardMapOffset
-	  | CurrentSource => !currentSourceOffset
 	  | CurrentThread => !currentThreadOffset
 	  | ExnStack => Error.bug "exn stack offset not defined"
 	  | Frontier => !frontierOffset
@@ -94,7 +89,6 @@
       val toString =
 	 fn CanHandle => "CanHandle"
 	  | CardMap => "CardMap"
-	  | CurrentSource => "CurrentSource"
 	  | CurrentThread => "CurrentThread"
 	  | ExnStack => "ExnStack"
 	  | Frontier => "Frontier"



1.20      +0 -2      mlton/mlton/backend/runtime.sig

Index: runtime.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/runtime.sig,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- runtime.sig	3 Jan 2003 06:14:15 -0000	1.19
+++ runtime.sig	23 Jan 2003 03:34:36 -0000	1.20
@@ -24,7 +24,6 @@
 	    datatype t =
 	       CanHandle
 	     | CardMap
-	     | CurrentSource
 	     | CurrentThread
 	     | ExnStack
 	     | Frontier (* The place where the next object is allocated. *)
@@ -41,7 +40,6 @@
 	    val offset: t -> int (* Field offset in struct GC_state. *)
 	    val setOffsets: {canHandle: int,
 			     cardMap: int,
-			     currentSource: int,
 			     currentThread: int,
 			     frontier: int,
 			     limit: int,



1.35      +0 -8      mlton/mlton/backend/ssa-to-rssa.fun

Index: ssa-to-rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/ssa-to-rssa.fun,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- ssa-to-rssa.fun	11 Jan 2003 00:34:39 -0000	1.34
+++ ssa-to-rssa.fun	23 Jan 2003 03:34:36 -0000	1.35
@@ -49,7 +49,6 @@
 	       modifiesFrontier = true,
 	       modifiesStackTop = false,
 	       name = name,
-	       needsCurrentSource = true,
 	       returnTy = SOME Type.pointer}
       in
 	 val intInfAdd = make ("IntInf_do_add", 2)
@@ -84,7 +83,6 @@
 	    modifiesFrontier = true,
 	    modifiesStackTop = true,
 	    name = "GC_copyCurrentThread",
-	    needsCurrentSource = false,
 	    returnTy = NONE}
 
       val copyThread =
@@ -95,7 +93,6 @@
 	    modifiesFrontier = true,
 	    modifiesStackTop = true,
 	    name = "GC_copyThread",
-	    needsCurrentSource = false,
 	    returnTy = SOME Type.pointer}
 
       val exit =
@@ -106,7 +103,6 @@
 	    modifiesFrontier = true,
 	    modifiesStackTop = true,
 	    name = "MLton_exit",
-	    needsCurrentSource = false,
 	    returnTy = NONE}
 
       val gcArrayAllocate =
@@ -117,7 +113,6 @@
 	    modifiesFrontier = true,
 	    modifiesStackTop = true,
 	    name = "GC_arrayAllocate",
-	    needsCurrentSource = true,
 	    returnTy = SOME Type.pointer}
 
       local
@@ -129,7 +124,6 @@
 	       modifiesFrontier = true,
 	       modifiesStackTop = true,
 	       name = name,
-	       needsCurrentSource = true,
 	       returnTy = NONE}
       in
 	 val pack = make "GC_pack"
@@ -144,7 +138,6 @@
 	    modifiesFrontier = true,
 	    modifiesStackTop = true,
 	    name = "Thread_switchTo",
-	    needsCurrentSource = false,
 	    returnTy = NONE}
 
       val worldSave =
@@ -155,7 +148,6 @@
 	    modifiesFrontier = true,
 	    modifiesStackTop = true,
 	    name = "GC_saveWorld",
-	    needsCurrentSource = false,
 	    returnTy = NONE}
    end
 



1.44      +25 -22    mlton/mlton/codegen/c-codegen/c-codegen.fun

Index: c-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.fun,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- c-codegen.fun	18 Jan 2003 19:01:10 -0000	1.43
+++ c-codegen.fun	23 Jan 2003 03:34:37 -0000	1.44
@@ -109,7 +109,8 @@
       fun bug (s: string, print) =
 	 call ("MLton_bug", [concat ["\"", String.escapeC s, "\""]], print)
 
-      fun push (i, print) = call ("\tPush", [int i], print)
+      fun push (i, print) =
+	 call ("\tPush", [int i], print)
 
       fun move ({dst, src}, print) =
 	 print (concat [dst, " = ", src, ";\n"])
@@ -205,9 +206,10 @@
 	  ; print "};\n")
       fun declareFrameLayouts () =
 	 declareArray ("GC_frameLayout", "frameLayouts", frameLayouts,
-		       fn (_, {frameOffsetsIndex, size}) =>
+		       fn (_, {frameOffsetsIndex, isC, size}) =>
 		       concat ["{",
-			       C.int size,
+			       C.bool isC,
+			       ", ", C.int size,
 			       ", frameOffsets", C.int frameOffsetsIndex,
 			       "}"])
       fun declareObjectTypes () =
@@ -408,7 +410,6 @@
 		     case r of
 			CanHandle => "gcState.canHandle"
 		      | CardMap => "gcState.cardMapForMutator"
-		      | CurrentSource => "gcState.currentSource"
 		      | CurrentThread => "gcState.currentThread"
 		      | ExnStack => "ExnStack"
 		      | Frontier => "frontier"
@@ -526,13 +527,17 @@
 		     | Switch s => Switch.foreachLabel (s, jump)
 		 end)
 	    fun push (return: Label.t, size: int) =
-	       (C.push (size, print)
-		; print "\t"
+	       (print "\t"
 		; C.move ({dst = operandToString
-			   (Operand.StackOffset {offset = ~Runtime.labelSize,
-						 ty = Type.label return}),
+			   (Operand.StackOffset
+			    {offset = size - Runtime.labelSize,
+			     ty = Type.label return}),
 			   src = operandToString (Operand.Label return)},
-			  print))
+			  print)
+		; C.push (size, print)
+		; if !Control.profile <> Control.ProfileNone
+		     then print "\tFlushStackTop();\n"
+		  else ())
 	    fun copyArgs (args: Operand.t vector): string list * (unit -> unit) =
 	       if Vector.exists (args,
 				 fn Operand.StackOffset _ => true
@@ -610,10 +615,10 @@
 		  val _ =
 		     case kind of
 			Kind.Cont {frameInfo, ...} => pop frameInfo
-		      | Kind.CReturn {dst, frameInfo, func, ...} =>
-			   (if CFunction.mayGC func
-			       then pop (valOf frameInfo)
-			    else ()
+		      | Kind.CReturn {dst, frameInfo, ...} =>
+			   (case frameInfo of
+			       NONE => ()
+			     | SOME fi => pop (valOf frameInfo)
 			    ; (Option.app
 			       (dst, fn x =>
 				print (concat
@@ -707,8 +712,7 @@
 			end
 		   | CCall {args,
 			    frameInfo,
-			    func = CFunction.T {mayGC,
-						maySwitchThreads,
+			    func = CFunction.T {maySwitchThreads,
 						modifiesFrontier,
 						modifiesStackTop,
 						name,
@@ -717,20 +721,19 @@
 			    return} =>
 			let
 			   val (args, afterCall) =
-			      if mayGC
-				 then
+			      case frameInfo of
+				 NONE =>
+				    (Vector.toListMap (args, operandToString),
+				     fn () => ())
+			       | SOME frameInfo =>
 				    let
 				       val size =
-					  Program.frameSize (program,
-							     valOf frameInfo)
+					  Program.frameSize (program, frameInfo)
 				       val res = copyArgs args
 				       val _ = push (valOf return, size)
 				    in
 				       res
 				    end
-			      else
-				 (Vector.toListMap (args, operandToString),
-				  fn () => ())
 			   val _ =
 			      if modifiesFrontier
 				 then print "\tFlushFrontier();\n"



1.38      +17 -16    mlton/mlton/codegen/x86-codegen/x86-generate-transfers.fun

Index: x86-generate-transfers.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-generate-transfers.fun,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- x86-generate-transfers.fun	20 Jan 2003 16:28:31 -0000	1.37
+++ x86-generate-transfers.fun	23 Jan 2003 03:34:37 -0000	1.38
@@ -508,9 +508,8 @@
 			    => near label
 			    | CReturn {dst, 
 				       frameInfo,
-				       func = CFunction.T {mayGC,
-							   maySwitchThreads,
-							   name, ...},
+				       func = CFunction.T {maySwitchThreads,
+							   ...},
 				       label}
 			    => let
 				 fun getReturn ()
@@ -536,10 +535,11 @@
 						    size = dstsize})
 					       | _ => Error.bug "CReturn")
 			       in
-				 if mayGC orelse maySwitchThreads
-				   then let
+				 case frameInfo of
+				   SOME fi =>
+				      let
 					  val FrameInfo.T {size, frameLayoutsIndex}
-					    = valOf frameInfo
+					    = fi
 					  val finish
 					    = AppendList.appends
 					      [let	
@@ -596,7 +596,8 @@
 							      weight = 1024}))})],
 						   finish)]
 					end
-				 else AppendList.append (near label, getReturn ())
+				 | NONE => 
+				      AppendList.append (near label, getReturn ())
 			       end
 			    | Func {label,...}
 			    => AppendList.appends
@@ -1078,8 +1079,7 @@
 		    end
 	        | CCall {args, dstsize,
 			 frameInfo,
-			 func = CFunction.T {mayGC,
-					     maySwitchThreads,
+			 func = CFunction.T {maySwitchThreads,
 					     modifiesFrontier,
 					     modifiesStackTop,
 					     name, ...},
@@ -1129,9 +1129,10 @@
 				   size = size}),
 				 assembly_args),
 			   (Size.toBytes size) + size_args))
-		     val flush 
-		       = if mayGC orelse maySwitchThreads
-			   then (* Entering runtime *)
+		     val flush =
+			case frameInfo of
+			   SOME (FrameInfo.T {size, ...}) =>
+			        (* Entering runtime *)
 			        let
 				  val return = valOf return
 				  val _ = enque return
@@ -1148,7 +1149,6 @@
 				    = x86MLton.gcState_stackTopMinusWordDeref ()
 				  val stackTopMinusWordDeref
 				    = x86MLton.gcState_stackTopMinusWordDerefOperand ()
-				  val FrameInfo.T {size, ...} = valOf frameInfo
 				  val bytes = x86.Operand.immediate_const_int size
 				    
 				  val live =
@@ -1222,7 +1222,8 @@
 				      dead_memlocs = MemLocSet.empty,
 				      dead_classes = ClassSet.empty})))
 				end
-			   else AppendList.single
+			 | NONE => 
+			        AppendList.single
 			        (Assembly.directive_force
 				 {commit_memlocs = let
 						     val s = MemLocSet.empty
@@ -1249,7 +1250,7 @@
 			  {target = Operand.label target,
 			   absolute = false}]
 		     val kill
-		       = if mayGC orelse maySwitchThreads
+		       = if isSome frameInfo
 			   then AppendList.single
 			        (Assembly.directive_force
 				 {commit_memlocs = MemLocSet.empty,
@@ -1313,7 +1314,7 @@
 				    absolute = true})))
 			 else case return
 				of NONE => AppendList.empty
-				 | SOME l => (if mayGC
+				 | SOME l => (if isSome frameInfo
 						then (* Don't need to trampoline,
 						      * since didn't switch threads,
 						      * but can't fall because



1.14      +0 -3      mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun

Index: x86-mlton-basic.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- x86-mlton-basic.fun	20 Jan 2003 21:27:40 -0000	1.13
+++ x86-mlton-basic.fun	23 Jan 2003 03:34:37 -0000	1.14
@@ -355,9 +355,6 @@
   val (_, _, gcState_cardMapContentsOperand) =
      make (Field.CardMap, wordSize, Classes.GCState)
 
-  val (_, _, gcState_currentSourceContentsOperand) =
-     make (Field.CurrentSource, wordSize, Classes.GCStateVolatile)
-
   val (gcState_currentThread, gcState_currentThreadContents,
         gcState_currentThreadContentsOperand) =
       make (Field.CurrentThread, pointerSize, Classes.GCState)



1.23      +0 -1      mlton/mlton/codegen/x86-codegen/x86-mlton-basic.sig

Index: x86-mlton-basic.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton-basic.sig,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- x86-mlton-basic.sig	20 Jan 2003 16:28:33 -0000	1.22
+++ x86-mlton-basic.sig	23 Jan 2003 03:34:37 -0000	1.23
@@ -105,7 +105,6 @@
     (* gcState relative locations defined in gc.h *)
     val gcState_canHandleContentsOperand: unit -> x86.Operand.t
     val gcState_cardMapContentsOperand: unit -> x86.Operand.t
-    val gcState_currentSourceContentsOperand: unit -> x86.Operand.t
     val gcState_currentThreadContentsOperand: unit -> x86.Operand.t
     val gcState_currentThread_exnStackContents: unit -> x86.MemLoc.t
     val gcState_currentThread_exnStackContentsOperand: unit -> x86.Operand.t



1.39      +0 -1      mlton/mlton/codegen/x86-codegen/x86-translate.fun

Index: x86-translate.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-translate.fun,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- x86-translate.fun	20 Jan 2003 16:28:37 -0000	1.38
+++ x86-translate.fun	23 Jan 2003 03:34:37 -0000	1.39
@@ -166,7 +166,6 @@
 		   case oper of
 		      CanHandle => gcState_canHandleContentsOperand ()
 		    | CardMap => gcState_cardMapContentsOperand ()
-		    | CurrentSource => gcState_currentSourceContentsOperand ()
 		    | CurrentThread => gcState_currentThreadContentsOperand ()
 		    | ExnStack =>
 			 gcState_currentThread_exnStackContentsOperand ()



1.19      +0 -1      mlton/mlton/core-ml/lookup-constant.fun

Index: lookup-constant.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/core-ml/lookup-constant.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- lookup-constant.fun	13 Jan 2003 01:14:27 -0000	1.18
+++ lookup-constant.fun	23 Jan 2003 03:34:37 -0000	1.19
@@ -122,7 +122,6 @@
 val gcFields =
    [
     "canHandle",
-    "currentSource",
     "currentThread",
     "frontier",
     "cardMapForMutator",



1.48      +0 -1      mlton/mlton/main/compile.sml

Index: compile.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/compile.sml,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- compile.sml	20 Jan 2003 20:38:31 -0000	1.47
+++ compile.sml	23 Jan 2003 03:34:38 -0000	1.48
@@ -374,7 +374,6 @@
 	    {
 	     canHandle = get "canHandle",
 	     cardMap = get "cardMapForMutator",
-	     currentSource = get "currentSource",
 	     currentThread = get "currentThread",
 	     frontier = get "frontier",
 	     limit = get "limit",



1.121     +135 -79   mlton/runtime/gc.c

Index: gc.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.c,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -r1.120 -r1.121
--- gc.c	18 Jan 2003 19:01:11 -0000	1.120
+++ gc.c	23 Jan 2003 03:34:38 -0000	1.121
@@ -592,14 +592,42 @@
 	return 0 == stack->used;
 }
 
+static inline uint getFrameIndex (GC_state s, word returnAddress) {
+	uint res;
+
+	if (s->native) {
+		if (DEBUG_PROFILE)
+			fprintf (stderr, "getFrameIndex (0x%08x) = ", 
+					returnAddress);
+		res = *((uint*)(returnAddress - WORD_SIZE));
+	} else {
+		if (DEBUG_PROFILE)
+			fprintf (stderr, "getFrameIndex (%u) = ", returnAddress);
+		res = (uint)returnAddress;
+	}
+	if (DEBUG_PROFILE)
+		fprintf (stderr, "%u\n", res);
+	return res;
+}
+
+static inline uint topFrameIndex (GC_state s) {
+	uint res;
+
+	res = getFrameIndex (s, *(word*)(s->stackTop - WORD_SIZE));
+	if (DEBUG_PROFILE)
+		fprintf (stderr, "topFrameIndex = %u\n", res);
+	return res;
+}
+
+static inline uint topFrameSourceSeqIndex (GC_state s) {
+	return s->frameSources[topFrameIndex (s)];
+}
+
 static inline GC_frameLayout * getFrameLayout (GC_state s, word returnAddress) {
 	GC_frameLayout *layout;
 	uint index;
 
-	if (s->native)
-		index = *((uint*)(returnAddress - WORD_SIZE));
-	else
-		index = (uint)returnAddress;
+	index = getFrameIndex (s, returnAddress);
 	if (DEBUG_DETAILED)
 		fprintf (stderr, "returnAddress = 0x%08x  index = %d  frameLayoutsSize = %d\n",
 				returnAddress, index, s->frameLayoutsSize);
@@ -2461,17 +2489,15 @@
 			bool forceMajor,
 			bool mayResize) {
 	uint gcTime;
-	uint oldSource = -1;
 	bool stackTopOk;
 	W64 stackBytesRequested;
 	struct rusage ru_start;
 	W64 totalBytesRequested;
 	
 	if (s->profilingIsOn) {
-		oldSource = s->currentSource;
 		if (s->profileStack)
 			GC_profileEnter (s);
-		s->currentSource = SOURCE_SEQ_GC;
+		s->amInGC = TRUE;
 	}
 	if (DEBUG or s->messages)
 		fprintf (stderr, "Starting gc.  Request %s nursery bytes and %s old gen bytes.\n",
@@ -2514,9 +2540,9 @@
 	assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
 	assert (invariant (s));
 	if (s->profilingIsOn) {
-		s->currentSource = oldSource;
 		if (s->profileStack)
 			GC_profileLeave (s);
+		s->amInGC = FALSE;
 	}
 }
 
@@ -2793,12 +2819,7 @@
 /*                            Profiling                             */
 /* ---------------------------------------------------------------- */
 
-static void enterFrame (GC_state s, uint i) {
-	s->currentSource = s->frameSources[i];
-	GC_profileEnter (s);
-	s->currentSource = CURRENT_SOURCE_UNDEFINED;
-}
-
+/* Apply f to the frame index of each frame in the current thread's stack. */
 void GC_foreachStackFrame (GC_state s, void (*f) (GC_state s, uint i)) {
 	pointer bottom;
 	word index;
@@ -2815,7 +2836,7 @@
 				(uint)bottom, (uint)s->stackTop);
 	for (top = s->stackTop; top > bottom; top -= layout->numBytes) {
 		returnAddress = *(word*)(top - WORD_SIZE);
-		index = *(word*)(returnAddress - WORD_SIZE);
+		index = getFrameIndex (s, returnAddress);
 		if (DEBUG_PROFILE)
 			fprintf (stderr, "top = 0x%08x  index = %u\n",
 					(uint)top, index);
@@ -2831,9 +2852,13 @@
 }
 
 static inline void removeFromStack (GC_state s, GC_profile p, uint i) {
+	ullong totalInc;
+
+	totalInc = p->total - p->lastTotal[i];
 	if (DEBUG_PROFILE)
-		fprintf (stderr, "removing %s from stack\n", s->sources[i]);
-	p->countStack[i] += p->total - p->lastTotal[i];
+		fprintf (stderr, "removing %s from stack  totalInc = %llu\n",
+				s->sources[i], totalInc);
+	p->countStack[i] += totalInc;
 	p->countStackGC[i] += p->totalGC - p->lastTotalGC[i];
 }
 
@@ -2872,19 +2897,18 @@
 	}
 }
 
-void GC_profileEnter (GC_state s) {
+static void profileEnter (GC_state s, uint sourceSeqIndex) {
 	int i;
 	GC_profile p;
 	uint sourceIndex;
 	uint *sourceSeq;
 
 	if (DEBUG_PROFILE)
-		fprintf (stderr, "GC_profileEnter  currentSource = %u\n",
-				(uint)s->currentSource);
+		fprintf (stderr, "profileEnter (%u)\n", sourceSeqIndex);
 	assert (s->profileStack);
-	assert (s->currentSource < s->sourceSeqsSize);
+	assert (sourceSeqIndex < s->sourceSeqsSize);
 	p = s->profile;
-	sourceSeq = s->sourceSeqs[s->currentSource];
+	sourceSeq = s->sourceSeqs[sourceSeqIndex];
 	for (i = 1; i <= sourceSeq[0]; ++i) {
 		sourceIndex = sourceSeq[i];
 		if (DEBUG_PROFILE)
@@ -2898,53 +2922,22 @@
 	}
 }
 
-/* Pre: s->currentSource is set. */
-void GC_profileInc (GC_state s, W32 amount) {
-	uint source;
-	uint *sourceSeq;
-
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "GC_profileInc (%u) currentSource = %u\n",
-				(uint)amount,
-				s->currentSource);
-	assert (s->currentSource < s->sourceSeqsSize);
-	sourceSeq = s->sourceSeqs[s->currentSource];
-	source = sourceSeq[0] > 0
-		? sourceSeq[sourceSeq[0]]
-		: SOURCES_INDEX_UNKNOWN;
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "bumping %s by %u\n",
-				s->sources[source], (uint)amount);
-	s->profile->countTop[source] += amount;
-	if (s->profileStack)
-		GC_profileEnter (s);
-	if (SOURCES_INDEX_GC == source)
-		s->profile->totalGC += amount;
-	else
-		s->profile->total += amount;
-	if (s->profileStack)
-		GC_profileLeave (s);
-}
-
-/* s->currentSource must be set. */
-void GC_profileAllocInc (GC_state s, W32 amount) {
-	if (s->profilingIsOn and (PROFILE_ALLOC == s->profileKind))
-		GC_profileInc (s, amount);
+static void enterFrame (GC_state s, uint i) {
+	profileEnter (s, s->frameSources[i]);
 }
 
-void GC_profileLeave (GC_state s) {
+static void profileLeave (GC_state s, uint sourceSeqIndex) {
 	int i;
 	GC_profile p;
 	uint sourceIndex;
 	uint *sourceSeq;
 
 	if (DEBUG_PROFILE)
-		fprintf (stderr, "GC_profileLeave  currentSource = %u\n",
-				s->currentSource);
+		fprintf (stderr, "profileLeave (%u)\n", sourceSeqIndex);
 	assert (s->profileStack);
-	assert (s->currentSource < s->sourceSeqsSize);
+	assert (sourceSeqIndex < s->sourceSeqsSize);
 	p = s->profile;
-	sourceSeq = s->sourceSeqs[s->currentSource];
+	sourceSeq = s->sourceSeqs[sourceSeqIndex];
 	for (i = sourceSeq[0]; i > 0; --i) {
 		sourceIndex = sourceSeq[i];
 		if (DEBUG_PROFILE)
@@ -2957,6 +2950,62 @@
 	}
 }
 
+static inline void profileInc (GC_state s, W32 amount, uint sourceSeqIndex) {
+	uint *sourceSeq;
+	uint topSourceIndex;
+
+	assert (not s->amInGC);
+	if (DEBUG_PROFILE)
+		fprintf (stderr, "profileInc (%u, %u)\n", 
+				(uint)amount, sourceSeqIndex);
+	assert (sourceSeqIndex < s->sourceSeqsSize);
+	sourceSeq = s->sourceSeqs[sourceSeqIndex];
+	topSourceIndex = sourceSeq[0] > 0
+		? sourceSeq[sourceSeq[0]]
+		: SOURCES_INDEX_UNKNOWN;
+	if (DEBUG_PROFILE)
+		fprintf (stderr, "bumping %s by %u\n",
+				s->sources[topSourceIndex], (uint)amount);
+	s->profile->countTop[topSourceIndex] += amount;
+	if (s->profileStack)
+		profileEnter (s, sourceSeqIndex);
+	if (SOURCES_INDEX_GC == topSourceIndex)
+		s->profile->totalGC += amount;
+	else
+		s->profile->total += amount;
+	if (s->profileStack)
+		profileLeave (s, sourceSeqIndex);
+}
+
+void GC_profileEnter (GC_state s) {
+	profileEnter (s, topFrameSourceSeqIndex (s));
+}
+
+void GC_profileLeave (GC_state s) {
+	profileLeave (s, topFrameSourceSeqIndex (s));
+}
+
+void GC_profileInc (GC_state s, W32 amount) {
+	assert (not s->amInGC);
+	if (DEBUG_PROFILE)
+		fprintf (stderr, "GC_profileInc (%u)\n", (uint)amount);
+	profileInc (s, amount, topFrameSourceSeqIndex (s));
+}
+
+void GC_profileAllocInc (GC_state s, W32 amount) {
+	if (DEBUG_PROFILE)
+		fprintf (stderr, "GC_profileAllocInc (%u)\n", (uint)amount);
+	if (s->profilingIsOn and (PROFILE_ALLOC == s->profileKind)) {
+		if (s->amInGC) {
+			if (DEBUG_PROFILE)
+				fprintf (stderr, "amInGC\n");
+			s->profile->totalGC += amount;
+			return;
+		}
+		GC_profileInc (s, amount);
+	}
+}
+
 static void showProf (GC_state s) {
 	int i;
 	int j;
@@ -3066,9 +3115,10 @@
  * Called on each SIGPROF interrupt.
  */
 static void catcher (int sig, siginfo_t *sip, ucontext_t *ucp) {
-	GC_state s;
+	uint frameIndex;
 	pointer pc;
-	bool undef;
+	GC_state s;
+	uint sourceSeqIndex;
 
 	s = catcherState;
 #if (defined (__linux__))
@@ -3079,21 +3129,24 @@
 #error pc not defined
 #endif
 	if (DEBUG_PROFILE)
-		fprintf (stderr, "pc = 0x%08x\n", (uint)pc);
-	if (CURRENT_SOURCE_UNDEFINED == s->currentSource) {
-		undef = TRUE;
+		fprintf (stderr, "catcher  pc = 0x%08x\n", (uint)pc);
+	if (s->amInGC) {
+		s->profile->totalGC++;
+		return;
+	}
+	frameIndex = topFrameIndex (s);
+	if (s->frameLayouts[frameIndex].isC) {
+		sourceSeqIndex = s->frameSources[frameIndex];
+	} else {
 		if (s->textStart <= pc and pc < s->textEnd) {
-			s->currentSource = s->textSources [pc - s->textStart];
+			sourceSeqIndex = s->textSources [pc - s->textStart];
 		} else {
 			if (DEBUG_PROFILE)
 				fprintf (stderr, "pc out of bounds\n");
-		       	s->currentSource = SOURCE_SEQ_UNKNOWN;
+		       	sourceSeqIndex = SOURCE_SEQ_UNKNOWN;
 		}
-	} else
-		undef = FALSE;
-	GC_profileInc (s, 1);
-	if (undef)
-		s->currentSource = CURRENT_SOURCE_UNDEFINED;
+	}
+	profileInc (s, 1, sourceSeqIndex);
 }
 
 /* To get the beginning and end of the text segment. */
@@ -3116,7 +3169,6 @@
 	uint sourceSeqsIndex;
 
 	s->profile = GC_profileNew (s);
-	s->currentSource = CURRENT_SOURCE_UNDEFINED;
 	/* Sort sourceLabels by address. */
 	qsort (s->sourceLabels, s->sourceLabelsSize, sizeof(*s->sourceLabels),
 		compareProfileLabels);
@@ -3382,7 +3434,7 @@
 	int numElements;
 
 	s->bytesLive = 0;
-	for (i = 0; s->intInfInits[i].mlstr != NULL; ++i) {
+	for (i = 0; i < s->intInfInitsSize; ++i) {
 		numElements = strlen (s->intInfInits[i].mlstr);
 		s->bytesLive +=
 			GC_ARRAY_HEADER_SIZE + WORD_SIZE // for the sign
@@ -3390,7 +3442,7 @@
 				? POINTER_SIZE 
 				: wordAlign (numElements));
 	}
-	for (i = 0; s->stringInits[i].str != NULL; ++i) {
+	for (i = 0; i < s->stringInitsSize; ++i) {
 		numElements = s->stringInits[i].size;
 		s->bytesLive +=
 			GC_ARRAY_HEADER_SIZE
@@ -3415,15 +3467,17 @@
 	uint	slen,
 		llen,
 		alen,
-		i;
+		i,
+		index;
 	bool	neg,
 		hex;
 	bignum	*bp;
 	char	*cp;
 
-	inits = s->intInfInits;
 	frontier = s->frontier;
-	for (; (str = inits->mlstr) != NULL; ++inits) {
+	for (index = 0; index < s->intInfInitsSize; ++index) {
+		inits = &s->intInfInits[index];
+		str = inits->mlstr;
 		assert (inits->globalIndex < s->globalsSize);
 		neg = *str == '~';
 		if (neg)
@@ -3494,7 +3548,7 @@
 
 	inits = s->stringInits;
 	frontier = s->frontier;
-	for (i = 0; inits[i].str != NULL; ++i) {
+	for (i = 0; i < s->stringInitsSize; ++i) {
 		uint numElements, numBytes;
 
 		numElements = inits[i].size;
@@ -3592,6 +3646,7 @@
 	char *worldFile;
 	int i;
 
+	s->amInGC = TRUE;
 	s->bytesAllocated = 0;
 	s->bytesCopied = 0;
 	s->bytesCopiedMinor = 0;
@@ -3600,7 +3655,6 @@
 	s->cardSize = 0x1 << s->cardSizeLog2;
 	s->copyRatio = 4.0;
 	s->copyGenerationalRatio = 4.0;
-	s->currentSource = SOURCE_SEQ_GC;
 	s->currentThread = BOGUS_THREAD;
 	s->growRatio = 8.0;
 	s->inSignalHandler = FALSE;
@@ -3648,6 +3702,7 @@
 	/* Initialize profiling. */
 	if (s->sourcesSize > 0) {
 		s->profilingIsOn = TRUE;
+		assert (s->frameSourcesSize == s->frameLayoutsSize);
 		if (s->sourceLabelsSize > 0) {
 			s->profileKind = PROFILE_TIME;
 			profileTimeInit (s);
@@ -3780,6 +3835,7 @@
 			GC_foreachStackFrame (s, enterFrame);
 	}
 	assert (mutatorInvariant (s));
+	s->amInGC = FALSE;
 	return i;
 }
 



1.56      +8 -10     mlton/runtime/gc.h

Index: gc.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.h,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- gc.h	18 Jan 2003 19:01:12 -0000	1.55
+++ gc.h	23 Jan 2003 03:34:38 -0000	1.56
@@ -109,9 +109,8 @@
 /*
  * GC_init uses the array of struct intInfInits in s at program start to 
  * allocate intInfs.
- * The array is terminated by an intInfInit with mlstr field NULL.
- * For each other entry, the globalIndex'th entry of the globals array in
- * s is set to the IntInf.int whose value corresponds to the mlstr string.
+ * The globalIndex'th entry of the globals array in s is set to the
+ * IntInf.int whose value corresponds to the mlstr string.
  *
  * The strings pointed to by the mlstr fields consist of
  *	an optional ~
@@ -138,6 +137,9 @@
 typedef ushort *GC_offsets;
 
 typedef struct GC_frameLayout {
+	/* isC is a boolean identifying whether or not the frame is for a C call.
+	 */
+	char isC;
 	/* Number of bytes in frame, including space for return address. */
 	ushort numBytes;
 	/* Offsets from stackTop pointing at bottom of frame at which pointers
@@ -290,6 +292,7 @@
 	pointer stackTop;
 	pointer stackLimit;	/* stackBottom + stackSize - maxFrameSize */
 
+	bool amInGC;
 	pointer back;     	/* Points at next available word in toSpace. */
 	ullong bytesAllocated;
  	ullong bytesCopied;
@@ -310,10 +313,6 @@
 	GC_heap crossMapHeap;	/* only used during GC. */
 	pointer crossMap;
 	uint crossMapSize;
-	/* currentSource is the index in sources of the currently executing
-	 * function.
-	 */
-	uint currentSource;
 	GC_thread currentThread; /* This points to a thread in the heap. */
 	uint fixedHeapSize; 	/* Only meaningful if useFixedHeap. */
 	GC_frameLayout *frameLayouts;
@@ -334,6 +333,7 @@
  	 * thread.  This is used to implement critical sections.
 	 */
 	struct GC_intInfInit *intInfInits;
+	uint intInfInitsSize;
 	volatile int canHandle;
 	bool isOriginal;
 	pointer limitPlusSlop; /* limit + LIMIT_SLOP */
@@ -432,10 +432,8 @@
 	uint *sourceSuccessors;
 	pointer stackBottom; /* The bottom of the stack in the current thread. */
  	uint startTime; /* The time when GC_init or GC_loadWorld was called. */
-        /* The inits array should be NULL terminated, 
-         *    i.e.the final element should be {0, NULL, 0}.
-         */
 	struct GC_stringInit *stringInits;
+	uint stringInitsSize;
 	/* If summary is TRUE, then print a summary of gc info when the program 
 	 * is done .
 	 */





-------------------------------------------------------
This SF.net email is sponsored by: Scholarships for Techies!
Can't afford IT training? All 2003 ictp students receive scholarships.
Get hands-on training in Microsoft, Cisco, Sun, Linux/UNIX, and more.
www.ictp.com/training/sourceforge.asp
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel