[MLton-commit] r4217
Matthew Fluet
MLton@mlton.org
Mon, 14 Nov 2005 15:03:24 -0800
gcState (as a symbol) is available both in the Basis Library
implementation and in the backend. So, eliminate silly wrapper
functions that do nothing by pass the gcState address.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/thread.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml
U mlton/branches/on-20050822-x86_64-branch/mlprof/main.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/profile.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/exit.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/share.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/size.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml 2005-11-14 23:03:16 UTC (rev 4217)
@@ -396,13 +396,17 @@
structure GC =
struct
val collect = _prim "GC_collect": unit -> unit;
- val pack = _import "MLton_GC_pack": unit -> unit;
+ val pack = _import "GC_pack": GCState.t -> unit;
val setHashConsDuringGC =
- _import "MLton_GC_setHashConsDuringGC": bool -> unit;
- val setMessages = _import "MLton_GC_setMessages": bool -> unit;
- val setRusageMeasureGC = _import "MLton_GC_setRusageMeasureGC": bool -> unit;
- val setSummary = _import "MLton_GC_setSummary": bool -> unit;
- val unpack = _import "MLton_GC_unpack": unit -> unit;
+ _import "GC_setHashConsDuringGC": GCState.t * bool -> unit;
+ val setMessages =
+ _import "GC_setMessages": GCState.t * bool -> unit;
+ val setRusageMeasureGC =
+ _import "GC_setRusageMeasureGC": GCState.t * bool -> unit;
+ val setSummary =
+ _import "GC_setSummary": GCState.t * bool -> unit;
+ val unpack =
+ _import "GC_unpack": GCState.t -> unit;
end
structure IEEEReal =
@@ -1040,16 +1044,20 @@
type t = word
val dummy:t = 0w0
- val free = _import "MLton_Profile_Data_free": t -> unit;
- val malloc = _import "MLton_Profile_Data_malloc": unit -> t;
- val write =
- _import "MLton_Profile_Data_write"
- : t * word (* fd *) -> unit;
+ val free =
+ _import "GC_profileFree": GCState.t * t -> unit;
+ val malloc =
+ _import "GC_profileMalloc": GCState.t * unit -> t;
+ val write =
+ _import "GC_profileWrite"
+ : GCState.t * t * word (* fd *) -> unit;
end
- val current = _import "MLton_Profile_current": unit -> Data.t;
- val done = _import "MLton_Profile_done": unit -> unit;
+ val done = _import "GC_profileDone": GCState.t -> unit;
+ val getCurrent =
+ _import "GC_getProfileCurrent": GCState.t -> Data.t;
val setCurrent =
- _import "MLton_Profile_setCurrent": Data.t -> unit;
+ _import "GC_setProfileCurrent"
+ : GCState.t * Data.t -> unit;
end
structure Rlimit =
@@ -1704,16 +1712,16 @@
* switching to a copy.
*)
val copyCurrent = _prim "Thread_copyCurrent": unit -> unit;
- val current = _import "Thread_current": unit -> thread;
- val finishSignalHandler = _import "Thread_finishSignalHandler": unit -> unit;
+ val current = _import "GC_getCurrentThread": GCState.t -> thread;
+ val finishSignalHandler = _import "GC_finishSignalHandler": GCState.t* -> unit;
val returnToC = _prim "Thread_returnToC": unit -> unit;
- val saved = _import "Thread_saved": unit -> thread;
- val savedPre = _import "Thread_saved": unit -> preThread;
+ val saved = _import "GC_getSavedThread": GCState.t -> thread;
+ val savedPre = _import "GC_getSavedThread": GCState.t -> preThread;
val setCallFromCHandler =
- _import "Thread_setCallFromCHandler": thread -> unit;
- val setSignalHandler = _import "Thread_setSignalHandler": thread -> unit;
- val setSaved = _import "Thread_setSaved": thread -> unit;
- val startSignalHandler = _import "Thread_startSignalHandler": unit -> unit;
+ _import "GC_setCallFromCHandlerThread": GCState.t * thread -> unit;
+ val setSignalHandler = _import "GC_setSignalHandlerThread": GCState.t * thread -> unit;
+ val setSaved = _import "GC_setSavedThread": GCState.t * thread -> unit;
+ val startSignalHandler = _import "GC_startSignalHandler": GCState.t -> unit;
val switchTo = _prim "Thread_switchTo": thread -> unit;
end
@@ -2182,8 +2190,8 @@
structure World =
struct
- val isOriginal = _import "World_isOriginal": unit -> bool;
- val makeOriginal = _import "World_makeOriginal": unit -> unit;
+ val getAmOriginal = _import "GC_getAmOriginal": GCState.t -> bool;
+ val setAmOriginal = _import "GC_setAmOriginal": GCState.t * bool -> unit;
val save = _prim "World_save": word (* filedes *) -> unit;
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sml 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sml 2005-11-14 23:03:16 UTC (rev 4217)
@@ -9,4 +9,21 @@
structure MLtonGC =
struct
open Primitive.GC
+
+ val gcState = Primitive.GCState.gcState
+
+ val pack : unit -> unit =
+ fn () => pack gcState
+ val unpack : unit -> unit =
+ fn () => unpack gcState
+
+ val setHashConsDuringGC : bool -> unit =
+ fn b => setHashConsDuringGC (gcState, b)
+ val setMessages : bool -> unit =
+ fn b => setMessages (gcState, b)
+ val setRusageMeasureGC : bool -> unit =
+ fn b => setRusageMeasureGC (gcState, b)
+ val setSummary : bool -> unit =
+ fn b => setSummary (gcState, b)
+
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml 2005-11-14 23:03:16 UTC (rev 4217)
@@ -10,6 +10,8 @@
structure P = Primitive.MLton.Profile
+val gcState = Primitive.GCState.gcState
+
val isOn = P.isOn
structure Data =
@@ -43,7 +45,7 @@
if equals (d, d')
then ac
else d' :: ac) [] (!all)
- ; P.Data.free raw
+ ; P.Data.free (gcState, raw)
; isFreed := true)
fun make (raw: P.Data.t): t =
@@ -55,7 +57,7 @@
let
val array =
if isOn
- then P.Data.malloc ()
+ then P.Data.malloc gcState
else P.Data.dummy
val d = make array
val _ = all := d :: !all
@@ -79,7 +81,7 @@
creat (file,
flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth])
end
- val _ = P.Data.write (raw, Posix.FileSys.fdToWord fd)
+ val _ = P.Data.write (gcState, raw, Posix.FileSys.fdToWord fd)
val _ = Posix.IO.close fd
in
()
@@ -102,7 +104,7 @@
val _ = ic := false
val _ = isCurrent := true
val _ = r := d
- val _ = P.setCurrent raw
+ val _ = P.setCurrent (gcState, raw)
in
()
end
@@ -115,7 +117,7 @@
DynamicWind.wind (f, fn () => setCurrent old)
end
-fun init () = setCurrent (Data.make (P.current ()))
+fun init () = setCurrent (Data.make (P.getCurrent gcState))
val _ =
if not isOn
@@ -127,7 +129,8 @@
(Cleaner.atExit, fn () =>
(P.done ()
; Data.write (current (), "mlmon.out")
- ; List.app (P.Data.free o Data.raw) (!Data.all)))
+ ; List.app (fn d => P.Data.free (gcState, Data.raw d))
+ (!Data.all)))
val _ =
Cleaner.addNew
(Cleaner.atLoadWorld, fn () =>
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 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/thread.sml 2005-11-14 23:03:16 UTC (rev 4217)
@@ -10,6 +10,8 @@
structure Prim = Primitive.Thread
+val gcState = Primitive.GCState.gcState
+
structure AtomicState =
struct
datatype t = NonAtomic | Atomic of int
@@ -68,7 +70,7 @@
val () = Prim.copyCurrent ()
in
case !func of
- NONE => Prim.savedPre ()
+ NONE => Prim.savedPre gcState
| SOME x =>
(* This branch never returns. *)
let
@@ -107,7 +109,7 @@
val r : (unit -> 'a) ref =
ref (fn () => die "Thread.atomicSwitch didn't set r.\n")
val t: 'a thread ref =
- ref (Paused (fn x => r := x, Prim.current ()))
+ ref (Paused (fn x => r := x, Prim.current gcState))
fun fail e = (t := Dead
; switching := false
; atomicEnd ()
@@ -170,9 +172,9 @@
let
(* Atomic 1 *)
val _ = state := InHandler
- val t = f (fromPrimitive (Prim.saved ()))
+ val t = f (fromPrimitive (Prim.saved gcState))
val _ = state := Normal
- val _ = Prim.finishSignalHandler ()
+ val _ = Prim.finishSignalHandler gcState
val _ =
atomicSwitch
(fn (T r) =>
@@ -192,7 +194,7 @@
(new (fn () => loop () handle e => MLtonExn.topLevelHandler e))
val _ = signalHandler := SOME p
in
- Prim.setSignalHandler p
+ Prim.setSignalHandler (gcState, p)
end
fun switchToSignalHandler () =
@@ -200,7 +202,7 @@
(* Atomic 0 *)
val () = atomicBegin ()
(* Atomic 1 *)
- val () = Prim.startSignalHandler () (* implicit atomicBegin () *)
+ val () = Prim.startSignalHandler gcState (* implicit atomicBegin () *)
(* Atomic 2 *)
in
case !signalHandler of
@@ -220,7 +222,7 @@
fun loop (): unit =
let
(* Atomic 2 *)
- val t = Prim.saved ()
+ val t = Prim.saved gcState
fun doit () =
let
(* Atomic 1 *)
@@ -233,7 +235,7 @@
; MLtonExn.topLevelHandler e)
(* atomicBegin() before putting res *)
(* Atomic 1 *)
- val _ = Prim.setSaved t
+ val _ = Prim.setSaved (gcState, t)
val _ = Prim.returnToC () (* implicit atomicEnd() *)
in
()
@@ -243,7 +245,7 @@
loop ()
end
val p = toPrimitive (new (fn () => loop ()))
- val _ = Prim.setCallFromCHandler p
+ val _ = Prim.setCallFromCHandler (gcState, p)
in
fn (i, f) => Array.update (exports, i, f)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2005-11-14 23:03:16 UTC (rev 4217)
@@ -9,6 +9,8 @@
structure MLtonWorld: MLTON_WORLD =
struct
structure Prim = Primitive.World
+
+ val gcState = Primitive.GCState.gcState
datatype status = Clone | Original
@@ -39,9 +41,9 @@
end
val _ = Prim.save (Posix.FileSys.fdToWord fd)
in
- if Prim.isOriginal ()
+ if Prim.getAmOriginal gcState
then (Posix.IO.close fd; Original)
- else (Prim.makeOriginal ()
+ else (Prim.setAmOriginal (gcState, true)
; Cleaner.clean Cleaner.atLoadWorld
; Clone)
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlprof/main.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlprof/main.sml 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/mlprof/main.sml 2005-11-14 23:03:16 UTC (rev 4217)
@@ -116,12 +116,12 @@
Process.callWithIn
(OS.Path.mkAbsolute {path = afile,
relativeTo = OS.FileSys.getDir ()},
- ["@MLton", "show-prof"],
+ ["@MLton", "show-sources"],
fn ins =>
let
fun line () =
case In.inputLine ins of
- NONE => Error.bug "unexpected end of show-prof data"
+ NONE => Error.bug "unexpected end of show-sources data"
| SOME l => l
val magic = valOf (Word.fromString (line ()))
fun vector (f: string -> 'a): 'a vector =
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/profile.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/profile.fun 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/profile.fun 2005-11-14 23:03:16 UTC (rev 4217)
@@ -630,7 +630,7 @@
add (#1 (enter (pushes, si)))
in
case target of
- Direct "GC_gc" => doit SourceInfo.gc
+ Direct "GC_collect" => doit SourceInfo.gc
| Direct "GC_arrayAllocate" =>
doit SourceInfo.gcArrayAllocate
| Direct "MLton_bug" => add pushes
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 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun 2005-11-14 23:03:16 UTC (rev 4217)
@@ -512,7 +512,7 @@
end,
readsStackTop = true,
return = unit,
- target = Direct "GC_gc",
+ target = Direct "GC_collect",
writesStackTop = true}
val t = make true
val f = make false
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 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun 2005-11-14 23:03:16 UTC (rev 4217)
@@ -91,7 +91,7 @@
writesStackTop = true}
val exit =
- T {args = Vector.new1 Word32,
+ T {args = Vector.new2 (GCState, Word32),
bytesNeeded = NONE,
convention = Cdecl,
ensuresBytesFree = false,
@@ -101,7 +101,7 @@
prototype = let
open CType
in
- (Vector.new1 Word32, NONE)
+ (Vector.new2 (Pointer, Word32), NONE)
end,
readsStackTop = true,
return = unit,
@@ -146,7 +146,7 @@
writesStackTop = true}
val threadSwitchTo =
- T {args = Vector.new2 (Type.thread, Word32),
+ T {args = Vector.new3 (gcState, Type.thread, Word32),
bytesNeeded = NONE,
convention = Cdecl,
ensuresBytesFree = true,
@@ -156,7 +156,7 @@
prototype = let
open CType
in
- (Vector.new2 (Pointer, Word32), NONE)
+ (Vector.new3 (Pointer, Pointer, Word32), NONE)
end,
readsStackTop = true,
return = unit,
@@ -236,7 +236,7 @@
writesStackTop = true}
fun share t =
- T {args = Vector.new1 t,
+ T {args = Vector.new2 (gcState, t),
bytesNeeded = NONE,
convention = Cdecl,
ensuresBytesFree = false,
@@ -246,22 +246,30 @@
prototype = let
open CType
in
- (Vector.new1 Pointer, NONE)
+ (Vector.new2 (Pointer, Pointer), NONE)
end,
readsStackTop = false,
return = unit,
- target = Direct "MLton_share",
+ target = Direct "GC_share",
writesStackTop = false}
fun size t =
- vanilla {args = Vector.new1 t,
- name = "MLton_size",
- prototype = let
- open CType
- in
- (Vector.new1 Pointer, SOME Word32)
- end,
- return = Word32}
+ T {args = Vector.new2 (gcState, t),
+ bytesNeeded = NONE,
+ convention = Cdecl,
+ ensuresBytesFree = false,
+ mayGC = false,
+ maySwitchThreads = false,
+ modifiesFrontier = false,
+ prototype = let
+ open CType
+ in
+ (Vector.new2 (Pointer, Pointer), NONE)
+ end,
+ readsStackTop = false,
+ return = Word32,
+ target = Direct "GC_size",
+ writesStackTop = false}
end
structure Name =
@@ -913,9 +921,12 @@
in
case Prim.name prim of
MLton_halt =>
- ([], Transfer.CCall {args = vos args,
- func = CFunction.exit,
- return = NONE})
+ ([],
+ Transfer.CCall
+ {args = Vector.concat [Vector.new1 GCState,
+ vos args],
+ func = CFunction.exit,
+ return = NONE})
| Thread_copyCurrent =>
let
val func = CFunction.copyCurrentThread
@@ -1090,6 +1101,11 @@
fun simpleCCall (f: CFunction.t) =
ccall {args = vos args,
func = f}
+ fun simpleCCallWithGCState (f: CFuntion.t) =
+ ccall {args = Vector.concat
+ (Vector.new1 GCState,
+ vos args),
+ func = f}
fun array (numElts: Operand.t) =
let
val result = valOf (toRtype ty)
@@ -1200,10 +1216,10 @@
if not (Type.isPointer t)
then none ()
else
- simpleCCall (CFunction.share
- (Operand.ty (a 0))))
+ simpleCCallWithGCState
+ (CFunction.share (Operand.ty (a 0)))
| MLton_size =>
- simpleCCall
+ simpleCCallWithGCState
(CFunction.size (Operand.ty (a 0)))
| MLton_touch =>
let
@@ -1334,45 +1350,31 @@
| Thread_canHandle =>
move (Runtime GCField.CanHandle)
| Thread_copy =>
- ccall {args = (Vector.concat
- [Vector.new1 GCState,
- vos args]),
- func = CFunction.copyThread}
+ simpleCCallWithGCState
+ CFunction.copyThread
| Thread_switchTo =>
- ccall {args = (Vector.new2
- (a 0, EnsuresBytesFree)),
+ ccall {args = (Vector.new3
+ (GCState,
+ a 0,
+ EnsuresBytesFree)),
func = CFunction.threadSwitchTo}
| Vector_length => arrayOrVectorLength ()
| Weak_canGet =>
ifIsWeakPointer
(varType (arg 0),
fn _ =>
- let
- val func =
- CFunction.weakCanGet
- {arg = Operand.ty (a 0)}
- in
- ccall {args = (Vector.new2
- (GCState,
- Vector.sub (vos args, 0))),
- func = func}
- end,
+ simpleCCallWithGCState
+ (CFunction.weakCanGet
+ {arg = Operand.ty (a 0)}),
fn () => move (Operand.bool false))
| Weak_get =>
ifIsWeakPointer
(varType (arg 0),
fn t =>
- let
- val func =
- CFunction.weakGet
- {arg = Operand.ty (a 0),
- return = t}
- in
- ccall {args = (Vector.new2
- (GCState,
- Vector.sub (vos args, 0))),
- func = func}
- end,
+ simpleCCallWithGCState
+ (CFunction.weakGet
+ {arg = Operand.ty (a 0),
+ return = t}),
none)
| Weak_new =>
ifIsWeakPointer
@@ -1385,15 +1387,11 @@
(case Type.dePointer result of
NONE => Error.bug "SsaToRssa.translateStatementsTransfer: PrimApp,Weak_new"
| SOME pt => pt)
- val func =
- CFunction.weakNew {arg = t,
- return = result}
in
- ccall {args = (Vector.concat
- [Vector.new2
- (GCState, header),
- vos args]),
- func = func}
+ simpleCCallWithGCState
+ (CFunction.weakNew
+ {arg = t,
+ return = result})
end,
none)
| Word_equal s =>
@@ -1431,10 +1429,8 @@
src = a 2})
| Word8Vector_subWord => subWord ()
| World_save =>
- ccall {args = (Vector.new2
- (GCState,
- Vector.sub (vos args, 0))),
- func = CFunction.worldSave}
+ simpleCCallWithGCState
+ CFunction.worldSave
| _ => codegenOrC prim
end
| S.Exp.Select {base, offset} =>
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun 2005-11-14 23:03:16 UTC (rev 4217)
@@ -400,7 +400,7 @@
val fileNameLabel = Label.fromString "fileName"
val fileName = Operand.immediate_label fileNameLabel
(* This is a hack: The line number needs to be pushed, but the actual
- * call to GC_gc is about 9 lines further (push 4 more arguments,
+ * call to GC_collect is about 9 lines further (push 4 more arguments,
* adjust stackTop, save return label,
* save gcState.frontier and gcState.stackTop, make call).
* However, there are probably cases where this is different.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -41,7 +41,7 @@
assert(not isSmall(arg));
bp = (GC_intInf)(arg - offsetof(struct GC_intInf, isneg));
if (DEBUG_INT_INF)
- fprintf (stderr, "bp->header = 0x%08x\n", bp->header);
+ fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
assert (bp->header == GC_intInfHeader ());
return bp;
}
@@ -265,7 +265,7 @@
shary(pointer arg, uint shift, uint bytes,
void(*shop)(__mpz_struct *resmpz,
__gmp_const __mpz_struct *argspace,
- ulong shift))
+ unsigned long shift))
{
__mpz_struct argmpz,
resmpz;
@@ -273,7 +273,7 @@
initRes(&resmpz, bytes);
fill(arg, &argmpz, argspace);
- shop(&resmpz, &argmpz, (ulong)shift);
+ shop(&resmpz, &argmpz, (unsigned long)shift);
return answer (&resmpz, bytes);
}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/exit.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/exit.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/exit.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -1,8 +0,0 @@
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-void MLton_exit (Int status) {
- GC_done (&gcState);
- exit (status);
-}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -1,29 +0,0 @@
-#define _ISOC99_SOURCE
-
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-void MLton_GC_setHashConsDuringGC (Int b) {
- GC_setHashConsDuringGC (&gcState, b);
-}
-
-void MLton_GC_setMessages (Int b) {
- GC_setMessages (&gcState, b);
-}
-
-void MLton_GC_setSummary (Int b) {
- GC_setSummary (&gcState, b);
-}
-
-void MLton_GC_setRusageMeasureGC (Int b) {
- GC_setRusageMeasureGC (&gcState, b);
-}
-
-void MLton_GC_pack (void) {
- GC_pack (&gcState);
-}
-
-void MLton_GC_unpack (void) {
- GC_unpack (&gcState);
-}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -1,43 +0,0 @@
-#include "platform.h"
-
-#ifndef DEBUG_PROFILE
-#define DEBUG_PROFILE FALSE
-#endif
-
-extern struct GC_state gcState;
-
-void MLton_Profile_Data_free (Pointer p) {
- GC_profileFree (&gcState, (GC_profileData)p);
-}
-
-Pointer MLton_Profile_Data_malloc (void) {
- return (Pointer)GC_profileNew (&gcState);
-}
-
-void MLton_Profile_Data_write (Pointer p, Word fd) {
- if (DEBUG_PROFILE)
- fprintf (stderr, "MLton_Profile_Data_write ("FMTPTR")\n",
- (uintptr_t)p);
- GC_profileWrite (&gcState, (GC_profileData)p, (int)fd);
-}
-
-Pointer MLton_Profile_current (void) {
- Pointer res;
-
- res = (Pointer)(GC_getProfileCurrent (&gcState));
- if (DEBUG_PROFILE)
- fprintf (stderr, FMTPTR" = MLton_Profile_current ()\n",
- (uintptr_t)res);
- return res;
-}
-
-void MLton_Profile_setCurrent (Pointer d) {
- if (DEBUG_PROFILE)
- fprintf (stderr, "MLton_Profile_setCurrent ("FMTPTR")\n",
- (uintptr_t)d);
- GC_setProfileCurrent (&gcState, (GC_profileData)d);
-}
-
-void MLton_Profile_done () {
- GC_profileDone (&gcState);
-}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/share.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/share.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/share.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -1,7 +0,0 @@
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-void MLton_share (Pointer p) {
- GC_share (&gcState, p);
-}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/size.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/size.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/size.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -1,7 +0,0 @@
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-Word MLton_size(Pointer p) {
- return GC_size(&gcState, p);
-}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -1,57 +0,0 @@
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-enum {
- DEBUG_THREAD = FALSE,
-};
-
-Pointer Thread_current () {
- Pointer t;
-
- t = (Pointer)(GC_getCurrentThread (&gcState));
- if (DEBUG_THREAD)
- fprintf (stderr, FMTPTR" = Thread_current ()\n",
- (uintptr_t)t);
- return t;
-}
-
-void Thread_finishSignalHandler () {
- GC_finishSignalHandler (&gcState);
-}
-
-Pointer Thread_saved () {
- Pointer t;
-
- t = (Pointer)(GC_getSavedThread (&gcState));
- if (DEBUG_THREAD)
- fprintf (stderr, FMTPTR" = Thread_saved ()\n",
- (uintptr_t)t);
- return t;
-}
-
-void Thread_setCallFromCHandler (Pointer t) {
- GC_setCallFromCHandlerThread (&gcState, (GC_thread)t);
-}
-
-void Thread_setSaved (Pointer t) {
- if (DEBUG_THREAD)
- fprintf (stderr, "Thread_setSaved ("FMTPTR")\n",
- (uintptr_t)t);
- GC_setSavedThread (&gcState, (GC_thread)t);
-}
-
-void Thread_setSignalHandler (Pointer t) {
- GC_setSignalHandlerThread (&gcState, (GC_thread)t);
-}
-
-void Thread_startSignalHandler () {
- GC_startSignalHandler (&gcState);
-}
-
-void Thread_switchTo (Pointer t, Word ensureBytesFree) {
- if (DEBUG_THREAD)
- fprintf (stderr, "Thread_switchTo ("FMTPTR", %u)\n",
- (uintptr_t)t, (uint)ensureBytesFree);
- GC_switchToThread (&gcState, (GC_thread)t, ensureBytesFree);
-}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -1,11 +0,0 @@
-#include "platform.h"
-
-extern struct GC_state gcState;
-
-Bool World_isOriginal(void) {
- return (Bool)(GC_getAmOriginal (&gcState));
-}
-
-void World_makeOriginal(void) {
- GC_setAmOriginal (&gcState, TRUE);
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -176,10 +176,10 @@
assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
}
-void GC_gc (GC_state s, size_t bytesRequested, bool force,
+void GC_collect (GC_state s, size_t bytesRequested, bool force,
char *file, int line) {
if (DEBUG or s->controls.messages)
- fprintf (stderr, "%s %d: GC_gc\n", file, line);
+ fprintf (stderr, "%s %d: GC_collect\n", file, line);
enter (s);
/* When the mutator requests zero bytes, it may actually need as
* much as GC_HEAP_LIMIT_SLOP.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-14 23:03:16 UTC (rev 4217)
@@ -22,7 +22,7 @@
static void ensureHasHeapBytesFree (GC_state s,
size_t oldGenBytesRequested,
size_t nurseryBytesRequested);
-void GC_gc (GC_state s, size_t bytesRequested, bool force,
- char *file, int line);
+void GC_collect (GC_state s, size_t bytesRequested, bool force,
+ char *file, int line);
#endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.c 2005-11-14 03:41:13 UTC (rev 4216)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.c 2005-11-14 23:03:16 UTC (rev 4217)
@@ -27,3 +27,7 @@
CommandLine_argv = (uint)(argv + start);
}
+void MLton_exit (Int status, GC_state s) {
+ GC_done (s);
+ exit (status);
+}