[MLton-devel] cvs commit: C codegen cleanup

Stephen Weeks sweeks@users.sourceforge.net
Wed, 14 May 2003 13:07:18 -0700


sweeks      03/05/14 13:07:18

  Modified:    include  c-chunk.h
               mlton/backend backend.fun machine.fun machine.sig
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-translate.fun
  Log:
  Added Machine.Operand.{Frontier,StackTop}.  The C codegen uses these
  and doesn't use Machine.Operand.Runtime.  Once the x86 codegen can
  handle offsets from GCState, it won't need to either.  I already
  inserted the two lines needed for the x86 codegen to handle the new
  operands.
  
  Put back in the Cache and Flush statements in the C codegen.

Revision  Changes    Path
1.2       +32 -4     mlton/include/c-chunk.h

Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- c-chunk.h	14 May 2003 02:50:10 -0000	1.1
+++ c-chunk.h	14 May 2003 20:07:13 -0000	1.2
@@ -38,9 +38,11 @@
 
 #define GCState ((Pointer)&gcState)
 #define ExnStack *(Word*)(GCState + ExnStackOffset)
-#define Frontier *(Word*)(GCState + FrontierOffset)
+#define FrontierMem *(Word*)(GCState + FrontierOffset)
+#define Frontier frontier
 #define StackBottom *(Word*)(GCState + StackBottomOffset)
-#define StackTop *(Word*)(GCState + StackTopOffset)
+#define StackTopMem *(Word*)(GCState + StackTopOffset)
+#define StackTop stackTop
 
 #define IsInt(p) (0x3 & (int)(p))
 
@@ -60,6 +62,26 @@
 		if (x) goto l;						\
 	} while (0)
 
+#define FlushFrontier()				\
+	do {					\
+		FrontierMem = Frontier;		\
+	} while (0)
+
+#define FlushStackTop()				\
+	do {					\
+		StackTopMem = StackTop;		\
+	} while (0)
+
+#define CacheFrontier()				\
+	do {					\
+		Frontier = FrontierMem;		\
+	} while (0)
+
+#define CacheStackTop()				\
+	do {					\
+		StackTop = StackTopMem;		\
+	} while (0)
+
 /* ------------------------------------------------- */
 /*                       Chunk                       */
 /* ------------------------------------------------- */
@@ -67,12 +89,16 @@
 #define Chunk(n)				\
 	DeclareChunk(n) {			\
 		struct cont cont;		\
-		int l_nextFun = nextFun;
+		Pointer frontier;		\
+		int l_nextFun = nextFun;	\
+		Pointer stackTop;
 
 #define ChunkSwitch(n)							\
 		if (DEBUG_CCODEGEN)					\
 			fprintf (stderr, "%s:%d: entering chunk %d  l_nextFun = %d\n",	\
-					__FILE__, __LINE__, n, l_nextFun);	\
+					__FILE__, __LINE__, n, l_nextFun);	\	
+		CacheFrontier();					\
+		CacheStackTop();					\
 		while (1) {						\
 		top:							\
 		switch (l_nextFun) {
@@ -83,6 +109,8 @@
 			nextFun = l_nextFun;				\
 			cont.nextChunk = (void*)nextChunks[nextFun];	\
 			leaveChunk:					\
+				FlushFrontier();			\
+				FlushStackTop();			\
 				return cont;				\
 		} /* end switch (l_nextFun) */				\
 		} /* end while (1) */					\



1.52      +10 -6     mlton/mlton/backend/backend.fun

Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- backend.fun	14 May 2003 02:50:10 -0000	1.51
+++ backend.fun	14 May 2003 20:07:15 -0000	1.52
@@ -422,12 +422,16 @@
 				})
 	 end
       fun runtimeOp (field: GCField.t, ty: Type.t): M.Operand.t =
-	 if !Control.Native.native
-	    then M.Operand.Runtime field
-	 else
-	    M.Operand.Offset {base = M.Operand.GCState,
-			      offset = GCField.offset field,
-			      ty = ty}
+	 case field of
+	    GCField.Frontier => M.Operand.Frontier
+	  | GCField.StackTop => M.Operand.StackTop
+	  | _ => 
+	       if !Control.Native.native
+		  then M.Operand.Runtime field
+	       else
+		  M.Operand.Offset {base = M.Operand.GCState,
+				    offset = GCField.offset field,
+				    ty = ty}
       val exnStackOp = runtimeOp (GCField.ExnStack, Type.ExnStack)
       val stackBottomOp = runtimeOp (GCField.StackBottom, Type.Word)
       val stackTopOp = runtimeOp (GCField.StackTop, Type.Word)



1.47      +8 -0      mlton/mlton/backend/machine.fun

Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- machine.fun	14 May 2003 02:50:10 -0000	1.46
+++ machine.fun	14 May 2003 20:07:16 -0000	1.47
@@ -178,6 +178,7 @@
        | Contents of {oper: t,
 		      ty: Type.t}
        | File
+       | Frontier
        | GCState
        | Global of Global.t
        | Int of int
@@ -189,6 +190,7 @@
        | Real of string
        | Runtime of GCField.t
        | StackOffset of StackOffset.t
+       | StackTop
        | Word of Word.t
     
       val rec isLocation =
@@ -222,6 +224,7 @@
 		  seq [str (concat ["C", Type.name ty, " "]),
 		       paren (layout oper)]
 	     | File => str "<File>"
+	     | Frontier => str "<Frontier>"
 	     | GCState => str "<GCState>"
 	     | Global g => Global.layout g
 	     | Int i => Int.layout i
@@ -236,6 +239,7 @@
 	     | Runtime r => GCField.layout r
 	     | SmallIntInf w => seq [str "SmallIntInf ", paren (Word.layout w)]
 	     | StackOffset so => StackOffset.layout so
+	     | StackTop => str "<StackTop>"
 	     | Word w => seq [str "0x", Word.layout w]
 	 end
 
@@ -247,6 +251,7 @@
 	| Char _ => Type.char
 	| Contents {ty, ...} => ty
 	| File => Type.cpointer
+	| Frontier => Type.word
 	| GCState => Type.cpointer
 	| Global g => Global.ty g
 	| Int _ => Type.int
@@ -261,6 +266,7 @@
 	       | _ => Type.fromRuntime (GCField.ty f))
 	| SmallIntInf _ => Type.intInf
 	| StackOffset {ty, ...} => ty
+	| StackTop => Type.word
 	| Word _ => Type.word
 	 
       val rec equals =
@@ -949,6 +955,7 @@
 			    ; Type.equals (Operand.ty oper,
 					   Type.cpointer))
 		      | File => true
+		      | Frontier => true
 		      | GCState => true
 		      | Global _ =>
 			   (* For now, we don't check that globals are
@@ -997,6 +1004,7 @@
 					      | Kind.Jump => true
 					  end
 				     | _ => true)
+		      | StackTop => true
 		      | Word _ => true
 	       in
 		  Err.check ("operand", ok, fn () => Operand.layout x)



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

Index: machine.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.sig,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- machine.sig	10 Apr 2003 02:03:06 -0000	1.34
+++ machine.sig	14 May 2003 20:07:16 -0000	1.35
@@ -67,6 +67,7 @@
 	     | Contents of {oper: t,
 			    ty: Type.t}
 	     | File (* expand by codegen into string constant *)
+	     | Frontier
 	     | GCState
 	     | Global of Global.t
 	     | Int of int
@@ -81,6 +82,7 @@
 	     | SmallIntInf of word
 	     | StackOffset of {offset: int,
 			       ty: Type.t}
+	     | StackTop
 	     | Word of Word.t
 
 	    val equals: t * t -> bool



1.55      +34 -5     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.54
retrieving revision 1.55
diff -u -r1.54 -r1.55
--- c-codegen.fun	14 May 2003 02:50:11 -0000	1.54
+++ c-codegen.fun	14 May 2003 20:07:17 -0000	1.55
@@ -476,6 +476,7 @@
 	     | Contents {oper, ty} =>
 		  concat ["C", Type.name ty, "(", toString oper, ")"]
 	     | File => "__FILE__"
+	     | Frontier => "Frontier"
 	     | GCState => "GCState"
 	     | Global g =>
 		  concat ["G", Type.name (Global.ty g),
@@ -498,6 +499,7 @@
 		  concat ["SmallIntInf", C.args [concat ["0x", Word.toString w]]]
 	     | StackOffset {offset, ty} =>
 		  concat ["S", Type.name ty, "(", C.int offset, ")"]
+	     | StackTop => "StackTop"
 	     | Word w => C.word w
       in
 	 val operandToString = toString
@@ -733,7 +735,10 @@
 			       src = operandToString (Operand.Label return),
 			       srcIsMem = false,
 			       ty = Type.Label return})
-		; C.push (size, print))
+		; C.push (size, print)
+		; if profiling
+		     then print "\tFlushStackTop();\n"
+		  else ())
 	    fun copyArgs (args: Operand.t vector): string list * (unit -> unit) =
 	       if Vector.exists (args,
 				 fn Operand.StackOffset _ => true
@@ -808,7 +813,10 @@
 			   end 
 		      | _ => ()
 		  fun pop (fi: FrameInfo.t) =
-		     C.push (~ (Program.frameSize (program, fi)), print)
+		     (C.push (~ (Program.frameSize (program, fi)), print)
+		      ; if profiling
+			   then print "\tFlushStackTop();\n"
+			else ())
 		  val _ =
 		     case kind of
 			Kind.Cont {frameInfo, ...} => pop frameInfo
@@ -918,7 +926,10 @@
 			end
 		   | CCall {args, frameInfo, func, return} =>
 			let
-			   val {maySwitchThreads, name, returnTy, ...} =
+			   val {maySwitchThreads,
+				modifiesFrontier,
+				modifiesStackTop,
+				name, returnTy, ...} =
 			      CFunction.dest func
 			   val (args, afterCall) =
 			      case frameInfo of
@@ -934,6 +945,16 @@
 				    in
 				       res
 				    end
+			   val _ =
+			      if modifiesFrontier
+				 then print "\tFlushFrontier();\n"
+			      else ()
+			   val _ =
+			      if modifiesStackTop
+				 andalso (Option.isNone frameInfo
+					  orelse not profiling)
+				 then print "\tFlushStackTop();\n"
+			      else ()
 			   val _ = print "\t"
 			   val _ =
 			      case returnTy of
@@ -941,6 +962,14 @@
 			       | SOME t => print (concat [creturn t, " = "])
 			   val _ = C.call (name, args, print)
 			   val _ = afterCall ()
+ 			   val _ =
+			      if modifiesFrontier
+				 then print "\tCacheFrontier();\n"
+			      else ()
+			   val _ =
+			      if modifiesStackTop
+				 then print "\tCacheStackTop();\n"
+			      else ()
 			   val _ =
 			      if maySwitchThreads
 				 then print "\tReturn();\n"
@@ -1062,8 +1091,8 @@
 		print (concat ["#define ", name, " ",
 			       Int.toString (GCField.offset f), "\n"]))
 	 in
-	    outputOffsets ()
-	    ; outputIncludes (["c-chunk.h"], print)
+	    outputIncludes (["c-chunk.h"], print)
+	    ; outputOffsets ()
 	    ; declareFFI ()
 	    ; declareChunks ()
 	    ; declareProfileLabels ()



1.41      +2 -0      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.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- x86-translate.fun	10 Apr 2003 02:03:08 -0000	1.40
+++ x86-translate.fun	14 May 2003 20:07:18 -0000	1.41
@@ -120,6 +120,7 @@
 		  x86.Operand.memloc memloc
 	       end
 	  | File => x86MLton.fileName
+	  | Frontier => x86MLton.gcState_frontierContentsOperand ()
 	  | GCState => x86.Operand.label x86MLton.gcState_label
 	  | Global g => x86.Operand.memloc (Global.toX86MemLoc g)
 	  | Int i => x86.Operand.immediate_const_int i
@@ -193,6 +194,7 @@
 	       in
 		  x86.Operand.memloc memloc
 	       end
+	  | StackTop => x86MLton.gcState_stackTopContentsOperand ()
 	  | Word w => x86.Operand.immediate_const_word w
 	       
       val toX86Operand =





-------------------------------------------------------
Enterprise Linux Forum Conference & Expo, June 4-6, 2003, Santa Clara
The only event dedicated to issues related to Linux enterprise solutions
www.enterpriselinuxforum.com

_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel