[MLton-devel] cvs commit: mark compact GC and x86-codegen changes

Matthew Fluet fluet@users.sourceforge.net
Wed, 10 Jul 2002 19:16:50 -0700


fluet       02/07/10 19:16:50

  Modified:    bin      regression
               mlton/backend c-function.fun runtime.fun runtime.sig
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-codegen.fun
                        x86-entry-transfer.fun x86-generate-transfers.fun
                        x86-jump-info.fun x86-live-transfers.fun
                        x86-loop-info.fun x86-mlton-basic.fun
                        x86-mlton-basic.sig x86-mlton.fun x86-pseudo.sig
                        x86-simplify.fun x86-translate.fun x86.fun x86.sig
               runtime/basis Thread.c
  Log:
  Here is a working checkin of the native codegen with the mark compact
  GC.  Passes all regressions (with -debug true -gc-check first) and a
  self compile, both with MARK_VERIFY=TRUE.  I've left the mark compact
  GC disabled for now.
  
  I added an additional check to CFunction.isOK that asserts
  maySwitchThreads => returnTy = NONE
  Nothing currently violates this check, but I was getting a headache
  trying to figure out the right caching of values across a thread
  switching function that returns a value, not to mention which thread
  should receive the returned value.
  
  The new CFunction interface is nice; it lets me express a (trivial)
  optimization of GC calls.  In particular, when a program doesn't
  handle signals, then a GC won't ever change threads.  Therefore, we
  don't need to do an indirect jump to stackTop on return, since we know
  that that will be the same return address that we pushed before the
  call.  Overall, I doubt it will make any performance difference, but
  it was easily added.
  
  There are a couple of outstanding issues with threads, but nothing
  that inhibits compilation.  My straightforward port of ccodegen.h's
  Thread_switchTo to native assembly is busted, but peforming
  Thread_switchTo via a C-call into Thread.c works fine.  (Really don't
  know why.)  There is also some extraneous shuffling of the return
  value from a C-call that mayGC; this is a side-effect of having
  previously assumed that runtime calls don't return.  The basic issue
  is that the way the return value is cached was partially relying on
  the fact that a CCall was always followed by a unique CReturn to which
  the code generator could just fall thru, thereby never needing to move
  the return value anywere.  While a mayGC call that returns will also
  have a unique CReturn, we can't fall thru, because the frame layouts
  data is prefixed to that code in order to GC the top frame.  So, we
  need to do an explicit jump, and I need to go back to
  x86-live-transfers.fun to instruct it to cache the returned value in a
  register over that jump.  Right now we spill it and reload it, which
  is semantically correct, and since it is a write followed by a read,
  probably always hits the cache, but it shouldn't be too hard to fix.
  
  Other than that, every thing seems to be in order.  I also just
  started a regression with -debug true -gc-check first -inline-array
  false, and I didn't get any failures through "list".

Revision  Changes    Path
1.46      +2 -2      mlton/bin/regression

Index: regression
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/regression,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- regression	6 Jul 2002 16:30:14 -0000	1.45
+++ regression	11 Jul 2002 02:16:48 -0000	1.46
@@ -6,7 +6,7 @@
 name=`basename $0`
 
 function usage {
-	echo >&2 "usage: $name [-cross host] [-run-only] [mlton flag ...]"
+	echo >&2 "usage: $name [-cross host] [-run-only] [mlton flags ...]"
 	exit 1
 }
 
@@ -77,7 +77,7 @@
 			$mlton $flags $extraFlags $f.sml
 			if [ $? -ne 0 ]; then
 				compFail $f
-				exit 1
+#				exit 1
 			fi
 		fi
 		if [ ! -r $f.nonterm -a $cross = 'no' ]; then



1.2       +16 -8     mlton/mlton/backend/c-function.fun

Index: c-function.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/c-function.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- c-function.fun	6 Jul 2002 17:22:05 -0000	1.1
+++ c-function.fun	11 Jul 2002 02:16:49 -0000	1.2
@@ -49,17 +49,25 @@
 
 fun isOk (T {ensuresBytesFree, mayGC, maySwitchThreads, modifiesFrontier,
 	     modifiesStackTop, needsArrayInit, returnTy, ...}): bool =
+   (if maySwitchThreads
+      then (case returnTy of
+	      NONE => true
+	    | SOME t => false)
+      else true)
+   andalso
    (if ensuresBytesFree orelse maySwitchThreads
        then mayGC
     else true)
-       andalso (if mayGC
-		   then modifiesFrontier andalso modifiesStackTop
-		else true)
-       andalso (if needsArrayInit
-		   then (case returnTy of
-			    NONE => false
-			  | SOME t => Type.equals (t, Type.pointer))
-		else true)
+   andalso 
+   (if mayGC
+       then modifiesFrontier andalso modifiesStackTop
+    else true)
+   andalso 
+   (if needsArrayInit
+      then (case returnTy of
+	      NONE => false
+	    | SOME t => Type.equals (t, Type.pointer))
+    else true)
 
 val isOk = Trace.trace ("CFunction.isOk", layout, Bool.layout) isOk
 



1.2       +1 -0      mlton/mlton/backend/runtime.fun

Index: runtime.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/runtime.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- runtime.fun	6 Jul 2002 17:22:05 -0000	1.1
+++ runtime.fun	11 Jul 2002 02:16:49 -0000	1.2
@@ -143,6 +143,7 @@
 
 val wordSize: int = 4
 val arrayHeaderSize = 3 * wordSize
+val intInfOverheadSize = arrayHeaderSize + wordSize (* for the sign *)
 val labelSize = wordSize
 val limitSlop: int = 512
 val normalHeaderSize = wordSize



1.11      +1 -0      mlton/mlton/backend/runtime.sig

Index: runtime.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/runtime.sig,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- runtime.sig	6 Jul 2002 17:22:05 -0000	1.10
+++ runtime.sig	11 Jul 2002 02:16:49 -0000	1.11
@@ -73,6 +73,7 @@
       val array0Size: int
       val headerToTypeIndex: word -> int
       val isWordAligned: int -> bool
+      val intInfOverheadSize: int
       val labelSize: int
       (* Same as LIMIT_SLOP from gc.c. *)
       val limitSlop: int



1.23      +7 -15     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.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- c-codegen.fun	6 Jul 2002 17:22:06 -0000	1.22
+++ c-codegen.fun	11 Jul 2002 02:16:49 -0000	1.23
@@ -53,12 +53,6 @@
 
 val traceGotoLabel = Trace.trace ("gotoLabel", Label.layout, Unit.layout) 
 
-val wordSize: int = 4
-val pointerSize = wordSize
-val objectHeaderSize = wordSize
-val arrayHeaderSize = 2 * wordSize
-val intInfOverhead = arrayHeaderSize + wordSize (* for the sign *)
-
 val overhead = "**C overhead**"
    
 structure C =
@@ -217,8 +211,8 @@
 	 C.call ("Globals",
 		 List.map (List.map (let open Type
 				     in [char, double, int, pointer, uint]
-				     end,
-					globals) @ [globalsNonRoot],
+				     end, 
+				     globals) @ [globalsNonRoot],
 			   C.int),
 		 print)
       fun locals ty =
@@ -228,12 +222,10 @@
 		    else max)
       fun declareLocals () =
 	 C.call ("Locals",
-		 List.map (List.map (let 
-					open Type
-				     in 
-					[char, double, int, pointer, uint]
+		 List.map (List.map (let open Type
+				     in [char, double, int, pointer, uint]
 				     end,
-					locals),
+				     locals),
 			   C.int),
 		 print)
       fun declareIntInfs () =
@@ -294,11 +286,11 @@
 	 let
 	    val stringSizes =
 	       List.fold (strings, 0, fn ((_, s), n) =>
-			  n + arrayHeaderSize
+			  n + Runtime.arrayHeaderSize
 			  + Type.align (Type.pointer, String.size s))
 	    val intInfSizes =
 	       List.fold (intInfs, 0, fn ((_, s), n) =>
-			  n + intInfOverhead
+			  n + Runtime.intInfOverheadSize
 			  + Type.align (Type.pointer, String.size s))
 	    val bytesLive = intInfSizes + stringSizes
 	    val (usedFixedHeap, fromSize) =



1.27      +15 -41    mlton/mlton/codegen/x86-codegen/x86-codegen.fun

Index: x86-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-codegen.fun,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- x86-codegen.fun	6 Jul 2002 17:22:06 -0000	1.26
+++ x86-codegen.fun	11 Jul 2002 02:16:49 -0000	1.27
@@ -9,12 +9,6 @@
 struct
   open S
 
-  val wordSize: int = 4
-  val pointerSize = wordSize
-  val objectHeaderSize = wordSize
-  val arrayHeaderSize = 2 * wordSize
-  val intInfOverhead = arrayHeaderSize + wordSize (* for the sign *)
-
   structure x86 
     = x86(structure Label = Machine.Label
 	  structure Runtime = Machine.Runtime)
@@ -163,18 +157,6 @@
 			       | SOME fi => (label, fi) :: l))
 
 	local
-	  val shift = let
-			val w = Word.fromInt (maxFrameSize div 4)
-			fun loop i
-			  = if i = Word.wordSize
-			       orelse
-			       Word.nthBitIsSet(w, i)
-			      then Word.wordSize - i
-			      else loop (i + 1)
-			val shift = loop 0
-		      in 
-			Word.fromInt (maxFrameSize div 4)
-		      end
 	  val hash' = fn {size, offsetIndex} => Word.fromInt (offsetIndex)
 	  val hash = fn {size, offsetIndex, frameLayoutsIndex}
 	              => hash' {size = size, offsetIndex = offsetIndex}
@@ -186,26 +168,25 @@
 	  val _
 	    = List.foreach
 	      (return_labels,
-	       fn (label,
-		   Machine.FrameInfo.T {size, frameOffsetsIndex = offsetIndex})
+	       fn (label, Machine.FrameInfo.T {size, frameOffsetsIndex = offsetIndex})
 	        => let
-		      val info = {size = size, offsetIndex = offsetIndex}
+		     val info = {size = size, offsetIndex = offsetIndex}
 		     val {frameLayoutsIndex, ...}
 		       = HashSet.lookupOrInsert
 		         (table,
 			  hash' info,
-			  fn {size = size', offsetIndex = offsetIndex', ...}
-			   => size = size' andalso offsetIndex = offsetIndex',
-			  fn ()
-			   => let
-				val _ = List.push(frameLayoutsData', info)
-				val frameLayoutsIndex = !maxFrameLayoutIndex'
-				val _ = Int.inc maxFrameLayoutIndex'
-			      in
-				{size = size,
-				 offsetIndex = offsetIndex,
-				 frameLayoutsIndex = frameLayoutsIndex}
-			      end)
+			  fn {size = size', offsetIndex = offsetIndex', ...} => 
+			  size = size' andalso offsetIndex = offsetIndex',
+			  fn () => 
+			  let
+			    val _ = List.push(frameLayoutsData', info)
+			    val frameLayoutsIndex = !maxFrameLayoutIndex'
+			    val _ = Int.inc maxFrameLayoutIndex'
+			  in
+			    {size = size,
+			     offsetIndex = offsetIndex,
+			     frameLayoutsIndex = frameLayoutsIndex}
+			  end)
 		   in
 		     setFrameLayoutIndex
 		     (label,
@@ -220,13 +201,6 @@
 	fun outputC ()
 	  = let
 	      val {file, print, done} = makeC ()
-	      fun locals ty
-		= List.fold(chunks,
-			    0,
-			    fn (Machine.Chunk.T {regMax, ...},max)
-			     => if regMax ty > max
-				  then regMax ty
-				  else max)
 	      fun make(name, l, pr)
 		= (print (concat["static ", name, " = {"]);
 		   List.foreachi(l,
@@ -252,7 +226,7 @@
 			| Control.Linux => mainLabel
 		 in
 		    [mainLabel,
-		     if reserveEsp then "TRUE" else "FALSE"]
+		     if reserveEsp then C.truee else C.falsee]
 		 end
 	      fun rest () =
 		 declareFrameLayouts()



1.7       +33 -29    mlton/mlton/codegen/x86-codegen/x86-entry-transfer.fun

Index: x86-entry-transfer.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-entry-transfer.fun,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- x86-entry-transfer.fun	6 Jul 2002 17:22:06 -0000	1.6
+++ x86-entry-transfer.fun	11 Jul 2002 02:16:49 -0000	1.7
@@ -39,36 +39,40 @@
 	fun isHandler l = case get l
 			    of SOME (Block.T {entry = Entry.Handler _, ...}) => true
 			     | _ => false
-	fun isCReturn l = case get l
-			    of SOME (Block.T {entry = Entry.CReturn _, ...}) => true
-			     | _ => false
+	fun isCReturn l f = case get l
+			      of SOME (Block.T {entry = Entry.CReturn {func, ...}, ...})
+			       => Runtime.CFunction.equals (f, func)
+			       | _ => false
+	val b = List.forall
+	        (blocks,
+		 fn block as Block.T {entry, transfer, ...}
+		  => (case transfer
+			of Transfer.Goto {target, ...}
+			 => isJump target
+			 | Transfer.Iff {truee, falsee, ...}
+			 => isJump truee andalso isJump falsee
+			 | Transfer.Switch {cases, default, ...}
+			 => isJump default andalso
+			    Transfer.Cases.forall(cases, isJump)
+			 | Transfer.Tail {target, ...}
+			 => isFunc target
+			 | Transfer.NonTail {target, return, handler, ...}
+			 => isFunc target andalso
+			    isCont return andalso
+			    (case handler
+			       of SOME handler => isHandler handler
+				| NONE => true)
+		         | Transfer.Return {...} => true
+			 | Transfer.Raise {...} => true
+			 | Transfer.CCall {return, func, ...} 
+			 => (case return
+			       of NONE => true
+				| SOME l => isCReturn l func)))
+	val _ = destroy ()
+	val _ = if b then ()
+		  else List.foreach(blocks, Block.printBlock)
       in
-	List.forall
-	(blocks,
-	 fn block as Block.T {entry, transfer, ...}
-	  => (case transfer
-		of Transfer.Goto {target, ...}
-		 => isJump target
-		 | Transfer.Iff {truee, falsee, ...}
-		 => isJump truee andalso isJump falsee
-		 | Transfer.Switch {cases, default, ...}
-	         => isJump default andalso
-	            Transfer.Cases.forall(cases, isJump)
-	         | Transfer.Tail {target, ...}
-	         => isFunc target
-	         | Transfer.NonTail {target, return, handler, ...}
-	         => isFunc target andalso
-	            isCont return andalso
-	            (case handler
-		       of SOME handler => isHandler handler
-			| NONE => true)
-		 | Transfer.Return {...} => true
-	         | Transfer.Raise {...} => true
-	         | Transfer.CCall {return, ...} =>
-		      (case return of
-			  NONE => true
-			| SOME l => isCReturn l)))
-	before destroy ()
+	b
       end
 
   val (verifyEntryTranfer, verifyEntryTransfer_msg)



1.30      +500 -253  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.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- x86-generate-transfers.fun	6 Jul 2002 17:22:06 -0000	1.29
+++ x86-generate-transfers.fun	11 Jul 2002 02:16:49 -0000	1.30
@@ -155,6 +155,28 @@
 						   else l}
 	   end
 	   
+	fun runtimeTransfer live setup trans
+	  = AppendList.appends
+	    [AppendList.single
+	     (Assembly.directive_force
+	      {commit_memlocs = removeHoldMemLocs live,
+	       commit_classes = ClassSet.empty,
+	       remove_memlocs = MemLocSet.empty,
+	       remove_classes = ClassSet.empty,
+	       dead_memlocs = MemLocSet.empty,
+	       dead_classes = ClassSet.empty}),
+	     setup,
+	     AppendList.fromList
+	     [(Assembly.directive_clearflt ()),
+	      (Assembly.directive_force
+	       {commit_memlocs = MemLocSet.empty,
+		commit_classes = farflushClasses,
+		remove_memlocs = MemLocSet.empty,
+		remove_classes = ClassSet.empty,
+		dead_memlocs = MemLocSet.empty,
+		dead_classes = ClassSet.empty})],
+	     trans]
+
 	fun runtimeEntry l = AppendList.cons (blockAssumes [], l)
 
 	fun farEntry l = AppendList.cons (blockAssumes [], l)
@@ -268,10 +290,7 @@
 	     jumpInfo = jumpInfo,
 	     loopInfo = loopInfo}
 	    handle exn
-	     => Error.bug ("x86LiveTransfers.computeLiveTransfers::" ^
-			   (case exn
-			      of Fail s => s
-			       | _ => "?"))
+	     => Error.reraise (exn, "x86LiveTransfers.computeLiveTransfers")
 
 	val getLiveRegsTransfers
 	  = #1 o x86LiveTransfers.getLiveTransfers
@@ -351,7 +370,27 @@
 	      label'
 	    end
 
+	val c_stackP = x86MLton.c_stackPContentsOperand
+
+	fun cacheEsp () =
+	   if reserveEsp
+	      then AppendList.empty
+	   else
+	      AppendList.single
+	      ((* explicit cache in case there are no args *)
+	       Assembly.directive_cache 
+	       {caches = [{register = Register.esp,
+			   memloc = valOf (Operand.deMemloc c_stackP),
+			   reserve = true}]})
+
+	fun unreserveEsp () =
+	   if reserveEsp
+	      then AppendList.empty
+	   else AppendList.single (Assembly.directive_unreserve 
+				   {registers = [Register.esp]})
+
 	datatype z = datatype Entry.t
+	datatype z = datatype Transfer.t
 	fun generateAll (gef as GEF {generate,effect,fall})
 	                {label, falling, unique} : 
 			Assembly.t AppendList.t
@@ -426,65 +465,95 @@
 		       = case entry
 			   of Jump {label}
 			    => near label
-			    | CReturn {dst, frameInfo, func, label}
-			    =>
-			       let
-				  fun getReturn () =
-				     case dst of
-					NONE => AppendList.empty
-				      | SOME (dst, dstsize) =>
-					   (case Size.class dstsize
-					       of Size.INT
-						  => AppendList.single
-						     (x86.Assembly.instruction_mov
-						      {dst = dst,
-						       src = x86MLton.cReturnTempContentsOperand dstsize,
-						       size = dstsize})
-						   | Size.FLT
-						     => AppendList.single
-							(x86.Assembly.instruction_pfmov
-							 {dst = dst,
-							  src = x86MLton.cReturnTempContentsOperand dstsize,
-							  size = dstsize})
-						   | _ => Error.bug "CReturn")
+			    | CReturn {dst, 
+				       frameInfo,
+				       func = CFunction.T {mayGC,
+							   maySwitchThreads,
+							   name, ...},
+				       label}
+			    => let
+				 fun getReturn ()
+				   = case dst 
+				       of NONE => AppendList.empty
+				        | SOME (dst, dstsize)
+					=> (case Size.class dstsize
+					      of Size.INT
+					       => AppendList.single
+						  (x86.Assembly.instruction_mov
+						   {dst = dst,
+						    src = Operand.memloc
+						          (MemLoc.cReturnTempContents 
+							   dstsize),
+						    size = dstsize})
+					       | Size.FLT
+					       => AppendList.single
+						  (x86.Assembly.instruction_pfmov
+						   {dst = dst,
+						    src = Operand.memloc
+						          (MemLoc.cReturnTempContents 
+							   dstsize),
+						    size = dstsize})
+					       | _ => Error.bug "CReturn")
 			       in
-				  if not (CFunction.mayGC func)
-				     then
-					AppendList.append
-					(near label, getReturn ())
-				  else
-				  let
-				     val FrameInfo.T {size, frameLayoutsIndex} =
-					valOf frameInfo
-				  in
-				     AppendList.append
-				     (AppendList.fromList
-				      [Assembly.pseudoop_p2align 
-				       (Immediate.const_int 4, NONE, NONE),
-				       Assembly.pseudoop_long 
-				       [Immediate.const_int frameLayoutsIndex],
-				       Assembly.label label],
-				      (* entry from far assumptions *)
-				      (farEntry
-				       (AppendList.appends
-					[profile_assembly,
-					 let
-					    val stackTop 
-					       = x86MLton.gcState_stackTopContentsOperand ()
-					    val bytes 
-					       = x86.Operand.immediate_const_int (~ size)
-					 in
-					    (* stackTop += bytes *)
-					    AppendList.single
-					    (x86.Assembly.instruction_binal 
-					     {oper = x86.Instruction.ADD,
-					      dst = stackTop,
-					      src = bytes, 
-					      size = pointerSize})
-					 end,
-					 (* assignTo dst *)
-					 getReturn ()])))
-				  end
+				 if mayGC orelse maySwitchThreads
+				   then let
+					  val FrameInfo.T {size, frameLayoutsIndex}
+					    = valOf frameInfo
+					  val finish
+					    = AppendList.appends
+					      [profile_assembly,
+					       let
+						 val stackTop 
+						   = x86MLton.gcState_stackTopContentsOperand ()
+						 val bytes 
+						   = x86.Operand.immediate_const_int (~ size)
+					       in
+						 (* stackTop += bytes *)
+						 AppendList.single
+						 (x86.Assembly.instruction_binal 
+						  {oper = x86.Instruction.ADD,
+						   dst = stackTop,
+						   src = bytes, 
+						   size = pointerSize})
+					       end,
+					       (* assignTo dst *)
+					       getReturn ()]
+					in
+					  AppendList.append
+					  (AppendList.fromList
+					   [Assembly.pseudoop_p2align 
+					    (Immediate.const_int 4, NONE, NONE),
+					    Assembly.pseudoop_long 
+					    [Immediate.const_int frameLayoutsIndex],
+					    Assembly.label label],
+					   if maySwitchThreads
+					     then (* entry from far assumptions *)
+					          farEntry finish
+					     else (* near entry & live transfer assumptions *)
+					          AppendList.append
+						  (AppendList.fromList
+						   [(blockAssumes
+						     (List.map
+						      (getLiveRegsTransfers
+						       (liveTransfers, label),
+						       fn (memloc,register,sync)
+						       => {register = register,
+							   memloc = memloc,
+							   sync = sync, 
+							   weight = 1024,
+							   reserve = false}))),
+						    (Assembly.directive_fltassume
+						     {assumes
+						      = (List.map
+							 (getLiveFltRegsTransfers
+							  (liveTransfers, label),
+							  fn (memloc,sync)
+							  => {memloc = memloc,
+							      sync = sync,
+							      weight = 1024}))})],
+						   finish))
+					end
+				 else AppendList.append (near label, getReturn ())
 			       end
 			    | Func {label,...}
 			    => AppendList.append
@@ -604,27 +673,7 @@
 		      transfer]
 		   end)
 	  
-	val c_stackP = x86MLton.c_stackPContentsOperand
-
-	fun cacheEsp () =
-	   if reserveEsp
-	      then AppendList.empty
-	   else
-	      AppendList.single
-	      ((* explicit cache in case there are no args *)
-	       Assembly.directive_cache 
-	       {caches = [{register = Register.esp,
-			   memloc = valOf (Operand.deMemloc c_stackP),
-			   reserve = true}]})
-
-	fun unreserveEsp () =
-	   if reserveEsp
-	      then AppendList.empty
-	   else AppendList.single (Assembly.directive_unreserve 
-				   {registers = [Register.esp]})
-
-	datatype z = datatype Transfer.t
-	fun effectDefault (gef as GEF {generate,effect,fall})
+	and effectDefault (gef as GEF {generate,effect,fall})
 	                  {label, transfer} : Assembly.t AppendList.t
 	  = AppendList.append
 	    (if !Control.Native.commented > 1
@@ -918,6 +967,161 @@
 			 {target = stackTopDeref,
 			  absolute = true})))
 		    end
+(*
+	        | CCall {args, dstsize,
+			 frameInfo,
+			 func = CFunction.T {mayGC,
+					     maySwitchThreads,
+					     modifiesFrontier,
+					     modifiesStackTop,
+					     name = "Thread_switchTo", ...},
+			 return, target}
+		=> let
+		     val return = valOf return
+		     val _ = enque return
+		     val FrameInfo.T {size, ...} = valOf frameInfo
+		     val bytes = x86.Operand.immediate_const_int size
+
+		     val live = x86Liveness.LiveInfo.getLive(liveInfo, return)
+
+		     val (thread,threadsize)
+		       = case args
+			   of [(thread,threadsize)] => (thread,threadsize)
+			    | _ => Error.bug "x86GenerateTransfers::CCall: Thread_switchTo"
+		     val threadTemp
+		       = x86MLton.threadTempContentsOperand
+
+		     val stackTop 
+		       = x86MLton.gcState_stackTopContentsOperand ()
+		     val stackTopMinusWordDeref'
+		       = x86MLton.gcState_stackTopMinusWordDeref ()
+		     val stackTopMinusWordDeref
+		       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
+
+		     val currentThread
+		       = x86MLton.gcState_currentThreadContentsOperand ()
+		     val stack
+		       = x86MLton.gcState_currentThread_stackContentsOperand ()
+		     val stack_used
+		       = x86MLton.gcState_currentThread_stack_usedContentsOperand ()
+		     val stack_reserved
+		       = x86MLton.gcState_currentThread_stack_reservedContentsOperand ()
+		     val stackBottom
+		       = x86MLton.gcState_stackBottomContentsOperand ()
+		     val stackLimit
+		       = x86MLton.gcState_stackLimitContentsOperand ()
+		     val maxFrameSize
+		       = x86MLton.gcState_maxFrameSizeContentsOperand ()
+		     val canHandle
+		       = x86MLton.gcState_canHandleContentsOperand ()
+		     val signalIsPending
+		       = x86MLton.gcState_signalIsPendingContentsOperand ()
+		     val limit
+		       = x86MLton.gcState_limitContentsOperand ()
+		     val base
+		       = x86MLton.gcState_baseContentsOperand ()
+		   in
+		     AppendList.append
+		     (AppendList.fromList
+		      [(* threadTemp = thread *)
+		       Assembly.instruction_mov
+		       {dst = threadTemp,
+			src = thread,
+			size = pointerSize},
+		       (* stackTop += bytes *)
+		       x86.Assembly.instruction_binal 
+		       {oper = x86.Instruction.ADD,
+			dst = stackTop,
+			src = bytes, 
+			size = pointerSize},
+		       (* *(stackTop - WORD_SIZE) = return *)
+		       x86.Assembly.instruction_mov
+		       {dst = stackTopMinusWordDeref,
+			src = Operand.immediate_label return,
+			size = pointerSize},
+		       (* flushing at Runtime *)
+		       Assembly.directive_force
+		       {commit_memlocs = LiveSet.toMemLocSet live,
+			commit_classes = threadflushClasses,
+			remove_memlocs = MemLocSet.empty,
+			remove_classes = ClassSet.empty,
+			dead_memlocs = MemLocSet.empty,
+			dead_classes = ClassSet.empty},
+		       Assembly.directive_force
+		       {commit_memlocs = MemLocSet.empty,
+			commit_classes = ClassSet.empty,
+			remove_memlocs = MemLocSet.empty,
+			remove_classes = ClassSet.empty,
+			dead_memlocs = MemLocSet.empty,
+			dead_classes = threadflushClasses},
+		       (* currentThread->stack->used = stackTop - stackBottom *)
+		       Assembly.instruction_mov
+		       {dst = stack_used,
+			src = stackTop,
+			size = pointerSize},
+		       Assembly.instruction_binal
+		       {oper = Instruction.SUB,
+			dst = stack_used,
+			src = stackBottom,
+			size = pointerSize},
+		       (* currentThread = threadTemp *)
+		       Assembly.instruction_mov
+		       {src = threadTemp,
+			dst = currentThread,
+			size = pointerSize},
+		       (* stackBottom = currentThread->stack + sizeOf(GC_stack) *)
+		       Assembly.instruction_mov
+		       {dst = stackBottom,
+			src = stack,
+			size = pointerSize},
+		       Assembly.instruction_binal
+		       {oper = Instruction.ADD,
+			dst = stackBottom,
+			src = Operand.immediate_const_int 16,
+			size = pointerSize},
+		       (* stackTop = stackBottom + currentThread->stack->used *)
+		       Assembly.instruction_mov
+		       {dst = stackTop,
+			src = stackBottom,
+			size = pointerSize},
+		       Assembly.instruction_binal
+		       {oper = Instruction.ADD,
+			dst = stackTop,
+			src = stack_used,
+			size = pointerSize},
+		       (* stackLimit
+			*   = stackBottom + currentThread->stack->reserved
+			*                 - 2 * maxFrameSize
+			*)
+		       Assembly.instruction_mov
+		       {dst = stackLimit,
+			src = stackBottom,
+			size = pointerSize},
+		       Assembly.instruction_binal
+		       {oper = Instruction.ADD,
+			dst = stackLimit,
+			src = stack_reserved,
+			size = pointerSize},
+		       Assembly.instruction_binal
+		       {oper = Instruction.SUB,
+			dst = stackLimit,
+			src = maxFrameSize,
+			size = pointerSize},
+		       Assembly.instruction_binal
+		       {oper = Instruction.SUB,
+			dst = stackLimit,
+			src = maxFrameSize,
+			size = pointerSize}],
+		      (* flushing at far transfer *)
+		      (farTransfer MemLocSet.empty
+		       AppendList.empty
+		       (AppendList.single
+			(* jmp *(stackTop - WORD_SIZE) *)
+			(x86.Assembly.instruction_jmp
+			 {target = stackTopMinusWordDeref,
+			  absolute = true}))))
+		   end
+*)
 	        | CCall {args, dstsize,
 			 frameInfo,
 			 func = CFunction.T {mayGC,
@@ -926,176 +1130,219 @@
 					     modifiesStackTop,
 					     name, ...},
 			 return, target}
-		  => let
-			val stackTopMinusWordDeref =
-			   x86MLton.gcState_stackTopMinusWordDerefOperand ()
-			val {dead, ...} =
-			   livenessTransfer {transfer = transfer,
-					     liveInfo = liveInfo}
-			val c_stackP = x86MLton.c_stackPContentsOperand
-			val c_stackPDerefDouble =
-			   x86MLton.c_stackPDerefDoubleOperand
-			val applyFFTemp = x86MLton.applyFFTempContentsOperand
-			val (pushArgs, size_args) =
-			   List.fold
-			   (args, (AppendList.empty, 0),
-			    fn ((arg, size), (assembly_args, size_args)) =>
-			    (AppendList.append
-			     (if Size.eq (size, Size.DBLE)
-				 then AppendList.fromList
-				    [Assembly.instruction_binal
-				     {oper = Instruction.SUB,
-				      dst = c_stackP,
-				      src = Operand.immediate_const_int 8,
+		=> let
+		     val stackTopMinusWordDeref
+		       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
+		     val {dead, ...}
+		       = livenessTransfer {transfer = transfer,
+					   liveInfo = liveInfo}
+		     val c_stackP = x86MLton.c_stackPContentsOperand
+		     val c_stackPDerefDouble = x86MLton.c_stackPDerefDoubleOperand
+		     val applyFFTemp = x86MLton.applyFFTempContentsOperand
+		       
+		     val (pushArgs, size_args)
+		       = List.fold
+		         (args, (AppendList.empty, 0),
+			  fn ((arg, size), (assembly_args, size_args)) =>
+			  (AppendList.append
+			   (if Size.eq (size, Size.DBLE)
+			      then AppendList.fromList
+			   	   [Assembly.instruction_binal
+				    {oper = Instruction.SUB,
+				     dst = c_stackP,
+				     src = Operand.immediate_const_int 8,
+				     size = pointerSize},
+				    Assembly.instruction_pfmov
+				    {src = arg,
+				     dst = c_stackPDerefDouble,
+				     size = size}]
+			    else if Size.eq (size, Size.BYTE)
+			      then AppendList.fromList
+			           [Assembly.instruction_movx
+				    {oper = Instruction.MOVZX,
+				     dst = applyFFTemp,
+				     src = arg,
+				     dstsize = wordSize,
+				     srcsize = size},
+				    Assembly.instruction_ppush
+				    {src = applyFFTemp,
+				     base = c_stackP,
+				     size = wordSize}]
+			    else AppendList.single
+				 (Assembly.instruction_ppush
+				  {src = arg,
+				   base = c_stackP,
+				   size = size}),
+				 assembly_args),
+			   (Size.toBytes size) + size_args))
+		     val flush 
+		       = if mayGC orelse maySwitchThreads
+			   then (* Entering runtime *)
+			        let
+				  val return = valOf return
+				  val _ = enque return
+				    
+				  val stackTop 
+				    = x86MLton.gcState_stackTopContentsOperand ()
+				  val stackTopMinusWordDeref'
+				    = x86MLton.gcState_stackTopMinusWordDeref ()
+				  val stackTopMinusWordDeref
+				    = x86MLton.gcState_stackTopMinusWordDerefOperand ()
+				  val FrameInfo.T {size, ...} = valOf frameInfo
+				  val bytes = x86.Operand.immediate_const_int size
+				    
+				  val live 
+				    = x86Liveness.LiveInfo.getLive(liveInfo, return)
+				in
+				  (runtimeTransfer (LiveSet.toMemLocSet live)
+				   (AppendList.fromList
+				    [(* stackTop += bytes *)
+				     x86.Assembly.instruction_binal 
+				     {oper = x86.Instruction.ADD,
+				      dst = stackTop,
+				      src = bytes, 
 				      size = pointerSize},
-				     Assembly.instruction_pfmov
-				     {src = arg,
-				      dst = c_stackPDerefDouble,
-				      size = size}]
-			      else if Size.eq (size, Size.BYTE)
-				      then AppendList.fromList
-					 [Assembly.instruction_movx
-					  {oper = Instruction.MOVZX,
-					   dst = applyFFTemp,
-					   src = arg,
-					   dstsize = wordSize,
-					   srcsize = size},
-					  Assembly.instruction_ppush
-					  {src = applyFFTemp,
-					   base = c_stackP,
-					   size = wordSize}]
-				   else AppendList.single
-				      (Assembly.instruction_ppush
-				       {src = arg,
-					base = c_stackP,
-					size = size}),
-				      assembly_args),
-				 (Size.toBytes size) + size_args))
-			val flush =
-			   if not mayGC
-			      then
-				 AppendList.single
-				 (Assembly.directive_force
-				  {commit_memlocs = MemLocSet.empty,
-				   commit_classes = ccallflushClasses,
-				   remove_memlocs = MemLocSet.empty,
-				   remove_classes = ClassSet.empty,
-				   dead_memlocs = LiveSet.toMemLocSet dead,
-				   dead_classes = ClassSet.empty})
-			   else
-			      let
-				 val return = valOf return
-				 val _ = enque return
-				 val FrameInfo.T {size, ...} = valOf frameInfo
-				 val stackTop' =
-				    x86MLton.gcState_stackTopContents ()
-				 val stackTop =
-				    x86MLton.gcState_stackTopContentsOperand ()
-				 val bytes =
-				    x86.Operand.immediate_const_int size
-				 val live =
-				    x86Liveness.LiveInfo.getLive
-				    (liveInfo, return)
-				 val target = Label.fromString name
-			      in
-				 AppendList.fromList
-				 [x86.Assembly.directive_force
-				  {commit_memlocs = MemLocSet.empty,
-				   commit_classes = ClassSet.empty,
-				   remove_memlocs = MemLocSet.empty,
-				   remove_classes = ClassSet.empty,
-				   dead_memlocs = LiveSet.toMemLocSet dead,
-				   dead_classes = ClassSet.empty},
-				  (* stackTop += bytes *)
-				  x86.Assembly.instruction_binal 
-				  {oper = x86.Instruction.ADD,
-				   dst = stackTop,
-				   src = bytes, 
-				   size = pointerSize},
-				  (* *(stackTop - WORD_SIZE) = return *)
-				  x86.Assembly.instruction_mov
-				  {dst = stackTopMinusWordDeref,
-				   src = Operand.immediate_label return,
-				   size = pointerSize},
-				  Assembly.directive_force
-				  {commit_memlocs = LiveSet.toMemLocSet live,
-				   commit_classes = runtimeClasses,
-				   remove_memlocs = MemLocSet.empty,
-				   remove_classes = ClassSet.empty,
-				   dead_memlocs = MemLocSet.empty,
-				   dead_classes = ClassSet.empty}]
-			      end
-			val kill =
-			   AppendList.single
-			   (Assembly.directive_force
-			    {commit_memlocs = MemLocSet.empty,
-			     commit_classes = ClassSet.empty,
-			     remove_memlocs = MemLocSet.empty,
-			     remove_classes = ClassSet.empty,
-			     dead_memlocs = MemLocSet.empty,
-			     dead_classes = if mayGC
-					       then runtimeClasses
-					    else ccallflushClasses})
-			val call =
-			   AppendList.fromList
-			   [Assembly.directive_ccall (),
-			    Assembly.instruction_call
-			    {target = Operand.label target,
-			     absolute = false}]
-			val getResult =
-			   case dstsize of
-			      NONE => AppendList.empty
-			    | SOME dstsize =>
-				 (case Size.class dstsize of
-				     Size.INT =>
-					AppendList.single
-					(Assembly.directive_return
-					 {memloc =
-					  x86MLton.cReturnTempContents dstsize})
-				   | Size.FLT =>
-					AppendList.single
-					(Assembly.directive_fltreturn
-					 {memloc = x86MLton.cReturnTempContents dstsize})
+				     (* *(stackTop - WORD_SIZE) = return *)
+				     x86.Assembly.instruction_mov
+				     {dst = stackTopMinusWordDeref,
+				      src = Operand.immediate_label return,
+				      size = pointerSize},
+				     x86.Assembly.directive_force
+				     {commit_memlocs = MemLocSet.singleton 
+				      stackTopMinusWordDeref',
+				      commit_classes = ClassSet.empty,
+				      remove_memlocs = MemLocSet.empty,
+				      remove_classes = ClassSet.empty,
+				      dead_memlocs = MemLocSet.empty,
+				      dead_classes = ClassSet.empty}])
+				   (AppendList.single
+				    (Assembly.directive_force
+				     {commit_memlocs = LiveSet.toMemLocSet live,
+				      commit_classes = runtimeClasses,
+				      remove_memlocs = MemLocSet.empty,
+				      remove_classes = ClassSet.empty,
+				      dead_memlocs = MemLocSet.empty,
+				      dead_classes = ClassSet.empty})))
+				end
+			   else AppendList.single
+			        (Assembly.directive_force
+				 {commit_memlocs = let
+						     val s = MemLocSet.empty
+						     val s = if modifiesFrontier
+							       then MemLocSet.add
+								    (s, frontier ())
+							       else s
+						     val s = if modifiesStackTop
+							       then MemLocSet.add
+								    (s, stackTop ())
+							       else s
+						   in
+						     s
+						   end,
+				  commit_classes = ccallflushClasses,
+				  remove_memlocs = MemLocSet.empty,
+				  remove_classes = ClassSet.empty,
+				  dead_memlocs = LiveSet.toMemLocSet dead,
+				  dead_classes = ClassSet.empty})
+		     val call 
+		       = AppendList.fromList
+		         [Assembly.directive_ccall (),
+			  Assembly.instruction_call
+			  {target = Operand.label target,
+			   absolute = false}]
+		     val kill
+		       = if mayGC orelse maySwitchThreads
+			   then AppendList.single
+			        (Assembly.directive_force
+				 {commit_memlocs = MemLocSet.empty,
+				  commit_classes = ClassSet.empty,
+				  remove_memlocs = MemLocSet.empty,
+				  remove_classes = ClassSet.empty,
+				  dead_memlocs = MemLocSet.empty,
+				  dead_classes = runtimeClasses})
+			   else AppendList.single
+			        (Assembly.directive_force
+				 {commit_memlocs = MemLocSet.empty,
+				  commit_classes = ClassSet.empty,
+				  remove_memlocs = MemLocSet.empty,
+				  remove_classes = ClassSet.empty,
+				  dead_memlocs = let
+						   val s = MemLocSet.empty
+						   val s = if modifiesFrontier
+							     then MemLocSet.add
+							          (s, frontier ())
+							     else s
+						   val s = if modifiesStackTop
+							     then MemLocSet.add
+							          (s, stackTop ())
+							     else s
+						 in
+						   s
+						 end,
+				  dead_classes = ccallflushClasses})
+		     val getResult
+		       = case dstsize
+			   of NONE => AppendList.empty
+			    | SOME dstsize
+			    => (case Size.class dstsize
+				  of Size.INT
+				   => AppendList.single
+				      (Assembly.directive_return
+				       {memloc = MemLoc.cReturnTempContents dstsize})
+				   | Size.FLT 
+				   => AppendList.single
+				      (Assembly.directive_fltreturn
+				       {memloc = MemLoc.cReturnTempContents dstsize})
 				   | _ => Error.bug "CCall")
-			val fixCStack =
-			   if size_args > 0
-			      then (AppendList.single
-				    (Assembly.instruction_binal
-				     {oper = Instruction.ADD,
-				      dst = c_stackP,
-				      src = Operand.immediate_const_int size_args,
-				      size = pointerSize}))
+		     val fixCStack 
+		       = if size_args > 0
+			   then (AppendList.single
+				 (Assembly.instruction_binal
+				  {oper = Instruction.ADD,
+				   dst = c_stackP,
+				   src = Operand.immediate_const_int size_args,
+				   size = pointerSize}))
 			   else AppendList.empty
-			val continue =
-			   if mayGC
-			      then
-				 (* flushing at far transfer *)
-				 (farTransfer MemLocSet.empty
-				  AppendList.empty
-				  (AppendList.single
-				   (* jmp *(stackTop - WORD_SIZE) *)
-				   (x86.Assembly.instruction_jmp
-				    {target = stackTopMinusWordDeref,
-				     absolute = true})))
-			   else
-			      case return of
-				 NONE => AppendList.empty
-			       | SOME l =>
-				    fall gef {label = l,
+		     val continue
+		       = if maySwitchThreads
+			   then (* Returning from runtime *)
+			        (farTransfer MemLocSet.empty
+				 AppendList.empty
+				 (AppendList.single
+				  (* jmp *(stackTop - WORD_SIZE) *)
+				  (x86.Assembly.instruction_jmp
+				   {target = stackTopMinusWordDeref,
+				    absolute = true})))
+			 else case return
+				of NONE => AppendList.empty
+				 | SOME l => (if mayGC
+						then (* Don't need to trampoline,
+						      * since didn't switch threads,
+						      * but can't fall because
+						      * frame layout data is prefixed
+						      * to l's code; use fallNone
+						      * to force a jmp with near
+						      * jump assumptions.
+						      *)
+						     fallNone
+						else fall)
+				             gef 
+					     {label = l,
 					      live = getLive (liveInfo, l)}
-		     in
-			AppendList.appends
-			[cacheEsp (),
-			 pushArgs,
-			 flush,
-			 call,
-			 kill,
-			 getResult,
-			 fixCStack,
-			 unreserveEsp (),
-			 continue]
-		     end)
-        fun effectJumpTable (gef as GEF {generate,effect,fall})
+		   in
+		     AppendList.appends
+		     [cacheEsp (),
+		      pushArgs,
+		      flush,
+		      call,
+		      kill,
+		      getResult,
+		      fixCStack,
+		      unreserveEsp (),
+		      continue]
+		   end)
+
+        and effectJumpTable (gef as GEF {generate,effect,fall})
 	                     {label, transfer} : Assembly.t AppendList.t
 	  = case transfer
 	      of Switch {test, cases, default}
@@ -1480,7 +1727,7 @@
 		                    {label = label,
 				     transfer = transfer}
 
-	fun fallNone (gef as GEF {generate,effect,fall})
+	and fallNone (gef as GEF {generate,effect,fall})
 	             {label, live} : Assembly.t AppendList.t
 	  = let
 	      val liveRegsTransfer = getLiveRegsTransfers
@@ -1553,10 +1800,10 @@
 		     default ())
 	    end
 
-	datatype z = datatype x86JumpInfo.status
-	fun fallDefault (gef as GEF {generate,effect,fall})
+	and fallDefault (gef as GEF {generate,effect,fall})
 	                {label, live} : Assembly.t AppendList.t
-	  = let
+	  = let	
+	      datatype z = datatype x86JumpInfo.status
 	      val liveRegsTransfer = getLiveRegsTransfers
 		                     (liveTransfers, label)
 	      val liveFltRegsTransfer = getLiveFltRegsTransfers



1.10      +7 -1      mlton/mlton/codegen/x86-codegen/x86-jump-info.fun

Index: x86-jump-info.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-jump-info.fun,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- x86-jump-info.fun	6 Jul 2002 17:22:06 -0000	1.9
+++ x86-jump-info.fun	11 Jul 2002 02:16:49 -0000	1.10
@@ -65,7 +65,13 @@
 	       | Entry.Func {label, ...} => forceNear (jumpInfo, label)
 	       | Entry.Cont {label, ...} => forceNear (jumpInfo, label)
 	       | Entry.Handler {label, ...} => forceNear (jumpInfo, label)
-	       | Entry.CReturn {label, ...} => ();
+	       | Entry.CReturn {label, 
+				func = Runtime.CFunction.T {maySwitchThreads, 
+							    ...}, 
+				...} 
+	       => if maySwitchThreads
+		    then forceNear (jumpInfo, label)
+		    else ();
 	    List.foreach
 	    (Transfer.nearTargets transfer,
 	     fn label 



1.11      +12 -18    mlton/mlton/codegen/x86-codegen/x86-live-transfers.fun

Index: x86-live-transfers.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-live-transfers.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- x86-live-transfers.fun	6 Jul 2002 17:22:06 -0000	1.10
+++ x86-live-transfers.fun	11 Jul 2002 02:16:49 -0000	1.11
@@ -261,7 +261,7 @@
 				 of Entry.Func _ => label::funcs
 				  | _ => funcs
 		 in
-		   (labels, funcs)
+	   (labels, funcs)
 		 end)
 
 	val labels = Vector.fromList labels
@@ -273,13 +273,7 @@
 	     fn label
 	      => let
 		   val {block, ...} = getInfo label
-		   fun doit' target
-		     = let
-			 val {pred = pred', ...} = getInfo target
-		       in
-			 List.push (pred', label)
-		       end
-		   fun doit'' target
+		   fun doit target
 		     = let
 			 val {pred = pred', ...} = getInfo target
 		       in
@@ -291,26 +285,26 @@
 		 in
 		   case transfer
 		     of Goto {target, ...} 
-		      => doit' target
+		      => doit target
 		      | Iff {truee, falsee, ...} 
-		      => (doit' truee; 
-			  doit' falsee)
+		      => (doit truee; 
+			  doit falsee)
 		      | Switch {cases, default, ...}
-		      => (doit' default;
-			  Transfer.Cases.foreach(cases, doit'))
+		      => (doit default;
+			  Transfer.Cases.foreach(cases, doit))
 		      | Tail {...}
 		      => ()
 		      | NonTail {return, handler, ...}
-		      => (doit'' return;
+		      => (doit return;
 			  case handler 
-			    of SOME handler => doit'' handler
+			    of SOME handler => doit handler
 			     | NONE => ())
 		      | Return {...}
 		      => ()
 		      | Raise {...}
 		      => ()
 		      | CCall {return, ...}
-		      => Option.app (return, doit')
+		      => Option.app (return, doit)
 		 end)
 
 	val _
@@ -928,8 +922,8 @@
 		       => ()
 		       | CCall {func, return, ...}
 		       => if CFunction.mayGC func
-			     then Option.app (return, doit'')
-			  else Option.app (return, doit')
+			    then Option.app (return, doit'')
+			    else Option.app (return, doit')
 		  end
 	    in
 	      case !defed



1.12      +4 -2      mlton/mlton/codegen/x86-codegen/x86-loop-info.fun

Index: x86-loop-info.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-loop-info.fun,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- x86-loop-info.fun	6 Jul 2002 17:22:06 -0000	1.11
+++ x86-loop-info.fun	11 Jul 2002 02:16:49 -0000	1.12
@@ -112,8 +112,10 @@
 		      => ()
 		      | Raise {...}
 		      => ()
-		      | CCall {return, ...}
-		      => Option.app (return, doit')
+		      | CCall {return, func, ...}
+		      => Option.app (return, if Runtime.CFunction.mayGC func
+					       then doit''
+					       else doit')
 		 end)
 
 	val lf = Graph.loopForestSteensgaard (G, {root = root})



1.2       +12 -48    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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- x86-mlton-basic.fun	6 Jul 2002 17:22:06 -0000	1.1
+++ x86-mlton-basic.fun	11 Jul 2002 02:16:49 -0000	1.2
@@ -16,17 +16,17 @@
   (*
    * x86.Size.t equivalents
    *)
-  val wordSize = Size.LONG
-  val wordBytes = Size.toBytes wordSize
-  val wordScale = Scale.Four
-  val pointerSize = Size.LONG
-  val pointerBytes = Size.toBytes pointerSize
-  val pointerScale = Scale.Four
+  val wordBytes = Runtime.wordSize
+  val wordSize = Size.fromBytes wordBytes
+  val wordScale = Scale.fromBytes wordBytes
+  val pointerBytes = Runtime.pointerSize
+  val pointerSize = Size.fromBytes pointerBytes
+  val pointerScale = Scale.fromBytes pointerBytes
   val floatSize = Size.DBLE
   val floatBytes = Size.toBytes floatSize
-  val objectHeaderBytes = wordBytes
+  val normalHeaderBytes = Runtime.normalHeaderSize
   val arrayHeaderBytes = Runtime.arrayHeaderSize
-  val intInfOverheadBytes = arrayHeaderBytes + wordBytes
+  val intInfOverheadBytes = Runtime.intInfOverheadSize
    
   local
     open Machine.Type
@@ -62,12 +62,12 @@
 	val Locals = new "Locals"
 	val Globals = new "Globals"
 	  
-	val Temp = MemLoc.Class.Temp
+	val Temp = MemLoc.Class.Temp	
+	val StaticTemp = MemLoc.Class.StaticTemp
 	val CStack = MemLoc.Class.CStack
 	val Code = MemLoc.Class.Code
 	  
 	val CStatic = new "CStatic"
-	val StaticTemp = new "StaticTemp"
 	val StaticNonTemp = new "StaticNonTemp"
 
 	val GCState = new "GCState"
@@ -94,10 +94,10 @@
 		     Locals::
 		     Globals::
 		     Temp::
+		     StaticTemp::
 		     CStack::
 		     Code::
 		     CStatic::
-		     StaticTemp::
 		     StaticNonTemp::
 		     GCState::
 		     GCStateHold::
@@ -154,16 +154,7 @@
 	  end
     end
 
-  (*
-   * Static memory locations
-   *)
-  fun makeContents {base, size, class}
-    = MemLoc.imm {base = base,
-		  index = Immediate.const_int 0,
-		  scale = wordScale,
-		  size = size,
-		  class = class}
-
+  val makeContents = x86.MemLoc.makeContents
   val c_stackP = Label.fromString "c_stackP"
   val c_stackPContents 
     = makeContents {base = Immediate.label c_stackP,
@@ -187,33 +178,6 @@
 		     class = Classes.CStack}
   val c_stackPDerefDoubleOperand
     = Operand.memloc c_stackPDerefDouble
-
-  local
-    open Machine.Type
-    val cReturnTempBYTE = Label.fromString "cReturnTempB"
-    val cReturnTempBYTEContents 
-      = makeContents {base = Immediate.label cReturnTempBYTE,
-		      size = x86.Size.BYTE,
-		      class = Classes.StaticTemp}
-    val cReturnTempDBLE = Label.fromString "cReturnTempD"
-    val cReturnTempDBLEContents 
-      = makeContents {base = Immediate.label cReturnTempDBLE,
-		      size = x86.Size.DBLE,
-		      class = Classes.StaticTemp}
-    val cReturnTempLONG = Label.fromString "cReturnTempL"
-    val cReturnTempLONGContents 
-      = makeContents {base = Immediate.label cReturnTempLONG,
-		      size = x86.Size.LONG,
-		      class = Classes.StaticTemp}
-  in
-    fun cReturnTempContents size
-      = case size
-	  of x86.Size.BYTE => cReturnTempBYTEContents
-	   | x86.Size.DBLE => cReturnTempDBLEContents
-	   | x86.Size.LONG => cReturnTempLONGContents
-	   | _ => Error.bug "cReturnTempContents: size"
-    val cReturnTempContentsOperand = Operand.memloc o cReturnTempContents
-  end
 
   val intInfTemp = Label.fromString "intInfTemp"
   val intInfTempContents 



1.12      +4 -14     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.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- x86-mlton-basic.sig	6 Jul 2002 17:22:06 -0000	1.11
+++ x86-mlton-basic.sig	11 Jul 2002 02:16:49 -0000	1.12
@@ -25,13 +25,13 @@
     (*
      * x86.Size.t equivalents
      *)
-    val wordSize : x86.Size.t
     val wordBytes : int
+    val wordSize : x86.Size.t
     val wordScale : x86.Scale.t
-    val pointerSize : x86.Size.t
     val pointerBytes : int
+    val pointerSize : x86.Size.t
     val pointerScale : x86.Scale.t
-    val objectHeaderBytes : int
+    val normalHeaderBytes : int
     val arrayHeaderBytes : int
     val intInfOverheadBytes : int
 
@@ -49,11 +49,11 @@
 	val Globals : x86.MemLoc.Class.t
 
 	val Temp : x86.MemLoc.Class.t
+	val StaticTemp : x86.MemLoc.Class.t
 	val CStack : x86.MemLoc.Class.t
 	val Code : x86.MemLoc.Class.t
 
 	val CStatic : x86.MemLoc.Class.t
-	val StaticTemp : x86.MemLoc.Class.t
 	val StaticNonTemp : x86.MemLoc.Class.t
 	  
 	val GCState : x86.MemLoc.Class.t
@@ -70,21 +70,11 @@
 	val cstaticClasses : x86.ClassSet.t ref
       end
 
-    (*
-     * Static memory locations
-     *)
-    val makeContents : {base: x86.Immediate.t,
-			size: x86.Size.t,
-			class: x86.MemLoc.Class.t} -> x86.MemLoc.t
     (* CStack locations *)
     val c_stackPContents : x86.MemLoc.t
     val c_stackPContentsOperand : x86.Operand.t
     val c_stackPDerefOperand : x86.Operand.t
     val c_stackPDerefDoubleOperand : x86.Operand.t
-
-    (* CReturn locations *)
-    val cReturnTempContents : x86.Size.t -> x86.MemLoc.t
-    val cReturnTempContentsOperand : x86.Size.t -> x86.Operand.t
 
     (* Static temps defined in x86codegen.h *)
     val applyFFTempContentsOperand : x86.Operand.t



1.35      +6 -7      mlton/mlton/codegen/x86-codegen/x86-mlton.fun

Index: x86-mlton.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.fun,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- x86-mlton.fun	6 Jul 2002 17:22:06 -0000	1.34
+++ x86-mlton.fun	11 Jul 2002 02:16:49 -0000	1.35
@@ -746,7 +746,7 @@
 			 val (dst,dstsize) = getDst ()
 
 			 val memloc
-			   = makeContents 
+			   = x86.MemLoc.makeContents 
 			     {base = Immediate.label (Label.fromString s),
 			      size = dstsize,
 			      class = Classes.CStatic}
@@ -1424,7 +1424,7 @@
 	       label: x86.Label.t, 
 	       transInfo as {live, liveInfo, ...}: transInfo}
     = let
-	 val name = CFunction.name func
+	val name = CFunction.name func
 	fun getDst ()
 	  = case dst
 	      of SOME dst => dst
@@ -1432,7 +1432,7 @@
 	fun default ()
 	  = let
 	      val _ = x86Liveness.LiveInfo.setLiveOperands
-	              (liveInfo, label, live label)
+		      (liveInfo, label, live label)
 	    in 
 	      AppendList.single
 	      (x86.Block.T'
@@ -1449,11 +1449,10 @@
 	      then (AppendList.single
 		    (x86.Block.T' {entry = NONE,
 				   profileInfo = x86.ProfileInfo.none,
-				   statements 
-				   = [x86.Assembly.comment 
-				      ("end creturn: " ^ name)],
+				   statements = [x86.Assembly.comment 
+						 ("end creturn: " ^ name)],
 				   transfer = NONE}))
-	    else AppendList.empty
+	      else AppendList.empty
       in
 	AppendList.appends [default (), comment_end]
       end



1.12      +8 -0      mlton/mlton/codegen/x86-codegen/x86-pseudo.sig

Index: x86-pseudo.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-pseudo.sig,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- x86-pseudo.sig	6 Jul 2002 17:22:06 -0000	1.11
+++ x86-pseudo.sig	11 Jul 2002 02:16:50 -0000	1.12
@@ -25,6 +25,7 @@
 	  = BYTE | WORD | LONG 
 	  | SNGL | DBLE | EXTD
 	  | FPIS | FPIL | FPIQ
+	val fromBytes : int -> t
 	val toBytes : t -> int
 	val class : t -> class
 	val eq : t * t -> bool
@@ -80,6 +81,7 @@
 	    type t
 	    val new : {name: string} -> t
 	    val Temp : t
+	    val StaticTemp : t
 	    val CStack : t
 	    val Code : t
 
@@ -111,6 +113,12 @@
 	  
 	val class : t -> Class.t
 	val compare : t * t -> order
+	(*
+	 * Static memory locations
+	 *)
+	val makeContents : {base: Immediate.t,
+			    size: Size.t,
+			    class: Class.t} -> t
       end
 
     structure ClassSet : SET



1.22      +0 -8      mlton/mlton/codegen/x86-codegen/x86-simplify.fun

Index: x86-simplify.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-simplify.fun,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- x86-simplify.fun	6 Jul 2002 17:22:06 -0000	1.21
+++ x86-simplify.fun	11 Jul 2002 02:16:50 -0000	1.22
@@ -2511,14 +2511,6 @@
 				             (cases,
 					      fn target => update target),
 			             default = update default}
-	         | Transfer.CCall {args, dstsize, frameInfo, func, return,
-				   target}
-	         => Transfer.CCall {args = args,
-				    dstsize = dstsize,
-				    frameInfo = frameInfo,
-				    func = func,
-				    return = Option.map (return, update),
-				    target = target}
 	         | transfer => transfer
 
 	    val blocks



1.26      +13 -57    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.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- x86-translate.fun	6 Jul 2002 17:22:06 -0000	1.25
+++ x86-translate.fun	11 Jul 2002 02:16:50 -0000	1.26
@@ -15,7 +15,7 @@
 
   val wordBytes = x86MLton.wordBytes
   val pointerBytes = x86MLton.pointerBytes
-  val objectHeaderBytes = x86MLton.objectHeaderBytes
+  val normalHeaderBytes = x86MLton.normalHeaderBytes
   val arrayHeaderBytes = x86MLton.arrayHeaderBytes
   val intInfOverheadBytes = x86MLton.intInfOverheadBytes
 
@@ -96,7 +96,7 @@
 	   => x86.Operand.immediate_const_word w
 	   | IntInf ii
 	   => x86.Operand.immediate_const_word ii
-	   | File => x86MLton.fileLine ()
+	   | File => x86MLton.fileName
 	   | Float f
 	     => Error.bug "toX86Operand: Float, unimplemented"
 	   | GCState => x86.Operand.label x86MLton.gcState_label
@@ -234,10 +234,7 @@
       val toX86Operand 
 	= fn operand => (toX86Operand operand)
 	                handle exn
-			 => Error.bug ("x86Translate.Operand.toX86Operand::" ^ 
-				       (case exn
-					  of Fail s => s
-					   | _ => "?"))
+			 => Error.reraise (exn, "x86Translate.Operand.toX86Operand")
     end
 
   type transInfo = x86MLton.transInfo
@@ -559,7 +556,7 @@
 		   val frontierPlusOHW
 		     = (x86.Operand.memloc o x86.MemLoc.simple)
 		       {base = x86MLton.gcState_frontierContents (), 
-			index = x86.Immediate.const_int objectHeaderBytes,
+			index = x86.Immediate.const_int normalHeaderBytes,
 			scale = x86.Scale.One,
 			size = x86MLton.pointerSize,
 			class = x86MLton.Classes.Heap}
@@ -606,8 +603,7 @@
 		      = ((* *(frontier) = header *)
 			 x86.Assembly.instruction_mov 
 			 {dst = frontierDeref,
-			  src = (x86.Operand.immediate
-				 (x86.Immediate.const_word header)),
+			  src = x86.Operand.immediate_const_word header,
 			  size = x86MLton.pointerSize})::
 		        ((* dst = frontier + objectHeaderSize *)
 			 x86.Assembly.instruction_lea
@@ -615,50 +611,19 @@
 			  src = frontierPlusOHW,
 			  size = x86MLton.pointerSize})::
 			(Vector.foldr(stores,
-				      [(* frontier += objectHeaderSize + size *)
+				      [(* frontier += size *)
 				       x86.Assembly.instruction_binal
 				       {oper = x86.Instruction.ADD,
 					dst = frontier,
-					src = (x86.Operand.immediate_const_int
-					       size),
+					src = x86.Operand.immediate_const_int size,
 					size = x86MLton.pointerSize}],
 				      stores_toX86Assembly)),
-(*
-		      = List.concat
-		        [[(* *(frontier) 
-			   *    = gcObjectHeader(numWordsNonPointers, 
-			   *                     numPointers)
-			   *)
-			  x86.Assembly.instruction_mov 
-			  {dst = frontierDeref,
-			   src = gcObjectHeaderWord,
-			   size = x86MLton.pointerSize},
-			  (* dst = frontier + objectHeaderSize *)
-			  x86.Assembly.instruction_lea
-			  {dst = dst,
-			   src = frontierPlusOHW,
-			   size = x86MLton.pointerSize}],
-			 (Vector.foldr(stores,
-				       [],
-				       stores_toX86Assembly)),
-			 [(* frontier += objectHeaderSize + size *)
-			  x86.Assembly.instruction_binal
-			  {oper = x86.Instruction.ADD,
-			   dst = frontier,
-			   src = x86.Operand.immediate_const_int 
-			         (objectHeaderSize + size),
-			   size = x86MLton.pointerSize}]],
-*)
 		      transfer = NONE}),
 		    comment_end]
-		 end
+		 end)
 	  handle exn
-	   => Error.bug (concat ["x86Translate.Statement.toX86Blocks::",
-				 Layout.toString (layout statement),
-				 "::",
-				 (case exn
-				     of Fail s => s
-				   | _ => "?")]))
+	   => Error.reraise (exn, concat ["x86Translate.Statement.toX86Blocks::",
+					  Layout.toString (layout statement)])
     end
 
   structure Transfer =
@@ -984,10 +949,7 @@
 					      => x86.MemLocSet.add(live, memloc)
 					      | NONE => live)})}))))
 	  handle exn
-	   => Error.bug ("x86Translate.Transfer.toX86Blocks::" ^ 
-			 (case exn
-			    of Fail s => s
-			     | _ => "?"))
+	   => Error.reraise (exn, "x86Translate.Transfer.toX86Blocks")
     end
 
   structure Block =
@@ -1080,10 +1042,7 @@
 	    blocks
 	  end
 	  handle exn
-	   => Error.bug ("x86Translate.Block.toX86Blocks::" ^ 
-			 (case exn
-			    of Fail s => s
-			     | _ => "?"))
+	   => Error.reraise (exn, "x86Translate.Block.toX86Blocks")
     end
 
   structure Chunk =
@@ -1127,10 +1086,7 @@
 	    x86.Chunk.T {data = data, blocks = x86Blocks}
 	  end
 	  handle exn
-	   => Error.bug ("x86Translate.Chunk.toX86Chunk::" ^ 
-			 (case exn
-			    of Fail s => s
-			     | _ => "?"))
+	   => Error.reraise (exn, "x86Translate.Chunk.toX86Chunk")
     end
 
   structure Program =



1.29      +56 -8     mlton/mlton/codegen/x86-codegen/x86.fun

Index: x86.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.fun,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- x86.fun	6 Jul 2002 17:22:06 -0000	1.28
+++ x86.fun	11 Jul 2002 02:16:50 -0000	1.29
@@ -111,6 +111,11 @@
 	  end
       val toString' = Layout.toString o layout'
 	    
+      val fromBytes : int -> t
+	= fn 1 => BYTE
+	   | 2 => WORD
+	   | 4 => LONG
+	   | _ => Error.bug "Size.fromBytes"
       val toBytes : t -> int
 	= fn BYTE => 1
 	   | WORD => 2
@@ -759,6 +764,7 @@
 	  val mayAlias = eq
 
 	  val Temp = new {name = "Temp"}
+	  val StaticTemp = new {name = "StaticTemp"}
 	  val CStack = new {name = "CStack"}
 	  val Code = new {name = "Code"}
 	end
@@ -1171,6 +1177,42 @@
 				      size = size,
 				      class = Class.Temp})
       end
+
+      (*
+       * Static memory locations
+       *)
+      fun makeContents {base, size, class}
+	= imm {base = base,
+	       index = Immediate.const_int 0,
+	       scale = Scale.Four,
+	       size = size,
+	       class = class}
+      local
+	open Runtime.Type
+	val cReturnTempBYTE = Label.fromString "cReturnTempB"
+	val cReturnTempBYTEContents 
+	  = makeContents {base = Immediate.label cReturnTempBYTE,
+			  size = Size.BYTE,
+			  class = Class.StaticTemp}
+	val cReturnTempDBLE = Label.fromString "cReturnTempD"
+	val cReturnTempDBLEContents 
+	  = makeContents {base = Immediate.label cReturnTempDBLE,
+			  size = Size.DBLE,
+			  class = Class.StaticTemp}
+	val cReturnTempLONG = Label.fromString "cReturnTempL"
+	val cReturnTempLONGContents 
+	  = makeContents {base = Immediate.label cReturnTempLONG,
+			  size = Size.LONG,
+			  class = Class.StaticTemp}
+      in
+	fun cReturnTempContents size
+	  = case size
+	      of Size.BYTE => cReturnTempBYTEContents
+	       | Size.DBLE => cReturnTempDBLEContents
+	       | Size.LONG => cReturnTempLONGContents
+	       | _ => Error.bug "cReturnTempContents: size"
+      end
+
     end
 
   local
@@ -3630,8 +3672,9 @@
       val layout = Layout.str o toString
 
       val uses_defs_kills
-	= fn CReturn {dst = SOME (dst, _), ...} 
-	   => {uses = [], defs = [dst], kills = []}
+	= fn CReturn {dst = SOME (dst, dstsize), ...} 
+	   => {uses = [Operand.memloc (MemLoc.cReturnTempContents dstsize)],
+	       defs = [dst], kills = []}
 	   | _ => {uses = [], defs = [], kills = []}
 	   
       val label
@@ -3655,7 +3698,8 @@
       val creturn = CReturn
 
       val isNear = fn Jump _ => true
-	            | CReturn _ => true
+	            | CReturn {func = CFunction.T {maySwitchThreads, ... }, ...} 
+	            => not maySwitchThreads
 	            | _ => false
     end
 
@@ -4002,9 +4046,12 @@
       val uses_defs_kills
 	= fn Switch {test, cases, default}
 	   => {uses = [test], defs = [], kills = []}
-	   | CCall {args, ...}
+	   | CCall {args, dstsize, ...}
 	   => {uses = List.map(args, fn (oper,_) => oper),
-	       defs = [],
+	       defs = case dstsize 
+			of NONE => []
+			 | SOME dstsize 
+			 => [Operand.memloc (MemLoc.cReturnTempContents dstsize)],
 	       kills = []}
 	   | _ => {uses = [], defs = [], kills = []}
 
@@ -4021,9 +4068,10 @@
 	   | NonTail {return,handler,...} => return::(case handler 
 							of NONE => nil
 							 | SOME handler => [handler])
-	   | CCall {return,...} => (case return of
-				       NONE => []
-				     | SOME l => [l])
+	   | CCall {return, func = CFunction.T {maySwitchThreads, ...}, ...} 
+	   => (case return of
+		 NONE => []
+	       | SOME l => [l])
 	   | _ => []
 
       val live



1.19      +11 -0     mlton/mlton/codegen/x86-codegen/x86.sig

Index: x86.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.sig,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- x86.sig	6 Jul 2002 17:22:06 -0000	1.18
+++ x86.sig	11 Jul 2002 02:16:50 -0000	1.19
@@ -35,6 +35,7 @@
 
 	val toString : t -> string
 	val toString' : t -> string
+	val fromBytes : int -> t
 	val toBytes : t -> int
 	val class : t -> class
 	val toFPI : t -> t
@@ -180,6 +181,7 @@
 
 	    val new : {name: string} -> t
 	    val Temp : t
+	    val StaticTemp : t
 	    val CStack : t
 	    val Code : t
 
@@ -233,6 +235,15 @@
 	val mayAliasOrd : t * t -> order option
 
 	val replace : (t -> t) -> t -> t
+
+	(*
+	 * Static memory locations
+	 *)
+	val makeContents : {base: Immediate.t,
+			    size: Size.t,
+			    class: Class.t} -> t
+	(* CReturn locations *)
+	val cReturnTempContents : Size.t -> t
     end
 
     structure ClassSet : SET



1.3       +11 -1     mlton/runtime/basis/Thread.c

Index: Thread.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Thread.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Thread.c	3 Mar 2002 04:41:10 -0000	1.2
+++ Thread.c	11 Jul 2002 02:16:50 -0000	1.3
@@ -21,5 +21,15 @@
 }
 
 void Thread_setHandler(Thread t) {
- 	gcState.signalHandler = (GC_thread)t;
+	gcState.signalHandler = (GC_thread)t;
+}
+
+void Thread_switchTo(Thread thread) {
+	GC_thread t = (GC_thread)thread;
+	gcState.currentThread->stack->used = gcState.stackTop - gcState.stackBottom;
+	gcState.currentThread = t;
+	gcState.stackBottom = ((pointer)t->stack) + sizeof(struct GC_stack); 
+	gcState.stackTop = gcState.stackBottom + t->stack->used;
+	gcState.stackLimit = 
+	  gcState.stackBottom + t->stack->reserved - 2 * gcState.maxFrameSize;
 }





-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Two, two, TWO treats in one.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel