[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