[MLton-devel] cvs commit: MAIL: synchronizing gcState.stackTop
Matthew Fluet
fluet@users.sourceforge.net
Mon, 16 Dec 2002 11:28:07 -0800
fluet 02/12/16 11:28:07
Modified: include x86codegen.h
mlton/codegen/x86-codegen x86-allocate-registers.fun
x86-generate-transfers.fun x86-mlton-basic.fun
x86-mlton-basic.sig
Log:
Modified x86-generate-transfers.fun to ensure that changes to %ebp (or
whatever register holds gcState.stackTop) are committed to
gcState.stackTop immediately. In addition, ensure that
gcState.stackTop always points to a valid stack (i.e., no missing
return address at stackTop). All of the modifications are predicated
by !Control.profile <> Control.ProfileNone. The changes to the
generated assembly are minimal:
addl $12,%ebp
movl $L_142,(0+(-1*4))(%ebp)
becomes
addl $12,%ebp
movl $L_142,(0+(-1*4))(%ebp)
movl %ebp,((gcState+8)+(0*4))
And you couldn't really ask for anything less.
Revision Changes Path
1.21 +1 -0 mlton/include/x86codegen.h
Index: x86codegen.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/x86codegen.h,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- x86codegen.h 12 Dec 2002 01:14:21 -0000 1.20
+++ x86codegen.h 16 Dec 2002 19:28:01 -0000 1.21
@@ -9,6 +9,7 @@
word checkTemp; \
word divTemp; \
struct GC_state gcState; \
+ word stackTopTemp; \
word c_stackP; \
char cReturnTempB; \
word cReturnTempL; \
1.25 +61 -10 mlton/mlton/codegen/x86-codegen/x86-allocate-registers.fun
Index: x86-allocate-registers.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-allocate-registers.fun,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- x86-allocate-registers.fun 2 Nov 2002 22:58:21 -0000 1.24
+++ x86-allocate-registers.fun 16 Dec 2002 19:28:02 -0000 1.25
@@ -23,6 +23,12 @@
in
ClassSet.contains(trackClasses, MemLoc.class memloc)
end
+ fun volatile memloc = let
+ val volatileClasses
+ = !x86MLton.Classes.volatileClasses
+ in
+ ClassSet.contains(volatileClasses, MemLoc.class memloc)
+ end
fun mkBorder c
= AppendList.single
@@ -336,11 +342,16 @@
then REMOVE
else commit
+ val default = case sawNothing future
+ of REMOVE => REMOVE
+ | DEAD => DEAD
+ | commit => check commit
in
- case sawNothing future
- of REMOVE => REMOVE
- | DEAD => DEAD
- | commit => check commit
+ if volatile memloc
+ then case default
+ of REMOVE => REMOVE
+ | _ => COMMIT
+ else default
end
val split
@@ -750,6 +761,40 @@
reserved: Register.t list,
fltstack: fltvalue list}
+ fun unique (registerAllocation as {entries, reserved, fltstack}: t)
+ = let
+ fun check_entries (entries: value list, res) =
+ case entries of
+ [] => res
+ | (value as {register, memloc, ...})::entries =>
+ check_entries
+ (entries,
+ List.foldr
+ (entries, res,
+ fn ({register = register',
+ memloc = memloc', ...}, res) =>
+ res
+ andalso (not (Register.coincide (register, register')))
+ andalso (not (MemLoc.eq (memloc, memloc')))))
+ fun check_fltstack (fltstack: fltvalue list, res) =
+ case fltstack of
+ [] => res
+ | (value as {fltregister, memloc, ...})::fltstack =>
+ check_fltstack
+ (fltstack,
+ List.foldr
+ (fltstack, res,
+ fn ({fltregister = fltregister',
+ memloc = memloc', ...}, res) =>
+ res
+ andalso (not (FltRegister.eq (fltregister, fltregister')))
+ andalso (not (MemLoc.eq (memloc, memloc')))))
+ in
+ check_entries(entries, true)
+ andalso
+ check_fltstack(fltstack, true)
+ end
+
fun toString (registerAllocation as {entries, reserved, fltstack}: t)
= let
fun doit (name, l, toString, ac)
@@ -3798,6 +3843,9 @@
registerAllocation: t}
= let
val ra = registerAllocation
+ val _ = Assert.assert
+ ("pre: " ^ (toString ra),
+ fn () => unique ra)
val dead_memlocs = dead
val commit_memlocs = commit
@@ -4001,6 +4049,9 @@
registerAllocation: t}
= let
val ra = registerAllocation
+ val _ = Assert.assert
+ ("post: " ^ (toString ra),
+ fn () => unique ra)
val (final_uses_registers,
final_defs_registers,
@@ -8766,8 +8817,8 @@
| _ => default ()
end
| pFLDC {oper, dst, size}
- (* Pseudo floating-point load constant.
- *)
+ (* Pseudo floating-point load constant.
+ *)
=> let
val {uses,defs,kills}
= Instruction.uses_defs_kills instruction
@@ -8824,8 +8875,8 @@
registerAllocation = registerAllocation}
end
| pFMOVFI {src, dst, srcsize, dstsize}
- (* Pseudo floating-point from integer.
- *)
+ (* Pseudo floating-point from integer.
+ *)
=> let
val {uses,defs,kills}
= Instruction.uses_defs_kills instruction
@@ -8901,8 +8952,8 @@
registerAllocation = registerAllocation}
end
| pFMOVTI {src, dst, srcsize, dstsize}
- (* Pseudo floating-point to integer.
- *)
+ (* Pseudo floating-point to integer.
+ *)
=> let
val {uses,defs,kills}
= Instruction.uses_defs_kills instruction
1.33 +180 -69 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.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- x86-generate-transfers.fun 19 Jul 2002 02:24:53 -0000 1.32
+++ x86-generate-transfers.fun 16 Dec 2002 19:28:03 -0000 1.33
@@ -140,6 +140,8 @@
val nonlivenessClasses = ClassSet.-(allClasses, livenessClasses)
val holdClasses = !x86MLton.Classes.holdClasses
val nonholdClasses = ClassSet.-(allClasses, holdClasses)
+ val volatileClasses = !x86MLton.Classes.volatileClasses
+ val nonvolatileClasses = ClassSet.-(allClasses, volatileClasses)
val farflushClasses = ClassSet.-(nonlivenessClasses, holdClasses)
val nearflushClasses = ClassSet.-(nonlivenessClasses, holdClasses)
val runtimeClasses = !x86MLton.Classes.runtimeClasses
@@ -233,6 +235,19 @@
dead_memlocs = MemLocSet.empty,
dead_classes = ClassSet.empty})],
trans]
+
+ val profileStackTopCommit' =
+ x86.Assembly.directive_force
+ {commit_memlocs = MemLocSet.singleton (stackTop ()),
+ commit_classes = ClassSet.empty,
+ remove_memlocs = MemLocSet.empty,
+ remove_classes = ClassSet.empty,
+ dead_memlocs = MemLocSet.empty,
+ dead_classes = ClassSet.empty}
+ val profileStackTopCommit =
+ if !Control.profile <> Control.ProfileNone
+ then AppendList.single profileStackTopCommit'
+ else AppendList.empty
val _
= Assert.assert
@@ -526,19 +541,20 @@
val finish
= AppendList.appends
[profile_assembly,
- let
+ let
val stackTop
= x86MLton.gcState_stackTopContentsOperand ()
val bytes
= x86.Operand.immediate_const_int (~ size)
in
- (* stackTop += bytes *)
- AppendList.single
- (x86.Assembly.instruction_binal
+ AppendList.cons
+ ((* stackTop += bytes *)
+ x86.Assembly.instruction_binal
{oper = x86.Instruction.ADD,
dst = stackTop,
src = bytes,
- size = pointerSize})
+ size = pointerSize},
+ profileStackTopCommit)
end,
(* assignTo dst *)
getReturn ()]
@@ -601,7 +617,7 @@
Assembly.label label],
(* entry from far assumptions *)
(farEntry
- (AppendList.snoc
+ (AppendList.append
(profile_assembly,
let
val stackTop
@@ -609,12 +625,14 @@
val bytes
= x86.Operand.immediate_const_int (~ size)
in
- (* stackTop += bytes *)
- x86.Assembly.instruction_binal
- {oper = x86.Instruction.ADD,
- dst = stackTop,
- src = bytes,
- size = pointerSize}
+ AppendList.cons
+ ((* stackTop += bytes *)
+ x86.Assembly.instruction_binal
+ {oper = x86.Instruction.ADD,
+ dst = stackTop,
+ src = bytes,
+ size = pointerSize},
+ profileStackTopCommit)
end))))
| Handler {label,
offset,
@@ -626,7 +644,7 @@
Assembly.label label],
(* entry from far assumptions *)
(farEntry
- (AppendList.snoc
+ (AppendList.append
(profile_assembly,
let
val stackTop
@@ -634,12 +652,14 @@
val bytes
= x86.Operand.immediate_const_int (~ offset)
in
- (* stackTop += bytes *)
- x86.Assembly.instruction_binal
- {oper = x86.Instruction.ADD,
- dst = stackTop,
- src = bytes,
- size = pointerSize}
+ AppendList.cons
+ ((* stackTop += bytes *)
+ x86.Assembly.instruction_binal
+ {oper = x86.Instruction.ADD,
+ dst = stackTop,
+ src = bytes,
+ size = pointerSize},
+ profileStackTopCommit)
end))))
val pre
= AppendList.appends
@@ -902,6 +922,12 @@
of SOME handler => enque handler
| NONE => ()
+ val stackTopTemp
+ = x86MLton.stackTopTempContentsOperand ()
+ val stackTopTempMinusWordDeref'
+ = x86MLton.stackTopTempMinusWordDeref ()
+ val stackTopTempMinusWordDeref
+ = x86MLton.stackTopTempMinusWordDerefOperand ()
val stackTop
= x86MLton.gcState_stackTopContentsOperand ()
val stackTopMinusWordDeref'
@@ -923,25 +949,55 @@
in
(* flushing at far transfer *)
(farTransfer live
- (AppendList.fromList
- [(* 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},
- 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}])
+ (if !Control.profile <> Control.ProfileNone
+ then (AppendList.fromList
+ [(* stackTopTemp = stackTop + bytes *)
+ x86.Assembly.instruction_mov
+ {dst = stackTopTemp,
+ src = stackTop,
+ size = pointerSize},
+ x86.Assembly.instruction_binal
+ {oper = x86.Instruction.ADD,
+ dst = stackTopTemp,
+ src = bytes,
+ size = pointerSize},
+ (* *(stackTopTemp - WORD_SIZE) = return *)
+ x86.Assembly.instruction_mov
+ {dst = stackTopTempMinusWordDeref,
+ src = Operand.immediate_label return,
+ size = pointerSize},
+ x86.Assembly.directive_force
+ {commit_memlocs = MemLocSet.singleton stackTopTempMinusWordDeref',
+ commit_classes = ClassSet.empty,
+ remove_memlocs = MemLocSet.empty,
+ remove_classes = ClassSet.empty,
+ dead_memlocs = MemLocSet.empty,
+ dead_classes = ClassSet.empty},
+ (* stackTop = stackTopTemp *)
+ x86.Assembly.instruction_mov
+ {dst = stackTop,
+ src = stackTopTemp,
+ size = pointerSize},
+ profileStackTopCommit'])
+ else (AppendList.fromList
+ [(* 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},
+ 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.instruction_jmp
{target = Operand.label target,
@@ -965,6 +1021,8 @@
=> let
val exnStack
= x86MLton.gcState_currentThread_exnStackContentsOperand ()
+ val stackTopTemp
+ = x86MLton.stackTopTempContentsOperand ()
val stackTop
= x86MLton.gcState_stackTopContentsOperand ()
val stackTopDeref
@@ -974,17 +1032,35 @@
in
(* flushing at far transfer *)
(farTransfer live
- (AppendList.fromList
- [(* stackTop = stackBottom + exnStack *)
- x86.Assembly.instruction_mov
- {dst = stackTop,
- src = stackBottom,
- size = pointerSize},
- x86.Assembly.instruction_binal
- {oper = x86.Instruction.ADD,
- dst = stackTop,
- src = exnStack,
- size = pointerSize}])
+ (if !Control.profile <> Control.ProfileNone
+ then (AppendList.fromList
+ [(* stackTopTemp = stackBottom + exnStack *)
+ x86.Assembly.instruction_mov
+ {dst = stackTopTemp,
+ src = stackBottom,
+ size = pointerSize},
+ x86.Assembly.instruction_binal
+ {oper = x86.Instruction.ADD,
+ dst = stackTopTemp,
+ src = exnStack,
+ size = pointerSize},
+ (* stackTop = stackTopTemp *)
+ x86.Assembly.instruction_mov
+ {dst = stackTop,
+ src = stackTopTemp,
+ size = pointerSize},
+ profileStackTopCommit'])
+ else (AppendList.fromList
+ [(* stackTop = stackBottom + exnStack *)
+ x86.Assembly.instruction_mov
+ {dst = stackTop,
+ src = stackBottom,
+ size = pointerSize},
+ x86.Assembly.instruction_binal
+ {oper = x86.Instruction.ADD,
+ dst = stackTop,
+ src = exnStack,
+ size = pointerSize}]))
(AppendList.single
(* jmp *(stackTop) *)
(x86.Assembly.instruction_jmp
@@ -1051,6 +1127,12 @@
val return = valOf return
val _ = enque return
+ val stackTopTemp
+ = x86MLton.stackTopTempContentsOperand ()
+ val stackTopTempMinusWordDeref'
+ = x86MLton.stackTopTempMinusWordDeref ()
+ val stackTopTempMinusWordDeref
+ = x86MLton.stackTopTempMinusWordDerefOperand ()
val stackTop
= x86MLton.gcState_stackTopContentsOperand ()
val stackTopMinusWordDeref'
@@ -1073,26 +1155,55 @@
| NONE => live)
in
(runtimeTransfer (LiveSet.toMemLocSet live)
- (AppendList.fromList
- [(* 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},
- 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}])
+ (if !Control.profile <> Control.ProfileNone
+ then (AppendList.fromList
+ [(* stackTopTemp = stackTop + bytes *)
+ x86.Assembly.instruction_mov
+ {dst = stackTopTemp,
+ src = stackTop,
+ size = pointerSize},
+ x86.Assembly.instruction_binal
+ {oper = x86.Instruction.ADD,
+ dst = stackTopTemp,
+ src = bytes,
+ size = pointerSize},
+ (* *(stackTopTemp - WORD_SIZE) = return *)
+ x86.Assembly.instruction_mov
+ {dst = stackTopTempMinusWordDeref,
+ src = Operand.immediate_label return,
+ size = pointerSize},
+ x86.Assembly.directive_force
+ {commit_memlocs = MemLocSet.singleton stackTopTempMinusWordDeref',
+ commit_classes = ClassSet.empty,
+ remove_memlocs = MemLocSet.empty,
+ remove_classes = ClassSet.empty,
+ dead_memlocs = MemLocSet.empty,
+ dead_classes = ClassSet.empty},
+ (* stackTop = stackTopTemp *)
+ x86.Assembly.instruction_mov
+ {dst = stackTop,
+ src = stackTopTemp,
+ size = pointerSize},
+ profileStackTopCommit'])
+ else (AppendList.fromList
+ [(* 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},
+ 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,
1.10 +39 -1 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.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- x86-mlton-basic.fun 12 Dec 2002 21:12:17 -0000 1.9
+++ x86-mlton-basic.fun 16 Dec 2002 19:28:06 -0000 1.10
@@ -72,6 +72,7 @@
val GCState = new "GCState"
val GCStateHold = new "GCStateHold"
+ val GCStateVolatile = new "GCStateVolatile"
val ThreadStack = new "ThreadStack"
end
@@ -79,6 +80,7 @@
val allClasses = ref x86.ClassSet.empty
val livenessClasses = ref x86.ClassSet.empty
val holdClasses = ref x86.ClassSet.empty
+ val volatileClasses = ref x86.ClassSet.empty
val runtimeClasses = ref x86.ClassSet.empty
val heapClasses = ref x86.ClassSet.empty
val cstaticClasses = ref x86.ClassSet.empty
@@ -100,6 +102,7 @@
StaticNonTemp::
GCState::
GCStateHold::
+ GCStateVolatile::
ThreadStack::
nil)
@@ -123,6 +126,15 @@
x86.ClassSet.fromList
(
GCStateHold::
+(*
+ GCStateVolatile::
+*)
+ nil)
+
+ val _ = volatileClasses :=
+ x86.ClassSet.fromList
+ (
+ GCStateVolatile::
nil)
val _ = runtimeClasses :=
@@ -133,6 +145,7 @@
Globals::
GCState::
GCStateHold::
+ GCStateVolatile::
ThreadStack::
nil)
@@ -375,6 +388,21 @@
make (Field.StackTop, pointerSize, Classes.GCStateHold)
local
+ val stackTopTemp =
+ Immediate.label (Label.fromString "stackTopTemp")
+ val stackTopTempContents =
+ makeContents {base = stackTopTemp,
+ size = wordSize,
+ class = Classes.StaticTemp}
+ val stackTopTempContentsOperand =
+ Operand.memloc (stackTopTempContents)
+ in
+ val stackTopTemp = fn () => stackTopTemp
+ val stackTopTempContents = fn () => stackTopTempContents
+ val stackTopTempContentsOperand = fn () => stackTopTempContentsOperand
+ end
+
+ local
fun make (contents, class) () =
Operand.memloc (MemLoc.simple {base = contents (),
index = Immediate.const_int 0,
@@ -386,8 +414,9 @@
make (gcState_frontierContents, Classes.Heap)
val gcState_stackTopDerefOperand =
make (gcState_stackTopContents, Classes.Stack)
+ val stackTopTempDerefOperand =
+ make (stackTopTempContents, Classes.Stack)
end
-
fun gcState_stackTopMinusWordDeref () =
MemLoc.simple {base = gcState_stackTopContents (),
@@ -397,6 +426,15 @@
class = Classes.Stack}
fun gcState_stackTopMinusWordDerefOperand () =
Operand.memloc (gcState_stackTopMinusWordDeref ())
+
+ fun stackTopTempMinusWordDeref () =
+ MemLoc.simple {base = stackTopTempContents (),
+ index = Immediate.const_int ~1,
+ scale = wordScale,
+ size = pointerSize,
+ class = Classes.Stack}
+ fun stackTopTempMinusWordDerefOperand () =
+ Operand.memloc (stackTopTempMinusWordDeref ())
fun gcState_currentThread_exnStackContents () =
MemLoc.simple {base = gcState_currentThreadContents (),
1.19 +9 -0 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.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- x86-mlton-basic.sig 12 Dec 2002 21:12:18 -0000 1.18
+++ x86-mlton-basic.sig 16 Dec 2002 19:28:06 -0000 1.19
@@ -58,12 +58,14 @@
val GCState : x86.MemLoc.Class.t
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
+ val volatileClasses : x86.ClassSet.t ref
val runtimeClasses : x86.ClassSet.t ref
val heapClasses : x86.ClassSet.t ref
val cstaticClasses : x86.ClassSet.t ref
@@ -123,4 +125,11 @@
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
+ val stackTopTempMinusWordDerefOperand: unit -> x86.Operand.t
end
-------------------------------------------------------
This sf.net email is sponsored by:
With Great Power, Comes Great Responsibility
Learn to use your power at OSDN's High Performance Computing Channel
http://hpc.devchannel.org/
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel