[MLton-devel] cvs commit: backend and x86-codegen cleanup
Matthew Fluet
fluet@users.sourceforge.net
Thu, 15 May 2003 07:50:58 -0700
fluet 03/05/15 07:50:58
Modified: mlton/backend backend.fun machine.fun machine.sig
mlton/codegen/c-codegen c-codegen.fun
mlton/codegen/x86-codegen x86-generate-transfers.fun
x86-mlton-basic.fun x86-mlton-basic.sig
x86-pseudo.sig x86-translate.fun x86.sig
Log:
Removed the Machine.Operand.Runtime variant. (Note, the x86-codegen
still needs to know that the offset is from the gcState in order to
correctly assign those memory locations to the GCState class; but, we
should be able to add and remove gcState elements without changing the
codegens.)
Revision Changes Path
1.53 +4 -9 mlton/mlton/backend/backend.fun
Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- backend.fun 14 May 2003 20:07:15 -0000 1.52
+++ backend.fun 15 May 2003 14:50:55 -0000 1.53
@@ -426,12 +426,9 @@
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}
+ 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)
@@ -459,9 +456,7 @@
M.Operand.Word (Runtime.typeIndexToHeader
(PointerTycon.index pt))
| Runtime f =>
- if !Control.Native.native
- then M.Operand.Runtime f
- else runtimeOp (f, R.Operand.ty oper)
+ runtimeOp (f, R.Operand.ty oper)
| SmallIntInf w => M.Operand.SmallIntInf w
| Var {var, ...} => varOperand var
end
1.48 +0 -9 mlton/mlton/backend/machine.fun
Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- machine.fun 14 May 2003 20:07:16 -0000 1.47
+++ machine.fun 15 May 2003 14:50:56 -0000 1.48
@@ -188,7 +188,6 @@
| Offset of {base: t, offset: int, ty: Type.t}
| Register of Register.t
| Real of string
- | Runtime of GCField.t
| StackOffset of StackOffset.t
| StackTop
| Word of Word.t
@@ -200,7 +199,6 @@
| Global _ => true
| Offset _ => true
| Register _ => true
- | Runtime z => true
| StackOffset _ => true
| _ => false
@@ -236,7 +234,6 @@
constrain ty]
| Real s => str s
| Register r => Register.layout r
- | Runtime r => GCField.layout r
| SmallIntInf w => seq [str "SmallIntInf ", paren (Word.layout w)]
| StackOffset so => StackOffset.layout so
| StackTop => str "<StackTop>"
@@ -260,10 +257,6 @@
| Offset {ty, ...} => ty
| Real _ => Type.real
| Register r => Register.ty r
- | Runtime f =>
- (case f of
- GCField.ExnStack => Type.exnStack
- | _ => Type.fromRuntime (GCField.ty f))
| SmallIntInf _ => Type.intInf
| StackOffset {ty, ...} => ty
| StackTop => Type.word
@@ -289,7 +282,6 @@
equals (b, b') andalso i = i'
| (Real s, Real s') => s = s'
| (Register r, Register r') => Register.equals (r, r')
- | (Runtime f, Runtime f') => GCField.equals (f, f')
| (SmallIntInf w, SmallIntInf w') => Word.equals (w, w')
| (StackOffset so, StackOffset so') => StackOffset.equals (so, so')
| (Word w, Word w') => w = w'
@@ -972,7 +964,6 @@
; offsetIsOk z)
| Real _ => true
| Register _ => Alloc.doesDefine (alloc, x)
- | Runtime _ => true
| SmallIntInf w => 0wx1 = Word.andb (w, 0wx1)
| StackOffset {offset, ty, ...} =>
offset + Type.size ty <= maxFrameSize
1.36 +0 -1 mlton/mlton/backend/machine.sig
Index: machine.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.sig,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- machine.sig 14 May 2003 20:07:16 -0000 1.35
+++ machine.sig 15 May 2003 14:50:56 -0000 1.36
@@ -78,7 +78,6 @@
ty: Type.t}
| Real of string
| Register of Register.t
- | Runtime of Runtime.GCField.t
| SmallIntInf of word
| StackOffset of {offset: int,
ty: Type.t}
1.56 +0 -1 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.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- c-codegen.fun 14 May 2003 20:07:17 -0000 1.55
+++ c-codegen.fun 15 May 2003 14:50:56 -0000 1.56
@@ -494,7 +494,6 @@
| Register r =>
concat ["R", Type.name (Register.ty r),
"(", Int.toString (Register.index r), ")"]
- | Runtime _ => Error.bug "C codegen saw Runtime operand"
| SmallIntInf w =>
concat ["SmallIntInf", C.args [concat ["0x", Word.toString w]]]
| StackOffset {offset, ty} =>
1.41 +1 -1 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.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- x86-generate-transfers.fun 28 Apr 2003 15:35:37 -0000 1.40
+++ x86-generate-transfers.fun 15 May 2003 14:50:57 -0000 1.41
@@ -1026,7 +1026,7 @@
| Raise {live}
=> let
val exnStack
- = x86MLton.gcState_currentThread_exnStackContentsOperand ()
+ = x86MLton.gcState_exnStackContentsOperand ()
val stackTopTemp
= x86MLton.stackTopTempContentsOperand ()
val stackTop
1.18 +30 -39 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.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- x86-mlton-basic.fun 14 May 2003 02:50:11 -0000 1.17
+++ x86-mlton-basic.fun 15 May 2003 14:50:57 -0000 1.18
@@ -73,8 +73,6 @@
val GCState = new "GCState"
val GCStateHold = new "GCStateHold"
val GCStateVolatile = new "GCStateVolatile"
-
- val ThreadStack = new "ThreadStack"
end
val allClasses = ref x86.ClassSet.empty
@@ -103,7 +101,6 @@
GCState::
GCStateHold::
GCStateVolatile::
- ThreadStack::
nil)
val _ = livenessClasses :=
@@ -146,7 +143,6 @@
GCState::
GCStateHold::
GCStateVolatile::
- ThreadStack::
nil)
val _ = heapClasses :=
@@ -330,6 +326,21 @@
val gcState_label = Label.fromString "gcState"
structure Field = Runtime.GCField
+ fun make' (offset: int, size, class) =
+ let
+ fun imm () =
+ Immediate.binexp
+ {oper = Immediate.Addition,
+ exp1 = Immediate.label gcState_label,
+ exp2 = Immediate.const_int offset}
+ fun contents () =
+ makeContents {base = imm (),
+ size = size,
+ class = class}
+ fun operand () = Operand.memloc (contents ())
+ in
+ (imm, contents, operand)
+ end
fun make (f: Field.t, size, class) =
let
fun imm () =
@@ -346,43 +357,19 @@
(imm, contents, operand)
end
- val gcState_operand =
- Operand.memloc (makeContents {base = Immediate.label gcState_label,
- size = pointerSize,
- class = Classes.StaticNonTemp})
+ val (_, gcState_exnStackContents,
+ gcState_exnStackContentsOperand) =
+ make (Field.ExnStack, wordSize, Classes.GCState)
- val (_, _, gcState_canHandleContentsOperand) =
- make (Field.CanHandle, wordSize, Classes.GCState)
-
- val (_, _, gcState_cardMapContentsOperand) =
- make (Field.CardMap, wordSize, Classes.GCState)
-
- val (gcState_currentThread, gcState_currentThreadContents,
- gcState_currentThreadContentsOperand) =
- make (Field.CurrentThread, pointerSize, Classes.GCState)
-
- val (_, gcState_frontierContents, gcState_frontierContentsOperand) =
+ val (_, gcState_frontierContents,
+ gcState_frontierContentsOperand) =
make (Field.Frontier, pointerSize, Classes.GCStateHold)
- val (_, _, gcState_limitContentsOperand) =
- make (Field.Limit, pointerSize, Classes.GCState)
-
- val (_, _, gcState_limitPlusSlopContentsOperand) =
- make (Field.LimitPlusSlop, pointerSize, Classes.GCState)
-
- val (_, _, gcState_maxFrameSizeContentsOperand) =
- make (Field.MaxFrameSize, pointerSize, Classes.GCState)
-
- val (_, _, gcState_signalIsPendingContentsOperand) =
- make (Field.SignalIsPending, wordSize, Classes.GCState)
-
- val (_, gcState_stackBottomContents, gcState_stackBottomContentsOperand) =
+ val (_, gcState_stackBottomContents,
+ gcState_stackBottomContentsOperand) =
make (Field.StackBottom, pointerSize, Classes.GCState)
- val (_, _, gcState_stackLimitContentsOperand) =
- make (Field.StackLimit, pointerSize, Classes.GCState)
-
- val (gcState_stackTop, gcState_stackTopContents,
+ val (_, gcState_stackTopContents,
gcState_stackTopContentsOperand) =
make (Field.StackTop, pointerSize, Classes.GCStateHold)
@@ -435,9 +422,13 @@
fun stackTopTempMinusWordDerefOperand () =
Operand.memloc (stackTopTempMinusWordDeref ())
- val (_, gcState_currentThread_exnStackContents,
- gcState_currentThread_exnStackContentsOperand) =
- make (Field.ExnStack, wordSize, Classes.GCState)
+ fun gcState_offset {offset, ty} =
+ let
+ val (_,_,operand) =
+ make' (offset, toX86Size ty, Classes.GCState)
+ in
+ operand ()
+ end
(* init *)
fun init () = let
1.24 +7 -19 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.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- x86-mlton-basic.sig 23 Jan 2003 03:34:37 -0000 1.23
+++ x86-mlton-basic.sig 15 May 2003 14:50:57 -0000 1.24
@@ -61,8 +61,6 @@
val GCStateHold : x86.MemLoc.Class.t
val GCStateVolatile : x86.MemLoc.Class.t
- val ThreadStack : x86.MemLoc.Class.t
-
val allClasses : x86.ClassSet.t ref
val livenessClasses : x86.ClassSet.t ref
val holdClasses : x86.ClassSet.t ref
@@ -78,7 +76,7 @@
val c_stackPDerefOperand : x86.Operand.t
val c_stackPDerefDoubleOperand : x86.Operand.t
- (* Static temps defined in x86codegen.h *)
+ (* Static temps defined in x86-main.h *)
val applyFFTempContentsOperand : x86.Operand.t
val threadTempContentsOperand : x86.Operand.t
val fileTempContentsOperand : x86.Operand.t
@@ -88,12 +86,12 @@
val fpswTempContentsOperand : x86.Operand.t
val statusTempContentsOperand : x86.Operand.t
- (* Static arrays defined in x86codegen.h *)
+ (* Static arrays defined in main.h and x86-main.h *)
val local_base : x86.Runtime.Type.t -> x86.Label.t
val global_base : x86.Runtime.Type.t -> x86.Label.t
val globalPointerNonRoot_base : x86.Label.t
- (* Static functions defined in x86codegen.h *)
+ (* Static functions defined in main.h *)
val saveGlobals : x86.Label.t
val loadGlobals : x86.Label.t
@@ -103,31 +101,21 @@
val fileLine : unit -> x86.Operand.t
(* gcState relative locations defined in gc.h *)
- val gcState_canHandleContentsOperand: unit -> x86.Operand.t
- val gcState_cardMapContentsOperand: 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
+ val gcState_label: x86.Label.t
+ val gcState_offset: {offset: int, ty: x86.Runtime.Type.t} -> x86.Operand.t
+ val gcState_exnStackContents: unit -> x86.MemLoc.t
+ val gcState_exnStackContentsOperand: unit -> x86.Operand.t
val gcState_frontierContents: unit -> x86.MemLoc.t
val gcState_frontierContentsOperand: unit -> x86.Operand.t
val gcState_frontierDerefOperand: unit -> x86.Operand.t
- val gcState_label: x86.Label.t
- val gcState_limitContentsOperand: unit -> x86.Operand.t
- val gcState_limitPlusSlopContentsOperand: unit -> x86.Operand.t
- val gcState_maxFrameSizeContentsOperand: unit -> x86.Operand.t
- val gcState_signalIsPendingContentsOperand: unit -> x86.Operand.t
val gcState_stackBottomContents: unit -> x86.MemLoc.t
val gcState_stackBottomContentsOperand: unit -> x86.Operand.t
- val gcState_stackLimitContentsOperand: unit -> x86.Operand.t
- val gcState_stackTop: unit -> x86.Immediate.t
val gcState_stackTopContents: unit -> x86.MemLoc.t
val gcState_stackTopContentsOperand: unit -> x86.Operand.t
val gcState_stackTopDerefOperand: unit -> x86.Operand.t
val gcState_stackTopMinusWordDeref: unit -> x86.MemLoc.t
val gcState_stackTopMinusWordDerefOperand: unit -> x86.Operand.t
- val stackTopTemp: unit -> x86.Immediate.t
- val stackTopTempContents: unit -> x86.MemLoc.t
val stackTopTempContentsOperand: unit -> x86.Operand.t
val stackTopTempDerefOperand: unit -> x86.Operand.t
val stackTopTempMinusWordDeref: unit -> x86.MemLoc.t
1.17 +3 -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.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- x86-pseudo.sig 20 Jan 2003 16:28:35 -0000 1.16
+++ x86-pseudo.sig 15 May 2003 14:50:57 -0000 1.17
@@ -89,6 +89,7 @@
end
type t
+ val layout : t -> Layout.t
val imm : {base: Immediate.t,
index: Immediate.t,
@@ -130,6 +131,7 @@
sig
type t
+ val layout : t -> Layout.t
val toString : t -> string
val immediate : Immediate.t -> t
@@ -139,6 +141,7 @@
val immediate_label : Label.t -> t
val deImmediate : t -> Immediate.t option
val label : Label.t -> t
+ val deLabel : t -> Label.t option
val memloc : MemLoc.t -> t
val deMemloc : t -> MemLoc.t option
1.42 +27 -37 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.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- x86-translate.fun 14 May 2003 20:07:18 -0000 1.41
+++ x86-translate.fun 15 May 2003 14:50:58 -0000 1.42
@@ -31,6 +31,11 @@
structure Prim = Prim
structure Register = Register
structure Runtime = Runtime
+ local
+ open Runtime
+ in
+ structure GCField = GCField
+ end
structure Type = Type
end
@@ -126,24 +131,30 @@
| Int i => x86.Operand.immediate_const_int i
| Label l => x86.Operand.immediate_label l
| Line => x86MLton.fileLine ()
+ | Offset {base = GCState, offset, ty} =>
+ let
+ val ty = Type.toRuntime ty
+ in
+ x86MLton.gcState_offset {offset = offset, ty = ty}
+ end
| Offset {base, offset, ty} =>
let
- val base = toX86Operand base
- val ty = Type.toRuntime ty
- val memloc =
- case x86.Operand.deMemloc base of
- SOME base =>
- x86.MemLoc.simple
- {base = base,
- index = x86.Immediate.const_int offset,
- scale = x86.Scale.One,
- size = x86MLton.toX86Size ty,
- class = x86MLton.Classes.Heap}
- | _ => Error.bug (concat ["toX86Operand: strange Offset:",
- " base: ",
- x86.Operand.toString base])
+ val base = toX86Operand base
+ val ty = Type.toRuntime ty
+ val memloc =
+ case x86.Operand.deMemloc base of
+ SOME base =>
+ x86.MemLoc.simple
+ {base = base,
+ index = x86.Immediate.const_int offset,
+ scale = x86.Scale.One,
+ size = x86MLton.toX86Size ty,
+ class = x86MLton.Classes.Heap}
+ | _ => Error.bug (concat ["toX86Operand: strange Offset:",
+ " base: ",
+ x86.Operand.toString base])
in
- x86.Operand.memloc memloc
+ x86.Operand.memloc memloc
end
| Real _ => Error.bug "toX86Operand: Real unimplemented"
| Register r =>
@@ -159,27 +170,6 @@
size = x86MLton.toX86Size ty,
class = x86MLton.Classes.Locals})
end
- | Runtime oper =>
- let
- datatype z = datatype Machine.Runtime.GCField.t
- open x86MLton
- in
- case oper of
- CanHandle => gcState_canHandleContentsOperand ()
- | CardMap => gcState_cardMapContentsOperand ()
- | CurrentThread => gcState_currentThreadContentsOperand ()
- | ExnStack =>
- gcState_currentThread_exnStackContentsOperand ()
- | Frontier => gcState_frontierContentsOperand ()
- | Limit => gcState_limitContentsOperand ()
- | LimitPlusSlop => gcState_limitPlusSlopContentsOperand ()
- | MaxFrameSize => gcState_maxFrameSizeContentsOperand ()
- | SignalIsPending =>
- gcState_signalIsPendingContentsOperand ()
- | StackBottom => gcState_stackBottomContentsOperand ()
- | StackLimit => gcState_stackLimitContentsOperand ()
- | StackTop => gcState_stackTopContentsOperand ()
- end
| SmallIntInf ii => x86.Operand.immediate_const_word ii
| StackOffset {offset, ty} =>
let
@@ -680,7 +670,7 @@
(x86.MemLocSet.add
(x86.MemLocSet.empty,
x86MLton.gcState_stackBottomContents ()),
- x86MLton.gcState_currentThread_exnStackContents ())})}))
+ x86MLton.gcState_exnStackContents ())})}))
| Switch switch
=> let
datatype z = datatype Machine.Switch.t
1.26 +2 -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.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- x86.sig 20 Jan 2003 16:28:39 -0000 1.25
+++ x86.sig 15 May 2003 14:50:58 -0000 1.26
@@ -203,6 +203,7 @@
size: Size.t,
class: Class.t}
+ val layout : t -> Layout.t
val toString : t -> string
val imm : {base: Immediate.t,
@@ -264,6 +265,7 @@
| Address of Address.t
| MemLoc of MemLoc.t
+ val layout : t -> Layout.t
val toString : t -> string
val register : Register.t -> t
-------------------------------------------------------
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