[MLton-commit] r5389

Matthew Fluet fluet at mlton.org
Sun Mar 4 08:25:30 PST 2007


Update names of primitives and runtime fields to match GC_state fields
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/thread.sml
U   mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
U   mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml
U   mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun

----------------------------------------------------------------------

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/thread.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/thread.sml	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/thread.sml	2007-03-04 16:25:27 UTC (rev 5389)
@@ -30,7 +30,7 @@
    val atomicBegin = atomicBegin
    val atomicEnd = atomicEnd
    val atomicState = fn () =>
-      case canHandle () of
+      case atomicState () of
          0wx0 => AtomicState.NonAtomic
        | w => AtomicState.Atomic (Word32.toInt w)
 end

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml	2007-03-04 16:25:27 UTC (rev 5389)
@@ -272,7 +272,7 @@
                       handlers: (syserror * (unit -> 'b)) list}: 'b =
                      err {default = fn () =>
                           if restart andalso errno = intr andalso !restartFlag
-                             then if Thread.canHandle () = 0w0
+                             then if Thread.atomicState () = 0w0
                                      then call errUnblocked
                                      else let val finish = !blocker ()
                                           in 

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml	2007-03-04 16:25:27 UTC (rev 5389)
@@ -296,10 +296,10 @@
       type preThread = PreThread.t
       type thread = Thread.t
 
+      val atomicState = _prim "Thread_atomicState": unit -> Word32.word;
       val atomicBegin = _prim "Thread_atomicBegin": unit -> unit;
-      val canHandle = _prim "Thread_canHandle": unit -> Word32.word;
       fun atomicEnd () = 
-         if canHandle () = 0w0
+         if atomicState () = 0w0
             then raise Primitive.Exn.Fail8 "Thread.atomicEnd"
             else _prim "Thread_atomicEnd": unit -> unit; ()
       val copy = _prim "Thread_copy": preThread -> thread;

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun	2007-03-04 16:25:27 UTC (rev 5389)
@@ -329,7 +329,7 @@
        | Ref_ref => oneTarg (fn t => ([t], reff t))
        | Thread_atomicBegin => done ([], unit)
        | Thread_atomicEnd => done ([], unit)
-       | Thread_canHandle => done ([], word32)
+       | Thread_atomicState => done ([], word32)
        | Thread_copy => done ([thread], thread)
        | Thread_copyCurrent => done ([], unit)
        | Thread_returnToC => done ([], unit)

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun	2007-03-04 16:25:27 UTC (rev 5389)
@@ -132,7 +132,7 @@
  | String_toWord8Vector (* defunctorize *)
  | Thread_atomicBegin (* backend *)
  | Thread_atomicEnd (* backend *)
- | Thread_canHandle (* backend *)
+ | Thread_atomicState (* backend *)
  | Thread_copy (* ssa to rssa *)
  | Thread_copyCurrent (* ssa to rssa *)
  | Thread_returnToC (* codegen *)
@@ -285,7 +285,7 @@
        | String_toWord8Vector => "String_toWord8Vector"
        | Thread_atomicBegin => "Thread_atomicBegin"
        | Thread_atomicEnd => "Thread_atomicEnd"
-       | Thread_canHandle => "Thread_canHandle"
+       | Thread_atomicState => "Thread_atomicState"
        | Thread_copy => "Thread_copy"
        | Thread_copyCurrent => "Thread_copyCurrent"
        | Thread_returnToC => "Thread_returnToC"
@@ -417,7 +417,7 @@
     | (String_toWord8Vector, String_toWord8Vector) => true
     | (Thread_atomicBegin, Thread_atomicBegin) => true
     | (Thread_atomicEnd, Thread_atomicEnd) => true
-    | (Thread_canHandle, Thread_canHandle) => true
+    | (Thread_atomicState, Thread_atomicState) => true
     | (Thread_copy, Thread_copy) => true
     | (Thread_copyCurrent, Thread_copyCurrent) => true
     | (Thread_returnToC, Thread_returnToC) => true
@@ -559,7 +559,7 @@
     | String_toWord8Vector => String_toWord8Vector
     | Thread_atomicBegin => Thread_atomicBegin
     | Thread_atomicEnd => Thread_atomicEnd
-    | Thread_canHandle => Thread_canHandle
+    | Thread_atomicState => Thread_atomicState
     | Thread_copy => Thread_copy
     | Thread_copyCurrent => Thread_copyCurrent
     | Thread_returnToC => Thread_returnToC
@@ -782,7 +782,7 @@
        | String_toWord8Vector => Functional
        | Thread_atomicBegin => SideEffect
        | Thread_atomicEnd => SideEffect
-       | Thread_canHandle => DependsOnState
+       | Thread_atomicState => DependsOnState
        | Thread_copy => Moveable
        | Thread_copyCurrent => SideEffect
        | Thread_returnToC => SideEffect
@@ -942,7 +942,7 @@
        String_toWord8Vector,
        Thread_atomicBegin,
        Thread_atomicEnd,
-       Thread_canHandle,
+       Thread_atomicState,
        Thread_copy,
        Thread_copyCurrent,
        Thread_returnToC,

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig	2007-03-04 16:25:27 UTC (rev 5389)
@@ -122,7 +122,7 @@
              | String_toWord8Vector (* defunctorize *)
              | Thread_atomicBegin (* backend *)
              | Thread_atomicEnd (* backend *)
-             | Thread_canHandle (* backend *)
+             | Thread_atomicState (* backend *)
              | Thread_copy (* ssa to rssa *)
              | Thread_copyCurrent (* ssa to rssa *)
              | Thread_returnToC (* codegen *)

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun	2007-03-04 16:25:27 UTC (rev 5389)
@@ -439,8 +439,8 @@
       datatype z = datatype GCField.t
    in
       case f of
-         CanHandle => word32
-       | CardMap => cpointer ()
+         AtomicState => word32
+       | CardMapAbsolute => cpointer ()
        | CurrentThread => thread ()
        | CurSourceSeqsIndex => word32
        | ExnStack => exnStack ()

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun	2007-03-04 16:25:27 UTC (rev 5389)
@@ -13,8 +13,8 @@
 structure GCField =
    struct
       datatype t =
-         CanHandle
-       | CardMap
+         AtomicState
+       | CardMapAbsolute
        | CurrentThread
        | CurSourceSeqsIndex
        | ExnStack
@@ -27,8 +27,8 @@
        | StackLimit
        | StackTop
 
-      val canHandleOffset: Bytes.t ref = ref Bytes.zero
-      val cardMapOffset: Bytes.t ref = ref Bytes.zero
+      val atomicStateOffset: Bytes.t ref = ref Bytes.zero
+      val cardMapAbsoluteOffset: Bytes.t ref = ref Bytes.zero
       val currentThreadOffset: Bytes.t ref = ref Bytes.zero
       val curSourceSeqsIndexOffset: Bytes.t ref = ref Bytes.zero
       val exnStackOffset: Bytes.t ref = ref Bytes.zero
@@ -41,11 +41,11 @@
       val stackLimitOffset: Bytes.t ref = ref Bytes.zero
       val stackTopOffset: Bytes.t ref = ref Bytes.zero
 
-      fun setOffsets {canHandle, cardMap, currentThread, curSourceSeqsIndex, 
+      fun setOffsets {atomicState, cardMapAbsolute, currentThread, curSourceSeqsIndex, 
                       exnStack, frontier, limit, limitPlusSlop, maxFrameSize, 
                       signalIsPending, stackBottom, stackLimit, stackTop} =
-         (canHandleOffset := canHandle
-          ; cardMapOffset := cardMap
+         (atomicStateOffset := atomicState
+          ; cardMapAbsoluteOffset := cardMapAbsolute
           ; currentThreadOffset := currentThread
           ; curSourceSeqsIndexOffset := curSourceSeqsIndex
           ; exnStackOffset := exnStack
@@ -59,8 +59,8 @@
           ; stackTopOffset := stackTop)
 
       val offset =
-         fn CanHandle => !canHandleOffset
-          | CardMap => !cardMapOffset
+         fn AtomicState => !atomicStateOffset
+          | CardMapAbsolute => !cardMapAbsoluteOffset
           | CurrentThread => !currentThreadOffset
           | CurSourceSeqsIndex => !curSourceSeqsIndexOffset
           | ExnStack => !exnStackOffset
@@ -73,8 +73,8 @@
           | StackLimit => !stackLimitOffset
           | StackTop => !stackTopOffset
 
-      val canHandleSize: Bytes.t ref = ref Bytes.zero
-      val cardMapSize: Bytes.t ref = ref Bytes.zero
+      val atomicStateSize: Bytes.t ref = ref Bytes.zero
+      val cardMapAbsoluteSize: Bytes.t ref = ref Bytes.zero
       val currentThreadSize: Bytes.t ref = ref Bytes.zero
       val curSourceSeqsIndexSize: Bytes.t ref = ref Bytes.zero
       val exnStackSize: Bytes.t ref = ref Bytes.zero
@@ -87,11 +87,11 @@
       val stackLimitSize: Bytes.t ref = ref Bytes.zero
       val stackTopSize: Bytes.t ref = ref Bytes.zero
 
-      fun setSizes {canHandle, cardMap, currentThread, curSourceSeqsIndex, 
+      fun setSizes {atomicState, cardMapAbsolute, currentThread, curSourceSeqsIndex, 
                     exnStack, frontier, limit, limitPlusSlop, maxFrameSize, 
                     signalIsPending, stackBottom, stackLimit, stackTop} =
-         (canHandleSize := canHandle
-          ; cardMapSize := cardMap
+         (atomicStateSize := atomicState
+          ; cardMapAbsoluteSize := cardMapAbsolute
           ; currentThreadSize := currentThread
           ; curSourceSeqsIndexSize := curSourceSeqsIndex
           ; exnStackSize := exnStack
@@ -105,8 +105,8 @@
           ; stackTopSize := stackTop)
 
       val size =
-         fn CanHandle => !canHandleSize
-          | CardMap => !cardMapSize
+         fn AtomicState => !atomicStateSize
+          | CardMapAbsolute => !cardMapAbsoluteSize
           | CurrentThread => !currentThreadSize
           | CurSourceSeqsIndex => !curSourceSeqsIndexSize
           | ExnStack => !exnStackSize
@@ -120,8 +120,8 @@
           | StackTop => !stackTopSize
 
       val toString =
-         fn CanHandle => "CanHandle"
-          | CardMap => "CardMap"
+         fn AtomicState => "AtomicState"
+          | CardMapAbsolute => "CardMapAbsolute"
           | CurrentThread => "CurrentThread"
           | CurSourceSeqsIndex => "CurSourceSeqsIndex"
           | ExnStack => "ExnStack"

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig	2007-03-04 16:25:27 UTC (rev 5389)
@@ -20,8 +20,8 @@
       structure GCField:
          sig
             datatype t =
-               CanHandle
-             | CardMap
+               AtomicState
+             | CardMapAbsolute
              | CurrentThread
              | CurSourceSeqsIndex
              | ExnStack
@@ -36,8 +36,8 @@
 
             val layout: t -> Layout.t
             val offset: t -> Bytes.t (* Field offset in struct GC_state. *)
-            val setOffsets: {canHandle: Bytes.t,
-                             cardMap: Bytes.t,
+            val setOffsets: {atomicState: Bytes.t,
+                             cardMapAbsolute: Bytes.t,
                              currentThread: Bytes.t,
                              curSourceSeqsIndex: Bytes.t,
                              exnStack: Bytes.t,
@@ -49,8 +49,8 @@
                              stackBottom: Bytes.t,
                              stackLimit: Bytes.t,
                              stackTop: Bytes.t} -> unit
-            val setSizes: {canHandle: Bytes.t,
-                           cardMap: Bytes.t,
+            val setSizes: {atomicState: Bytes.t,
+                           cardMapAbsolute: Bytes.t,
                            currentThread: Bytes.t,
                            curSourceSeqsIndex: Bytes.t,
                            exnStack: Bytes.t,

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun	2007-03-04 16:25:27 UTC (rev 5389)
@@ -553,7 +553,7 @@
                 dst = SOME (index, indexTy),
                 prim = Prim.wordRshift (sz, {signed = false})},
        Move {dst = (ArrayOffset
-                    {base = Runtime GCField.CardMap,
+                    {base = Runtime GCField.CardMapAbsolute,
                      index = Var {ty = indexTy, var = index},
                      offset = Bytes.zero,
                      scale = Scale.One,
@@ -1027,15 +1027,15 @@
                                                prim = prim,
                                                args = varOps args})
                               datatype z = datatype Prim.Name.t
-                              fun bumpCanHandle n =
+                              fun bumpAtomicState n =
                                  let
-                                    val canHandle = Runtime GCField.CanHandle
+                                    val atomicState = Runtime GCField.AtomicState
                                     val res = Var.newNoname ()
-                                    val resTy = Operand.ty canHandle
+                                    val resTy = Operand.ty atomicState
                                  in
                                     [Statement.PrimApp
                                      {args = (Vector.new2
-                                              (canHandle,
+                                              (atomicState,
                                                (Operand.word
                                                 (WordX.fromIntInf
                                                  (IntInf.fromInt n,
@@ -1043,7 +1043,7 @@
                                       dst = SOME (res, resTy),
                                       prim = Prim.wordAdd WordSize.word32},
                                      Statement.Move
-                                     {dst = canHandle,
+                                     {dst = atomicState,
                                       src = Var {ty = resTy, var = res}}]
                                  end
                               fun ccall {args: Operand.t vector,
@@ -1204,7 +1204,7 @@
                                | Pointer_setReal _ => pointerSet ()
                                | Pointer_setWord _ => pointerSet ()
                                | Thread_atomicBegin =>
-                                    (* gcState.canHandle++;
+                                    (* gcState.atomicState++;
                                      * if (gcState.signalsInfo.signalIsPending)
                                      *   gcState.limit = gcState.limitPlusSlop - LIMIT_SLOP;
                                      *)
@@ -1240,7 +1240,7 @@
                                                         {args = Vector.new0 (),
                                                          dst = continue})}
                                      in
-                                        (bumpCanHandle 1,
+                                        (bumpAtomicState 1,
                                          if handlesSignals 
                                             then
                                                Transfer.ifBool
@@ -1252,9 +1252,9 @@
                                                            dst = continue})
                                      end)
                                | Thread_atomicEnd =>
-                                    (* gcState.canHandle--;
+                                    (* gcState.atomicState--;
                                      * if (gcState.signalsInfo.signalIsPending
-                                     *     and 0 == gcState.canHandle)
+                                     *     and 0 == gcState.atomicState)
                                      *   gc;
                                      *)
                                     split
@@ -1289,30 +1289,30 @@
                                             {args = args,
                                              func = func,
                                              return = SOME returnFromHandler}}
-                                        val testCanHandle =
+                                        val testAtomicState =
                                            newBlock
                                            {args = Vector.new0 (),
                                             kind = Kind.Jump,
                                             statements = Vector.new0 (),
                                             transfer =
                                             Transfer.ifZero
-                                            (Runtime CanHandle,
+                                            (Runtime AtomicState,
                                              {falsee = continue,
                                               truee = switchToHandler})}
                                      in
-                                        (bumpCanHandle ~1,
+                                        (bumpAtomicState ~1,
                                          if handlesSignals 
                                             then 
                                                Transfer.ifBool
                                                (Runtime SignalIsPending,
                                                 {falsee = continue,
-                                                 truee = testCanHandle})
+                                                 truee = testAtomicState})
                                          else 
                                             Transfer.Goto {args = Vector.new0 (),
                                                            dst = continue})
                                      end)
-                               | Thread_canHandle =>
-                                    move (Runtime GCField.CanHandle)
+                               | Thread_atomicState =>
+                                    move (Runtime GCField.AtomicState)
                                | Thread_copy =>
                                     simpleCCallWithGCState
                                     (CFunction.copyThread ())

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun	2007-03-04 16:25:27 UTC (rev 5389)
@@ -450,8 +450,8 @@
          in
             Runtime.GCField.setOffsets
             {
-             canHandle = get "atomicState_Offset",
-             cardMap = get "generationalMaps.cardMapAbsolute_Offset",
+             atomicState = get "atomicState_Offset",
+             cardMapAbsolute = get "generationalMaps.cardMapAbsolute_Offset",
              currentThread = get "currentThread_Offset",
              curSourceSeqsIndex = get "sourceMaps.curSourceSeqsIndex_Offset",
              exnStack = get "exnStack_Offset",
@@ -466,8 +466,8 @@
              };
             Runtime.GCField.setSizes
             {
-             canHandle = get "atomicState_Size",
-             cardMap = get "generationalMaps.cardMapAbsolute_Size",
+             atomicState = get "atomicState_Size",
+             cardMapAbsolute = get "generationalMaps.cardMapAbsolute_Size",
              currentThread = get "currentThread_Size",
              curSourceSeqsIndex = get "sourceMaps.curSourceSeqsIndex_Size",
              exnStack = get "exnStack_Size",

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun	2007-03-03 17:05:32 UTC (rev 5388)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun	2007-03-04 16:25:27 UTC (rev 5389)
@@ -441,7 +441,7 @@
              | Real_toWord (s, s', _) => done ([real s], word s')
              | Thread_atomicBegin => done ([], unit)
              | Thread_atomicEnd => done ([], unit)
-             | Thread_canHandle => done ([], word32)
+             | Thread_atomicState => done ([], word32)
              | Thread_copy => done ([thread], thread)
              | Thread_copyCurrent => done ([], unit)
              | Thread_returnToC => done ([], unit)




More information about the MLton-commit mailing list