Menu
▾
▴
mlton-commit — [MLton-commit] Code commits
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(56) |
Sep
(40) |
Oct
(30) |
Nov
(144) |
Dec
(23) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(41) |
Feb
(29) |
Mar
(31) |
Apr
(39) |
May
(193) |
Jun
(45) |
Jul
(19) |
Aug
(3) |
Sep
(23) |
Oct
(83) |
Nov
(92) |
Dec
(123) |
| 2007 |
Jan
(90) |
Feb
(267) |
Mar
(120) |
Apr
(51) |
May
(40) |
Jun
(121) |
Jul
(109) |
Aug
(173) |
Sep
(77) |
Oct
(52) |
Nov
(121) |
Dec
(62) |
| 2008 |
Jan
(76) |
Feb
(53) |
Mar
(98) |
Apr
(87) |
May
(26) |
Jun
(27) |
Jul
(23) |
Aug
(136) |
Sep
(79) |
Oct
(68) |
Nov
(29) |
Dec
(14) |
| 2009 |
Jan
(7) |
Feb
(2) |
Mar
(11) |
Apr
(75) |
May
(1) |
Jun
(95) |
Jul
(19) |
Aug
(4) |
Sep
(8) |
Oct
(93) |
Nov
(43) |
Dec
(21) |
| 2010 |
Jan
(20) |
Feb
(23) |
Mar
(18) |
Apr
(6) |
May
(20) |
Jun
(23) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
(2) |
Feb
(6) |
Mar
(15) |
Apr
(5) |
May
(9) |
Jun
(14) |
Jul
(9) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(17) |
Jul
(37) |
Aug
|
Sep
(1) |
Oct
(6) |
Nov
|
Dec
|
| 2013 |
Jan
|
Feb
|
Mar
(5) |
Apr
(2) |
May
(7) |
Jun
(11) |
Jul
(8) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
(2) |
Mar
(1) |
Apr
|
May
(1) |
Jun
(1) |
Jul
(7) |
Aug
(2) |
Sep
|
Oct
(5) |
Nov
(2) |
Dec
(4) |
| 2015 |
Jan
|
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(9) |
Jul
(1) |
Aug
|
Sep
|
Oct
(4) |
Nov
(1) |
Dec
|
| 2016 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(5) |
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
(3) |
Mar
(3) |
Apr
(7) |
May
(2) |
Jun
(2) |
Jul
(5) |
Aug
(1) |
Sep
(2) |
Oct
(17) |
Nov
(4) |
Dec
(7) |
| 2018 |
Jan
(5) |
Feb
(14) |
Mar
(2) |
Apr
(5) |
May
(2) |
Jun
(5) |
Jul
|
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(5) |
Dec
|
| 2019 |
Jan
(4) |
Feb
(2) |
Mar
(3) |
Apr
(1) |
May
(8) |
Jun
(14) |
Jul
(2) |
Aug
|
Sep
(2) |
Oct
(2) |
Nov
(15) |
Dec
(2) |
| 2020 |
Jan
(10) |
Feb
(3) |
Mar
(1) |
Apr
|
May
(9) |
Jun
(4) |
Jul
(16) |
Aug
(10) |
Sep
(4) |
Oct
(3) |
Nov
|
Dec
|
| 2021 |
Jan
(11) |
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
|
Oct
(6) |
Nov
(4) |
Dec
(4) |
| 2022 |
Jan
(4) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(6) |
Jun
(3) |
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
(2) |
May
(5) |
Jun
(1) |
Jul
(4) |
Aug
(1) |
Sep
|
Oct
(1) |
Nov
(13) |
Dec
|
| 2024 |
Jan
(1) |
Feb
|
Mar
(5) |
Apr
|
May
(10) |
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
(1) |
Dec
(14) |
| 2025 |
Jan
(3) |
Feb
|
Mar
(1) |
Apr
|
May
(2) |
Jun
(3) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Stephen W. <sw...@ml...> - 2005-11-02 19:51:13
|
Removed reference to stdint.h, which should be handled by platform.h.
----------------------------------------------------------------------
U mlton/trunk/bytecode/interpret.c
----------------------------------------------------------------------
Modified: mlton/trunk/bytecode/interpret.c
===================================================================
--- mlton/trunk/bytecode/interpret.c 2005-11-03 03:41:35 UTC (rev 4134)
+++ mlton/trunk/bytecode/interpret.c 2005-11-03 03:51:11 UTC (rev 4135)
@@ -6,7 +6,6 @@
*/
#include "platform.h"
-#include <stdint.h>
#include "interpret.h"
#include "c-chunk.h" // c-chunk.h must come before opcode.h because it
// redefines some opcode symbols
|
|
From: Matthew F. <fl...@ml...> - 2005-11-02 19:41:45
|
MAIL fixed fix to getrusage bug
In Revision 3995:
Added
val MLton.GC.setRusage: bool -> unit
This sets a flag in the GC state that controls whether rusage
information is gathered for each collection. The default is FALSE,
which is different than earlier behavior, but probably makes sense
because the getrusage calls at each GC can be costly, because
MLton.Rusage.rusage is not so used, and because it's easy to enable
the old behavior by calling MLton.GC.setRusage false.
However, this function was never used in the basis library. In
particular, we never enabled rusage when MLton.Rusage.rusage was used.
This further meant that Timer.getGCTime would _always_ return zero,
unless the user happened to run with gc-summary or gc-messages (or
used the corresponding MLton.GC functions).
----------------------------------------------------------------------
U mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb
U mlton/trunk/basis-library/mlton/rusage.sml
U mlton/trunk/runtime/basis/GC.c
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb 2005-11-03 02:56:30 UTC (rev 4133)
+++ mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb 2005-11-03 03:41:35 UTC (rev 4134)
@@ -166,6 +166,8 @@
../../mlton/signal.sml
../../mlton/process.sig
../../mlton/process.sml
+ ../../mlton/gc.sig
+ ../../mlton/gc.sml
../../mlton/rusage.sig
../../mlton/rusage.sml
@@ -214,8 +216,6 @@
in
../../mlton/ffi.sml
end
- ../../mlton/gc.sig
- ../../mlton/gc.sml
../../mlton/int-inf.sig
../../mlton/platform.sig
../../mlton/platform.sml
Modified: mlton/trunk/basis-library/mlton/rusage.sml
===================================================================
--- mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 02:56:30 UTC (rev 4133)
+++ mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 03:41:35 UTC (rev 4134)
@@ -28,16 +28,20 @@
utime = toTime (utimeSec, utimeUsec)}
end
- fun rusage () =
- let
- val () = Prim.ru ()
- open Prim
+ val rusage =
+ let val () = MLtonGC.setRusage true
in
- {children = collect (children_utime_sec, children_utime_usec,
- children_stime_sec, children_stime_usec),
- gc = collect (gc_utime_sec, gc_utime_usec,
- gc_stime_sec, gc_stime_usec),
- self = collect (self_utime_sec, self_utime_usec,
- self_stime_sec, self_stime_usec)}
+ fn () =>
+ let
+ val () = Prim.ru ()
+ open Prim
+ in
+ {children = collect (children_utime_sec, children_utime_usec,
+ children_stime_sec, children_stime_usec),
+ gc = collect (gc_utime_sec, gc_utime_usec,
+ gc_stime_sec, gc_stime_usec),
+ self = collect (self_utime_sec, self_utime_usec,
+ self_stime_sec, self_stime_usec)}
+ end
end
end
Modified: mlton/trunk/runtime/basis/GC.c
===================================================================
--- mlton/trunk/runtime/basis/GC.c 2005-11-03 02:56:30 UTC (rev 4133)
+++ mlton/trunk/runtime/basis/GC.c 2005-11-03 03:41:35 UTC (rev 4134)
@@ -16,8 +16,8 @@
gcState.summary = b;
}
-void GC_setRusage () {
- gcState.rusageIsEnabled = TRUE;
+void GC_setRusage (Int b) {
+ gcState.rusageIsEnabled = b;
}
void MLton_GC_pack () {
|
|
From: Stephen W. <sw...@ml...> - 2005-11-02 18:56:31
|
Took hamlet out of regression.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-02 23:33:24 UTC (rev 4132)
+++ mlton/trunk/bin/regression 2005-11-03 02:56:30 UTC (rev 4133)
@@ -208,7 +208,7 @@
f=`basename $f .sml`
tmpf=/tmp/$f.$$
case "$f" in
- fxp)
+ fxp|hamlet)
echo "skipping $f"
;;
*)
|
|
From: Stephen W. <sw...@ml...> - 2005-11-02 15:33:26
|
Added setgroups stub for MinGW.
----------------------------------------------------------------------
U mlton/trunk/basis-library/posix/stub-mingw.sml
U mlton/trunk/runtime/platform/mingw.c
U mlton/trunk/runtime/platform/mingw.h
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/posix/stub-mingw.sml
===================================================================
--- mlton/trunk/basis-library/posix/stub-mingw.sml 2005-11-02 20:16:40 UTC (rev 4131)
+++ mlton/trunk/basis-library/posix/stub-mingw.sml 2005-11-02 23:33:24 UTC (rev 4132)
@@ -73,6 +73,7 @@
val getppid = stub ("getppid", getppid)
val getuid = stub ("getuid", getuid)
val setgid = stub ("setgid", setgid)
+ val setgroups = stub ("stegroups", setgroups)
val setpgid = stub ("setpgid", setpgid)
val setsid = stub ("setsid", setsid)
val setuid = stub ("setuid", setuid)
Modified: mlton/trunk/runtime/platform/mingw.c
===================================================================
--- mlton/trunk/runtime/platform/mingw.c 2005-11-02 20:16:40 UTC (rev 4131)
+++ mlton/trunk/runtime/platform/mingw.c 2005-11-02 23:33:24 UTC (rev 4132)
@@ -341,6 +341,11 @@
int setgid (gid_t gid) {
die ("setgid not implemented");
}
+
+int setgroups (size_t size, gid_t *list) {
+ die ("setgroups not implemented");
+}
+
int setpgid (pid_t pid, pid_t pgid) {
die ("setpgid not implemented");
}
Modified: mlton/trunk/runtime/platform/mingw.h
===================================================================
--- mlton/trunk/runtime/platform/mingw.h 2005-11-02 20:16:40 UTC (rev 4131)
+++ mlton/trunk/runtime/platform/mingw.h 2005-11-02 23:33:24 UTC (rev 4132)
@@ -262,6 +262,7 @@
uid_t getuid (void);
int setenv (const char *name, const char *value, int overwrite);
int setgid (gid_t gid);
+int setgroups (size_t size, gid_t *list);
int setpgid (pid_t pid, pid_t pgid);
pid_t setsid (void);
int setuid (uid_t uid);
|
|
From: Stephen W. <sw...@ml...> - 2005-11-02 12:16:45
|
Added MLton.ProcEnv.setgroups.
----------------------------------------------------------------------
U mlton/trunk/lib/mlton-stubs/mlton.sml
----------------------------------------------------------------------
Modified: mlton/trunk/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs/mlton.sml 2005-11-02 17:43:11 UTC (rev 4130)
+++ mlton/trunk/lib/mlton-stubs/mlton.sml 2005-11-02 20:16:40 UTC (rev 4131)
@@ -279,6 +279,7 @@
structure ProcEnv =
struct
fun setenv _ = raise Fail "setenv"
+ fun setgroups _ = raise Fail "setgroups"
end
structure Process =
|
|
From: Stephen W. <sw...@ml...> - 2005-11-02 09:43:12
|
Added Wesley's very simple mlton.bat file for running the MinGW MLton when you don't have MSYS. If you have MSYS, you can just use the bash script. ---------------------------------------------------------------------- A mlton/trunk/package/mingw/ A mlton/trunk/package/mingw/mlton.bat ---------------------------------------------------------------------- Added: mlton/trunk/package/mingw/mlton.bat =================================================================== --- mlton/trunk/package/mingw/mlton.bat 2005-11-02 17:35:21 UTC (rev 4129) +++ mlton/trunk/package/mingw/mlton.bat 2005-11-02 17:43:11 UTC (rev 4130) @@ -0,0 +1,13 @@ +@echo off +set lib=c:\MLton\lib +set cc=c:\MinGW\bin\gcc.exe + +set world=%lib%\world.mlton +set mlton=%lib%\mlton-compile.exe + +set ccopts=-I%lib%\include -O1 -fno-strict-aliasing -fomit-frame-pointer -w +set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2 +set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2 -mtune=pentium4 +set linkopts=-L%lib%\lib -lgdtoa -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32 + +%mlton% @MLton load-world %world% -- %lib% -cc %cc% -cc-opt "%ccopts%" -link-opt "%linkopts%" %1 %2 %3 %4 %5 %6 %7 %8 %9 |
|
From: Stephen W. <sw...@ml...> - 2005-11-02 09:35:25
|
A not-yet-entirely-working script to make a pdf guide from the wiki.
----------------------------------------------------------------------
A mlton/trunk/bin/make-pdf-guide
----------------------------------------------------------------------
Added: mlton/trunk/bin/make-pdf-guide
===================================================================
--- mlton/trunk/bin/make-pdf-guide 2005-11-02 15:01:11 UTC (rev 4128)
+++ mlton/trunk/bin/make-pdf-guide 2005-11-02 17:35:21 UTC (rev 4129)
@@ -0,0 +1,33 @@
+#!/bin/sh
+
+set -e
+set -x
+
+name=`basename $0`
+dir=`dirname $0`
+src=`cd $dir/.. && pwd`
+
+die () {
+ echo >&2 "$1"
+ exit 1
+}
+
+usage () {
+ die "usage: $name"
+}
+
+case "$#" in
+0)
+;;
+*)
+ usage
+;;
+esac
+
+tmp='/tmp/guide'
+rm -rf $tmp
+mkdir $tmp
+
+( cd $src/doc/guide && tar -cf - . ) | ( cd $tmp && tar -xf - )
+yes | time html2ps -DHnRtTU -C fb -W bL http://localhost/guide/ >guide.ps 2>/tmp/z.log
+ps2pdf guide.ps
Property changes on: mlton/trunk/bin/make-pdf-guide
___________________________________________________________________
Name: svn:executable
+ *
|
|
From: Matthew F. <fl...@ml...> - 2005-11-02 07:01:34
|
More cleanups
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.h
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/gc/gc_state.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-11-02 15:01:11 UTC (rev 4128)
@@ -90,6 +90,7 @@
dfs-mark.c \
enter_leave.c \
foreach.c \
+ forward.c \
frame.c \
garbage-collection.c \
gc_state.c \
@@ -107,7 +108,6 @@
pack.c \
pointer.c \
pointer_predicates.c \
- ratios_predicates.c \
share.c \
size.c \
stack.c \
@@ -129,8 +129,9 @@
safe.h \
rusage.h \
virtual-memory.h \
+ model.h \
pointer.h \
- model.h \
+ objptr.h \
object.h \
array.h \
frame.h \
@@ -145,9 +146,11 @@
current.h \
foreach.h \
statistics.h \
- controls.h \
sysvals.h \
ratios.h \
+ controls.h \
+ forward.h \
+ cheney-copy.h \
hash-cons.h \
profiling.h \
signals.h \
@@ -158,15 +161,14 @@
atomic.h \
invariant.h \
enter_leave.h \
- cheney-copy.h \
dfs-mark.h \
- share.h \
mark-compact.h \
new-object.h \
garbage-collection.h \
array-allocate.h \
copy-thread.h \
pack.h \
+ share.h \
size.h \
gc_suffix.h
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -6,13 +6,13 @@
* See the file MLton-LICENSE for details.
*/
-void atomicBegin (GC_state s) {
+void beginAtomic (GC_state s) {
s->atomicState++;
if (0 == s->limit)
s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP;
}
-void atomicEnd (GC_state s) {
+void endAtomic (GC_state s) {
s->atomicState--;
if (0 == s->atomicState
and s->signalsInfo.signalIsPending)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -6,5 +6,5 @@
* See the file MLton-LICENSE for details.
*/
-void atomicBegin (GC_state s);
-void atomicEnd (GC_state s);
+void beginAtomic (GC_state s);
+void endAtomic (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -10,156 +10,15 @@
/* Cheney Copying Collection */
/* ---------------------------------------------------------------- */
-#define GC_FORWARDED ~((GC_header)0)
-
-/* forward (s, opp)
- * Forwards the object pointed to by *opp and updates *opp to point to
- * the new object.
- * It also updates the crossMap.
- */
-struct forwardState {
- bool amInMinorGC;
- pointer back;
- pointer toStart;
- pointer toLimit;
-};
-static struct forwardState forwardState;
-
-bool isPointerInToSpace (pointer p) {
- return (not (isPointer (p))
- or (forwardState.toStart <= p and p < forwardState.toLimit));
-}
-
-bool isObjptrInToSpace (objptr op) {
+void updateWeaksForCheneyCopy (GC_state s) {
pointer p;
-
- if (not (isObjptr (op)))
- return TRUE;
- p = objptrToPointer (op, forwardState.toStart);
- return isPointerInToSpace (p);
-}
-
-void forwardObjptr (GC_state s, objptr *opp) {
- objptr op;
- pointer p;
- GC_header header;
-
- op = *opp;
- p = objptrToPointer (op, s->heap.start);
- if (DEBUG_DETAILED)
- fprintf (stderr,
- "forwardObjptr opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
- (uintptr_t)opp, op, (uintptr_t)p);
- assert (isObjptrInFromSpace (s, *opp));
- header = getHeader (p);
- if (DEBUG_DETAILED and header == GC_FORWARDED)
- fprintf (stderr, " already FORWARDED\n");
- if (header != GC_FORWARDED) { /* forward the object */
- uint16_t numNonObjptrs, numObjptrs;
- GC_objectTypeTag tag;
-
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
-
- size_t headerBytes, objectBytes, size, skip;
-
- /* Compute the space taken by the header and object body. */
- if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) { /* Fixed size object. */
- headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes = sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs);
- skip = 0;
- } else if (ARRAY_TAG == tag) {
- headerBytes = GC_ARRAY_HEADER_SIZE;
- objectBytes = sizeofArrayNoHeader (s, getArrayLength (p),
- numNonObjptrs, numObjptrs);
- skip = 0;
- } else { /* Stack. */
- GC_stack stack;
-
- assert (STACK_TAG == tag);
- headerBytes = GC_STACK_HEADER_SIZE;
- stack = (GC_stack)p;
-
- if (getStackCurrentObjptr(s) == op) {
- /* Shrink stacks that don't use a lot of their reserved space;
- * but don't violate the stack invariant.
- */
- if (stack->used <= stack->reserved / 4) {
- size_t new =
- alignStackReserved
- (s, max (stack->reserved / 2,
- sizeofStackMinimumReserved (s, stack)));
- /* It's possible that new > stack->reserved if the stack
- * invariant is violated. In that case, we want to leave the
- * stack alone, because some other part of the gc will grow
- * the stack. We cannot do any growing here because we may
- * run out of to space.
- */
- if (new <= stack->reserved) {
- stack->reserved = new;
- if (DEBUG_STACKS)
- fprintf (stderr, "Shrinking stack to size %zu.\n",
- /*uintToCommaString*/(stack->reserved));
- }
- }
- } else {
- /* Shrink heap stacks. */
- stack->reserved =
- alignStackReserved
- (s, max((size_t)(s->ratios.threadShrink * stack->reserved), stack->used));
- if (DEBUG_STACKS)
- fprintf (stderr, "Shrinking stack to size %zu.\n",
- /*uintToCommaString*/(stack->reserved));
- }
- objectBytes = sizeof (struct GC_stack) + stack->used;
- skip = stack->reserved - stack->used;
- }
- size = headerBytes + objectBytes;
- assert (forwardState.back + size + skip <= forwardState.toLimit);
- /* Copy the object. */
- GC_memcpy (p - headerBytes, forwardState.back, size);
- /* If the object has a valid weak pointer, link it into the weaks
- * for update after the copying GC is done.
- */
- if ((WEAK_TAG == tag) and (numObjptrs == 1)) {
- GC_weak w;
-
- w = (GC_weak)(forwardState.back + GC_NORMAL_HEADER_SIZE);
- if (DEBUG_WEAK)
- fprintf (stderr, "forwarding weak "FMTPTR" ",
- (uintptr_t)w);
- if (isObjptr (w->objptr)
- and (not forwardState.amInMinorGC
- or isObjptrInNursery (s, w->objptr))) {
- if (DEBUG_WEAK)
- fprintf (stderr, "linking\n");
- w->link = s->weaks;
- s->weaks = w;
- } else {
- if (DEBUG_WEAK)
- fprintf (stderr, "not linking\n");
- }
- }
- /* Store the forwarding pointer in the old object. */
- *(GC_header*)(p - GC_HEADER_SIZE) = GC_FORWARDED;
- *(objptr*)p = pointerToObjptr(forwardState.back + headerBytes, forwardState.toStart);
- /* Update the back of the queue. */
- forwardState.back += size + skip;
- assert (isAligned ((size_t)forwardState.back + GC_NORMAL_HEADER_SIZE,
- s->alignment));
- }
- *opp = *(objptr*)p;
- assert (isObjptrInToSpace (*opp));
-}
-
-void updateWeaks (GC_state s) {
- pointer p;
GC_weak w;
for (w = s->weaks; w != NULL; w = w->link) {
assert (BOGUS_OBJPTR != w->objptr);
if (DEBUG_WEAK)
- fprintf (stderr, "updateWeaks w = "FMTPTR" ", (uintptr_t)w);
+ fprintf (stderr, "updateWeaksForCheneyCopy w = "FMTPTR" ", (uintptr_t)w);
p = objptrToPointer (w->objptr, s->heap.start);
if (GC_FORWARDED == getHeader (p)) {
if (DEBUG_WEAK)
@@ -177,7 +36,7 @@
s->weaks = NULL;
}
-void swapHeaps (GC_state s) {
+void swapHeapsForCheneyCopy (GC_state s) {
struct GC_heap tempHeap;
tempHeap = s->secondaryHeap;
@@ -194,9 +53,9 @@
if (detailedGCTime (s))
startTiming (&ru_start);
s->cumulativeStatistics.numCopyingGCs++;
- forwardState.amInMinorGC = FALSE;
- forwardState.toStart = s->secondaryHeap.start;
- forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.size;
+ s->forwardState.amInMinorGC = FALSE;
+ s->forwardState.toStart = s->secondaryHeap.start;
+ s->forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.size;
if (DEBUG or s->controls.messages) {
fprintf (stderr, "Major copying GC.\n");
fprintf (stderr, "fromSpace = "FMTPTR" of size %zu\n",
@@ -214,16 +73,16 @@
*/
assert (s->secondaryHeap.size >= s->heap.oldGenSize);
toStart = alignFrontier (s, s->secondaryHeap.start);
- forwardState.back = toStart;
+ s->forwardState.back = toStart;
foreachGlobalObjptr (s, forwardObjptr);
- foreachObjptrInRange (s, toStart, &forwardState.back, TRUE, forwardObjptr);
- updateWeaks (s);
- s->secondaryHeap.oldGenSize = forwardState.back - s->secondaryHeap.start;
+ foreachObjptrInRange (s, toStart, &s->forwardState.back, forwardObjptr, TRUE);
+ updateWeaksForCheneyCopy (s);
+ s->secondaryHeap.oldGenSize = s->forwardState.back - s->secondaryHeap.start;
s->cumulativeStatistics.bytesCopied += s->secondaryHeap.oldGenSize;
if (DEBUG)
fprintf (stderr, "%zu bytes live.\n",
/*uintToCommaString*/(s->secondaryHeap.oldGenSize));
- swapHeaps (s);
+ swapHeapsForCheneyCopy (s);
clearCrossMap (s);
s->lastMajorStatistics.kind = GC_COPYING;
if (detailedGCTime (s))
@@ -236,111 +95,6 @@
/* Minor Cheney Copying Collection */
/* ---------------------------------------------------------------- */
-void forwardObjptrIfInNursery (GC_state s, objptr *opp) {
- objptr op;
- pointer p;
-
- op = *opp;
- p = objptrToPointer (op, s->heap.start);
- if (p < s->heap.nursery)
- return;
- if (DEBUG_GENERATIONAL)
- fprintf (stderr,
- "forwardObjptrIfInNursery opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
- (uintptr_t)opp, op, (uintptr_t)p);
- assert (s->heap.nursery <= p and p < s->limitPlusSlop);
- forwardObjptr (s, opp);
-}
-
-/* Walk through all the cards and forward all intergenerational pointers. */
-void forwardInterGenerationalObjptrs (GC_state s) {
- GC_cardMapElem *cardMap;
- GC_crossMapElem *crossMap;
- pointer oldGenStart, oldGenEnd;
-
- size_t cardIndex, maxCardIndex;
- pointer cardStart, cardEnd;
- pointer objectStart;
-
- if (DEBUG_GENERATIONAL)
- fprintf (stderr, "Forwarding inter-generational pointers.\n");
- updateCrossMap (s);
- /* Constants. */
- cardMap = s->generationalMaps.cardMap;
- crossMap = s->generationalMaps.crossMap;
- maxCardIndex = sizeToCardMapIndex (align (s->heap.oldGenSize, CARD_SIZE));
- oldGenStart = s->heap.start;
- oldGenEnd = oldGenStart + s->heap.oldGenSize;
- /* Loop variables*/
- objectStart = alignFrontier (s, s->heap.start);
- cardIndex = 0;
- cardStart = oldGenStart;
-checkAll:
- assert (cardIndex <= maxCardIndex);
- assert (isAlignedFrontier (s, objectStart));
- if (cardIndex == maxCardIndex)
- goto done;
-checkCard:
- if (DEBUG_GENERATIONAL)
- fprintf (stderr, "checking card %zu objectStart = "FMTPTR"\n",
- cardIndex, (uintptr_t)objectStart);
- assert (objectStart < oldGenStart + cardMapIndexToSize (cardIndex + 1));
- if (cardMap[cardIndex]) {
- pointer lastObject;
- size_t size;
-
- s->cumulativeStatistics.markedCards++;
- if (DEBUG_GENERATIONAL)
- fprintf (stderr, "card %zu is marked objectStart = "FMTPTR"\n",
- cardIndex, (uintptr_t)objectStart);
- lastObject = objectStart;
-skipObjects:
- assert (isAlignedFrontier (s, objectStart));
- size = sizeofObject (s, advanceToObjectData (s, objectStart));
- if (objectStart + size < cardStart) {
- objectStart += size;
- goto skipObjects;
- }
- s->cumulativeStatistics.minorBytesSkipped += objectStart - lastObject;
- cardEnd = cardStart + CARD_SIZE;
- if (oldGenEnd < cardEnd)
- cardEnd = oldGenEnd;
- assert (objectStart < cardEnd);
- lastObject = objectStart;
- /* If we ever add Weak.set, then there could be intergenerational
- * weak pointers, in which case we would need to link the weak
- * objects into s->weaks. But for now, since there is no
- * Weak.set, the foreachObjptrInRange will do the right thing on
- * weaks, since the weak pointer will never be into the nursery.
- */
- objectStart = foreachObjptrInRange (s, objectStart, &cardEnd,
- FALSE, forwardObjptrIfInNursery);
- s->cumulativeStatistics.minorBytesScanned += objectStart - lastObject;
- if (objectStart == oldGenEnd)
- goto done;
- cardIndex = sizeToCardMapIndex (objectStart - oldGenStart);
- cardStart = oldGenStart + cardMapIndexToSize (cardIndex);
- goto checkCard;
- } else {
- unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
- objectStart = cardStart + (size_t)(crossMap[cardIndex]);
- if (DEBUG_GENERATIONAL)
- fprintf (stderr,
- "card %zu is not marked"
- " crossMap[%zu] == %zu"
- " objectStart = "FMTPTR"\n",
- cardIndex, cardIndex,
- (size_t)(crossMap[cardIndex]), (uintptr_t)objectStart);
- cardIndex++;
- cardStart += CARD_SIZE;
- goto checkAll;
- }
- assert (FALSE);
-done:
- if (DEBUG_GENERATIONAL)
- fprintf (stderr, "Forwarding inter-generational pointers done.\n");
-}
-
void minorCheneyCopyGC (GC_state s) {
size_t bytesAllocated;
size_t bytesCopied;
@@ -362,25 +116,25 @@
fprintf (stderr, "Minor copying GC.\n");
if (detailedGCTime (s))
startTiming (&ru_start);
- forwardState.amInMinorGC = TRUE;
- forwardState.toStart = s->heap.start + s->heap.oldGenSize;
+ s->forwardState.amInMinorGC = TRUE;
+ s->forwardState.toStart = s->heap.start + s->heap.oldGenSize;
if (DEBUG_GENERATIONAL)
- fprintf (stderr, "toStart = "FMTPTR"\n", (uintptr_t)forwardState.toStart);
- assert (isAlignedFrontier (s, forwardState.toStart));
- forwardState.toLimit = forwardState.toStart + bytesAllocated;
+ fprintf (stderr, "toStart = "FMTPTR"\n", (uintptr_t)s->forwardState.toStart);
+ assert (isAlignedFrontier (s, s->forwardState.toStart));
+ s->forwardState.toLimit = s->forwardState.toStart + bytesAllocated;
assert (invariant (s));
s->cumulativeStatistics.numMinorGCs++;
s->lastMajorStatistics.numMinorGCs++;
- forwardState.back = forwardState.toStart;
+ s->forwardState.back = s->forwardState.toStart;
/* Forward all globals. Would like to avoid doing this once all
* the globals have been assigned.
*/
foreachGlobalObjptr (s, forwardObjptrIfInNursery);
forwardInterGenerationalObjptrs (s);
- foreachObjptrInRange (s, forwardState.toStart, &forwardState.back,
- TRUE, forwardObjptrIfInNursery);
- updateWeaks (s);
- bytesCopied = forwardState.back - forwardState.toStart;
+ foreachObjptrInRange (s, s->forwardState.toStart, &s->forwardState.back,
+ forwardObjptrIfInNursery, TRUE);
+ updateWeaksForCheneyCopy (s);
+ bytesCopied = s->forwardState.back - s->forwardState.toStart;
s->cumulativeStatistics.bytesCopiedMinor += bytesCopied;
s->heap.oldGenSize += bytesCopied;
if (detailedGCTime (s))
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -6,12 +6,7 @@
* See the file MLton-LICENSE for details.
*/
-bool pointerIsInToSpace (pointer p);
-bool objptrIsInToSpace (objptr op);
-void forwardObjptr (GC_state s, objptr *opp);
-void updateWeaks (GC_state s);
-void swapHeaps (GC_state s);
+void updateWeaksForCheneyCopy (GC_state s);
+void swapHeapsForCheneyCopy (GC_state s);
void majorCheneyCopyGC (GC_state s);
-void forwardObjptrIfInNursery (GC_state s, objptr *opp);
-void forwardInterGenerationalObjptrs (GC_state s);
void minorCheneyCopyGC (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -9,3 +9,10 @@
bool detailedGCTime (GC_state s) {
return s->controls.summary;
}
+
+bool needGCTime (GC_state s) {
+ return
+ DEBUG
+ or s->controls.summary
+ or s->controls.messages;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -13,7 +13,9 @@
bool mayProcessAtMLton;
bool messages; /* Print a message at the start and end of each gc. */
size_t oldGenArraySize; /* Arrays larger are allocated in old gen, if possible. */
+ struct GC_ratios ratios;
bool summary; /* Print a summary of gc info when program exits. */
};
bool detailedGCTime (GC_state s);
+bool needGCTime (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -24,22 +24,3 @@
pointer p = objptrToPointer(getStackCurrentObjptr(s), s->heap.start);
return (GC_stack)p;
}
-
-size_t sizeofStackCurrentUsed (GC_state s) {
- return s->stackTop - s->stackBottom;
-}
-
-
-
-void setThreadAndStackCurrent (GC_state s) {
- GC_thread thread;
- GC_stack stack;
-
- thread = getThreadCurrent (s);
- s->exnStack = thread->exnStack;
- stack = getStackCurrent (s);
- s->stackBottom = getStackBottom (s, stack);
- s->stackTop = getStackTop (s, stack);
- s->stackLimit = getStackLimit (s, stack);
- markCard (s, (pointer)stack);
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -10,6 +10,3 @@
GC_thread getThreadCurrent (GC_state s);
objptr getStackCurrentObjptr (GC_state s);
GC_stack getStackCurrent (GC_state s);
-size_t sizeofStackCurrentUsed (GC_state s);
-
-void setThreadAndStackCurrent (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -148,7 +148,7 @@
/* There is nothing to mark. */
normalDone:
if (shouldHashCons)
- cur = hashCons (s, cur, TRUE);
+ cur = hashConsPointer (s, cur, TRUE);
goto ret;
}
todo = cur + sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
@@ -174,7 +174,8 @@
nextHeaderp = getHeaderp (next);
nextHeader = *nextHeaderp;
if (mark == (nextHeader & MARK_MASK)) {
- maybeShareObjptr (s, (objptr*)todo, shouldHashCons);
+ if (shouldHashCons)
+ shareObjptr (s, (objptr*)todo);
goto markNextInNormal;
}
*headerp = (header & ~COUNTER_MASK) | (index << COUNTER_SHIFT);
@@ -197,7 +198,7 @@
/* There is nothing to mark. */
arrayDone:
if (shouldHashCons)
- cur = hashCons (s, cur, TRUE);
+ cur = hashConsPointer (s, cur, TRUE);
goto ret;
}
/* Begin marking first element. */
@@ -237,7 +238,8 @@
nextHeaderp = getHeaderp (next);
nextHeader = *nextHeaderp;
if (mark == (nextHeader & MARK_MASK)) {
- maybeShareObjptr (s, (objptr*)todo, shouldHashCons);
+ if (shouldHashCons)
+ shareObjptr (s, (objptr*)todo);
goto markNextInArray;
}
/* Recur and mark next. */
@@ -287,7 +289,8 @@
nextHeader = *nextHeaderp;
if (mark == (nextHeader & MARK_MASK)) {
index++;
- maybeShareObjptr (s, (objptr*)todo, shouldHashCons);
+ if (shouldHashCons)
+ shareObjptr (s, (objptr*)todo);
goto markInFrame;
}
((GC_stack)cur)->markIndex = index;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -15,11 +15,11 @@
if (DEBUG)
fprintf (stderr, "enter\n");
/* used needs to be set because the mutator has changed s->stackTop. */
- getStackCurrent(s)->used = sizeofStackCurrentUsed (s);
+ getStackCurrent(s)->used = sizeofGCStateCurrentStackUsed (s);
getThreadCurrent(s)->exnStack = s->exnStack;
if (DEBUG)
displayGCState (s, stderr);
- atomicBegin (s);
+ beginAtomic (s);
assert (invariant (s));
if (DEBUG)
fprintf (stderr, "enter ok\n");
@@ -32,7 +32,7 @@
* for functions that don't ensureBytesFree.
*/
assert (mutatorInvariant (s, FALSE, TRUE));
- atomicEnd (s);
+ endAtomic (s);
if (DEBUG)
fprintf (stderr, "leave ok\n");
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -6,7 +6,7 @@
* See the file MLton-LICENSE for details.
*/
-void maybeCall (GC_state s, GC_foreachObjptrFun f, objptr *opp) {
+void callIfIsObjptr (GC_state s, GC_foreachObjptrFun f, objptr *opp) {
if (isObjptr (*opp))
f (s, opp);
}
@@ -19,18 +19,18 @@
for (unsigned int i = 0; i < s->globalsLength; ++i) {
if (DEBUG_DETAILED)
fprintf (stderr, "foreachGlobal %u\n", i);
- maybeCall (s, f, &s->globals [i]);
+ callIfIsObjptr (s, f, &s->globals [i]);
}
if (DEBUG_DETAILED)
fprintf (stderr, "foreachGlobal threads\n");
- maybeCall (s, f, &s->callFromCHandlerThread);
- maybeCall (s, f, &s->currentThread);
- maybeCall (s, f, &s->savedThread);
- maybeCall (s, f, &s->signalHandlerThread);
+ callIfIsObjptr (s, f, &s->callFromCHandlerThread);
+ callIfIsObjptr (s, f, &s->currentThread);
+ callIfIsObjptr (s, f, &s->savedThread);
+ callIfIsObjptr (s, f, &s->signalHandlerThread);
}
-/* foreachObjptrInObject (s, p, skipWeaks, f)
+/* foreachObjptrInObject (s, p, f, skipWeaks)
*
* Applies f to each object pointer in the object pointed to by p.
* Returns pointer to the end of object, i.e. just past object.
@@ -38,7 +38,7 @@
* If skipWeaks, then the object pointer in weak objects is skipped.
*/
pointer foreachObjptrInObject (GC_state s, pointer p,
- bool skipWeaks, GC_foreachObjptrFun f) {
+ GC_foreachObjptrFun f, bool skipWeaks) {
GC_header header;
uint16_t numNonObjptrs;
uint16_t numObjptrs;
@@ -64,12 +64,12 @@
fprintf (stderr,
" p = "FMTPTR" *p = "FMTOBJPTR"\n",
(uintptr_t)p, *(objptr*)p);
- maybeCall (s, f, (objptr*)p);
+ callIfIsObjptr (s, f, (objptr*)p);
}
} else if (WEAK_TAG == tag) {
p += sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
if (not skipWeaks and 1 == numObjptrs) {
- maybeCall (s, f, (objptr*)p);
+ callIfIsObjptr (s, f, (objptr*)p);
p += OBJPTR_SIZE;
}
} else if (ARRAY_TAG == tag) {
@@ -97,7 +97,7 @@
if (0 == numNonObjptrs)
/* Array with only pointers. */
for ( ; p < last; p += OBJPTR_SIZE)
- maybeCall (s, f, (objptr*)p);
+ callIfIsObjptr (s, f, (objptr*)p);
else {
/* Array with a mix of pointers and non-pointers. */
size_t nonObjptrBytes;
@@ -115,7 +115,7 @@
next = p + objptrBytes;
/* For each internal pointer. */
for ( ; p < next; p += OBJPTR_SIZE)
- maybeCall (s, f, (objptr*)p);
+ callIfIsObjptr (s, f, (objptr*)p);
}
}
assert (p == last);
@@ -153,7 +153,7 @@
if (DEBUG)
fprintf(stderr, " offset %"PRIx16" address "FMTOBJPTR"\n",
frameOffsets[i + 1], *(objptr*)(top + frameOffsets[i + 1]));
- maybeCall (s, f, (objptr*)(top + frameOffsets[i + 1]));
+ callIfIsObjptr (s, f, (objptr*)(top + frameOffsets[i + 1]));
}
}
assert(top == bottom);
@@ -162,7 +162,7 @@
return p;
}
-/* foreachObjptrInRange (s, front, back, skipWeaks, f)
+/* foreachObjptrInRange (s, front, back, f, skipWeaks)
*
* Apply f to each pointer between front and *back, which should be a
* contiguous sequence of objects, where front points at the beginning
@@ -175,7 +175,7 @@
*/
pointer foreachObjptrInRange (GC_state s, pointer front, pointer *back,
- bool skipWeaks, GC_foreachObjptrFun f) {
+ GC_foreachObjptrFun f, bool skipWeaks) {
pointer b;
assert (isAlignedFrontier (s, front));
@@ -192,7 +192,7 @@
fprintf (stderr,
" front = "FMTPTR" *back = "FMTPTR"\n",
(uintptr_t)front, (uintptr_t)(*back));
- front = foreachObjptrInObject (s, advanceToObjectData (s, front), skipWeaks, f);
+ front = foreachObjptrInObject (s, advanceToObjectData (s, front), f, skipWeaks);
}
b = *back;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -8,7 +8,7 @@
typedef void (*GC_foreachObjptrFun) (GC_state s, objptr *opp);
-void maybeCall (GC_state s, GC_foreachObjptrFun f, objptr *opp);
+void callIfIsObjptr (GC_state s, GC_foreachObjptrFun f, objptr *opp);
/* foreachGlobalObjptr (s, f)
*
* Apply f to each global object pointer into the heap.
@@ -22,8 +22,8 @@
* If skipWeaks, then the object pointer in weak objects is skipped.
*/
pointer foreachObjptrInObject (GC_state s, pointer p,
- bool skipWeaks, GC_foreachObjptrFun f);
-/* foreachObjptrInRange (s, front, back, skipWeaks, f)
+ GC_foreachObjptrFun f, bool skipWeaks);
+/* foreachObjptrInRange (s, front, back, f, skipWeaks)
*
* Apply f to each pointer between front and *back, which should be a
* contiguous sequence of objects, where front points at the beginning
@@ -35,7 +35,7 @@
* If skipWeaks, then the object pointer in weak objects is skipped.
*/
pointer foreachObjptrInRange (GC_state s, pointer front, pointer *back,
- bool skipWeaks, GC_foreachObjptrFun f);
+ GC_foreachObjptrFun f, bool skipWeaks);
typedef void (*GC_foreachStackFrameFun) (GC_state s, GC_frameIndex i);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c (from rev 4127, mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -0,0 +1,245 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+bool isPointerInToSpace (GC_state s, pointer p) {
+ return (not (isPointer (p))
+ or (s->forwardState.toStart <= p and p < s->forwardState.toLimit));
+}
+
+bool isObjptrInToSpace (GC_state s, objptr op) {
+ pointer p;
+
+ if (not (isObjptr (op)))
+ return TRUE;
+ p = objptrToPointer (op, s->forwardState.toStart);
+ return isPointerInToSpace (s, p);
+}
+
+/* forward (s, opp)
+ * Forwards the object pointed to by *opp and updates *opp to point to
+ * the new object.
+ * It also updates the crossMap.
+ */
+void forwardObjptr (GC_state s, objptr *opp) {
+ objptr op;
+ pointer p;
+ GC_header header;
+
+ op = *opp;
+ p = objptrToPointer (op, s->heap.start);
+ if (DEBUG_DETAILED)
+ fprintf (stderr,
+ "forwardObjptr opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
+ (uintptr_t)opp, op, (uintptr_t)p);
+ assert (isObjptrInFromSpace (s, *opp));
+ header = getHeader (p);
+ if (DEBUG_DETAILED and header == GC_FORWARDED)
+ fprintf (stderr, " already FORWARDED\n");
+ if (header != GC_FORWARDED) { /* forward the object */
+ uint16_t numNonObjptrs, numObjptrs;
+ GC_objectTypeTag tag;
+
+ splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+
+ size_t headerBytes, objectBytes, size, skip;
+
+ /* Compute the space taken by the header and object body. */
+ if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) { /* Fixed size object. */
+ headerBytes = GC_NORMAL_HEADER_SIZE;
+ objectBytes = sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs);
+ skip = 0;
+ } else if (ARRAY_TAG == tag) {
+ headerBytes = GC_ARRAY_HEADER_SIZE;
+ objectBytes = sizeofArrayNoHeader (s, getArrayLength (p),
+ numNonObjptrs, numObjptrs);
+ skip = 0;
+ } else { /* Stack. */
+ GC_stack stack;
+
+ assert (STACK_TAG == tag);
+ headerBytes = GC_STACK_HEADER_SIZE;
+ stack = (GC_stack)p;
+
+ if (getStackCurrentObjptr(s) == op) {
+ /* Shrink stacks that don't use a lot of their reserved space;
+ * but don't violate the stack invariant.
+ */
+ if (stack->used <= stack->reserved / 4) {
+ size_t new =
+ alignStackReserved
+ (s, max (stack->reserved / 2,
+ sizeofStackMinimumReserved (s, stack)));
+ /* It's possible that new > stack->reserved if the stack
+ * invariant is violated. In that case, we want to leave the
+ * stack alone, because some other part of the gc will grow
+ * the stack. We cannot do any growing here because we may
+ * run out of to space.
+ */
+ if (new <= stack->reserved) {
+ stack->reserved = new;
+ if (DEBUG_STACKS)
+ fprintf (stderr, "Shrinking stack to size %zu.\n",
+ /*uintToCommaString*/(stack->reserved));
+ }
+ }
+ } else {
+ /* Shrink heap stacks. */
+ stack->reserved =
+ alignStackReserved
+ (s, max((size_t)(s->controls.ratios.threadShrink * stack->reserved),
+ stack->used));
+ if (DEBUG_STACKS)
+ fprintf (stderr, "Shrinking stack to size %zu.\n",
+ /*uintToCommaString*/(stack->reserved));
+ }
+ objectBytes = sizeof (struct GC_stack) + stack->used;
+ skip = stack->reserved - stack->used;
+ }
+ size = headerBytes + objectBytes;
+ assert (s->forwardState.back + size + skip <= s->forwardState.toLimit);
+ /* Copy the object. */
+ GC_memcpy (p - headerBytes, s->forwardState.back, size);
+ /* If the object has a valid weak pointer, link it into the weaks
+ * for update after the copying GC is done.
+ */
+ if ((WEAK_TAG == tag) and (numObjptrs == 1)) {
+ GC_weak w;
+
+ w = (GC_weak)(s->forwardState.back + GC_NORMAL_HEADER_SIZE);
+ if (DEBUG_WEAK)
+ fprintf (stderr, "forwarding weak "FMTPTR" ",
+ (uintptr_t)w);
+ if (isObjptr (w->objptr)
+ and (not s->forwardState.amInMinorGC
+ or isObjptrInNursery (s, w->objptr))) {
+ if (DEBUG_WEAK)
+ fprintf (stderr, "linking\n");
+ w->link = s->weaks;
+ s->weaks = w;
+ } else {
+ if (DEBUG_WEAK)
+ fprintf (stderr, "not linking\n");
+ }
+ }
+ /* Store the forwarding pointer in the old object. */
+ *(GC_header*)(p - GC_HEADER_SIZE) = GC_FORWARDED;
+ *(objptr*)p = pointerToObjptr(s->forwardState.back + headerBytes,
+ s->forwardState.toStart);
+ /* Update the back of the queue. */
+ s->forwardState.back += size + skip;
+ assert (isAligned ((size_t)s->forwardState.back + GC_NORMAL_HEADER_SIZE,
+ s->alignment));
+ }
+ *opp = *(objptr*)p;
+ assert (isObjptrInToSpace (s, *opp));
+}
+
+void forwardObjptrIfInNursery (GC_state s, objptr *opp) {
+ objptr op;
+ pointer p;
+
+ op = *opp;
+ p = objptrToPointer (op, s->heap.start);
+ if (p < s->heap.nursery)
+ return;
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr,
+ "forwardObjptrIfInNursery opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
+ (uintptr_t)opp, op, (uintptr_t)p);
+ assert (s->heap.nursery <= p and p < s->limitPlusSlop);
+ forwardObjptr (s, opp);
+}
+
+/* Walk through all the cards and forward all intergenerational pointers. */
+void forwardInterGenerationalObjptrs (GC_state s) {
+ GC_cardMapElem *cardMap;
+ GC_crossMapElem *crossMap;
+ pointer oldGenStart, oldGenEnd;
+
+ size_t cardIndex, maxCardIndex;
+ pointer cardStart, cardEnd;
+ pointer objectStart;
+
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "Forwarding inter-generational pointers.\n");
+ updateCrossMap (s);
+ /* Constants. */
+ cardMap = s->generationalMaps.cardMap;
+ crossMap = s->generationalMaps.crossMap;
+ maxCardIndex = sizeToCardMapIndex (align (s->heap.oldGenSize, CARD_SIZE));
+ oldGenStart = s->heap.start;
+ oldGenEnd = oldGenStart + s->heap.oldGenSize;
+ /* Loop variables*/
+ objectStart = alignFrontier (s, s->heap.start);
+ cardIndex = 0;
+ cardStart = oldGenStart;
+checkAll:
+ assert (cardIndex <= maxCardIndex);
+ assert (isAlignedFrontier (s, objectStart));
+ if (cardIndex == maxCardIndex)
+ goto done;
+checkCard:
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "checking card %zu objectStart = "FMTPTR"\n",
+ cardIndex, (uintptr_t)objectStart);
+ assert (objectStart < oldGenStart + cardMapIndexToSize (cardIndex + 1));
+ if (cardMap[cardIndex]) {
+ pointer lastObject;
+ size_t size;
+
+ s->cumulativeStatistics.markedCards++;
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "card %zu is marked objectStart = "FMTPTR"\n",
+ cardIndex, (uintptr_t)objectStart);
+ lastObject = objectStart;
+skipObjects:
+ assert (isAlignedFrontier (s, objectStart));
+ size = sizeofObject (s, advanceToObjectData (s, objectStart));
+ if (objectStart + size < cardStart) {
+ objectStart += size;
+ goto skipObjects;
+ }
+ s->cumulativeStatistics.minorBytesSkipped += objectStart - lastObject;
+ cardEnd = cardStart + CARD_SIZE;
+ if (oldGenEnd < cardEnd)
+ cardEnd = oldGenEnd;
+ assert (objectStart < cardEnd);
+ lastObject = objectStart;
+ /* If we ever add Weak.set, then there could be intergenerational
+ * weak pointers, in which case we would need to link the weak
+ * objects into s->weaks. But for now, since there is no
+ * Weak.set, the foreachObjptrInRange will do the right thing on
+ * weaks, since the weak pointer will never be into the nursery.
+ */
+ objectStart = foreachObjptrInRange (s, objectStart, &cardEnd,
+ forwardObjptrIfInNursery, FALSE);
+ s->cumulativeStatistics.minorBytesScanned += objectStart - lastObject;
+ if (objectStart == oldGenEnd)
+ goto done;
+ cardIndex = sizeToCardMapIndex (objectStart - oldGenStart);
+ cardStart = oldGenStart + cardMapIndexToSize (cardIndex);
+ goto checkCard;
+ } else {
+ unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
+ objectStart = cardStart + (size_t)(crossMap[cardIndex]);
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr,
+ "card %zu is not marked"
+ " crossMap[%zu] == %zu"
+ " objectStart = "FMTPTR"\n",
+ cardIndex, cardIndex,
+ (size_t)(crossMap[cardIndex]), (uintptr_t)objectStart);
+ cardIndex++;
+ cardStart += CARD_SIZE;
+ goto checkAll;
+ }
+ assert (FALSE);
+done:
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "Forwarding inter-generational pointers done.\n");
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.h (from rev 4127, mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -0,0 +1,22 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+struct GC_forwardState {
+ bool amInMinorGC;
+ pointer back;
+ pointer toStart;
+ pointer toLimit;
+};
+
+#define GC_FORWARDED ~((GC_header)0)
+
+bool isPointerInToSpace (GC_state s, pointer p);
+bool isObjptrsInToSpace (GC_state s, objptr op);
+void forwardObjptr (GC_state s, objptr *opp);
+void forwardObjptrIfInNursery (GC_state s, objptr *opp);
+void forwardInterGenerationalObjptrs (GC_state s);
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-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -20,7 +20,7 @@
+ s->cumulativeStatistics.numMarkCompactGCs;
if (0 < numGCs
and ((float)(s->cumulativeStatistics.numHashConsGCs) / (float)(numGCs)
- < s->ratios.hashCons))
+ < s->controls.ratios.hashCons))
s->hashConsDuringGC = TRUE;
desiredSize =
sizeofHeapDesired (s, s->lastMajorStatistics.bytesLive + bytesRequested, 0);
@@ -69,14 +69,6 @@
s->amInGC = FALSE;
}
-bool needGCTime (GC_state s) {
- return
- DEBUG
- or s->controls.summary
- or s->controls.messages
- or s->rusageIsEnabled;
-}
-
void doGC (GC_state s,
size_t oldGenBytesRequested,
size_t nurseryBytesRequested,
@@ -109,13 +101,13 @@
if (forceMajor
or totalBytesRequested > s->heap.size - s->heap.oldGenSize)
majorGC (s, totalBytesRequested, mayResize);
- setHeapNursery (s, oldGenBytesRequested + stackBytesRequested,
- nurseryBytesRequested);
+ setGCStateCurrentHeap (s, oldGenBytesRequested + stackBytesRequested,
+ nurseryBytesRequested);
assert (hasHeapBytesFree (s, oldGenBytesRequested + stackBytesRequested,
nurseryBytesRequested));
unless (stackTopOk)
growStack (s);
- setThreadAndStackCurrent (s);
+ setGCStateCurrentThreadAndStack (s);
if (needGCTime (s)) {
gcTime = stopTiming (&ru_start, &s->cumulativeStatistics.ru_gc);
s->cumulativeStatistics.maxPause =
@@ -179,7 +171,7 @@
op, stack->used, stack->reserved);
}
s->currentThread = op;
- setThreadAndStackCurrent (s);
+ setGCStateCurrentThreadAndStack (s);
}
/* GC_startHandler does not do an enter()/leave(), even though it is
@@ -246,9 +238,9 @@
leave (s);
} else {
/* BEGIN: enter(s); */
- getStackCurrent(s)->used = sizeofStackCurrentUsed (s);
+ getStackCurrent(s)->used = sizeofGCStateCurrentStackUsed (s);
getThreadCurrent(s)->exnStack = s->exnStack;
- atomicBegin (s);
+ beginAtomic (s);
/* END: enter(s); */
getThreadCurrent(s)->bytesNeeded = ensureBytesFree;
switchToThread (s, pointerToObjptr((pointer)t, s->heap.start));
@@ -262,7 +254,7 @@
}
/* END: ensureMutatorInvariant */
/* BEGIN: leave(s); */
- atomicEnd (s);
+ endAtomic (s);
/* END: leave(s); */
}
assert (mutatorFrontierInvariant(s));
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-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -10,7 +10,6 @@
void majorGC (GC_state s, size_t bytesRequested, bool mayResize);
void enterGC (GC_state s);
void leaveGC (GC_state s);
-bool needGCTime (GC_state s);
void doGC (GC_state s,
size_t oldGenBytesRequested,
size_t nurseryBytesRequested,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -26,3 +26,86 @@
(uintptr_t)s->stackBottom,
(uintptr_t)s->stackTop);
}
+
+size_t sizeofGCStateCurrentStackUsed (GC_state s) {
+ return s->stackTop - s->stackBottom;
+}
+
+void setGCStateCurrentThreadAndStack (GC_state s) {
+ GC_thread thread;
+ GC_stack stack;
+
+ thread = getThreadCurrent (s);
+ s->exnStack = thread->exnStack;
+ stack = getStackCurrent (s);
+ s->stackBottom = getStackBottom (s, stack);
+ s->stackTop = getStackTop (s, stack);
+ s->stackLimit = getStackLimit (s, stack);
+ markCard (s, (pointer)stack);
+}
+
+void setGCStateCurrentHeap (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested) {
+ GC_heap h;
+ size_t nurserySize;
+
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "setGCStateCurrentHeap(%zu, %zu)\n",
+ /*uintToCommaString*/(oldGenBytesRequested),
+ /*uintToCommaString*/(nurseryBytesRequested));
+ h = &s->heap;
+ assert (isAlignedFrontier (s, h->start + h->oldGenSize + oldGenBytesRequested));
+ nurserySize = h->size - h->oldGenSize - oldGenBytesRequested;
+ s->limitPlusSlop = h->start + h->size;
+ s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP;
+ assert (isAligned (nurserySize, POINTER_SIZE));
+ if (/* The mutator marks cards. */
+ s->mutatorMarksCards
+ /* There is enough space in the nursery. */
+ and (nurseryBytesRequested
+ <= (size_t)(s->limitPlusSlop
+ - alignFrontier (s, (s->limitPlusSlop
+ - nurserySize / 2 + 2))))
+ /* The nursery is large enough to be worth it. */
+ and (((float)(h->size - s->lastMajorStatistics.bytesLive)
+ / (float)nurserySize)
+ <= s->controls.ratios.nursery)
+ and /* There is a reason to use generational GC. */
+ (
+ /* We must use it for debugging pruposes. */
+ FORCE_GENERATIONAL
+ /* We just did a mark compact, so it will be advantageous to to
+ * use it.
+ */
+ or (s->lastMajorStatistics.kind == GC_MARK_COMPACT)
+ /* The live ratio is low enough to make it worthwhile. */
+ or ((float)h->size / (float)s->lastMajorStatistics.bytesLive
+ <= (h->size < s->sysvals.ram
+ ? s->controls.ratios.copyGenerational
+ : s->controls.ratios.markCompactGenerational))
+ )) {
+ s->canMinor = TRUE;
+ nurserySize /= 2;
+ while (not (isAligned (nurserySize, POINTER_SIZE))) {
+ nurserySize -= 2;
+ }
+ clearCardMap (s);
+ } else {
+ unless (nurseryBytesRequested
+ <= (size_t)(s->limitPlusSlop
+ - alignFrontier (s, s->limitPlusSlop
+ - nurserySize)))
+ die ("Out of memory. Insufficient space in nursery.");
+ s->canMinor = FALSE;
+ }
+ assert (nurseryBytesRequested
+ <= (size_t)(s->limitPlusSlop
+ - alignFrontier (s, s->limitPlusSlop
+ - nurserySize)));
+ s->heap.nursery = alignFrontier (s, s->limitPlusSlop - nurserySize);
+ s->frontier = s->heap.nursery;
+ assert (nurseryBytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
+ assert (isAlignedFrontier (s, s->heap.nursery));
+ assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -19,13 +19,14 @@
struct GC_cumulativeStatistics cumulativeStatistics;
objptr currentThread; /* Currently executing thread (in heap). */
uint32_t exnStack;
+ struct GC_forwardState forwardState;
GC_frameLayout frameLayouts; /* Array of frame layouts. */
uint32_t frameLayoutsLength; /* Cardinality of frameLayouts array. */
pointer frontier; /* heap.start <= frontier < limit */
struct GC_generationalMaps generationalMaps;
objptr *globals;
uint32_t globalsLength;
- /*Bool*/bool hashConsDuringGC;
+ bool hashConsDuringGC;
struct GC_heap heap;
struct GC_intInfInit *intInfInits;
uint32_t intInfInitsLength;
@@ -35,14 +36,12 @@
void (*loadGlobals)(int fd); /* loads the globals from the fd. */
uint32_t magic; /* The magic number for this executable. */
uint32_t maxFrameSize;
- /*Bool*/bool mutatorMarksCards;
+ bool mutatorMarksCards;
GC_objectHashTable objectHashTable;
GC_objectType objectTypes; /* Array of object types. */
uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
struct GC_profiling profiling;
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
- struct GC_ratios ratios;
- bool rusageIsEnabled;
objptr savedThread; /* Result of GC_copyCurrentThread.
* Thread interrupted by arrival of signal.
*/
@@ -61,3 +60,9 @@
};
void displayGCState (GC_state s, FILE *stream);
+
+size_t sizeofGCStateCurrentStackUsed (GC_state s);
+void setGCStateCurrentThreadAndStack (GC_state s);
+void setGCStateCurrentHeap (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -25,7 +25,7 @@
* we ensure by making it odd and keeping the table size as a power of 2.
*/
-GC_objectHashTable newHashTable (GC_state s) {
+GC_objectHashTable allocHashTable (GC_state s) {
uint32_t elementsLengthMax;
pointer regionStart;
pointer regionEnd;
@@ -82,22 +82,21 @@
fprintf (stderr, "elementsIsInHeap = %s\n",
boolToString (t->elementsIsInHeap));
fprintf (stderr, "elementsLengthMax = %"PRIu32"\n", t->elementsLengthMax);
- fprintf (stderr, FMTPTR" = newHashTable ()\n", (uintptr_t)t);
+ fprintf (stderr, FMTPTR" = allocHashTable ()\n", (uintptr_t)t);
}
return t;
}
-void destroyHashTable (GC_objectHashTable t) {
+void freeHashTable (GC_objectHashTable t) {
unless (t->elementsIsInHeap)
free (t->elements);
free (t);
}
-pointer tableInsert (__attribute__ ((unused)) GC_state s,
- GC_objectHashTable t,
- GC_hash hash, pointer object,
- bool mightBeThere,
- GC_header header, GC_objectTypeTag tag, pointer max) {
+pointer insertHashTableElem (__attribute__ ((unused)) GC_state s,
+ GC_objectHashTable t,
+ GC_hash hash, pointer object,
+ pointer max, bool mightBeThere) {
static bool init = FALSE;
static uint64_t mult; // magic multiplier for hashing
static uint32_t maxNumProbes = 0;
@@ -110,10 +109,11 @@
unsigned int *p2;
if (DEBUG_SHARE)
- fprintf (stderr, "tableInsert ("FMTHASH", "FMTPTR", %s, "FMTHDR", "FMTPTR")\n",
- hash, (uintptr_t)object,
- boolToString (mightBeThere),
- header, (uintptr_t)max);
+ fprintf (stderr, "insertHashTableElem ("FMTHASH", "FMTPTR", "FMTPTR", %s)\n",
+ hash,
+ (uintptr_t)object,
+ (uintptr_t)max,
+ boolToString (mightBeThere));
if (! init) {
init = TRUE;
mult = floor (((sqrt (5.0) - 1.0) / 2.0)
@@ -160,6 +160,10 @@
(uintptr_t)object, (uintptr_t)e->object);
/* Compare object to e->object. */
unless (object == e->object) {
+ GC_header header;
+ GC_objectTypeTag tag;
+
+ header = getHeader (object);
unless (header == getHeader (e->object))
goto lookNext;
for (p1 = (unsigned int*)object,
@@ -168,6 +172,7 @@
++p1, ++p2)
unless (*p1 == *p2)
goto lookNext;
+ splitHeader (s, header, &tag, NULL, NULL, NULL);
if (ARRAY_TAG == tag
and (getArrayLength (object) != getArrayLength (e->object)))
goto lookNext;
@@ -176,7 +181,7 @@
return e->object;
}
-void maybeGrowTable (GC_state s, GC_objectHashTable t) {
+void growHashTableMaybe (GC_state s, GC_objectHashTable t) {
GC_objectHashElement oldElement;
struct GC_objectHashElement *oldElements;
uint32_t oldElementsLengthMax;
@@ -207,8 +212,8 @@
for (unsigned int i = 0; i < oldElementsLengthMax; ++i) {
oldElement = &oldElements[i];
unless (NULL == oldElement->object)
- tableInsert (s, t, oldElement->hash, oldElement->object,
- FALSE, 0, 0, NULL);
+ insertHashTableElem
+ (s, t, oldElement->hash, oldElement->object, NULL, FALSE);
}
if (t->elementsIsInHeap)
t->elementsIsInHeap = FALSE;
@@ -218,7 +223,7 @@
fprintf (stderr, "done growing table\n");
}
-pointer hashCons (GC_state s, pointer object, bool countBytesHashConsed) {
+pointer hashConsPointer (GC_state s, pointer object, bool countBytesHashConsed) {
GC_objectHashTable t;
GC_header header;
uint16_t numNonObjptrs;
@@ -246,15 +251,14 @@
+ (ARRAY_TAG == tag
? (sizeofArrayNoHeader (s, getArrayLength (object),
numNonObjptrs, numObjptrs))
- : (sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs)
- + (numObjptrs * OBJPTR_SIZE)));
+ : (sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs)));
// Compute the hash.
hash = (GC_hash)header;
for (p = (GC_hash*)object; p < (GC_hash*)max; ++p)
hash = hash * 31 + *p;
/* Insert into table. */
- res = tableInsert (s, t, hash, object, TRUE, header, tag, max);
- maybeGrowTable (s, t);
+ res = insertHashTableElem (s, t, hash, object, max, TRUE);
+ growHashTableMaybe (s, t);
if (countBytesHashConsed and res != object) {
size_t amount;
@@ -263,45 +267,30 @@
amount += GC_ARRAY_HEADER_SIZE;
else
amount += GC_NORMAL_HEADER_SIZE;
- s->cumulativeStatistics.bytesHashConsed += amount;
+ s->lastMajorStatistics.bytesHashConsed += amount;
}
done:
if (DEBUG_SHARE)
- fprintf (stderr, FMTPTR" = hashCons ("FMTPTR")\n",
+ fprintf (stderr, FMTPTR" = hashConsPointer ("FMTPTR")\n",
(uintptr_t)res, (uintptr_t)object);
return res;
}
-void maybeSharePointer (GC_state s,
- pointer *pp,
- bool shouldHashCons) {
- unless (shouldHashCons)
- return;
- if (DEBUG_SHARE)
- fprintf (stderr, "maybeSharePointer pp = "FMTPTR" *pp = "FMTPTR"\n",
- (uintptr_t)pp, (uintptr_t)*pp);
- *pp = hashCons (s, *pp, FALSE);
-}
-
-void maybeShareObjptr (GC_state s,
- objptr *opp,
- bool shouldHashCons) {
+void shareObjptr (GC_state s, objptr *opp) {
pointer p;
- unless (shouldHashCons)
- return;
p = objptrToPointer (*opp, s->heap.start);
if (DEBUG_SHARE)
- fprintf (stderr, "maybeShareObjptr opp = "FMTPTR" *opp = "FMTOBJPTR"\n",
+ fprintf (stderr, "shareObjptrMaybe opp = "FMTPTR" *opp = "FMTOBJPTR"\n",
(uintptr_t)opp, *opp);
- p = hashCons (s, p, FALSE);
+ p = hashConsPointer (s, p, FALSE);
*opp = pointerToObjptr (p, s->heap.start);
}
-void bytesHashConsedMessage (GC_state s, uintmax_t total) {
- fprintf (stderr, "%"PRIuMAX" bytes hash consed (%.1f%%).\n",
- /*ullongToCommaString*/(s->cumulativeStatistics.bytesHashConsed),
+void printBytesHashConsedMessage (GC_state s, uintmax_t total) {
+ fprintf (stderr, "%"PRIuMAX" bytes hash-consed (%.1f%%).\n",
+ /*ullongToCommaString*/(s->lastMajorStatistics.bytesHashConsed),
(100.0
- * ((double)s->cumulativeStatistics.bytesHashConsed
+ * ((double)s->lastMajorStatistics.bytesHashConsed
/ (double)total)));
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h 2005-11-02 15:01:11 UTC (rev 4128)
@@ -29,14 +29,15 @@
bool mayInsert;
} *GC_objectHashTable;
-GC_objectHashTable newHashTable (GC_state s);
-void destroyHashTable (GC_objectHashTable t);
-pointer tableInsert (GC_state s, GC_objectHashTable t,
- GC_hash hash, pointer object,
- bool mightBeThere,
- GC_header header, GC_objectTypeTag tag, pointer max);
-void maybeGrowTable (GC_state s, GC_objectHashTable t);
-pointer hashCons (GC_state s, pointer object, bool countBytesHashConsed);
-void maybeSharePointer (GC_state s, pointer *pp, bool shouldHashCons);
-void maybeShareObjptr (GC_state s, objptr *opp, bool shouldHashCons);
-void bytesHashConsedMessage (GC_state s, uintmax_t total);
+GC_objectHashTable allocHashTable (GC_state s);
+void freeHashTable (GC_objectHashTable t);
+
+pointer insertHashTableElem (GC_state s,
+ GC_objectHashTable t, GC_hash hash,
+ pointer object, pointer max, bool mightBeThere);
+void growHashTableMaybe (GC_state s, GC_objectHashTable t);
+
+pointer hashConsPointer (GC_state s, pointer object, bool countBytesHashConsed);
+void shareObjptr (GC_state s, objptr *opp);
+
+void printBytesHashConsedMessage (GC_state s, uintmax_t total);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-31 02:52:58 UTC (rev 4127)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-11-02 15:01:11 UTC (rev 4128)
@@ -38,26 +38,26 @@
float ratio;
ratio = (float)s->sysvals.ram / (float)live;
- if (ratio >= s->ratios.live + s->ratios.grow) {
+ if (ratio >= s->controls.ratios.live + s->controls.ratios.grow) {
/* Cheney copying fits in RAM with desired ratios.live. */
- res = live * s->ratios.live;
+ res = live * s->controls.ratios.live;
/* If the heap is currently close in size to what we want, leave
* it alone. Favor growing over shrinking.
*/
unless (1.1 * currentSize <= res
or res <= .5 * currentSize)
res = currentSize;
- } else if (s->ratios.grow...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2005-10-30 18:52:59
|
Duplicate inline
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c 2005-10-31 02:47:56 UTC (rev 4126)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c 2005-10-31 02:52:58 UTC (rev 4127)
@@ -100,7 +100,7 @@
writeString (fd, buf);
}
-static inline inline void writeNewline (int fd) {
+static inline void writeNewline (int fd) {
writeString (fd, "\n");
}
#undef BUF_SIZE
|
|
From: Matthew F. <fl...@ml...> - 2005-10-30 18:48:24
|
Fixing on a naming convention
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/model_predicates.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-31 02:47:56 UTC (rev 4126)
@@ -70,7 +70,7 @@
CFLAGS = -O2 $(CWFLAGS) -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
DEBUGFLAGS = $(CFLAGS) -Wunused -gstabs+ -g2
-## Order matters, as these are concatenated together to form "gc.c".
+## Order matters, as these are concatenated together to form "libgc.c".
CFILES = \
gc_prefix.c \
util.c \
@@ -80,51 +80,54 @@
debug.c \
align.c \
virtual-memory.c \
- pointer_predicates.c \
- pointer.c \
- model_predicates.c \
- model.c \
- object.c \
+ array-allocate.c \
array.c \
- object_size.c \
+ atomic.c \
+ cheney-copy.c \
+ controls.c \
+ copy-thread.c \
+ current.c \
+ dfs-mark.c \
+ enter_leave.c \
+ foreach.c \
frame.c \
- stack_predicates.c \
- stack.c \
- thread.c \
+ garbage-collection.c \
+ gc_state.c \
generational.c \
- current.c \
- foreach.c \
- translate.c \
+ hash-cons.c \
+ heap.c \
heap_predicates.c \
- heap.c \
- ratios_predicates.c \
- atomic.c \
- gc_state.c \
invariant.c \
- enter_leave.c \
- cheney-copy.c \
- hash-cons.c \
- dfs-mark.c \
- share.c \
mark-compact.c \
- new_object.c \
- garbage-collection.c \
- array-allocate.c \
- copy-thread.c \
+ model.c \
+ model_predicates.c \
+ new-object.c \
+ object.c \
+ object-size.c \
pack.c \
+ pointer.c \
+ pointer_predicates.c \
+ ratios_predicates.c \
+ share.c \
size.c \
+ stack.c \
+ stack_predicates.c \
+ thread.c \
+ translate.c \
+ weak.c \
+ world.c \
profiling.c \
- world.c \
- weak.c \
init.c \
done.c \
assumptions.c \
gc_suffix.c
-## Order matters, as these are concatenated together to form "gc.h".
+## Order matters, as these are concatenated together to form "libgc.h".
HFILES = \
gc_prefix.h \
util.h \
+ safe.h \
+ rusage.h \
virtual-memory.h \
pointer.h \
model.h \
@@ -134,10 +137,13 @@
stack.h \
thread.h \
weak.h \
+ object-size.h \
int-inf.h \
heap.h \
major.h \
generational.h \
+ current.h \
+ foreach.h \
statistics.h \
controls.h \
sysvals.h \
@@ -148,40 +154,54 @@
world.h \
init.h \
gc_state.h \
+ translate.h \
+ atomic.h \
+ invariant.h \
+ enter_leave.h \
+ cheney-copy.h \
+ dfs-mark.h \
+ share.h \
+ mark-compact.h \
+ new-object.h \
+ garbage-collection.h \
+ array-allocate.h \
+ copy-thread.h \
+ pack.h \
+ size.h \
gc_suffix.h
-all: gc.o gc-gdb.o
+all: libgc.o libgc-gdb.o
-gc-gdb.o: gc.c gc.h
- $(CC) $(DEBUGFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -O1 -DASSERT=1 -c -o $@ gc.c
+libgc-gdb.o: libgc.c libgc.h
+ $(CC) $(DEBUGFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -O1 -DASSERT=1 -c -o $@ libgc.c
-gc.o: gc.c gc.h
- $(CC) $(CFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -c -o $@ gc.c
+libgc.o: libgc.c libgc.h
+ $(CC) $(CFLAGS) -DGC_MODEL_$(DEFAULT_MODEL) -c -o $@ libgc.c
-gc.c: $(CFILES)
- rm -f gc.c
+libgc.c: $(CFILES)
+ rm -f libgc.c
( \
for f in $(CFILES); do \
echo "#line 1 \"$$f\""; \
cat $$f; \
done; \
- ) > gc.c
+ ) > libgc.c
-gc.h: $(HFILES)
- rm -f gc.h
+libgc.h: $(HFILES)
+ rm -f libgc.h
( \
for f in $(HFILES); do \
echo "#line 1 \"$$f\""; \
cat $$f; \
done; \
- ) > gc.h
+ ) > libgc.h
.PHONY: models
-models: gc.c gc.h
+models: libgc.c libgc.h
( \
for m in $(ALL_MODELS); do \
- $(CC) $(CFLAGS) -DGC_MODEL_$$m -c -o gc.$$m.o gc.c; \
- $(CC) $(DEBUGFLAGS) -O1 -DASSERT=1 -DGC_MODEL_$$m -c -o gc-gdb.$$m.o gc.c; \
+ $(CC) $(CFLAGS) -DGC_MODEL_$$m -c -o libgc.$$m.o libgc.c; \
+ $(CC) $(DEBUGFLAGS) -O1 -DASSERT=1 -DGC_MODEL_$$m -c -o libgc-gdb.$$m.o libgc.c; \
done; \
)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -21,6 +21,13 @@
return a;
}
+static inline uintmax_t alignMaxDown (uintmax_t a, uintmax_t b) {
+ assert (b >= 1);
+ a -= a % b;
+ assert (isAlignedMax (a, b));
+ return a;
+}
+
static inline size_t align (size_t a, size_t b) {
assert (b >= 1);
a += b - 1;
@@ -59,10 +66,6 @@
return (pointer)res;
}
-pointer GC_alignFrontier (GC_state s, pointer p) {
- return alignFrontier (s, p);
-}
-
#if ASSERT
static inline bool isAlignedStackReserved (GC_state s, size_t reserved) {
return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved,
@@ -75,7 +78,7 @@
res = pad (s, reserved, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
if (DEBUG_STACKS)
- fprintf (stderr, "%zu = stackReserved (%zu)\n", res, reserved);
+ fprintf (stderr, "%zu = alignStackReserved (%zu)\n", res, reserved);
assert (isAlignedStackReserved (s, res));
return res;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -24,7 +24,7 @@
fprintf (stderr, "GC_arrayAllocate (%zu, "FMTARRLEN", "FMTHDR")\n",
ensureBytesFree, numElements, header);
bytesPerElement =
- numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
+ sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs)
+ (numObjptrs * OBJPTR_SIZE);
arraySizeMax =
alignMax ((uintmax_t)bytesPerElement * (uintmax_t)numElements + GC_ARRAY_HEADER_SIZE,
@@ -82,7 +82,7 @@
size_t nonObjptrBytes;
size_t objptrBytes;
- nonObjptrBytes = numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+ nonObjptrBytes = sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
objptrBytes = numObjptrs * OBJPTR_SIZE;
for (p = frontier; p < last; ) {
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,12 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+pointer GC_arrayAllocate (GC_state s,
+ size_t ensureBytesFree,
+ GC_arrayLength numElements,
+ GC_header header);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -6,19 +6,39 @@
* See the file MLton-LICENSE for details.
*/
+/* getArrayLengthp (p)
+ *
+ * Returns a pointer to the length for the array pointed to by p.
+ */
+GC_arrayLength* getArrayLengthp (pointer a) {
+ return (GC_arrayLength*)(a
+ - GC_HEADER_SIZE
+ - GC_ARRAY_LENGTH_SIZE);
+}
+
+/* getArrayLength (p)
+ *
+ * Returns the length for the array pointed to by p.
+ */
+GC_arrayLength getArrayLength (pointer a) {
+ return *(getArrayLengthp (a));
+}
+
/* getArrayCounterp (p)
*
* Returns a pointer to the counter for the array pointed to by p.
*/
-static inline GC_arrayCounter* getArrayCounterp (pointer a) {
- return (GC_arrayCounter*)(a - GC_HEADER_SIZE
- - GC_ARRAY_LENGTH_SIZE - GC_ARRAY_COUNTER_SIZE);
+GC_arrayCounter* getArrayCounterp (pointer a) {
+ return (GC_arrayCounter*)(a
+ - GC_HEADER_SIZE
+ - GC_ARRAY_LENGTH_SIZE
+ - GC_ARRAY_COUNTER_SIZE);
}
/* getArrayCounter (p)
*
* Returns the counter for the array pointed to by p.
*/
-static inline GC_arrayCounter getArrayCounter (pointer a) {
+GC_arrayCounter getArrayCounter (pointer a) {
return *(getArrayCounterp (a));
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -24,20 +24,11 @@
#define FMTARRLEN "%"PRIxARRLEN
typedef GC_arrayLength GC_arrayCounter;
#define GC_ARRAY_COUNTER_SIZE GC_ARRAY_LENGTH_SIZE
+#define PRIxARRCTR PRIu32
+#define FMTARRCTR "%"PRIxARRCTR
#define GC_ARRAY_HEADER_SIZE (GC_ARRAY_COUNTER_SIZE + GC_ARRAY_LENGTH_SIZE + GC_HEADER_SIZE)
-/* getArrayLengthp (p)
- *
- * Returns a pointer to the length for the array pointed to by p.
- */
-static inline GC_arrayLength* getArrayLengthp (pointer a) {
- return (GC_arrayLength*)(a - GC_HEADER_SIZE - GC_ARRAY_LENGTH_SIZE);
-}
-
-/* getArrayLength (p)
- *
- * Returns the length for the array pointed to by p.
- */
-static inline GC_arrayLength getArrayLength (pointer a) {
- return *(getArrayLengthp (a));
-}
+GC_arrayLength* getArrayLengthp (pointer a);
+GC_arrayLength getArrayLength (pointer a);
+GC_arrayCounter* getArrayCounterp (pointer a);
+GC_arrayCounter getArrayCounter (pointer a);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -6,13 +6,13 @@
* See the file MLton-LICENSE for details.
*/
-static inline void atomicBegin (GC_state s) {
+void atomicBegin (GC_state s) {
s->atomicState++;
if (0 == s->limit)
- s->limit = s->limitPlusSlop - LIMIT_SLOP;
+ s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP;
}
-static inline void atomicEnd (GC_state s) {
+void atomicEnd (GC_state s) {
s->atomicState--;
if (0 == s->atomicState
and s->signalsInfo.signalIsPending)
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,10 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void atomicBegin (GC_state s);
+void atomicEnd (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -25,21 +25,21 @@
};
static struct forwardState forwardState;
-static inline bool pointerIsInToSpace (pointer p) {
+bool isPointerInToSpace (pointer p) {
return (not (isPointer (p))
or (forwardState.toStart <= p and p < forwardState.toLimit));
}
-static inline bool objptrIsInToSpace (objptr op) {
+bool isObjptrInToSpace (objptr op) {
pointer p;
if (not (isObjptr (op)))
return TRUE;
p = objptrToPointer (op, forwardState.toStart);
- return pointerIsInToSpace (p);
+ return isPointerInToSpace (p);
}
-static void forwardObjptr (GC_state s, objptr *opp) {
+void forwardObjptr (GC_state s, objptr *opp) {
objptr op;
pointer p;
GC_header header;
@@ -50,7 +50,7 @@
fprintf (stderr,
"forwardObjptr opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
(uintptr_t)opp, op, (uintptr_t)p);
- assert (objptrIsInFromSpace (s, *opp));
+ assert (isObjptrInFromSpace (s, *opp));
header = getHeader (p);
if (DEBUG_DETAILED and header == GC_FORWARDED)
fprintf (stderr, " already FORWARDED\n");
@@ -65,13 +65,12 @@
/* Compute the space taken by the header and object body. */
if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) { /* Fixed size object. */
headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes =
- numNonObjptrsToBytes(numNonObjptrs, NORMAL_TAG)
- + (numObjptrs * OBJPTR_SIZE);
+ objectBytes = sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs);
skip = 0;
} else if (ARRAY_TAG == tag) {
headerBytes = GC_ARRAY_HEADER_SIZE;
- objectBytes = arraySizeNoHeader (s, p, numNonObjptrs, numObjptrs);
+ objectBytes = sizeofArrayNoHeader (s, getArrayLength (p),
+ numNonObjptrs, numObjptrs);
skip = 0;
} else { /* Stack. */
GC_stack stack;
@@ -80,14 +79,15 @@
headerBytes = GC_STACK_HEADER_SIZE;
stack = (GC_stack)p;
- if (currentThreadStackObjptr(s) == op) {
+ if (getStackCurrentObjptr(s) == op) {
/* Shrink stacks that don't use a lot of their reserved space;
* but don't violate the stack invariant.
*/
if (stack->used <= stack->reserved / 4) {
size_t new =
alignStackReserved
- (s, max (stack->reserved / 2, stackMinimumReserved (s, stack)));
+ (s, max (stack->reserved / 2,
+ sizeofStackMinimumReserved (s, stack)));
/* It's possible that new > stack->reserved if the stack
* invariant is violated. In that case, we want to leave the
* stack alone, because some other part of the gc will grow
@@ -129,7 +129,7 @@
(uintptr_t)w);
if (isObjptr (w->objptr)
and (not forwardState.amInMinorGC
- or objptrIsInNursery (s, w->objptr))) {
+ or isObjptrInNursery (s, w->objptr))) {
if (DEBUG_WEAK)
fprintf (stderr, "linking\n");
w->link = s->weaks;
@@ -148,10 +148,10 @@
s->alignment));
}
*opp = *(objptr*)p;
- assert (objptrIsInToSpace (*opp));
+ assert (isObjptrInToSpace (*opp));
}
-static inline void updateWeaks (GC_state s) {
+void updateWeaks (GC_state s) {
pointer p;
GC_weak w;
@@ -177,7 +177,7 @@
s->weaks = NULL;
}
-static inline void swapHeaps (GC_state s) {
+void swapHeaps (GC_state s) {
struct GC_heap tempHeap;
tempHeap = s->secondaryHeap;
@@ -186,7 +186,7 @@
setCardMapAbsolute (s);
}
-static void majorCheneyCopyGC (GC_state s) {
+void majorCheneyCopyGC (GC_state s) {
struct rusage ru_start;
pointer toStart;
@@ -236,7 +236,7 @@
/* Minor Cheney Copying Collection */
/* ---------------------------------------------------------------- */
-static inline void forwardObjptrIfInNursery (GC_state s, objptr *opp) {
+void forwardObjptrIfInNursery (GC_state s, objptr *opp) {
objptr op;
pointer p;
@@ -253,7 +253,7 @@
}
/* Walk through all the cards and forward all intergenerational pointers. */
-static void forwardInterGenerationalObjptrs (GC_state s) {
+void forwardInterGenerationalObjptrs (GC_state s) {
GC_cardMapElem *cardMap;
GC_crossMapElem *crossMap;
pointer oldGenStart, oldGenEnd;
@@ -268,7 +268,7 @@
/* Constants. */
cardMap = s->generationalMaps.cardMap;
crossMap = s->generationalMaps.crossMap;
- maxCardIndex = sizeToCardIndex (align (s->heap.oldGenSize, CARD_SIZE));
+ maxCardIndex = sizeToCardMapIndex (align (s->heap.oldGenSize, CARD_SIZE));
oldGenStart = s->heap.start;
oldGenEnd = oldGenStart + s->heap.oldGenSize;
/* Loop variables*/
@@ -284,7 +284,7 @@
if (DEBUG_GENERATIONAL)
fprintf (stderr, "checking card %zu objectStart = "FMTPTR"\n",
cardIndex, (uintptr_t)objectStart);
- assert (objectStart < oldGenStart + cardIndexToSize (cardIndex + 1));
+ assert (objectStart < oldGenStart + cardMapIndexToSize (cardIndex + 1));
if (cardMap[cardIndex]) {
pointer lastObject;
size_t size;
@@ -296,7 +296,7 @@
lastObject = objectStart;
skipObjects:
assert (isAlignedFrontier (s, objectStart));
- size = objectSize (s, objectData (s, objectStart));
+ size = sizeofObject (s, advanceToObjectData (s, objectStart));
if (objectStart + size < cardStart) {
objectStart += size;
goto skipObjects;
@@ -318,8 +318,8 @@
s->cumulativeStatistics.minorBytesScanned += objectStart - lastObject;
if (objectStart == oldGenEnd)
goto done;
- cardIndex = sizeToCardIndex (objectStart - oldGenStart);
- cardStart = oldGenStart + cardIndexToSize (cardIndex);
+ cardIndex = sizeToCardMapIndex (objectStart - oldGenStart);
+ cardStart = oldGenStart + cardMapIndexToSize (cardIndex);
goto checkCard;
} else {
unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
@@ -341,7 +341,7 @@
fprintf (stderr, "Forwarding inter-generational pointers done.\n");
}
-static void minorCheneyCopyGC (GC_state s) {
+void minorCheneyCopyGC (GC_state s) {
size_t bytesAllocated;
size_t bytesCopied;
struct rusage ru_start;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -5,3 +5,13 @@
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*/
+
+bool pointerIsInToSpace (pointer p);
+bool objptrIsInToSpace (objptr op);
+void forwardObjptr (GC_state s, objptr *opp);
+void updateWeaks (GC_state s);
+void swapHeaps (GC_state s);
+void majorCheneyCopyGC (GC_state s);
+void forwardObjptrIfInNursery (GC_state s, objptr *opp);
+void forwardInterGenerationalObjptrs (GC_state s);
+void minorCheneyCopyGC (GC_state s);
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,11 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+bool detailedGCTime (GC_state s) {
+ return s->controls.summary;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -15,3 +15,5 @@
size_t oldGenArraySize; /* Arrays larger are allocated in old gen, if possible. */
bool summary; /* Print a summary of gc info when program exits. */
};
+
+bool detailedGCTime (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -6,25 +6,25 @@
* See the file MLton-LICENSE for details.
*/
-static GC_thread newThread (GC_state s, size_t stackSize) {
+GC_thread newThread (GC_state s, size_t reserved) {
GC_stack stack;
GC_thread thread;
- ensureFree (s, stackSizeTotalAligned (s, stackSize) + threadSize (s));
- stack = newStack (s, stackSize, FALSE);
+ ensureFree (s, sizeofStackWithHeaderAligned (s, reserved) + sizeofThread (s));
+ stack = newStack (s, reserved, FALSE);
thread = (GC_thread) newObject (s, GC_THREAD_HEADER,
- threadSize (s),
+ sizeofThread (s),
FALSE);
thread->bytesNeeded = 0;
thread->exnStack = BOGUS_EXN_STACK;
thread->stack = pointerToObjptr((pointer)stack, s->heap.start);
if (DEBUG_THREADS)
fprintf (stderr, FMTPTR" = newThreadOfSize (%zu)\n",
- (uintptr_t)thread, stackSize);;
+ (uintptr_t)thread, reserved);;
return thread;
}
-static GC_thread copyThread (GC_state s, GC_thread from, size_t size) {
+GC_thread copyThread (GC_state s, GC_thread from, size_t size) {
GC_thread to;
if (DEBUG_THREADS)
@@ -40,7 +40,7 @@
fprintf (stderr, FMTPTR" = copyThread ("FMTPTR")\n",
(uintptr_t)to, (uintptr_t)from);
}
- stackCopy (s,
+ copyStack (s,
(GC_stack)(objptrToPointer(from->stack, s->heap.start)),
(GC_stack)(objptrToPointer(to->stack, s->heap.start)));
to->bytesNeeded = from->bytesNeeded;
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,12 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+GC_thread newThread (GC_state s, size_t stackSize);
+GC_thread copyThread (GC_state s, GC_thread from, size_t size);
+void GC_copyCurrentThread (GC_state s);
+pointer GC_copyThread (GC_state s, pointer p);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -6,40 +6,40 @@
* See the file MLton-LICENSE for details.
*/
-static inline objptr currentThreadObjptr (GC_state s) {
+objptr getThreadCurrentObjptr (GC_state s) {
return s->currentThread;
}
-static inline GC_thread currentThread (GC_state s) {
- pointer p = objptrToPointer(currentThreadObjptr(s), s->heap.start);
+GC_thread getThreadCurrent (GC_state s) {
+ pointer p = objptrToPointer(getThreadCurrentObjptr(s), s->heap.start);
return (GC_thread)p;
}
-static inline objptr currentThreadStackObjptr (GC_state s) {
- GC_thread ct = currentThread (s);
- return ct->stack;
+objptr getStackCurrentObjptr (GC_state s) {
+ GC_thread thread = getThreadCurrent(s);
+ return thread->stack;
}
-static inline GC_stack currentThreadStack (GC_state s) {
- pointer p = objptrToPointer(currentThreadStackObjptr(s), s->heap.start);
+GC_stack getStackCurrent (GC_state s) {
+ pointer p = objptrToPointer(getStackCurrentObjptr(s), s->heap.start);
return (GC_stack)p;
}
-static inline size_t currentStackUsed (GC_state s) {
+size_t sizeofStackCurrentUsed (GC_state s) {
return s->stackTop - s->stackBottom;
}
-static void setCurrentStack (GC_state s) {
+void setThreadAndStackCurrent (GC_state s) {
GC_thread thread;
GC_stack stack;
- thread = currentThread (s);
+ thread = getThreadCurrent (s);
s->exnStack = thread->exnStack;
- stack = currentThreadStack (s);
- s->stackBottom = stackBottom (s, stack);
- s->stackTop = stackTop (s, stack);
- s->stackLimit = stackLimit (s, stack);
+ stack = getStackCurrent (s);
+ s->stackBottom = getStackBottom (s, stack);
+ s->stackTop = getStackTop (s, stack);
+ s->stackLimit = getStackLimit (s, stack);
markCard (s, (pointer)stack);
}
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,15 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+objptr getThreadCurrentObjptr (GC_state s);
+GC_thread getThreadCurrent (GC_state s);
+objptr getStackCurrentObjptr (GC_state s);
+GC_stack getStackCurrent (GC_state s);
+size_t sizeofStackCurrentUsed (GC_state s);
+
+void setThreadAndStackCurrent (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -10,16 +10,11 @@
/* Depth-first Marking */
/* ---------------------------------------------------------------- */
-typedef enum {
- MARK_MODE,
- UNMARK_MODE,
-} GC_markMode;
-
-static inline bool isMarked (pointer p) {
+bool isMarked (pointer p) {
return MARK_MASK & getHeader (p);
}
-static bool isMarkedMode (GC_markMode m, pointer p) {
+bool isMarkedMode (GC_markMode m, pointer p) {
switch (m) {
case MARK_MODE:
return isMarked (p);
@@ -30,11 +25,9 @@
}
}
-#if ASSERT
-static inline pointer arrayIndexAtPointer (GC_state s,
- pointer a,
- GC_arrayCounter arrayIndex,
- uint32_t pointerIndex) {
+pointer arrayIndexAtPointer (GC_state s, pointer a,
+ GC_arrayCounter arrayIndex,
+ uint32_t pointerIndex) {
GC_header header;
uint16_t numNonObjptrs;
uint16_t numObjptrs;
@@ -45,7 +38,7 @@
assert (tag == ARRAY_TAG);
size_t nonObjptrBytesPerElement =
- numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+ sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
size_t bytesPerElement =
nonObjptrBytesPerElement
+ (numObjptrs * OBJPTR_SIZE);
@@ -55,7 +48,6 @@
+ nonObjptrBytesPerElement
+ pointerIndex * OBJPTR_SIZE;
}
-#endif
/* dfsMark (s, r, m, shc)
*
@@ -87,7 +79,7 @@
GC_arrayCounter arrayIndex;
pointer top; /* The top of the next stack frame to mark. */
GC_returnAddress returnAddress;
- GC_frameLayout *frameLayout;
+ GC_frameLayout frameLayout;
GC_frameOffsets frameOffsets;
if (isMarkedMode (mode, root))
@@ -150,7 +142,7 @@
if (NORMAL_TAG == tag) {
size +=
GC_NORMAL_HEADER_SIZE
- + numNonObjptrsToBytes (numNonObjptrs, tag)
+ + sizeofNumNonObjptrs (tag, numNonObjptrs)
+ (numObjptrs * OBJPTR_SIZE);
if (0 == numObjptrs) {
/* There is nothing to mark. */
@@ -159,7 +151,7 @@
cur = hashCons (s, cur, TRUE);
goto ret;
}
- todo = cur + numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG);
+ todo = cur + sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
index = 0;
markInNormal:
if (DEBUG_MARK_COMPACT)
@@ -200,7 +192,7 @@
*/
size +=
GC_ARRAY_HEADER_SIZE
- + arraySizeNoHeader (s, cur, numNonObjptrs, numObjptrs);
+ + sizeofArrayNoHeader (s, getArrayLength (cur), numNonObjptrs, numObjptrs);
if (0 == numObjptrs or 0 == getArrayLength (cur)) {
/* There is nothing to mark. */
arrayDone:
@@ -215,7 +207,7 @@
assert (arrayIndex < getArrayLength (cur));
index = 0;
/* Skip to the first pointer. */
- todo += numNonObjptrsToBytes (numNonObjptrs, ARRAY_TAG);
+ todo += sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
markInArray:
if (DEBUG_MARK_COMPACT)
fprintf (stderr, "markInArray arrayIndex = %"PRIu32" index = %"PRIu32"\n",
@@ -257,17 +249,17 @@
size +=
GC_STACK_HEADER_SIZE
+ sizeof (struct GC_stack) + ((GC_stack)cur)->reserved;
- top = stackTop (s, (GC_stack)cur);
+ top = getStackTop (s, (GC_stack)cur);
assert (((GC_stack)cur)->used <= ((GC_stack)cur)->reserved);
markInStack:
/* Invariant: top points just past the return address of the frame
* to be marked.
*/
- assert (stackBottom (s, (GC_stack)cur) <= top);
+ assert (getStackBottom (s, (GC_stack)cur) <= top);
if (DEBUG_MARK_COMPACT)
fprintf (stderr, "markInStack top = %zu\n",
- (size_t)(top - stackBottom (s, (GC_stack)cur)));
- if (top == stackBottom (s, (GC_stack)(cur)))
+ (size_t)(top - getStackBottom (s, (GC_stack)cur)));
+ if (top == getStackBottom (s, (GC_stack)(cur)))
goto ret;
index = 0;
returnAddress = *(GC_returnAddress*) (top - GC_RETURNADDRESS_SIZE);
@@ -323,7 +315,7 @@
*/
assert (WEAK_TAG != tag);
if (NORMAL_TAG == tag) {
- todo = cur + numNonObjptrsToBytes (numNonObjptrs, tag);
+ todo = cur + sizeofNumNonObjptrs (tag, numNonObjptrs);
index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
todo += index * OBJPTR_SIZE;
// prev = *(pointer*)todo;
@@ -333,10 +325,10 @@
goto markNextInNormal;
} else if (ARRAY_TAG == tag) {
arrayIndex = getArrayCounter (cur);
- todo = cur + arrayIndex * (numNonObjptrsToBytes (numNonObjptrs, ARRAY_TAG)
+ todo = cur + arrayIndex * (sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs)
+ (numObjptrs * OBJPTR_SIZE));
index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
- todo += numNonObjptrsToBytes (numNonObjptrs, ARRAY_TAG) + index * OBJPTR_SIZE;
+ todo += sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs) + index * OBJPTR_SIZE;
// prev = *(pointer*)todo;
prev = fetchObjptrToPointer (todo, s->heap.start);
// *(pointer*)todo = next;
@@ -360,3 +352,24 @@
}
assert (FALSE);
}
+
+void dfsMarkTrue (GC_state s, objptr *opp) {
+ pointer p;
+
+ p = objptrToPointer (*opp, s->heap.start);
+ dfsMark (s, p, MARK_MODE, TRUE);
+}
+
+void dfsMarkFalse (GC_state s, objptr *opp) {
+ pointer p;
+
+ p = objptrToPointer (*opp, s->heap.start);
+ dfsMark (s, p, MARK_MODE, FALSE);
+}
+
+void dfsUnmark (GC_state s, objptr *opp) {
+ pointer p;
+
+ p = objptrToPointer (*opp, s->heap.start);
+ dfsMark (s, p, UNMARK_MODE, FALSE);
+}
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,24 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+typedef enum {
+ MARK_MODE,
+ UNMARK_MODE,
+} GC_markMode;
+
+bool isMarked (pointer p);
+bool isMarkedMode (GC_markMode m, pointer p);
+pointer arrayIndexAtPointer (GC_state s,
+ pointer a,
+ GC_arrayCounter arrayIndex,
+ uint32_t pointerIndex);
+size_t dfsMark (GC_state s, pointer root,
+ GC_markMode mode, bool shouldHashCons);
+void dfsMarkTrue (GC_state s, objptr *opp);
+void dfsMarkFalse (GC_state s, objptr *opp);
+void dfsUnmark (GC_state s, objptr *opp);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -87,6 +87,6 @@
fprintf (out, "minor skipped: %s bytes\n",
uintmaxToCommaString (s->cumulativeStatistics.minorBytesSkipped));
}
- heapRelease (s, &s->heap);
- heapRelease (s, &s->secondaryHeap);
+ releaseHeap (s, &s->heap);
+ releaseHeap (s, &s->secondaryHeap);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -11,13 +11,12 @@
* that the function is run in a critical section and check the GC
* invariant.
*/
-static void enter (GC_state s) {
-
+void enter (GC_state s) {
if (DEBUG)
fprintf (stderr, "enter\n");
/* used needs to be set because the mutator has changed s->stackTop. */
- currentThreadStack(s)->used = currentStackUsed (s);
- currentThread(s)->exnStack = s->exnStack;
+ getStackCurrent(s)->used = sizeofStackCurrentUsed (s);
+ getThreadCurrent(s)->exnStack = s->exnStack;
if (DEBUG)
displayGCState (s, stderr);
atomicBegin (s);
@@ -26,7 +25,7 @@
fprintf (stderr, "enter ok\n");
}
-static void leave (GC_state s) {
+void leave (GC_state s) {
if (DEBUG)
fprintf (stderr, "leave\n");
/* The mutator frontier invariant may not hold
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,10 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void enter (GC_state s);
+void leave (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -6,10 +6,7 @@
* See the file MLton-LICENSE for details.
*/
-typedef void (*GC_foreachObjptrFun) (GC_state s, objptr *opp);
-
-static inline void maybeCall (GC_foreachObjptrFun f,
- GC_state s, objptr *opp) {
+void maybeCall (GC_state s, GC_foreachObjptrFun f, objptr *opp) {
if (isObjptr (*opp))
f (s, opp);
}
@@ -18,19 +15,18 @@
*
* Apply f to each global object pointer into the heap.
*/
-static inline void foreachGlobalObjptr (GC_state s,
- GC_foreachObjptrFun f) {
+void foreachGlobalObjptr (GC_state s, GC_foreachObjptrFun f) {
for (unsigned int i = 0; i < s->globalsLength; ++i) {
if (DEBUG_DETAILED)
fprintf (stderr, "foreachGlobal %u\n", i);
- maybeCall (f, s, &s->globals [i]);
+ maybeCall (s, f, &s->globals [i]);
}
if (DEBUG_DETAILED)
fprintf (stderr, "foreachGlobal threads\n");
- maybeCall (f, s, &s->callFromCHandlerThread);
- maybeCall (f, s, &s->currentThread);
- maybeCall (f, s, &s->savedThread);
- maybeCall (f, s, &s->signalHandlerThread);
+ maybeCall (s, f, &s->callFromCHandlerThread);
+ maybeCall (s, f, &s->currentThread);
+ maybeCall (s, f, &s->savedThread);
+ maybeCall (s, f, &s->signalHandlerThread);
}
@@ -41,10 +37,8 @@
*
* If skipWeaks, then the object pointer in weak objects is skipped.
*/
-static inline pointer foreachObjptrInObject (GC_state s,
- pointer p,
- bool skipWeaks,
- GC_foreachObjptrFun f) {
+pointer foreachObjptrInObject (GC_state s, pointer p,
+ bool skipWeaks, GC_foreachObjptrFun f) {
GC_header header;
uint16_t numNonObjptrs;
uint16_t numObjptrs;
@@ -62,7 +56,7 @@
(uintptr_t)p, header, objectTypeTagToString (tag),
numNonObjptrs, numObjptrs);
if (NORMAL_TAG == tag) {
- p += numNonObjptrsToBytes(numNonObjptrs, NORMAL_TAG);
+ p += sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
pointer max = p + (numObjptrs * OBJPTR_SIZE);
/* Apply f to all internal pointers. */
for ( ; p < max; p += OBJPTR_SIZE) {
@@ -70,12 +64,12 @@
fprintf (stderr,
" p = "FMTPTR" *p = "FMTOBJPTR"\n",
(uintptr_t)p, *(objptr*)p);
- maybeCall (f, s, (objptr*)p);
+ maybeCall (s, f, (objptr*)p);
}
} else if (WEAK_TAG == tag) {
- p += numNonObjptrsToBytes(numNonObjptrs, NORMAL_TAG);
+ p += sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
if (not skipWeaks and 1 == numObjptrs) {
- maybeCall (f, s, (objptr*)p);
+ maybeCall (s, f, (objptr*)p);
p += OBJPTR_SIZE;
}
} else if (ARRAY_TAG == tag) {
@@ -86,7 +80,7 @@
numElements = getArrayLength (p);
bytesPerElement =
- numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
+ sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs)
+ (numObjptrs * OBJPTR_SIZE);
dataBytes = numElements * bytesPerElement;
/* Must check 0 == dataBytes before 0 == numPointers to correctly
@@ -103,13 +97,13 @@
if (0 == numNonObjptrs)
/* Array with only pointers. */
for ( ; p < last; p += OBJPTR_SIZE)
- maybeCall (f, s, (objptr*)p);
+ maybeCall (s, f, (objptr*)p);
else {
/* Array with a mix of pointers and non-pointers. */
size_t nonObjptrBytes;
size_t objptrBytes;
- nonObjptrBytes = numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+ nonObjptrBytes = sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
objptrBytes = numObjptrs * OBJPTR_SIZE;
/* For each array element. */
@@ -121,7 +115,7 @@
next = p + objptrBytes;
/* For each internal pointer. */
for ( ; p < next; p += OBJPTR_SIZE)
- maybeCall (f, s, (objptr*)p);
+ maybeCall (s, f, (objptr*)p);
}
}
assert (p == last);
@@ -133,13 +127,13 @@
pointer top, bottom;
unsigned int i;
GC_returnAddress returnAddress;
- GC_frameLayout *frameLayout;
+ GC_frameLayout frameLayout;
GC_frameOffsets frameOffsets;
assert (STACK_TAG == tag);
stack = (GC_stack)p;
- bottom = stackBottom (s, stack);
- top = stackTop (s, stack);
+ bottom = getStackBottom (s, stack);
+ top = getStackTop (s, stack);
if (DEBUG) {
fprintf (stderr, " bottom = "FMTPTR" top = "FMTPTR"\n",
(uintptr_t)bottom, (uintptr_t)top);
@@ -159,7 +153,7 @@
if (DEBUG)
fprintf(stderr, " offset %"PRIx16" address "FMTOBJPTR"\n",
frameOffsets[i + 1], *(objptr*)(top + frameOffsets[i + 1]));
- maybeCall(f, s, (objptr*)(top + frameOffsets[i + 1]));
+ maybeCall (s, f, (objptr*)(top + frameOffsets[i + 1]));
}
}
assert(top == bottom);
@@ -180,11 +174,8 @@
* If skipWeaks, then the object pointer in weak objects is skipped.
*/
-static inline pointer foreachObjptrInRange (GC_state s,
- pointer front,
- pointer *back,
- bool skipWeaks,
- GC_foreachObjptrFun f) {
+pointer foreachObjptrInRange (GC_state s, pointer front, pointer *back,
+ bool skipWeaks, GC_foreachObjptrFun f) {
pointer b;
assert (isAlignedFrontier (s, front));
@@ -201,7 +192,7 @@
fprintf (stderr,
" front = "FMTPTR" *back = "FMTPTR"\n",
(uintptr_t)front, (uintptr_t)(*back));
- front = foreachObjptrInObject (s, objectData (s, front), skipWeaks, f);
+ front = foreachObjptrInObject (s, advanceToObjectData (s, front), skipWeaks, f);
}
b = *back;
}
@@ -209,19 +200,17 @@
}
-typedef void (*GC_foreachStackFrameFun) (GC_state s, GC_frameIndex i);
-
/* Apply f to the frame index of each frame in the current thread's stack. */
void foreachStackFrame (GC_state s, GC_foreachStackFrameFun f) {
pointer bottom;
GC_frameIndex index;
- GC_frameLayout *layout;
+ GC_frameLayout layout;
GC_returnAddress returnAddress;
pointer top;
if (DEBUG_PROFILE)
fprintf (stderr, "foreachStackFrame\n");
- bottom = stackBottom (s, currentThreadStack(s));
+ bottom = getStackBottom (s, getStackCurrent(s));
if (DEBUG_PROFILE)
fprintf (stderr, " bottom = "FMTPTR" top = "FMTPTR".\n",
(uintptr_t)bottom, (uintptr_t)s->stackTop);
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -0,0 +1,47 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+typedef void (*GC_foreachObjptrFun) (GC_state s, objptr *opp);
+
+void maybeCall (GC_state s, GC_foreachObjptrFun f, objptr *opp);
+/* foreachGlobalObjptr (s, f)
+ *
+ * Apply f to each global object pointer into the heap.
+ */
+void foreachGlobalObjptr (GC_state s, GC_foreachObjptrFun f);
+/* foreachObjptrInObject (s, p, skipWeaks, f)
+ *
+ * Applies f to each object pointer in the object pointed to by p.
+ * Returns pointer to the end of object, i.e. just past object.
+ *
+ * If skipWeaks, then the object pointer in weak objects is skipped.
+ */
+pointer foreachObjptrInObject (GC_state s, pointer p,
+ bool skipWeaks, GC_foreachObjptrFun f);
+/* foreachObjptrInRange (s, front, back, skipWeaks, f)
+ *
+ * Apply f to each pointer between front and *back, which should be a
+ * contiguous sequence of objects, where front points at the beginning
+ * of the first object and *back points just past the end of the last
+ * object. f may increase *back (for example, this is done by
+ * forward). foreachObjptrInRange returns a pointer to the end of
+ * the last object it visits.
+ *
+ * If skipWeaks, then the object pointer in weak objects is skipped.
+ */
+pointer foreachObjptrInRange (GC_state s, pointer front, pointer *back,
+ bool skipWeaks, GC_foreachObjptrFun f);
+
+
+typedef void (*GC_foreachStackFrameFun) (GC_state s, GC_frameIndex i);
+
+/* foreachStackFrame (s, f);
+ *
+ * Apply f to the frame index of each frame in the current stack.
+ */
+void foreachStackFrame (GC_state s, GC_foreachStackFrameFun f);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -6,8 +6,7 @@
* See the file MLton-LICENSE for details.
*/
-static inline GC_frameIndex
-getFrameIndexFromReturnAddress (GC_state s, GC_returnAddress ra) {
+GC_frameIndex getFrameIndexFromReturnAddress (GC_state s, GC_returnAddress ra) {
GC_frameIndex res;
res = s->returnAddressToFrameIndex (ra);
@@ -17,14 +16,11 @@
return res;
}
-static inline GC_frameLayout *
-getFrameLayoutFromFrameIndex (GC_state s, GC_frameIndex index) {
- GC_frameLayout *layout;
+GC_frameLayout getFrameLayoutFromFrameIndex (GC_state s, GC_frameIndex index) {
+ GC_frameLayout layout;
if (DEBUG_DETAILED)
- fprintf (stderr,
- "index = "FMTFI
- " frameLayoutsLength = %"PRIu32"\n",
+ fprintf (stderr, "index = "FMTFI" frameLayoutsLength = %"PRIu32"\n",
index, s->frameLayoutsLength);
assert (index < s->frameLayoutsLength);
layout = &(s->frameLayouts[index]);
@@ -32,9 +28,8 @@
return layout;
}
-static inline GC_frameLayout *
-getFrameLayoutFromReturnAddress (GC_state s, GC_returnAddress ra) {
- GC_frameLayout *layout;
+GC_frameLayout getFrameLayoutFromReturnAddress (GC_state s, GC_returnAddress ra) {
+ GC_frameLayout layout;
GC_frameIndex index;
index = getFrameIndexFromReturnAddress (s, ra);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h 2005-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h 2005-10-31 02:47:56 UTC (rev 4126)
@@ -34,9 +34,9 @@
typedef struct GC_frameLayout {
GC_frameKind kind;
+ GC_frameOffsets offsets;
uint16_t size;
- GC_frameOffsets offsets;
-} GC_frameLayout;
+} *GC_frameLayout;
typedef uint32_t GC_frameIndex;
#define PRIFI PRIu32
#define FMTFI "%"PRIFI
@@ -44,3 +44,7 @@
typedef uintptr_t GC_returnAddress;
#define GC_RETURNADDRESS_SIZE sizeof(GC_returnAddress)
#define FMTRA "0x%016"PRIxPTR
+
+GC_frameIndex getFrameIndexFromReturnAddress (GC_state s, GC_returnAddress ra);
+GC_frameLayout getFrameLayoutFromFrameIndex (GC_state s, GC_frameIndex index);
+GC_frameLayout getFrameLayoutFromReturnAddress (GC_state s, GC_returnAddress ra);
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-10-30 14:38:45 UTC (rev 4125)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-10-31 02:47:56 UTC (rev 4126)
@@ -6,11 +6,11 @@
* See the file MLton-LICENSE for details.
*/
-static void minorGC (GC_state s) {
+void minorGC (GC_state s) {
minorCheneyCopyGC (s);
}
-static void majorGC (GC_state s, size_t bytesRequested, bool mayResize) {
+void majorGC (GC_state s, size_t bytesRequested, bool mayResize) {
uintmax_t numGCs;
size_t desiredSize;
@@ -23,12 +23,12 @@
< s->ratios.hashCons))
s->hashConsDuringGC = TRUE;
desiredSize =
- heapDesiredSize (s, s->lastMajorStatistics.bytesLive + bytesRequested, 0);
+ sizeofHeapDesired (s, s->lastMajorStatistics.bytesLive + bytesRequested, 0);
if ((not FORCE_MARK_COMPACT)
and not s->hashConsDuringGC // only markCompact can hash cons
and s->heap.size < s->sysvals.ram
- and (not heapIsInit (&s->secondaryHeap)
- or secondaryHeapCreate (s, desiredSize)))
+ and (not isHeapInit (&s->secondaryHeap)
+ or createHeapSecondary (s, desiredSize)))
majorCheneyCopyGC (s);
else
majorMarkCompactGC (s);
@@ -36,17 +36,18 @@
s->lastMajorStatistics.bytesLive = s->heap.oldGenSize;
if (s->lastMajorStatistics.bytesLive > s->cumulativeStatistics.maxBytesLive)
s->cumulativeStatistics.maxBytesLive = s->lastMajorStatistics.bytesLive;
- /* Notice that the s->bytesLive below is different than the s->bytesLive
- * used as an argument to heapAllocateSecondSemi above. Above, it was
- * an estimate. Here, it is exactly how much was live after the GC.
+ /* Notice that the s->bytesLive below is different than the
+ * s->bytesLive used as an argument to createHeapSecondary above.
+ * Above, it was an estimate. Here, it is exactly how much was live
+ * after the GC.
*/
if (mayResize)
- heapResize (s, s->lastMajorStatistics.bytesLive + bytesRequested);
- secondaryHeapResize (s);
+ resizeHeap (s, s->lastMajorStatistics.bytesLive + bytesRequested);
+ resizeHeapSecondary (s);
assert (s->heap.oldGenSize + bytesRequested <= s->heap.size);
}
-static inline void enterGC (GC_state s) {
+void enterGC (GC_state s) {
if (s->profiling.isOn) {
/* We don't need to profileEnter for count profiling because it
* has already bumped the counter. If we did allow the bump, then
@@ -59,7 +60,7 @@
s->amInGC = TRUE;
}
-static inline void leaveGC (GC_state s) {
+void leaveGC (GC_state s) {
if (s->profiling.isOn) {
if (s->profiling.stack
and not (PROFILE_COUNT == s->profiling.kind))
@@ -68,7 +69,7 @@
s->amInGC = FALSE;
}
-static inline bool needGCTime (GC_state s) {
+bool needGCTime (GC_state s) {
return
DEBUG
or s->controls.summary
@@ -76,11 +77,11 @@
or s->rusageIsEnabled;
}
-static void doGC (GC_state s,
- size_t oldGenBytesRequested,
- size_t nurseryBytesRequested,
- bool forceMajor,
- bool mayResize) {
+void doGC (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested,
+ bool forceMajor,
+ bool mayResize) {
uintmax_t gcTime;
bool stackTopOk;
size_t stackBytesRequested;
@@ -98,7 +99,9 @@
minorGC (s);
stackTopOk = mutatorStackInvariant (s);
stackBytesRequested =
- stackTopOk ? 0 : stackSizeTotalAligned (s, stackGrowSize (s));
+ stackTopOk
+ ? 0
+ : sizeofStackWithHeaderAligned (s, sizeofStackGrow (s, getStackCurrent (s)));
totalBytesRequested =
oldGenBytesRequested
+ nurseryBytesRequested
@@ -106,13 +109,13 @@
if (forceMajor
or totalBytesRequested > s->heap.size - s->heap.oldGenSize)
majorGC (s, totalBytesRequested, mayResize);
- heapSetNursery (s, oldGenBytesRequested + stackBytesRequested,
+ setHeapNursery (s, oldGenBytesRequested + stackBytesRequested,
nurseryBytesRequested);
- assert (heapHasBytesFree (s, oldGenBytesRequested + stackBytesRequested,
+ assert (hasHeapBytesFree (s, oldGenBytesRequested + stackBytesRequested,
nurseryBytesRequested));
unless (stackTopOk)
- stackGrow (s);
- setCurrentStack (s);
+ growStack (s);
+ setThreadAndStackCurrent (s);
if (needGCTime (s)) {
gcTime = stopTiming (&ru_start, &s->cumulativeStatistics.ru_gc);
s->cumulativeStatistics.maxPause =
@@ -138,17 +141,17 @@
}
if (DEBUG)
displayGCState (s, stderr);
- assert (heapHasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+ assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
assert (invariant (s));
leaveGC (s);
}
-static inline void ensureMutatorInvariant (GC_state s, bool force) {
+void ensureMutatorInvariant (GC_state s, bool force) {
if (force
or not (mutatorFrontierInvariant(s))
or not (mutatorStackInvariant(s))) {
/* This GC will grow the stack, if necessary. */
- doGC (s, 0, currentThread(s)->bytesNeeded, force, TRUE);
+ doGC (s, 0, getThreadCurrent(s)->bytesNeeded, force, TRUE);
}
assert (mutatorFrontierInvariant(s));
assert (mutatorStackInvariant(s));
@@ -157,14 +160,14 @@
/* ensureFree (s, b) ensures that upon return
* b <= s->limitPlusSlop - s->frontier
*/
-static inline void ensureFree (GC_state s, size_t bytesRequested) {
+void ensureFree (GC_state s, size_t bytesRequested) {
assert (s->frontier <= s->limitPlusSlop);
if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier))
doGC (s, 0, bytesRequested, FALSE, TRUE);
assert (bytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
}
-static void switchToThread (GC_state s, objptr op) {
+void switchToThread (GC_state s, objptr op) {
if (DEBUG_THREADS) {
GC_thread thread;
GC_stack stack;
@@ -176,7 +179,7 @@
op, stack->used, stack->reserved);
}
s->currentThread = op;
- setCurrentStack (s);
+ setThreadAndStackCurrent (s);
}
/* GC_startHandler does not do an enter()/leave(), even though it is
@@ -214,7 +217,7 @@
s->signalsInfo.amInSignalHandler = FALSE;
}
-static inline void maybeSwitchToHandler (GC_state s) {
+void maybeSwitchToHandler (GC_state s) {
if (s->atomicState == 1
and s->signalsInfo.signalIsPending) {
GC_startHandler (s);
@@ -222,48 +225,49 @@
}
}
-/* void GC_switchToThread (GC_state s, GC_thread t, uint ensureBytesFree) { */
-/* if (DEBUG_THREADS) */
-/* fprintf (stderr, "GC_switchToThread (0x%08x, %u)\n", (uint)t, ensureBytesFree); */
-/* if (FALSE) { */
-/* /\* This branch is slower than the else branch, especially */
-/* * when debugging is turned on, because it does an invariant */
-/* * check on every thread switch. */
-/* * So, we'll stick with the else branch for now. */
-/* *\/ */
-/* enter (s); */
-/* s->currentThread->bytesNeeded = ensureBytesFree; */
-/* switchToThread (s, t); */
-/* s->canHandle--; */
-/* maybeSwitchToHandler (s); */
-/* ensureMutatorInvariant (s, FALSE); */
-/* assert (mutatorFrontierInvariant(s)); */
-/* ...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2005-10-30 06:38:46
|
Weak functions
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-30 03:31:46 UTC (rev 4124)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-30 14:38:45 UTC (rev 4125)
@@ -115,6 +115,7 @@
size.c \
profiling.c \
world.c \
+ weak.c \
init.c \
done.c \
assumptions.c \
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-10-30 03:31:46 UTC (rev 4124)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-10-30 14:38:45 UTC (rev 4125)
@@ -7,34 +7,35 @@
*/
-bool GC_weakCanGet (pointer p) {
- Bool res;
+uint32_t GC_weakCanGet (GC_state s, pointer p) {
+ uint32_t res;
- res = WEAK_GONE_HEADER != GC_getHeader (p);
- if (DEBUG_WEAK)
- fprintf (stderr, "%s = GC_weakCanGet (0x%08x)\n",
- boolToString (res), (uint)p);
- return res;
+ res = GC_WEAK_GONE_HEADER != getHeader (p);
+ if (DEBUG_WEAK)
+ fprintf (stderr, "%s = GC_weakCanGet ("FMTPTR")\n",
+ boolToString (res), (uintptr_t)p);
+ return res;
}
-Pointer GC_weakGet (Pointer p) {
- pointer res;
+pointer GC_weakGet (GC_state s, pointer p) {
+ pointer res;
- res = ((GC_weak)p)->object;
- if (DEBUG_WEAK)
- fprintf (stderr, "0x%08x = GC_weakGet (0x%08x)\n",
- (uint)res, (uint)p);
- return res;
+ res = objptrToPointer(((GC_weak)p)->objptr, s->heap.start);
+ if (DEBUG_WEAK)
+ fprintf (stderr, FMTPTR" = GC_weakGet ("FMTPTR")\n",
+ (uintptr_t)res, (uintptr_t)p);
+ return res;
}
-Pointer GC_weakNew (GC_state s, Word32 header, Pointer p) {
- pointer res;
+pointer GC_weakNew (GC_state s, GC_header header, pointer p) {
+ pointer res;
- res = object (s, header, GC_NORMAL_HEADER_SIZE + 3 * WORD_SIZE,
- FALSE, FALSE);
- ((GC_weak)res)->object = p;
- if (DEBUG_WEAK)
- fprintf (stderr, "0x%08x = GC_weakNew (0x%08x, 0x%08x)\n",
- (uint)res, (uint)header, (uint)p);
- return res;
+ res = newObject (s, header,
+ GC_NORMAL_HEADER_SIZE + sizeof(struct GC_weak),
+ FALSE);
+ ((GC_weak)res)->objptr = pointerToObjptr(p, s->heap.start);
+ if (DEBUG_WEAK)
+ fprintf (stderr, FMTPTR" = GC_weakNew ("FMTHDR", "FMTPTR")\n",
+ (uintptr_t)res, header, (uintptr_t)p);
+ return res;
}
|
|
From: Matthew F. <fl...@ml...> - 2005-10-29 20:31:52
|
init and done functions
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-29 21:05:39 UTC (rev 4123)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-30 03:31:46 UTC (rev 4124)
@@ -114,7 +114,9 @@
pack.c \
size.c \
profiling.c \
+ world.c \
init.c \
+ done.c \
assumptions.c \
gc_suffix.c
@@ -142,6 +144,7 @@
hash-cons.h \
profiling.h \
signals.h \
+ world.h \
init.h \
gc_state.h \
gc_suffix.h
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c (from rev 4120, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-26 00:53:09 UTC (rev 4120)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c 2005-10-30 03:31:46 UTC (rev 4124)
@@ -0,0 +1,92 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+static void displayCol (FILE *out, int width, char *s) {
+ int extra;
+ int i;
+ int len;
+
+ len = strlen (s);
+ if (len < width) {
+ extra = width - len;
+ for (i = 0; i < extra; i++)
+ fprintf (out, " ");
+ }
+ fprintf (out, "%s\t", s);
+}
+
+static void displayCollectionStats (FILE *out, char *name, struct rusage *ru,
+ uintmax_t num, uintmax_t bytes) {
+ uintmax_t ms;
+
+ ms = rusageTime (ru);
+ fprintf (out, "%s", name);
+ displayCol (out, 7, uintmaxToCommaString (ms));
+ displayCol (out, 7, uintmaxToCommaString (num));
+ displayCol (out, 15, uintmaxToCommaString (bytes));
+ displayCol (out, 15,
+ (ms > 0)
+ ? uintmaxToCommaString (1000.0 * (float)bytes/(float)ms)
+ : "-");
+ fprintf (out, "\n");
+}
+
+void GC_done (GC_state s) {
+ FILE *out;
+
+ enter (s);
+ minorGC (s);
+ out = stderr;
+ if (s->controls.summary) {
+ uintmax_t time;
+ uintmax_t gcTime;
+
+ gcTime = rusageTime (&s->cumulativeStatistics.ru_gc);
+ fprintf (out, "GC type\t\ttime ms\t number\t\t bytes\t bytes/sec\n");
+ fprintf (out, "-------------\t-------\t-------\t---------------\t---------------\n");
+ displayCollectionStats
+ (out, "copying\t\t",
+ &s->cumulativeStatistics.ru_gcCopy,
+ s->cumulativeStatistics.numCopyingGCs,
+ s->cumulativeStatistics.bytesCopied);
+ displayCollectionStats
+ (out, "mark-compact\t",
+ &s->cumulativeStatistics.ru_gcMarkCompact,
+ s->cumulativeStatistics.numMarkCompactGCs,
+ s->cumulativeStatistics.bytesMarkCompacted);
+ displayCollectionStats
+ (out, "minor\t\t",
+ &s->cumulativeStatistics.ru_gcMinor,
+ s->cumulativeStatistics.numMinorGCs,
+ s->cumulativeStatistics.bytesCopiedMinor);
+ time = currentTime () - s->startTime;
+ fprintf (out, "total GC time: %s ms (%.1f%%)\n",
+ uintmaxToCommaString (gcTime),
+ (0 == time)
+ ? 0.0
+ : 100.0 * ((double) gcTime) / (double)time);
+ fprintf (out, "max pause: %s ms\n",
+ uintmaxToCommaString (s->cumulativeStatistics.maxPause));
+ fprintf (out, "total allocated: %s bytes\n",
+ uintmaxToCommaString (s->cumulativeStatistics.bytesAllocated));
+ fprintf (out, "max live: %s bytes\n",
+ uintmaxToCommaString (s->cumulativeStatistics.maxBytesLive));
+ fprintf (out, "max semispace: %s bytes\n",
+ uintmaxToCommaString (s->cumulativeStatistics.maxHeapSizeSeen));
+ fprintf (out, "max stack size: %s bytes\n",
+ uintmaxToCommaString (s->cumulativeStatistics.maxStackSizeSeen));
+ fprintf (out, "marked cards: %s\n",
+ uintmaxToCommaString (s->cumulativeStatistics.markedCards));
+ fprintf (out, "minor scanned: %s bytes\n",
+ uintmaxToCommaString (s->cumulativeStatistics.minorBytesScanned));
+ fprintf (out, "minor skipped: %s bytes\n",
+ uintmaxToCommaString (s->cumulativeStatistics.minorBytesSkipped));
+ }
+ heapRelease (s, &s->heap);
+ heapRelease (s, &s->secondaryHeap);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-29 21:05:39 UTC (rev 4123)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-30 03:31:46 UTC (rev 4124)
@@ -32,7 +32,7 @@
struct GC_lastMajorStatistics lastMajorStatistics;
pointer limit; /* limit = heap.start + heap.totalBytes */
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
- void (*loadGlobals)(FILE *file); /* loads the globals from the stream. */
+ void (*loadGlobals)(int fd); /* loads the globals from the fd. */
uint32_t magic; /* The magic number for this executable. */
uint32_t maxFrameSize;
/*Bool*/bool mutatorMarksCards;
@@ -46,7 +46,7 @@
objptr savedThread; /* Result of GC_copyCurrentThread.
* Thread interrupted by arrival of signal.
*/
- void (*saveGlobals)(int fd); /* writes out the values of all of the globals to fd. */
+ void (*saveGlobals)(int fd); /* saves the globals to the fd. */
struct GC_heap secondaryHeap; /* Used for major copying collection. */
objptr signalHandlerThread; /* Handler for signals (in heap). */
struct GC_signalsInfo signalsInfo;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-29 21:05:39 UTC (rev 4123)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-30 03:31:46 UTC (rev 4124)
@@ -227,7 +227,6 @@
} else {
/* Write the heap to a file and try again. */
int fd;
- FILE *stream;
char template[80];
char *tmpDefault;
char *tmpDir;
@@ -248,14 +247,14 @@
if (s->controls.messages)
fprintf (stderr, "Paging heap from "FMTPTR" to %s.\n",
(uintptr_t)orig, template);
- stream = fopen_safe (template, "wb");
- fwrite_safe (orig, 1, size, stream);
- fclose_safe (stream);
+ fd = open_safe (template, O_WRONLY, 0);
+ write_safe (fd, orig, size);
+ close_safe (fd);
heapRelease (s, curHeapp);
if (heapCreate (s, curHeapp, desiredSize, minSize)) {
- stream = fopen_safe (template, "rb");
- fread_safe (curHeapp->start, 1, size, stream);
- fclose_safe (stream);
+ fd = open_safe (template, O_RDONLY, 0);
+ read_safe (fd, curHeapp->start, size);
+ close_safe (fd);
unlink_safe (template);
} else {
unlink_safe (template);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-29 21:05:39 UTC (rev 4123)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-30 03:31:46 UTC (rev 4124)
@@ -263,46 +263,6 @@
switchToThread (s, pointerToObjptr((pointer)thread, s->heap.start));
}
-/* worldTerminator is used to separate the human readable messages at the
- * beginning of the world file from the machine readable data.
- */
-static const char worldTerminator = '\000';
-
-static void loadWorld (GC_state s, char *fileName) {
- FILE *file;
- uint32_t magic;
- pointer oldGen;
- int c;
-
- if (DEBUG_WORLD)
- fprintf (stderr, "loadWorld (%s)\n", fileName);
- file = fopen_safe (fileName, "rb");
- until ((c = fgetc (file)) == worldTerminator or EOF == c) ;
- if (EOF == c) die ("Invalid world.");
- // magic = sfreadUint (file);
- unless (s->magic == magic)
- die ("Invalid world: wrong magic number.");
-/* oldGen = (pointer) sfreadUint (file); */
-/* s->oldGenSize = sfreadUint (file); */
-/* s->callFromCHandler = (GC_thread) sfreadUint (file); */
-/* s->canHandle = sfreadUint (file); */
-/* s->currentThread = (GC_thread) sfreadUint (file); */
-/* s->signalHandler = (GC_thread) sfreadUint (file); */
- heapCreate (s, &s->heap, heapDesiredSize (s, s->heap.oldGenSize, 0), s->heap.oldGenSize);
- createCardMapAndCrossMap (s);
-/* sfread (s->heap.start, 1, s->oldGenSize, file); */
- (*s->loadGlobals) (file);
- unless (EOF == fgetc (file))
- die ("Invalid world: junk at end of file.");
- fclose_safe (file);
- /* translateHeap must occur after loading the heap and globals, since it
- * changes pointers in all of them.
- */
- translateHeap (s, oldGen, s->heap.start, s->heap.oldGenSize);
- heapSetNursery (s, 0, 0);
- setCurrentStack (s);
-}
-
/* ---------------------------------------------------------------- */
/* GC_init */
/* ---------------------------------------------------------------- */
@@ -594,82 +554,3 @@
/* CommandLine_argc = argc - start; */
/* CommandLine_argv = (uint)(argv + start); */
/* } */
-
-/* static void displayCol (FILE *out, int width, string s) { */
-/* int extra; */
-/* int i; */
-/* int len; */
-
-/* len = strlen (s); */
-/* if (len < width) { */
-/* extra = width - len; */
-/* for (i = 0; i < extra; ++i) */
-/* fprintf (out, " "); */
-/* } */
-/* fprintf (out, "%s\t", s); */
-/* } */
-
-/* static void displayCollectionStats (FILE *out, string name, struct rusage *ru, */
-/* uint num, ullong bytes) { */
-/* uint ms; */
-
-/* ms = rusageTime (ru); */
-/* fprintf (out, "%s", name); */
-/* displayCol (out, 7, uintToCommaString (ms)); */
-/* displayCol (out, 7, uintToCommaString (num)); */
-/* displayCol (out, 15, ullongToCommaString (bytes)); */
-/* displayCol (out, 15, */
-/* (ms > 0) */
-/* ? uintToCommaString (1000.0 * (float)bytes/(float)ms) */
-/* : "-"); */
-/* fprintf (out, "\n"); */
-/* } */
-
-/* void GC_done (GC_state s) { */
-/* FILE *out; */
-
-/* enter (s); */
-/* minorGC (s); */
-/* out = stderr; */
-/* if (s->summary) { */
-/* double time; */
-/* uint gcTime; */
-
-/* gcTime = rusageTime (&s->ru_gc); */
-/* fprintf (out, "GC type\t\ttime ms\t number\t\t bytes\t bytes/sec\n"); */
-/* fprintf (out, "-------------\t-------\t-------\t---------------\t---------------\n"); */
-/* displayCollectionStats */
-/* (out, "copying\t\t", &s->ru_gcCopy, s->numCopyingGCs, */
-/* s->bytesCopied); */
-/* displayCollectionStats */
-/* (out, "mark-compact\t", &s->ru_gcMarkCompact, */
-/* s->numMarkCompactGCs, s->bytesMarkCompacted); */
-/* displayCollectionStats */
-/* (out, "minor\t\t", &s->ru_gcMinor, s->numMinorGCs, */
-/* s->bytesCopiedMinor); */
-/* time = (double)(currentTime () - s->startTime); */
-/* fprintf (out, "total GC time: %s ms (%.1f%%)\n", */
-/* intToCommaString (gcTime), */
-/* (0.0 == time) */
-/* ? 0.0 */
-/* : 100.0 * ((double) gcTime) / time); */
-/* fprintf (out, "max pause: %s ms\n", */
-/* uintToCommaString (s->maxPause)); */
-/* fprintf (out, "total allocated: %s bytes\n", */
-/* ullongToCommaString (s->bytesAllocated)); */
-/* fprintf (out, "max live: %s bytes\n", */
-/* uintToCommaString (s->maxBytesLive)); */
-/* fprintf (out, "max semispace: %s bytes\n", */
-/* uintToCommaString (s->maxHeapSizeSeen)); */
-/* fprintf (out, "max stack size: %s bytes\n", */
-/* uintToCommaString (s->maxStackSizeSeen)); */
-/* fprintf (out, "marked cards: %s\n", */
-/* ullongToCommaString (s->markedCards)); */
-/* fprintf (out, "minor scanned: %s bytes\n", */
-/* uintToCommaString (s->minorBytesScanned)); */
-/* fprintf (out, "minor skipped: %s bytes\n", */
-/* uintToCommaString (s->minorBytesSkipped)); */
-/* } */
-/* heapRelease (s, &s->heap); */
-/* heapRelease (s, &s->heap2); */
-/* } */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c 2005-10-29 21:05:39 UTC (rev 4123)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c 2005-10-30 03:31:46 UTC (rev 4124)
@@ -6,19 +6,79 @@
* See the file MLton-LICENSE for details.
*/
+static inline char readChar (int fd) {
+ char res;
+ read_safe (fd, &res, sizeof(char));
+ return res;
+}
-static void writeString (int fd, char* s) {
+static inline pointer readPointer (int fd) {
+ uintptr_t res;
+ read_safe (fd, &res, sizeof(uintptr_t));
+ return (pointer)res;
+}
+
+static inline objptr readObjptr (int fd) {
+ objptr res;
+ read_safe (fd, &res, sizeof(objptr));
+ return res;
+}
+
+static inline size_t readSize (int fd) {
+ size_t res;
+ read_safe (fd, &res, sizeof(size_t));
+ return res;
+}
+
+static inline uint32_t readUint32 (int fd) {
+ uint32_t res;
+ read_safe (fd, &res, sizeof(uint32_t));
+ return res;
+}
+
+static inline uintptr_t readUintptr (int fd) {
+ uintptr_t res;
+ read_safe (fd, &res, sizeof(uintptr_t));
+ return res;
+}
+
+static inline void writeChar (int fd, char c) {
+ write_safe (fd, &c, sizeof(char));
+}
+
+static inline void writePointer (int fd, pointer p) {
+ uintptr_t u = (uintptr_t)p;
+ write_safe (fd, &u, sizeof(uintptr_t));
+}
+
+static inline void writeObjptr (int fd, objptr op) {
+ write_safe (fd, &op, sizeof(objptr));
+}
+
+static inline void writeSize (int fd, size_t z) {
+ write_safe (fd, &z, sizeof(size_t));
+}
+
+static inline void writeUint32 (int fd, uint32_t u) {
+ write_safe (fd, &u, sizeof(uint32_t));
+}
+
+static inline void writeUintptr (int fd, uintptr_t u) {
+ write_safe (fd, &u, sizeof(uintptr_t));
+}
+
+static inline void writeString (int fd, char* s) {
write_safe (fd, s, strlen(s));
}
-static void writeUint32U (int fd, uint32_t u) {
+static inline void writeUint32U (int fd, uint32_t u) {
char buf[(UINT32_MAX / 10) + 2];
sprintf (buf, "%"PRIu32, u);
writeString (fd, buf);
}
-static void writeUintmaxU (int fd, uintmax_t u) {
+static inline void writeUintmaxU (int fd, uintmax_t u) {
// char buf[(UINTMAX_MAX / 10) + 2];
char buf[20];
@@ -26,13 +86,13 @@
writeString (fd, buf);
}
-static void writeUint32X (int fd, uint32_t u) {
+static inline void writeUint32X (int fd, uint32_t u) {
char buf[5 + (UINT32_MAX / 16) + 2];
sprintf (buf, "0x%08"PRIx32, u);
writeString (fd, buf);
}
-static inline void writeNewline (int fd) {
- writeString (fd, "\n");
+static inline inline void writeNewline (int fd) {
+ writeString (fd, "\n");
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c 2005-10-29 21:05:39 UTC (rev 4123)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c 2005-10-30 03:31:46 UTC (rev 4124)
@@ -34,6 +34,15 @@
return fd;
}
+int open_safe (const char *fileName, int flags, mode_t mode) {
+ int res;
+
+ res = open (fileName, flags, mode);
+ if (-1 == res)
+ diee ("open (%s,_,_) failed.\n", fileName);
+ return res;
+}
+
void close_safe (int fd) {
int res;
@@ -43,6 +52,7 @@
return;
}
+/*
FILE *fopen_safe (char *fileName, char *mode) {
FILE *file;
@@ -83,6 +93,7 @@
diee ("fread (_, _, _, _) failed.\n");
return;
}
+*/
void unlink_safe (const char *pathname) {
int res;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c 2005-10-29 21:05:39 UTC (rev 4123)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c 2005-10-30 03:31:46 UTC (rev 4124)
@@ -8,3 +8,32 @@
const char* boolToString (bool b) {
return b ? "TRUE" : "FALSE";
}
+
+#define BUF_SIZE 81
+char* uintmaxToCommaString (uintmax_t n) {
+ static char buf1[BUF_SIZE];
+ static char buf2[BUF_SIZE];
+ static char buf3[BUF_SIZE];
+ static char buf4[BUF_SIZE];
+ static char buf5[BUF_SIZE];
+ static char *bufs[] = {buf1, buf2, buf3, buf4, buf5};
+ static int bufIndex = 0;
+ static char *buf;
+ int i;
+
+ buf = bufs[bufIndex++];
+ bufIndex %= 5;
+
+ i = BUF_SIZE - 1;
+ buf[i--] = '\000';
+ if (0 == n)
+ buf[i--] = '0';
+ else {
+ while (n > 0) {
+ buf[i--] = n % 10 + '0';
+ n = n / 10;
+ if (i % 4 == 0 and n > 0) buf[i--] = ',';
+ }
+ }
+ return buf + i + 1;
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c (from rev 4120, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-26 00:53:09 UTC (rev 4120)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c 2005-10-30 03:31:46 UTC (rev 4124)
@@ -0,0 +1,71 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+static void loadWorld (GC_state s, char *fileName) {
+ int fd;
+ uint32_t magic;
+ pointer start;
+
+ if (DEBUG_WORLD)
+ fprintf (stderr, "loadWorld (%s)\n", fileName);
+ fd = open_safe (fileName, O_RDONLY, 0);
+ until (readChar (fd) == '\000') ;
+ magic = readUint32 (fd);
+ unless (s->magic == magic)
+ die ("Invalid world: wrong magic number.");
+ start = readPointer (fd);
+ s->heap.oldGenSize = readSize (fd);
+ s->atomicState = readUint32 (fd);
+ s->callFromCHandlerThread = readObjptr (fd);
+ s->currentThread = readObjptr (fd);
+ s->signalHandlerThread = readObjptr (fd);
+ heapCreate (s, &s->heap,
+ heapDesiredSize (s, s->heap.oldGenSize, 0),
+ s->heap.oldGenSize);
+ createCardMapAndCrossMap (s);
+ read_safe (fd, s->heap.start, s->heap.oldGenSize);
+ (*s->loadGlobals) (fd);
+ // unless (EOF == fgetc (file))
+ // die ("Invalid world: junk at end of file.");
+ close_safe (fd);
+ /* translateHeap must occur after loading the heap and globals,
+ * since it changes pointers in all of them.
+ */
+ translateHeap (s, start, s->heap.start, s->heap.oldGenSize);
+ heapSetNursery (s, 0, 0);
+ setCurrentStack (s);
+}
+
+static void saveWorld (GC_state s, int fd) {
+ char buf[80];
+
+ if (DEBUG_WORLD)
+ fprintf (stderr, "GC_saveWorld (%d).\n", fd);
+ enter (s);
+ /* Compact the heap. */
+ doGC (s, 0, 0, TRUE, TRUE);
+ sprintf (buf,
+ "Heap file created by MLton.\nheap.start = "FMTPTR"\nbytesLive = %zu\n",
+ (uintptr_t)s->heap.start,
+ s->lastMajorStatistics.bytesLive);
+ write_safe (fd, buf, 1 + strlen(buf)); /* +1 to get the '\000' */
+ writeUint32 (fd, s->magic);
+ writePointer (fd, s->heap.start);
+ writeSize (fd, s->heap.oldGenSize);
+ /* atomicState must be saved in the heap, because the saveWorld may
+ * be run in the context of a critical section, which will expect to
+ * be in the same context when it is restored.
+ */
+ writeUint32 (fd, s->atomicState);
+ writeObjptr (fd, s->callFromCHandlerThread);
+ writeObjptr (fd, s->currentThread);
+ writeObjptr (fd, s->signalHandlerThread);
+ write_safe (fd, s->heap.start, s->heap.oldGenSize);
+ (*s->saveGlobals) (fd);
+ leave (s);
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h (from rev 4120, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-10-26 00:53:09 UTC (rev 4120)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h 2005-10-30 03:31:46 UTC (rev 4124)
@@ -0,0 +1,11 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+static void loadWorld (GC_state s, char *fileName);
+
+static void saveWorld (GC_state s, int fd);
|
|
From: Matthew F. <fl...@ml...> - 2005-10-29 14:05:46
|
Working on init
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-29 21:05:39 UTC (rev 4123)
@@ -131,6 +131,7 @@
stack.h \
thread.h \
weak.h \
+ int-inf.h \
heap.h \
major.h \
generational.h \
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-10-29 21:05:39 UTC (rev 4123)
@@ -1,6 +1,6 @@
* reorder ZZZ_TYPE_INDEX
-* eliminate STRING_TYPE_INDEX, STRING_TYPE_HEADER in favor or WORD8.
+* eliminate STRING_TYPE_INDEX, STRING_TYPE_HEADER in favor of WORD8.
* fix semantics of numNonPointers for normal objects to mean bytes of
non-pointer data, rather than number of 32-bit words of
non-pointer data. Rename to sizeNonPointers.
@@ -17,3 +17,4 @@
be implemented in Backend.
* the "skipObjects" loop in forwardInterGenerationalObjptrs appears to
be unnecessary.
+* Why do {load,save}Globals differ in the representation of the file?
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-29 21:05:39 UTC (rev 4123)
@@ -370,7 +370,7 @@
forwardState.toLimit = forwardState.toStart + bytesAllocated;
assert (invariant (s));
s->cumulativeStatistics.numMinorGCs++;
- s->lastMajorStatistics.numMinorsGCs++;
+ s->lastMajorStatistics.numMinorGCs++;
forwardState.back = forwardState.toStart;
/* Forward all globals. Would like to avoid doing this once all
* the globals have been assigned.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-29 21:05:39 UTC (rev 4123)
@@ -10,6 +10,8 @@
size_t alignment; /* */
bool amInGC;
bool amOriginal;
+ char **atMLtons; /* Initial @MLton args, processed before command line. */
+ int32_t atMLtonsLength;
uint32_t atomicState;
objptr callFromCHandlerThread; /* Handler for exported C calls (in heap). */
bool canMinor; /* TRUE iff there is space for a minor gc. */
@@ -30,6 +32,7 @@
struct GC_lastMajorStatistics lastMajorStatistics;
pointer limit; /* limit = heap.start + heap.totalBytes */
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
+ void (*loadGlobals)(FILE *file); /* loads the globals from the stream. */
uint32_t magic; /* The magic number for this executable. */
uint32_t maxFrameSize;
/*Bool*/bool mutatorMarksCards;
@@ -43,12 +46,14 @@
objptr savedThread; /* Result of GC_copyCurrentThread.
* Thread interrupted by arrival of signal.
*/
+ void (*saveGlobals)(int fd); /* writes out the values of all of the globals to fd. */
struct GC_heap secondaryHeap; /* Used for major copying collection. */
objptr signalHandlerThread; /* Handler for signals (in heap). */
struct GC_signalsInfo signalsInfo;
pointer stackBottom; /* Bottom of stack in current thread. */
pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
pointer stackTop; /* Top of stack in current thread. */
+ uintmax_t startTime; /* The time when GC_init or GC_loadWorld was called. */
struct GC_sysvals sysvals;
struct GC_vectorInit *vectorInits;
uint32_t vectorInitsLength;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-29 21:05:39 UTC (rev 4123)
@@ -104,86 +104,82 @@
}
static void initIntInfs (GC_state s) {
-/* struct GC_intInfInit *inits; */
-/* pointer frontier; */
-/* char *str; */
-/* uint slen, */
-/* llen, */
-/* alen, */
-/* i, */
-/* index; */
-/* bool neg, */
-/* hex; */
-/* bignum *bp; */
-/* uchar *cp; */
+ struct GC_intInfInit *inits;
+ pointer frontier;
+ char *str;
+ size_t slen, llen;
+ mp_size_t alen;
+ uint32_t i, j;
+ bool neg, hex;
+ GC_intInf bp;
+ unsigned char *cp;
-/* assert (isAlignedFrontier (s, s->frontier)); */
-/* frontier = s->frontier; */
-/* for (index = 0; index < s->intInfInitsSize; ++index) { */
-/* inits = &s->intInfInits[index]; */
-/* str = inits->mlstr; */
-/* assert (inits->globalIndex < s->globalsSize); */
-/* neg = *str == '~'; */
-/* if (neg) */
-/* ++str; */
-/* slen = strlen (str); */
-/* hex = str[0] == '0' && str[1] == 'x'; */
-/* if (hex) { */
-/* str += 2; */
-/* slen -= 2; */
-/* llen = (slen + 7) / 8; */
-/* } else */
-/* llen = (slen + 8) / 9; */
-/* assert (slen > 0); */
-/* bp = (bignum *)frontier; */
-/* cp = (uchar *)&bp->limbs[llen]; */
-/* for (i = 0; i != slen; ++i) */
-/* if ('0' <= str[i] && str[i] <= '9') */
-/* cp[i] = str[i] - '0' + 0; */
-/* else if ('a' <= str[i] && str[i] <= 'f') */
-/* cp[i] = str[i] - 'a' + 0xa; */
-/* else { */
-/* assert('A' <= str[i] && str[i] <= 'F'); */
-/* cp[i] = str[i] - 'A' + 0xA; */
-/* } */
-/* alen = mpn_set_str (bp->limbs, cp, slen, hex ? 0x10 : 10); */
-/* assert (alen <= llen); */
-/* if (alen <= 1) { */
-/* uint val, */
-/* ans; */
+ assert (isAlignedFrontier (s, s->frontier));
+ frontier = s->frontier;
+ for (i= 0; i < s->intInfInitsLength; i++) {
+ inits = &s->intInfInits[i];
+ str = inits->mlstr;
+ assert (inits->globalIndex < s->globalsLength);
+ neg = *str == '~';
+ if (neg)
+ str++;
+ slen = strlen (str);
+ hex = str[0] == '0' && str[1] == 'x';
+ if (hex) {
+ str += 2;
+ slen -= 2;
+ llen = (slen + 7) / 8;
+ } else
+ llen = (slen + 8) / 9;
+ assert (slen > 0);
+ bp = (GC_intInf)frontier;
+ cp = (unsigned char *)&bp->limbs[llen];
-/* if (alen == 0) */
-/* val = 0; */
-/* else */
-/* val = bp->limbs[0]; */
-/* if (neg) { */
-/* /\* */
-/* * We only fit if val in [1, 2^30]. */
-/* *\/ */
-/* ans = - val; */
-/* val = val - 1; */
-/* } else */
-/* /\* */
-/* * We only fit if val in [0, 2^30 - 1]. */
-/* *\/ */
-/* ans = val; */
-/* if (val < (uint)1<<30) { */
-/* s->globals[inits->globalIndex] = */
-/* (pointer)(ans<<1 | 1); */
-/* continue; */
-/* } */
-/* } */
-/* s->globals[inits->globalIndex] = (pointer)&bp->isneg; */
-/* bp->counter = 0; */
-/* bp->card = alen + 1; */
-/* bp->magic = BIGMAGIC; */
-/* bp->isneg = neg; */
-/* frontier = alignFrontier (s, (pointer)&bp->limbs[alen]); */
-/* } */
-/* assert (isAlignedFrontier (s, frontier)); */
-/* s->frontier = frontier; */
-/* GC_profileAllocInc (s, frontier - s->frontier); */
-/* s->bytesAllocated += frontier - s->frontier; */
+ for (j = 0; j != slen; j++)
+ if ('0' <= str[j] && str[j] <= '9')
+ cp[j] = str[j] - '0' + 0;
+ else if ('a' <= str[j] && str[j] <= 'f')
+ cp[j] = str[j] - 'a' + 0xa;
+ else {
+ assert('A' <= str[j] && str[j] <= 'F');
+ cp[j] = str[j] - 'A' + 0xA;
+ }
+ alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, hex ? 0x10 : 10);
+ assert ((size_t)alen <= llen);
+ if (alen <= 1) {
+ uint32_t val, ans;
+
+ if (alen == 0)
+ val = 0;
+ else
+ val = bp->limbs[0];
+ if (neg) {
+ /*
+ * We only fit if val in [1, 2^30].
+ */
+ ans = - val;
+ val = val - 1;
+ } else
+ /*
+ * We only fit if val in [0, 2^30 - 1].
+ */
+ ans = val;
+ if (val < (uint32_t)1<<30) {
+ s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
+ continue;
+ }
+ }
+ s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
+ bp->counter = 0;
+ bp->length = alen + 1;
+ bp->header = objectHeader (WORD32_VECTOR_TYPE_INDEX);
+ bp->isneg = neg;
+ frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
+ }
+ assert (isAlignedFrontier (s, frontier));
+ GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
+ s->frontier = frontier;
+ s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
}
static void initVectors (GC_state s) {
@@ -194,7 +190,7 @@
assert (isAlignedFrontier (s, s->frontier));
inits = s->vectorInits;
frontier = s->frontier;
- for (i = 0; i < s->vectorInitsLength; ++i) {
+ for (i = 0; i < s->vectorInitsLength; i++) {
size_t bytesPerElement;
size_t dataBytes;
size_t objectSize;
@@ -267,46 +263,45 @@
switchToThread (s, pointerToObjptr((pointer)thread, s->heap.start));
}
-/* /\* worldTerminator is used to separate the human readable messages at the */
-/* * beginning of the world file from the machine readable data. */
-/* *\/ */
-/* static const char worldTerminator = '\000'; */
+/* worldTerminator is used to separate the human readable messages at the
+ * beginning of the world file from the machine readable data.
+ */
+static const char worldTerminator = '\000';
-/* static void loadWorld (GC_state s, char *fileName) { */
-/* FILE *file; */
-/* uint magic; */
-/* pointer oldGen; */
-/* int c; */
+static void loadWorld (GC_state s, char *fileName) {
+ FILE *file;
+ uint32_t magic;
+ pointer oldGen;
+ int c;
-/* if (DEBUG_WORLD) */
-/* fprintf (stderr, "loadWorld (%s)\n", fileName); */
-/* file = sfopen (fileName, "rb"); */
-/* until ((c = fgetc (file)) == worldTerminator or EOF == c); */
-/* if (EOF == c) die ("Invalid world."); */
-/* magic = sfreadUint (file); */
-/* unless (s->magic == magic) */
-/* die ("Invalid world: wrong magic number."); */
+ if (DEBUG_WORLD)
+ fprintf (stderr, "loadWorld (%s)\n", fileName);
+ file = fopen_safe (fileName, "rb");
+ until ((c = fgetc (file)) == worldTerminator or EOF == c) ;
+ if (EOF == c) die ("Invalid world.");
+ // magic = sfreadUint (file);
+ unless (s->magic == magic)
+ die ("Invalid world: wrong magic number.");
/* oldGen = (pointer) sfreadUint (file); */
/* s->oldGenSize = sfreadUint (file); */
/* s->callFromCHandler = (GC_thread) sfreadUint (file); */
/* s->canHandle = sfreadUint (file); */
/* s->currentThread = (GC_thread) sfreadUint (file); */
/* s->signalHandler = (GC_thread) sfreadUint (file); */
-/* heapCreate (s, &s->heap, heapDesiredSize (s, s->oldGenSize, 0), */
-/* s->oldGenSize); */
-/* createCardMapAndCrossMap (s); */
+ heapCreate (s, &s->heap, heapDesiredSize (s, s->heap.oldGenSize, 0), s->heap.oldGenSize);
+ createCardMapAndCrossMap (s);
/* sfread (s->heap.start, 1, s->oldGenSize, file); */
-/* (*s->loadGlobals) (file); */
-/* unless (EOF == fgetc (file)) */
-/* die ("Invalid world: junk at end of file."); */
-/* fclose (file); */
-/* /\* translateHeap must occur after loading the heap and globals, since it */
-/* * changes pointers in all of them. */
-/* *\/ */
-/* translateHeap (s, oldGen, s->heap.start, s->oldGenSize); */
-/* setNursery (s, 0, 0); */
-/* setStack (s); */
-/* } */
+ (*s->loadGlobals) (file);
+ unless (EOF == fgetc (file))
+ die ("Invalid world: junk at end of file.");
+ fclose_safe (file);
+ /* translateHeap must occur after loading the heap and globals, since it
+ * changes pointers in all of them.
+ */
+ translateHeap (s, oldGen, s->heap.start, s->heap.oldGenSize);
+ heapSetNursery (s, 0, 0);
+ setCurrentStack (s);
+}
/* ---------------------------------------------------------------- */
/* GC_init */
@@ -334,38 +329,38 @@
arg = argv[i];
if (0 == strcmp (arg, "copy-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton copy-ratio missing argument.");
s->ratios.copy = stringToFloat (argv[i++]);
} else if (0 == strcmp(arg, "fixed-heap")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton fixed-heap missing argument.");
s->controls.fixedHeap = align (stringToBytes (argv[i++]),
2 * s->sysvals.pageSize);
} else if (0 == strcmp (arg, "gc-messages")) {
- ++i;
+ i++;
s->controls.messages = TRUE;
} else if (0 == strcmp (arg, "gc-summary")) {
- ++i;
+ i++;
#if (defined (__MINGW32__))
fprintf (stderr, "Warning: MinGW doesn't yet support gc-summary\n");
#else
s->controls.summary = TRUE;
#endif
} else if (0 == strcmp (arg, "copy-generational-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton copy-generational-ratio missing argument.");
s->ratios.copyGenerational = stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "grow-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton grow-ratio missing argument.");
s->ratios.grow = stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "hash-cons")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton hash-cons missing argument.");
s->ratios.hashCons = stringToFloat (argv[i++]);
@@ -373,44 +368,44 @@
and s->ratios.hashCons <= 1.0)
die ("@MLton hash-cons argument must be between 0.0 and 1.0");
} else if (0 == strcmp (arg, "live-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton live-ratio missing argument.");
s->ratios.live = stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "load-world")) {
unless (s->controls.mayLoadWorld)
die ("May not load world.");
- ++i;
+ i++;
s->amOriginal = FALSE;
if (i == argc)
die ("@MLton load-world missing argument.");
*worldFile = argv[i++];
} else if (0 == strcmp (arg, "max-heap")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton max-heap missing argument.");
s->controls.maxHeap = align (stringToBytes (argv[i++]),
2 * s->sysvals.pageSize);
} else if (0 == strcmp (arg, "mark-compact-generational-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton mark-compact-generational-ratio missing argument.");
s->ratios.markCompactGenerational = stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "mark-compact-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton mark-compact-ratio missing argument.");
s->ratios.markCompact = stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "no-load-world")) {
- ++i;
+ i++;
s->controls.mayLoadWorld = FALSE;
} else if (0 == strcmp (arg, "nursery-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton nursery-ratio missing argument.");
s->ratios.nursery = stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "ram-slop")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton ram-slop missing argument.");
s->ratios.ramSlop = stringToFloat (argv[i++]);
@@ -418,18 +413,18 @@
showProf (s);
exit (0);
} else if (0 == strcmp (arg, "stop")) {
- ++i;
+ i++;
s->controls.mayProcessAtMLton = FALSE;
} else if (0 == strcmp (arg, "thread-shrink-ratio")) {
- ++i;
+ i++;
if (i == argc)
die ("@MLton thread-shrink-ratio missing argument.");
s->ratios.threadShrink = stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "use-mmap")) {
- ++i;
+ i++;
MLton_Platform_CygwinUseMmap = TRUE;
} else if (0 == strcmp (arg, "--")) {
- ++i;
+ i++;
done = TRUE;
} else if (i > 1)
die ("Strange @MLton arg: %s", argv[i]);
@@ -440,148 +435,152 @@
return i;
}
-/* int GC_init (GC_state s, int argc, char **argv) { */
-/* char *worldFile; */
-/* int i; */
+int GC_init (GC_state s, int argc, char **argv) {
+ char *worldFile;
+ int i;
-/* assert (isAligned (sizeof (struct GC_stack), s->alignment)); */
-/* assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread), */
-/* s->alignment)); */
-/* assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak), */
-/* s->alignment)); */
-/* MLton_Platform_CygwinUseMmap = FALSE; */
-/* s->amInGC = TRUE; */
-/* s->amInMinorGC = FALSE; */
-/* s->bytesAllocated = 0; */
-/* s->bytesCopied = 0; */
-/* s->bytesCopiedMinor = 0; */
-/* s->bytesMarkCompacted = 0; */
-/* s->callFromCHandler = BOGUS_THREAD; */
-/* s->canHandle = 0; */
-/* s->cardSize = 0x1 << CARD_SIZE_LOG2; */
-/* s->copyRatio = 4.0; */
-/* s->copyGenerationalRatio = 4.0; */
-/* s->currentThread = BOGUS_THREAD; */
-/* s->fixedHeap = 0.0; */
-/* s->gcSignalIsPending = FALSE; */
-/* s->growRatio = 8.0; */
-/* s->handleGCSignal = FALSE; */
-/* s->hashConsDuringGC = FALSE; */
-/* s->hashConsFrequency = 0.0; */
-/* s->inSignalHandler = FALSE; */
-/* s->isOriginal = TRUE; */
-/* s->lastMajor = GC_COPYING; */
-/* s->liveRatio = 8.0; */
-/* s->markCompactRatio = 1.04; */
-/* s->markCompactGenerationalRatio = 8.0; */
-/* s->markedCards = 0; */
-/* s->maxBytesLive = 0; */
-/* s->maxHeap = 0; */
-/* s->maxHeapSizeSeen = 0; */
-/* s->maxPause = 0; */
-/* s->maxStackSizeSeen = 0; */
-/* s->mayLoadWorld = TRUE; */
-/* s->mayProcessAtMLton = TRUE; */
-/* s->messages = FALSE; */
-/* s->minorBytesScanned = 0; */
-/* s->minorBytesSkipped = 0; */
-/* s->numCopyingGCs = 0; */
-/* s->numLCs = 0; */
-/* s->numHashConsGCs = 0; */
-/* s->numMarkCompactGCs = 0; */
-/* s->numMinorGCs = 0; */
-/* s->numMinorsSinceLastMajor = 0; */
-/* s->nurseryRatio = 10.0; */
-/* s->oldGenArraySize = 0x100000; */
-/* s->pageSize = getpagesize (); */
-/* s->ramSlop = 0.5; */
-/* s->rusageIsEnabled = FALSE; */
-/* s->savedThread = BOGUS_THREAD; */
-/* s->signalHandler = BOGUS_THREAD; */
-/* s->signalIsPending = FALSE; */
-/* s->startTime = currentTime (); */
-/* s->summary = FALSE; */
-/* s->threadShrinkRatio = 0.5; */
-/* s->weaks = NULL; */
-/* heapInit (&s->heap); */
-/* heapInit (&s->heap2); */
-/* sigemptyset (&s->signalsHandled); */
-/* initSignalStack (s); */
-/* sigemptyset (&s->signalsPending); */
-/* rusageZero (&s->ru_gc); */
-/* rusageZero (&s->ru_gcCopy); */
-/* rusageZero (&s->ru_gcMarkCompact); */
-/* rusageZero (&s->ru_gcMinor); */
-/* worldFile = NULL; */
-/* unless (isAligned (s->pageSize, s->cardSize)) */
-/* die ("Page size must be a multiple of card size."); */
-/* processAtMLton (s, s->atMLtonsSize, s->atMLtons, &worldFile); */
-/* i = processAtMLton (s, argc, argv, &worldFile); */
-/* if (s->fixedHeap > 0 and s->maxHeap > 0) */
-/* die ("Cannot use both fixed-heap and max-heap.\n"); */
-/* unless (ratiosOk (s)) */
-/* die ("invalid ratios"); */
-/* s->totalRam = totalRam (s); */
-/* /\* We align s->ram by pageSize so that we can test whether or not we */
-/* * we are using mark-compact by comparing heap size to ram size. If */
-/* * we didn't round, the size might be slightly off. */
-/* *\/ */
-/* s->ram = align (s->ramSlop * s->totalRam, s->pageSize); */
-/* if (DEBUG or DEBUG_RESIZING or s->messages) */
-/* fprintf (stderr, "total RAM = %s RAM = %s\n", */
-/* uintToCommaString (s->totalRam), */
-/* uintToCommaString (s->ram)); */
-/* if (DEBUG_PROFILE) { */
-/* int i; */
-/* for (i = 0; i < s->frameSourcesSize; ++i) { */
-/* int j; */
-/* uint *sourceSeq; */
-/* fprintf (stderr, "%d\n", i); */
-/* sourceSeq = s->sourceSeqs[s->frameSources[i]]; */
-/* for (j = 1; j <= sourceSeq[0]; ++j) */
-/* fprintf (stderr, "\t%s\n", */
-/* s->sourceNames[s->sources[sourceSeq[j]].nameIndex]); */
-/* } */
-/* } */
-/* /\* Initialize profiling. This must occur after processing command-line */
-/* * arguments, because those may just be doing a show prof, in which */
-/* * case we don't want to initialize the atExit. */
-/* *\/ */
-/* if (PROFILE_NONE == s->profileKind) */
-/* s->profilingIsOn = FALSE; */
-/* else { */
-/* s->profilingIsOn = TRUE; */
-/* assert (s->frameSourcesSize == s->frameLayoutsSize); */
-/* switch (s->profileKind) { */
-/* case PROFILE_ALLOC: */
-/* case PROFILE_COUNT: */
-/* s->profile = GC_profileNew (s); */
-/* break; */
-/* case PROFILE_NONE: */
-/* die ("impossible PROFILE_NONE"); */
-/* case PROFILE_TIME: */
-/* profileTimeInit (s); */
-/* break; */
-/* } */
-/* profileEndState = s; */
-/* atexit (profileEnd); */
-/* } */
-/* if (s->isOriginal) { */
-/* newWorld (s); */
-/* /\* The mutator stack invariant doesn't hold, */
-/* * because the mutator has yet to run. */
-/* *\/ */
-/* assert (mutatorInvariant (s, TRUE, FALSE)); */
-/* } else { */
-/* loadWorld (s, worldFile); */
-/* if (s->profilingIsOn and s->profileStack) */
-/* GC_foreachStackFrame (s, enterFrame); */
-/* assert (mutatorInvariant (s, TRUE, TRUE)); */
-/* } */
-/* s->amInGC = FALSE; */
-/* return i; */
-/* } */
+ assert (isAligned (sizeof (struct GC_stack), s->alignment));
+ assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
+ s->alignment));
+ assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
+ s->alignment));
+ s->amInGC = TRUE;
+ s->amOriginal = TRUE;
+ s->atomicState = 0;
+ s->callFromCHandlerThread = BOGUS_OBJPTR;
+ s->controls.fixedHeap = 0;
+ s->controls.maxHeap = 0;
+ s->controls.mayLoadWorld = TRUE;
+ s->controls.mayProcessAtMLton = TRUE;
+ s->controls.messages = FALSE;
+ s->controls.oldGenArraySize = 0x100000;
+ s->controls.summary = FALSE;
+ s->cumulativeStatistics.bytesAllocated = 0;
+ s->cumulativeStatistics.bytesCopied = 0;
+ s->cumulativeStatistics.bytesCopiedMinor = 0;
+ s->cumulativeStatistics.bytesHashConsed = 0;
+ s->cumulativeStatistics.bytesMarkCompacted = 0;
+ s->cumulativeStatistics.markedCards = 0;
+ s->cumulativeStatistics.maxBytesLive = 0;
+ s->cumulativeStatistics.maxHeapSizeSeen = 0;
+ s->cumulativeStatistics.maxStackSizeSeen = 0;
+ s->cumulativeStatistics.minorBytesScanned = 0;
+ s->cumulativeStatistics.minorBytesSkipped = 0;
+ s->cumulativeStatistics.numLimitChecks = 0;
+ s->cumulativeStatistics.numCopyingGCs = 0;
+ s->cumulativeStatistics.numHashConsGCs = 0;
+ s->cumulativeStatistics.numMarkCompactGCs = 0;
+ s->cumulativeStatistics.numMinorGCs = 0;
+ s->cumulativeStatistics.maxPause = 0;
+ rusageZero (&s->cumulativeStatistics.ru_gc);
+ rusageZero (&s->cumulativeStatistics.ru_gcCopy);
+ rusageZero (&s->cumulativeStatistics.ru_gcMarkCompact);
+ rusageZero (&s->cumulativeStatistics.ru_gcMinor);
+ s->currentThread = BOGUS_OBJPTR;
+ s->hashConsDuringGC = FALSE;
+ heapInit (&s->heap);
+ s->lastMajorStatistics.bytesLive = 0;
+ s->lastMajorStatistics.kind = GC_COPYING;
+ s->lastMajorStatistics.numMinorGCs = 0;
+ s->ratios.copy = 4.0;
+ s->ratios.copyGenerational = 4.0;
+ s->ratios.grow = 8.0;
+ s->ratios.hashCons = 0.0;
+ s->ratios.live = 8.0;
+ s->ratios.markCompact = 1.04;
+ s->ratios.markCompactGenerational = 8.0;
+ s->ratios.nursery = 10.0;
+ s->ratios.ramSlop = 0.5;
+ s->ratios.threadShrink = 0.5;
+ s->rusageIsEnabled = FALSE;
+ s->savedThread = BOGUS_OBJPTR;
+ heapInit (&s->secondaryHeap);
+ s->signalHandlerThread = BOGUS_OBJPTR;
+ s->signalsInfo.amInSignalHandler = FALSE;
+ s->signalsInfo.gcSignalHandled = FALSE;
+ s->signalsInfo.gcSignalPending = FALSE;
+ s->signalsInfo.signalIsPending = FALSE;
+ sigemptyset (&s->signalsInfo.signalsHandled);
+ sigemptyset (&s->signalsInfo.signalsPending);
+ s->startTime = currentTime ();
+ // s->sysvals.availRam = ;
+ // s->sysvals.totalRam = ;
+ // s->sysvals.pageSize = ;
+ s->weaks = NULL;
+
+ initSignalStack (s);
+ worldFile = NULL;
+
+ unless (isAligned (s->sysvals.pageSize, CARD_SIZE))
+ die ("Page size must be a multiple of card size.");
+ processAtMLton (s, s->atMLtonsLength, s->atMLtons, &worldFile);
+ i = processAtMLton (s, argc, argv, &worldFile);
+ if (s->controls.fixedHeap > 0 and s->controls.maxHeap > 0)
+ die ("Cannot use both fixed-heap and max-heap.\n");
+ unless (ratiosOk (s->ratios))
+ die ("invalid ratios");
+ // s->totalRam = totalRam (s);
+ /* We align s->ram by pageSize so that we can test whether or not we
+ * we are using mark-compact by comparing heap size to ram size. If
+ * we didn't round, the size might be slightly off.
+ */
+ s->sysvals.ram = align (s->ratios.ramSlop * s->sysvals.totalRam, s->sysvals.pageSize);
+ if (DEBUG or DEBUG_RESIZING or s->controls.messages)
+ fprintf (stderr, "total RAM = %zu RAM = %zu\n",
+ /*uintToCommaString*/(s->sysvals.totalRam),
+ /*uintToCommaString*/(s->sysvals.ram));
+ if (DEBUG_PROFILE) {
+ uint32_t i;
+ for (i = 0; i < s->profiling.frameSourcesLength; i++) {
+ uint32_t j;
+ uint32_t *sourceSeq;
+ fprintf (stderr, "%"PRIu32"\n", i);
+ sourceSeq = s->profiling.sourceSeqs[s->profiling.frameSources[i]];
+ for (j = 1; j <= sourceSeq[0]; j++)
+ fprintf (stderr, "\t%s\n",
+ s->profiling.sourceNames[s->profiling.sources[sourceSeq[j]].nameIndex]);
+ }
+ }
+ /* Initialize profiling. This must occur after processing
+ * command-line arguments, because those may just be doing a show
+ * prof, in which case we don't want to initialize the atExit.
+ */
+ if (PROFILE_NONE == s->profiling.kind)
+ s->profiling.isOn = FALSE;
+ else {
+ s->profiling.isOn = TRUE;
+ assert (s->profiling.frameSourcesLength == s->frameLayoutsLength);
+ switch (s->profiling.kind) {
+ case PROFILE_ALLOC:
+ case PROFILE_COUNT:
+ s->profiling.data = GC_profileNew (s);
+ break;
+ case PROFILE_NONE:
+ die ("impossible PROFILE_NONE");
+ case PROFILE_TIME:
+ profileTimeInit (s);
+ break;
+ }
+ profileEndState = s;
+ atexit (profileEnd);
+ }
+ if (s->amOriginal) {
+ newWorld (s);
+ /* The mutator stack invariant doesn't hold,
+ * because the mutator has yet to run.
+ */
+ assert (mutatorInvariant (s, TRUE, FALSE));
+ } else {
+ loadWorld (s, worldFile);
+ if (s->profiling.isOn and s->profiling.stack)
+ foreachStackFrame (s, enterFrame);
+ assert (mutatorInvariant (s, TRUE, TRUE));
+ }
+ s->amInGC = FALSE;
+ return i;
+}
+
/* extern char **environ; /\* for Posix_ProcEnv_environ *\/ */
/* void MLton_init (int argc, char **argv, GC_state s) { */
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h (from rev 4120, mlton/branches/on-20050822-x86_64-branch/runtime/platform.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2005-10-26 00:53:09 UTC (rev 4120)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h 2005-10-29 21:05:39 UTC (rev 4123)
@@ -0,0 +1,15 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+typedef struct GC_intInf {
+ GC_arrayCounter counter;
+ GC_arrayLength length;
+ GC_header header;
+ uint32_t isneg;
+ uint32_t *limbs;
+} *GC_intInf;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h 2005-10-29 21:05:39 UTC (rev 4123)
@@ -7,12 +7,12 @@
*/
struct GC_ratios {
+ /* Minimum live ratio to use copying GC. */
+ float copy;
/* Only use generational GC with copying collection if the ratio of
* heap size to live data size is below copyGenerational.
*/
float copyGenerational;
- /* Minimum live ratio to use copying GC. */
- float copy;
float grow;
float hashCons;
/* Desired ratio of heap size to live data. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-10-29 21:05:39 UTC (rev 4123)
@@ -39,5 +39,5 @@
struct GC_lastMajorStatistics {
size_t bytesLive; /* Number of bytes live at most recent major GC. */
GC_majorKind kind;
- uintmax_t numMinorsGCs;
+ uintmax_t numMinorGCs;
};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-29 19:00:21 UTC (rev 4122)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-29 21:05:39 UTC (rev 4123)
@@ -33,6 +33,8 @@
#include <sys/resource.h>
#include <sys/time.h>
+#include "gmp.h"
+
#include "../assert.h"
#define TWOPOWER(n) (1 << (n))
|
|
From: Matthew F. <fl...@ml...> - 2005-10-29 12:00:23
|
Mark-compact GC
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-10-26 01:25:07 UTC (rev 4121)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-10-29 19:00:21 UTC (rev 4122)
@@ -31,242 +31,261 @@
dfsMark (s, p, UNMARK_MODE, FALSE);
}
-static inline void threadInternal (GC_state s, objptr *opp) {
+/* An object pointer might be larger than a header.
+ */
+static inline void threadInternalCopy (pointer dst, pointer src) {
+ size_t count = (OBJPTR_SIZE - GC_HEADER_SIZE) / GC_HEADER_SIZE;
+ src = src + GC_HEADER_SIZE * count;
+
+ for (size_t i = 0; i <= count; i++) {
+ *((GC_header*)dst) = *((GC_header*)src);
+ dst += GC_HEADER_SIZE;
+ src -= GC_HEADER_SIZE;
+ }
+}
+
+static inline void threadInternalObjptr (GC_state s, objptr *opp) {
+ objptr opop;
pointer p;
GC_header *headerp;
+ opop = pointerToObjptr ((pointer)opp, s->heap.start);
p = objptrToPointer (*opp, s->heap.start);
if (FALSE)
fprintf (stderr,
"threadInternal opp = "FMTPTR" p = "FMTPTR" header = "FMTHDR"\n",
(uintptr_t)opp, (uintptr_t)p, getHeader (p));
headerp = getHeaderp (p);
+ threadInternalCopy ((pointer)(opp), (pointer)(headerp));
+ threadInternalCopy ((pointer)(headerp), (pointer)(&opop));
}
-/* static inline void threadInternal (GC_state s, pointer *pp) { */
-/* Header *headerp; */
+/* If p is weak, the object pointer was valid, and points to an unmarked object,
+ * then clear the object pointer.
+ */
+static inline void maybeClearWeak (GC_state s, pointer p) {
+ GC_header header;
+ GC_header *headerp;
+ uint16_t numNonObjptrs, numObjptrs;
+ GC_objectTypeTag tag;
-/* if (FALSE) */
-/* fprintf (stderr, "threadInternal pp = 0x%08x *pp = 0x%08x header = 0x%08x\n", */
-/* (uint)pp, *(uint*)pp, (uint)GC_getHeader (*pp)); */
-/* headerp = GC_getHeaderp (*pp); */
-/* *(Header*)pp = *headerp; */
-/* *headerp = (Header)pp; */
-/* } */
+ headerp = getHeaderp (p);
+ header = *headerp;
+ splitHeader(s, *headerp, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ if (WEAK_TAG == tag and 1 == numObjptrs) {
+ GC_header h2;
+
+ if (DEBUG_WEAK)
+ fprintf (stderr, "maybeClearWeak ("FMTPTR") header = "FMTHDR"\n",
+ (uintptr_t)p, header);
+ h2 = getHeader (objptrToPointer(((GC_weak)p)->objptr, s->heap.start));
+ /* If it's unmarked not threaded, clear the weak pointer. */
+ if (1 == ((MARK_MASK | 1) & h2)) {
+ ((GC_weak)p)->objptr = BOGUS_OBJPTR;
+ header = GC_WEAK_GONE_HEADER | MARK_MASK;
+ if (DEBUG_WEAK)
+ fprintf (stderr, "cleared. new header = "FMTHDR"\n",
+ header);
+ *headerp = header;
+ }
+ }
+}
-/* /\* If p is weak, the object pointer was valid, and points to an unmarked object, */
-/* * then clear the object pointer. */
-/* *\/ */
-/* static inline void maybeClearWeak (GC_state s, pointer p) { */
-/* Bool hasIdentity; */
-/* Header header; */
-/* Header *headerp; */
-/* uint numPointers; */
-/* uint numNonPointers; */
-/* uint tag; */
+static void updateForwardPointers (GC_state s) {
+ pointer back;
+ pointer endOfLastMarked;
+ pointer front;
+ size_t gap;
+ GC_header header;
+ GC_header *headerp;
+ pointer p;
+ size_t size;
-/* headerp = GC_getHeaderp (p); */
-/* header = *headerp; */
-/* SPLIT_HEADER(); */
-/* if (WEAK_TAG == tag and 1 == numPointers) { */
-/* Header h2; */
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "Update forward pointers.\n");
+ front = alignFrontier (s, s->heap.start);
+ back = s->heap.start + s->heap.oldGenSize;
+ endOfLastMarked = front;
+ gap = 0;
+updateObject:
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "updateObject front = "FMTPTR" back = "FMTPTR"\n",
+ (uintptr_t)front, (uintptr_t)back);
+ if (front == back)
+ goto done;
+ headerp = (GC_header*)front;
+ header = *headerp;
+ if (0 == header) {
+ /* We're looking at an array. Move to the header. */
+ p = front + GC_ARRAY_HEADER_SIZE;
+ headerp = (GC_header*)(p - GC_HEADER_SIZE);
+ header = *headerp;
+ } else
+ p = front + GC_HEADER_SIZE;
+ if (1 == (1 & header)) {
+ /* It's a header */
+ if (MARK_MASK & header) {
+ /* It is marked, but has no forward pointers.
+ * Thread internal pointers.
+ */
+thread:
+ maybeClearWeak (s, p);
+ size = objectSize (s, p);
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "threading "FMTPTR" of size %zu\n",
+ (uintptr_t)p, size);
+ if ((size_t)(front - endOfLastMarked) >= GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE) {
+ /* Compress all of the unmarked into one string. We require
+ * (GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE) space to be available
+ * because that is the smallest possible array. You cannot
+ * use GC_ARRAY_HEADER_SIZE because even zero-length arrays
+ * require an extra word for the forwarding pointer. If you
+ * did use GC_ARRAY_HEADER_SIZE,
+ * updateBackwardPointersAndSlide would skip the extra word
+ * and be completely busted.
+ */
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "compressing from "FMTPTR" to "FMTPTR" (length = %zu)\n",
+ (uintptr_t)endOfLastMarked, (uintptr_t)front,
+ (size_t)(front - endOfLastMarked));
+ *((GC_arrayCounter*)(endOfLastMarked)) = 0;
+ endOfLastMarked = endOfLastMarked + GC_ARRAY_COUNTER_SIZE;
+ *((GC_arrayLength*)(endOfLastMarked)) = ((size_t)(front - endOfLastMarked)) - GC_ARRAY_HEADER_SIZE;
+ endOfLastMarked = endOfLastMarked + GC_ARRAY_LENGTH_SIZE;
+ *((GC_header*)(endOfLastMarked)) = GC_STRING_HEADER;
+ }
+ front += size;
+ endOfLastMarked = front;
+ foreachObjptrInObject (s, p, FALSE, threadInternalObjptr);
+ goto updateObject;
+ } else {
+ /* It's not marked. */
+ size = objectSize (s, p);
+ gap += size;
+ front += size;
+ goto updateObject;
+ }
+ } else {
+ pointer new;
+ objptr newObjptr;
-/* if (DEBUG_WEAK) */
-/* fprintf (stderr, "maybeClearWeak (0x%08x) header = 0x%08x\n", */
-/* (uint)p, (uint)header); */
-/* h2 = GC_getHeader (((GC_weak)p)->object); */
-/* /\* If it's unmarked not threaded, clear the weak pointer. *\/ */
-/* if (1 == ((MARK_MASK | 1) & h2)) { */
-/* ((GC_weak)p)->object = (pointer)BOGUS_POINTER; */
-/* header = WEAK_GONE_HEADER | MARK_MASK; */
-/* if (DEBUG_WEAK) */
-/* fprintf (stderr, "cleared. new header = 0x%08x\n", */
-/* (uint)header); */
-/* *headerp = header; */
-/* } */
-/* } */
-/* } */
+ assert (0 == (1 & header));
+ /* It's a pointer. This object must be live. Fix all the forward
+ * pointers to it, store its header, then thread its internal
+ * pointers.
+ */
+ new = p - gap;
+ newObjptr = pointerToObjptr (new, s->heap.start);
+ do {
+ pointer cur;
+ objptr curObjptr;
-/* static void updateForwardPointers (GC_state s) { */
-/* pointer back; */
-/* pointer front; */
-/* uint gap; */
-/* pointer endOfLastMarked; */
-/* Header header; */
-/* Header *headerp; */
-/* pointer p; */
-/* uint size; */
+ threadInternalCopy ((pointer)(&curObjptr), (pointer)headerp);
+ cur = objptrToPointer (curObjptr, s->heap.start);
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "Update forward pointers.\n"); */
-/* front = alignFrontier (s, s->heap.start); */
-/* back = s->heap.start + s->oldGenSize; */
-/* endOfLastMarked = front; */
-/* gap = 0; */
-/* updateObject: */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "updateObject front = 0x%08x back = 0x%08x\n", */
-/* (uint)front, (uint)back); */
-/* if (front == back) */
-/* goto done; */
-/* headerp = (Header*)front; */
-/* header = *headerp; */
-/* if (0 == header) { */
-/* /\* We're looking at an array. Move to the header. *\/ */
-/* p = front + 3 * WORD_SIZE; */
-/* headerp = (Header*)(p - WORD_SIZE); */
-/* header = *headerp; */
-/* } else */
-/* p = front + WORD_SIZE; */
-/* if (1 == (1 & header)) { */
-/* /\* It's a header *\/ */
-/* if (MARK_MASK & header) { */
-/* /\* It is marked, but has no forward pointers. */
-/* * Thread internal pointers. */
-/* *\/ */
-/* thread: */
-/* maybeClearWeak (s, p); */
-/* size = objectSize (s, p); */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "threading 0x%08x of size %u\n", */
-/* (uint)p, size); */
-/* if (front - endOfLastMarked >= 4 * WORD_SIZE) { */
-/* /\* Compress all of the unmarked into one string. */
-/* * We require 4 * WORD_SIZE space to be available */
-/* * because that is the smallest possible array. */
-/* * You cannot use 3 * WORD_SIZE because even */
-/* * zero-length arrays require an extra word for */
-/* * the forwarding pointer. If you did use */
-/* * 3 * WORD_SIZE, updateBackwardPointersAndSlide */
-/* * would skip the extra word and be completely */
-/* * busted. */
-/* *\/ */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "compressing from 0x%08x to 0x%08x (length = %u)\n", */
-/* (uint)endOfLastMarked, */
-/* (uint)front, */
-/* front - endOfLastMarked); */
-/* *(uint*)endOfLastMarked = 0; */
-/* *(uint*)(endOfLastMarked + WORD_SIZE) = */
-/* front - endOfLastMarked - 3 * WORD_SIZE; */
-/* *(uint*)(endOfLastMarked + 2 * WORD_SIZE) = */
-/* GC_objectHeader (STRING_TYPE_INDEX); */
-/* } */
-/* front += size; */
-/* endOfLastMarked = front; */
-/* foreachPointerInObject (s, p, FALSE, threadInternal); */
-/* goto updateObject; */
-/* } else { */
-/* /\* It's not marked. *\/ */
-/* size = objectSize (s, p); */
-/* gap += size; */
-/* front += size; */
-/* goto updateObject; */
-/* } */
-/* } else { */
-/* pointer new; */
+ threadInternalCopy ((pointer)headerp, cur);
+ *((objptr*)cur) = newObjptr;
-/* assert (0 == (3 & header)); */
-/* /\* It's a pointer. This object must be live. Fix all the */
-/* * forward pointers to it, store its header, then thread */
-/* * its internal pointers. */
-/* *\/ */
-/* new = p - gap; */
-/* do { */
-/* pointer cur; */
+ header = *headerp;
+ } while (0 == (1 & header));
+ goto thread;
+ }
+ assert (FALSE);
+done:
+ return;
+}
-/* cur = (pointer)header; */
-/* header = *(word*)cur; */
-/* *(word*)cur = (word)new; */
-/* } while (0 == (1 & header)); */
-/* *headerp = header; */
-/* goto thread; */
-/* } */
-/* assert (FALSE); */
-/* done: */
-/* return; */
-/* } */
+static void updateBackwardPointersAndSlide (GC_state s) {
+ pointer back;
+ pointer front;
+ size_t gap;
+ GC_header header;
+ GC_header *headerp;
+ pointer p;
+ size_t size;
-/* static void updateBackwardPointersAndSlide (GC_state s) { */
-/* pointer back; */
-/* pointer front; */
-/* uint gap; */
-/* Header header; */
-/* pointer p; */
-/* uint size; */
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "Update backward pointers and slide.\n");
+ front = alignFrontier (s, s->heap.start);
+ back = s->heap.start + s->heap.oldGenSize;
+ gap = 0;
+updateObject:
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "updateObject front = "FMTPTR" back = "FMTPTR"\n",
+ (uintptr_t)front, (uintptr_t)back);
+ if (front == back)
+ goto done;
+ headerp = (GC_header*)front;
+ header = *headerp;
+ if (0 == header) {
+ /* We're looking at an array. Move to the header. */
+ p = front + GC_ARRAY_HEADER_SIZE;
+ headerp = (GC_header*)(p - GC_HEADER_SIZE);
+ header = *headerp;
+ } else
+ p = front + GC_HEADER_SIZE;
+ if (1 == (1 & header)) {
+ /* It's a header */
+ if (MARK_MASK & header) {
+ /* It is marked, but has no backward pointers to it.
+ * Unmark it.
+ */
+unmark:
+ size = objectSize (s, p);
+ /* unmark */
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "unmarking "FMTPTR" of size %zu\n",
+ (uintptr_t)p, size);
+ *headerp = header & ~MARK_MASK;
+ /* slide */
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "sliding "FMTPTR" down %zu\n",
+ (uintptr_t)front, gap);
+ GC_memcpy (front, front - gap, size);
+ front += size;
+ goto updateObject;
+ } else {
+ /* It's not marked. */
+ size = objectSize (s, p);
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "skipping "FMTPTR" of size %zu\n",
+ (uintptr_t)p, size);
+ gap += size;
+ front += size;
+ goto updateObject;
+ }
+ } else {
+ pointer new;
+ objptr newObjptr;
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "Update backward pointers and slide.\n"); */
-/* front = alignFrontier (s, s->heap.start); */
-/* back = s->heap.start + s->oldGenSize; */
-/* gap = 0; */
-/* updateObject: */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "updateObject front = 0x%08x back = 0x%08x\n", */
-/* (uint)front, (uint)back); */
-/* if (front == back) */
-/* goto done; */
-/* header = *(word*)front; */
-/* if (0 == header) { */
-/* /\* We're looking at an array. Move to the header. *\/ */
-/* p = front + 3 * WORD_SIZE; */
-/* header = *(Header*)(p - WORD_SIZE); */
-/* } else */
-/* p = front + WORD_SIZE; */
-/* if (1 == (1 & header)) { */
-/* /\* It's a header *\/ */
-/* if (MARK_MASK & header) { */
-/* /\* It is marked, but has no backward pointers to it. */
-/* * Unmark it. */
-/* *\/ */
-/* unmark: */
-/* *GC_getHeaderp (p) = header & ~MARK_MASK; */
-/* size = objectSize (s, p); */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "unmarking 0x%08x of size %u\n", */
-/* (uint)p, size); */
-/* /\* slide *\/ */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "sliding 0x%08x down %u\n", */
-/* (uint)front, gap); */
-/* copy (front, front - gap, size); */
-/* front += size; */
-/* goto updateObject; */
-/* } else { */
-/* /\* It's not marked. *\/ */
-/* size = objectSize (s, p); */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "skipping 0x%08x of size %u\n", */
-/* (uint)p, size); */
-/* gap += size; */
-/* front += size; */
-/* goto updateObject; */
-/* } */
-/* } else { */
-/* pointer new; */
+ assert (0 == (1 & header));
+ /* It's a pointer. This object must be live. Fix all the
+ * backward pointers to it. Then unmark it.
+ */
+ new = p - gap;
+ newObjptr = pointerToObjptr (new, s->heap.start);
+ do {
+ pointer cur;
+ objptr curObjptr;
+
+ threadInternalCopy ((pointer)(&curObjptr), (pointer)headerp);
+ cur = objptrToPointer (curObjptr, s->heap.start);
-/* /\* It's a pointer. This object must be live. Fix all the */
-/* * backward pointers to it. Then unmark it. */
-/* *\/ */
-/* new = p - gap; */
-/* do { */
-/* pointer cur; */
+ threadInternalCopy ((pointer)headerp, cur);
+ *((objptr*)cur) = newObjptr;
-/* assert (0 == (3 & header)); */
-/* cur = (pointer)header; */
-/* header = *(word*)cur; */
-/* *(word*)cur = (word)new; */
-/* } while (0 == (1 & header)); */
-/* /\* The header will be stored by unmark. *\/ */
-/* goto unmark; */
-/* } */
-/* assert (FALSE); */
-/* done: */
-/* s->oldGenSize = front - gap - s->heap.start; */
-/* if (DEBUG_MARK_COMPACT) */
-/* fprintf (stderr, "bytesLive = %u\n", s->bytesLive); */
-/* return; */
-/* } */
+ header = *headerp;
+ } while (0 == (1 & header));
+ /* The unmarked header will be stored by unmark. */
+ goto unmark;
+ }
+ assert (FALSE);
+done:
+ s->heap.oldGenSize = front - gap - s->heap.start;
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "oldGenSize = %zu\n", s->heap.oldGenSize);
+ return;
+}
static void majorMarkCompactGC (GC_state s) {
struct rusage ru_start;
@@ -289,9 +308,9 @@
} else {
foreachGlobalObjptr (s, dfsMarkFalse);
}
-/* foreachGlobal (s, threadInternal); */
-/* updateForwardPointers (s); */
-/* updateBackwardPointersAndSlide (s); */
+ foreachGlobalObjptr (s, threadInternalObjptr);
+ updateForwardPointers (s);
+ updateBackwardPointersAndSlide (s);
clearCrossMap (s);
s->cumulativeStatistics.bytesMarkCompacted += s->heap.oldGenSize;
s->lastMajorStatistics.kind = GC_MARK_COMPACT;
|
|
From: Matthew F. <fl...@ml...> - 2005-10-25 18:25:08
|
Includes and defines
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-26 00:53:09 UTC (rev 4120)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-26 01:25:07 UTC (rev 4121)
@@ -31,6 +31,7 @@
#include <signal.h>
#include <unistd.h>
#include <sys/resource.h>
+#include <sys/time.h>
#include "../assert.h"
@@ -61,3 +62,6 @@
extern void diee (char *fmt, ...)
__attribute__ ((format(printf, 1, 2)))
__attribute__ ((noreturn));
+
+#define HAS_SIGALTSTACK TRUE
+#define HAS_TIME_PROFILING TRUE
|
|
From: Matthew F. <fl...@ml...> - 2005-10-25 17:53:16
|
Profiling functions
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-26 00:53:09 UTC (rev 4120)
@@ -75,6 +75,7 @@
gc_prefix.c \
util.c \
safe.c \
+ read_write.c \
rusage.c \
debug.c \
align.c \
@@ -90,12 +91,12 @@
stack_predicates.c \
stack.c \
thread.c \
+ generational.c \
+ current.c \
foreach.c \
translate.c \
- generational.c \
heap_predicates.c \
heap.c \
- current.c \
ratios_predicates.c \
atomic.c \
gc_state.c \
@@ -110,9 +111,10 @@
garbage-collection.c \
array-allocate.c \
copy-thread.c \
- init.c \
pack.c \
size.c \
+ profiling.c \
+ init.c \
assumptions.c \
gc_suffix.c
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-10-26 00:53:09 UTC (rev 4120)
@@ -75,23 +75,26 @@
pointer p;
if (0 == numNonObjptrs)
- for (p = frontier;
- p < last;
- p += OBJPTR_SIZE)
+ for (p = frontier; p < last; p += OBJPTR_SIZE)
*((objptr*)p) = BOGUS_OBJPTR;
- else
- for (p = frontier;
- p < last; ) {
+ else {
+ /* Array with a mix of pointers and non-pointers. */
+ size_t nonObjptrBytes;
+ size_t objptrBytes;
+
+ nonObjptrBytes = numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+ objptrBytes = numObjptrs * OBJPTR_SIZE;
+
+ for (p = frontier; p < last; ) {
pointer next;
- p += numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
- next = p + numObjptrs * OBJPTR_SIZE;
+ p += nonObjptrBytes;
+ next = p + objptrBytes;
assert (next <= last);
- while (p < next) {
+ for ( ; p < next; p += OBJPTR_SIZE)
*((objptr*)p) = BOGUS_OBJPTR;
- p += OBJPTR_SIZE;
- }
}
+ }
}
GC_profileAllocInc (s, arraySize);
if (DEBUG_ARRAY) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-26 00:53:09 UTC (rev 4120)
@@ -81,7 +81,7 @@
} else if (ARRAY_TAG == tag) {
size_t bytesPerElement;
size_t dataBytes;
- pointer max;
+ pointer last;
GC_arrayLength numElements;
numElements = getArrayLength (p);
@@ -99,10 +99,10 @@
/* No pointers to process. */
;
else {
- max = p + dataBytes;
+ last = p + dataBytes;
if (0 == numNonObjptrs)
/* Array with only pointers. */
- for ( ; p < max; p += OBJPTR_SIZE)
+ for ( ; p < last; p += OBJPTR_SIZE)
maybeCall (f, s, (objptr*)p);
else {
/* Array with a mix of pointers and non-pointers. */
@@ -113,18 +113,18 @@
objptrBytes = numObjptrs * OBJPTR_SIZE;
/* For each array element. */
- while (p < max) {
- pointer max2;
+ for ( ; p < last; ) {
+ pointer next;
/* Skip the non-pointers. */
p += nonObjptrBytes;
- max2 = p + objptrBytes;
+ next = p + objptrBytes;
/* For each internal pointer. */
- for ( ; p < max2; p += OBJPTR_SIZE)
+ for ( ; p < next; p += OBJPTR_SIZE)
maybeCall (f, s, (objptr*)p);
}
}
- assert (p == max);
+ assert (p == last);
p -= dataBytes;
}
p += pad (s, dataBytes, GC_ARRAY_HEADER_SIZE);
@@ -147,9 +147,9 @@
assert (stack->used <= stack->reserved);
while (top > bottom) {
/* Invariant: top points just past a "return address". */
- returnAddress = *(GC_returnAddress*) (top - GC_RETURNADDRESS_SIZE);
+ returnAddress = *((GC_returnAddress*)(top - GC_RETURNADDRESS_SIZE));
if (DEBUG) {
- fprintf (stderr, " top = "FMTPTR" return address = "FMTPTR"\n",
+ fprintf (stderr, " top = "FMTPTR" return address = "FMTRA"\n",
(uintptr_t)top, returnAddress);
}
frameLayout = getFrameLayoutFromReturnAddress (s, returnAddress);
@@ -207,3 +207,37 @@
}
return front;
}
+
+
+typedef void (*GC_foreachStackFrameFun) (GC_state s, GC_frameIndex i);
+
+/* Apply f to the frame index of each frame in the current thread's stack. */
+void foreachStackFrame (GC_state s, GC_foreachStackFrameFun f) {
+ pointer bottom;
+ GC_frameIndex index;
+ GC_frameLayout *layout;
+ GC_returnAddress returnAddress;
+ pointer top;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "foreachStackFrame\n");
+ bottom = stackBottom (s, currentThreadStack(s));
+ if (DEBUG_PROFILE)
+ fprintf (stderr, " bottom = "FMTPTR" top = "FMTPTR".\n",
+ (uintptr_t)bottom, (uintptr_t)s->stackTop);
+ for (top = s->stackTop; top > bottom; top -= layout->size) {
+ returnAddress = *((GC_returnAddress*)(top - GC_RETURNADDRESS_SIZE));
+ index = getFrameIndexFromReturnAddress (s, returnAddress);
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "top = "FMTPTR" index = "FMTFI"\n",
+ (uintptr_t)top, index);
+ unless (index < s->frameLayoutsLength)
+ die ("top = "FMTPTR" returnAddress = "FMTRA" index = "FMTFI"\n",
+ (uintptr_t)top, (uintptr_t)returnAddress, index);
+ f (s, index);
+ layout = &(s->frameLayouts[index]);
+ assert (layout->size > 0);
+ }
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "done foreachStackFrame\n");
+}
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-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-10-26 00:53:09 UTC (rev 4120)
@@ -47,22 +47,22 @@
}
static inline void enterGC (GC_state s) {
- if (s->profilingInfo.isOn) {
+ if (s->profiling.isOn) {
/* We don't need to profileEnter for count profiling because it
* has already bumped the counter. If we did allow the bump, then
* the count would look like function(s) had run an extra time.
*/
- if (s->profilingInfo.stack
- and not (PROFILE_COUNT == s->profilingInfo.kind))
+ if (s->profiling.stack
+ and not (PROFILE_COUNT == s->profiling.kind))
GC_profileEnter (s);
}
s->amInGC = TRUE;
}
static inline void leaveGC (GC_state s) {
- if (s->profilingInfo.isOn) {
- if (s->profilingInfo.stack
- and not (PROFILE_COUNT == s->profilingInfo.kind))
+ if (s->profiling.isOn) {
+ if (s->profiling.stack
+ and not (PROFILE_COUNT == s->profiling.kind))
GC_profileLeave (s);
}
s->amInGC = FALSE;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-26 00:53:09 UTC (rev 4120)
@@ -30,12 +30,13 @@
struct GC_lastMajorStatistics lastMajorStatistics;
pointer limit; /* limit = heap.start + heap.totalBytes */
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
+ uint32_t magic; /* The magic number for this executable. */
uint32_t maxFrameSize;
/*Bool*/bool mutatorMarksCards;
GC_objectHashTable objectHashTable;
GC_objectType *objectTypes; /* Array of object types. */
uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
- struct GC_profilingInfo profilingInfo;
+ struct GC_profiling profiling;
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
struct GC_ratios ratios;
bool rusageIsEnabled;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-26 00:53:09 UTC (rev 4120)
@@ -196,16 +196,16 @@
frontier = s->frontier;
for (i = 0; i < s->vectorInitsLength; ++i) {
size_t bytesPerElement;
- size_t numBytes;
+ size_t dataBytes;
size_t objectSize;
uint32_t typeIndex;
bytesPerElement = inits[i].bytesPerElement;
- numBytes = bytesPerElement * inits[i].numElements;
+ dataBytes = bytesPerElement * inits[i].numElements;
objectSize = align (GC_ARRAY_HEADER_SIZE
- + ((0 == numBytes)
+ + ((0 == dataBytes)
? POINTER_SIZE
- : numBytes),
+ : dataBytes),
s->alignment);
assert (objectSize <= (size_t)(s->heap.start + s->heap.size - frontier));
*((GC_arrayCounter*)(frontier)) = 0;
@@ -232,7 +232,7 @@
if (DEBUG_DETAILED)
fprintf (stderr, "allocated vector at "FMTPTR"\n",
(uintptr_t)(s->globals[inits[i].globalIndex]));
- GC_memcpy (inits[i].bytes, frontier, numBytes);
+ GC_memcpy (inits[i].bytes, frontier, dataBytes);
frontier += objectSize - GC_ARRAY_HEADER_SIZE;
}
if (DEBUG_DETAILED)
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c (from rev 4119, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c 2005-10-26 00:53:09 UTC (rev 4120)
@@ -0,0 +1,522 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#define SOURCES_INDEX_UNKNOWN 0
+#define SOURCES_INDEX_GC 1
+#define SOURCE_SEQ_GC 1
+#define SOURCE_SEQ_UNKNOWN 0
+
+static uint32_t numStackFrames;
+static uint32_t *callStack;
+
+static void fillCallStack (__attribute__ ((unused))GC_state s,
+ GC_frameIndex i) {
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, "fillCallStack ("FMTFI")\n", i);
+ callStack[numStackFrames] = i;
+ numStackFrames++;
+}
+
+void GC_callStack (GC_state s, pointer p) {
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, "GC_callStack\n");
+ numStackFrames = 0;
+ callStack = (uint32_t*)p;
+ foreachStackFrame (s, fillCallStack);
+}
+
+static void incNumStackFrames (__attribute__ ((unused)) GC_state s,
+ __attribute__ ((unused)) GC_frameIndex i) {
+ numStackFrames++;
+}
+
+uint32_t GC_numStackFrames (GC_state s) {
+ numStackFrames = 0;
+ foreachStackFrame (s, incNumStackFrames);
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, "%"PRIu32" = GC_numStackFrames\n", numStackFrames);
+ return numStackFrames;
+}
+
+static inline uint32_t topFrameSourceSeqIndex (GC_state s, GC_stack stack) {
+ return s->profiling.frameSources[topFrameIndex (s, stack)];
+}
+
+uint32_t* GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex) {
+ uint32_t *res;
+
+ res = s->profiling.sourceSeqs[s->profiling.frameSources[frameIndex]];
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, FMTPTR" = GC_frameIndexSourceSeq ("FMTFI")\n",
+ (uintptr_t)res, frameIndex);
+ return res;
+}
+
+inline char* GC_sourceName (GC_state s, uint32_t i) {
+ if (i < s->profiling.sourcesLength)
+ return s->profiling.sourceNames[s->profiling.sources[i].nameIndex];
+ else
+ return s->profiling.sourceNames[i - s->profiling.sourcesLength];
+}
+
+static inline GC_profileStack profileStackInfo (GC_state s, uint32_t i) {
+ assert (s->profiling.data != NULL);
+ return &(s->profiling.data->stack[i]);
+}
+
+static inline uint32_t profileMaster (GC_state s, uint32_t i) {
+ return s->profiling.sources[i].nameIndex + s->profiling.sourcesLength;
+}
+
+static inline void removeFromStack (GC_state s, uint32_t i) {
+ GC_profileData p;
+ GC_profileStack ps;
+ uintmax_t totalInc;
+
+ p = s->profiling.data;
+ ps = profileStackInfo (s, i);
+ totalInc = p->total - ps->lastTotal;
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "removing %s from stack ticksInc = %"PRIuMAX" ticksInGCInc = %"PRIuMAX"\n",
+ GC_sourceName (s, i), totalInc,
+ p->totalGC - ps->lastTotalGC);
+ ps->ticks += totalInc;
+ ps->ticksInGC += p->totalGC - ps->lastTotalGC;
+}
+
+static void setProfTimer (long usec) {
+ struct itimerval iv;
+
+ iv.it_interval.tv_sec = 0;
+ iv.it_interval.tv_usec = usec;
+ iv.it_value.tv_sec = 0;
+ iv.it_value.tv_usec = usec;
+ unless (0 == setitimer (ITIMER_PROF, &iv, NULL))
+ die ("setProfTimer failed");
+}
+
+void GC_profileDone (GC_state s) {
+ GC_profileData p;
+ uint32_t sourceIndex;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "GC_profileDone ()\n");
+ assert (s->profiling.isOn);
+ if (PROFILE_TIME == s->profiling.kind)
+ setProfTimer (0);
+ s->profiling.isOn = FALSE;
+ p = s->profiling.data;
+ if (s->profiling.stack) {
+ for (sourceIndex = 0;
+ sourceIndex < s->profiling.sourcesLength + s->profiling.sourceNamesLength;
+ sourceIndex++) {
+ if (p->stack[sourceIndex].numOccurrences > 0) {
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "done leaving %s\n",
+ GC_sourceName (s, sourceIndex));
+ removeFromStack (s, sourceIndex);
+ }
+ }
+ }
+}
+
+static int profileDepth = 0;
+
+static void profileIndent (void) {
+ int i;
+
+ for (i = 0; i < profileDepth; ++i)
+ fprintf (stderr, " ");
+}
+
+static inline void profileEnterSource (GC_state s, uint32_t i) {
+ GC_profileData p;
+ GC_profileStack ps;
+
+ p = s->profiling.data;
+ ps = profileStackInfo (s, i);
+ if (0 == ps->numOccurrences) {
+ ps->lastTotal = p->total;
+ ps->lastTotalGC = p->totalGC;
+ }
+ ps->numOccurrences++;
+}
+
+static void profileEnter (GC_state s, uint32_t sourceSeqIndex) {
+ uint32_t i;
+ GC_profileData p;
+ uint32_t sourceIndex;
+ uint32_t *sourceSeq;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "profileEnter (%"PRIu32")\n", sourceSeqIndex);
+ assert (s->profiling.stack);
+ assert (sourceSeqIndex < s->profiling.sourceSeqsLength);
+ p = s->profiling.data;
+ sourceSeq = s->profiling.sourceSeqs[sourceSeqIndex];
+ for (i = 1; i <= sourceSeq[0]; i++) {
+ sourceIndex = sourceSeq[i];
+ if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
+ profileIndent ();
+ fprintf (stderr, "(entering %s\n",
+ GC_sourceName (s, sourceIndex));
+ profileDepth++;
+ }
+ profileEnterSource (s, sourceIndex);
+ profileEnterSource (s, profileMaster (s, sourceIndex));
+ }
+}
+
+static void enterFrame (GC_state s, uint32_t i) {
+ profileEnter (s, s->profiling.frameSources[i]);
+}
+
+static inline void profileLeaveSource (GC_state s, uint32_t i) {
+ GC_profileData p;
+ GC_profileStack ps;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "profileLeaveSource (%"PRIu32")\n", i);
+ p = s->profiling.data;
+ ps = profileStackInfo (s, i);
+ assert (ps->numOccurrences > 0);
+ ps->numOccurrences--;
+ if (0 == ps->numOccurrences)
+ removeFromStack (s, i);
+}
+
+static void profileLeave (GC_state s, uint32_t sourceSeqIndex) {
+ int32_t i;
+ GC_profileData p;
+ uint32_t sourceIndex;
+ uint32_t *sourceSeq;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "profileLeave (%"PRIu32")\n", sourceSeqIndex);
+ assert (s->profiling.stack);
+ assert (sourceSeqIndex < s->profiling.sourceSeqsLength);
+ p = s->profiling.data;
+ sourceSeq = s->profiling.sourceSeqs[sourceSeqIndex];
+ for (i = sourceSeq[0]; i > 0; i--) {
+ sourceIndex = sourceSeq[i];
+ if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
+ profileDepth--;
+ profileIndent ();
+ fprintf (stderr, "leaving %s)\n",
+ GC_sourceName (s, sourceIndex));
+ }
+ profileLeaveSource (s, sourceIndex);
+ profileLeaveSource (s, profileMaster (s, sourceIndex));
+ }
+}
+
+static inline void profileInc (GC_state s, size_t amount, uint32_t sourceSeqIndex) {
+ uint32_t *sourceSeq;
+ uint32_t topSourceIndex;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "profileInc (%zu, %"PRIu32")\n",
+ amount, sourceSeqIndex);
+ assert (sourceSeqIndex < s->profiling.sourceSeqsLength);
+ sourceSeq = s->profiling.sourceSeqs[sourceSeqIndex];
+ topSourceIndex = sourceSeq[0] > 0 ? sourceSeq[sourceSeq[0]] : SOURCES_INDEX_UNKNOWN;
+ if (DEBUG_PROFILE) {
+ profileIndent ();
+ fprintf (stderr, "bumping %s by %zu\n",
+ GC_sourceName (s, topSourceIndex), amount);
+ }
+ s->profiling.data->countTop[topSourceIndex] += amount;
+ s->profiling.data->countTop[profileMaster (s, topSourceIndex)] += amount;
+ if (s->profiling.stack)
+ profileEnter (s, sourceSeqIndex);
+ if (SOURCES_INDEX_GC == topSourceIndex)
+ s->profiling.data->totalGC += amount;
+ else
+ s->profiling.data->total += amount;
+ if (s->profiling.stack)
+ profileLeave (s, sourceSeqIndex);
+}
+
+void GC_profileEnter (GC_state s) {
+ profileEnter (s, topFrameSourceSeqIndex (s, currentThreadStack (s)));
+}
+
+void GC_profileLeave (GC_state s) {
+ profileLeave (s, topFrameSourceSeqIndex (s, currentThreadStack (s)));
+}
+
+void GC_profileInc (GC_state s, size_t amount) {
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "GC_profileInc (%zu)\n", amount);
+ profileInc (s, amount,
+ s->amInGC
+ ? SOURCE_SEQ_GC
+ : topFrameSourceSeqIndex (s, currentThreadStack (s)));
+}
+
+void GC_profileAllocInc (GC_state s, size_t amount) {
+ if (s->profiling.isOn and (PROFILE_ALLOC == s->profiling.kind)) {
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "GC_profileAllocInc (%u)\n", (uint)amount);
+ GC_profileInc (s, amount);
+ }
+}
+
+static void showProf (GC_state s) {
+ uint32_t i;
+ uint32_t j;
+
+ fprintf (stdout, "0x%08"PRIx32"\n", s->magic);
+ fprintf (stdout, "%"PRIu32"\n", s->profiling.sourceNamesLength);
+ for (i = 0; i < s->profiling.sourceNamesLength; i++)
+ fprintf (stdout, "%s\n", s->profiling.sourceNames[i]);
+ fprintf (stdout, "%"PRIu32"\n", s->profiling.sourcesLength);
+ for (i = 0; i < s->profiling.sourcesLength; i++)
+ fprintf (stdout, "%"PRIu32" %"PRIu32"\n",
+ s->profiling.sources[i].nameIndex,
+ s->profiling.sources[i].successorsIndex);
+ fprintf (stdout, "%"PRIu32"\n", s->profiling.sourceSeqsLength);
+ for (i = 0; i < s->profiling.sourceSeqsLength; i++) {
+ uint32_t *sourceSeq;
+
+ sourceSeq = s->profiling.sourceSeqs[i];
+ for (j = 1; j <= sourceSeq[0]; j++)
+ fprintf (stdout, "%"PRIu32" ", sourceSeq[j]);
+ fprintf (stdout, "\n");
+ }
+}
+
+GC_profileData GC_profileNew (GC_state s) {
+ GC_profileData p;
+ uint32_t size;
+
+ p = (GC_profileData)(malloc_safe (sizeof(*p)));
+ p->total = 0;
+ p->totalGC = 0;
+ size = s->profiling.sourcesLength + s->profiling.sourceNamesLength;
+ p->countTop = (uintmax_t*)(calloc_safe(size, sizeof(*(p->countTop))));
+ if (s->profiling.stack)
+ p->stack =
+ (struct GC_profileStack *)
+ (calloc_safe(size, sizeof(*(p->stack))));
+ if (DEBUG_PROFILE)
+ fprintf (stderr, FMTPTR" = GC_profileNew ()\n", (uintptr_t)p);
+ return p;
+}
+
+void GC_profileFree (GC_state s, GC_profileData p) {
+ free (p->countTop);
+ if (s->profiling.stack)
+ free (p->stack);
+ free (p);
+}
+
+static void profileWriteCount (GC_state s, GC_profileData p, int fd, uint32_t i) {
+ writeUintmaxU (fd, p->countTop[i]);
+ if (s->profiling.stack) {
+ GC_profileStack ps;
+
+ ps = &(p->stack[i]);
+ writeString (fd, " ");
+ writeUintmaxU (fd, ps->ticks);
+ writeString (fd, " ");
+ writeUintmaxU (fd, ps->ticksInGC);
+ }
+ writeNewline (fd);
+}
+
+void GC_profileWrite (GC_state s, GC_profileData p, int fd) {
+ uint32_t i;
+ char* kind;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "GC_profileWrite\n");
+ writeString (fd, "MLton prof\n");
+ kind = "";
+ switch (s->profiling.kind) {
+ case PROFILE_ALLOC:
+ kind = "alloc\n";
+ break;
+ case PROFILE_COUNT:
+ kind = "count\n";
+ break;
+ case PROFILE_NONE:
+ die ("impossible PROFILE_NONE");
+ break;
+ case PROFILE_TIME:
+ kind = "time\n";
+ break;
+ }
+ writeString (fd, kind);
+ writeString (fd, s->profiling.stack ? "stack\n" : "current\n");
+ writeUint32X (fd, s->magic);
+ writeNewline (fd);
+ writeUintmaxU (fd, p->total);
+ writeString (fd, " ");
+ writeUintmaxU (fd, p->totalGC);
+ writeNewline (fd);
+ writeUint32U (fd, s->profiling.sourcesLength);
+ writeNewline (fd);
+ for (i = 0; i < s->profiling.sourcesLength; i++)
+ profileWriteCount (s, p, fd, i);
+ writeUint32U (fd, s->profiling.sourceNamesLength);
+ writeNewline (fd);
+ for (i = 0; i < s->profiling.sourceNamesLength; i++)
+ profileWriteCount (s, p, fd, i + s->profiling.sourcesLength);
+}
+
+#if not HAS_TIME_PROFILING
+
+/* No time profiling on this platform. There is a check in
+ * mlton/main/main.fun to make sure that time profiling is never
+ * turned on.
+ */
+static void profileTimeInit (GC_state s) __attribute__ ((noreturn));
+static void profileTimeInit (GC_state s) {
+ die ("no time profiling");
+}
+
+#else
+
+static GC_state catcherState;
+
+void GC_handleSigProf (pointer pc) {
+ GC_frameIndex frameIndex;
+ GC_state s;
+ uint32_t sourceSeqIndex;
+
+ s = catcherState;
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "GC_handleSigProf ("FMTPTR")\n", (uintptr_t)pc);
+ if (s->amInGC)
+ sourceSeqIndex = SOURCE_SEQ_GC;
+ else {
+ frameIndex = topFrameIndex (s, currentThreadStack (s));
+ if (C_FRAME == s->frameLayouts[frameIndex].kind)
+ sourceSeqIndex = s->profiling.frameSources[frameIndex];
+ else {
+ if (s->profiling.textStart <= pc and pc < s->profiling.textEnd)
+ sourceSeqIndex = s->profiling.textSources [pc - s->profiling.textStart];
+ else {
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "pc out of bounds\n");
+ sourceSeqIndex = SOURCE_SEQ_UNKNOWN;
+ }
+ }
+ }
+ profileInc (s, 1, sourceSeqIndex);
+}
+
+static int compareSourceLabels (const void *v1, const void *v2) {
+ uintptr_t ui1;
+ uintptr_t ui2;
+
+ ui1 = (uintptr_t)v1;
+ ui2 = (uintptr_t)v2;
+
+ if (ui1 < ui2)
+ return -1;
+ else if (ui1 == ui2)
+ return 0;
+ else /* if (ui1 > ui2) */
+ return 1;
+}
+
+static void profileTimeInit (GC_state s) {
+ uint32_t i;
+ pointer p;
+ struct sigaction sa;
+ uint32_t sourceSeqsIndex;
+
+ s->profiling.data = GC_profileNew (s);
+ /* Sort sourceLabels by address. */
+ qsort (s->profiling.sourceLabels,
+ s->profiling.sourceLabelsLength,
+ sizeof (*s->profiling.sourceLabels),
+ compareSourceLabels);
+ if (0 == s->profiling.sourceLabels[s->profiling.sourceLabelsLength - 1].label)
+ die ("Max profile label is 0 -- something is wrong.");
+ if (DEBUG_PROFILE)
+ for (i = 0; i < s->profiling.sourceLabelsLength; i++)
+ fprintf (stderr, FMTPTR" %"PRIu32"\n",
+ (uintptr_t)s->profiling.sourceLabels[i].label,
+ s->profiling.sourceLabels[i].sourceSeqsIndex);
+ if (ASSERT)
+ for (i = 1; i < s->profiling.sourceLabelsLength; i++)
+ assert (s->profiling.sourceLabels[i-1].label
+ <= s->profiling.sourceLabels[i].label);
+ /* Initialize s->textSources. */
+ s->profiling.textEnd = (pointer)(getTextEnd());
+ s->profiling.textStart = (pointer)(getTextStart());
+ if (ASSERT)
+ for (i = 0; i < s->profiling.sourceLabelsLength; i++) {
+ pointer label;
+
+ label = s->profiling.sourceLabels[i].label;
+ assert (0 == label
+ or (s->profiling.textStart <= label
+ and label < s->profiling.textEnd));
+ }
+ s->profiling.textSources =
+ (uint32_t*)
+ (calloc_safe((size_t)(s->profiling.textEnd - s->profiling.textStart),
+ sizeof(*(s->profiling.textSources))));
+ p = s->profiling.textStart;
+ sourceSeqsIndex = SOURCE_SEQ_UNKNOWN;
+ for (i = 0; i < s->profiling.sourceLabelsLength; i++) {
+ for ( ; p < s->profiling.sourceLabels[i].label; p++)
+ s->profiling.textSources[p - s->profiling.textStart] = sourceSeqsIndex;
+ sourceSeqsIndex = s->profiling.sourceLabels[i].sourceSeqsIndex;
+ }
+ for ( ; p < s->profiling.textEnd; p++)
+ s->profiling.textSources[p - s->profiling.textStart] = sourceSeqsIndex;
+ /*
+ * Install catcher, which handles SIGPROF and calls MLton_Profile_inc.
+ *
+ * One thing I should point out that I discovered the hard way: If
+ * the call to sigaction does NOT specify the SA_ONSTACK flag, then
+ * even if you have called sigaltstack(), it will NOT switch stacks,
+ * so you will probably die. Worse, if the call to sigaction DOES
+ * have SA_ONSTACK and you have NOT called sigaltstack(), it still
+ * switches stacks (to location 0) and you die of a SEGV. Thus the
+ * sigaction() call MUST occur after the call to sigaltstack(), and
+ * in order to have profiling cover as much as possible, you want it
+ * to occur right after the sigaltstack() call.
+ */
+ catcherState = s;
+ sigemptyset (&sa.sa_mask);
+ setSigProfHandler (&sa);
+ unless (sigaction (SIGPROF, &sa, NULL) == 0)
+ diee ("sigaction() failed");
+ /* Start the SIGPROF timer. */
+ setProfTimer (10000);
+}
+
+#endif
+
+/* profileEnd is for writing out an mlmon.out file even if the C code
+ * terminates abnormally, e.g. due to running out of memory. It will
+ * only run if the usual SML profile atExit cleanup code did not
+ * manage to run.
+ */
+static GC_state profileEndState;
+
+static void profileEnd (void) {
+ int fd;
+ GC_state s;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "profileEnd ()\n");
+ s = profileEndState;
+ if (s->profiling.isOn) {
+ fd = creat ("mlmon.out", 0666);
+ if (fd < 0)
+ diee ("Cannot create mlmon.out");
+ GC_profileWrite (s, s->profiling.data, fd);
+ }
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-10-26 00:53:09 UTC (rev 4120)
@@ -23,7 +23,6 @@
uint32_t sourceSeqsIndex;
} *GC_sourceLabel;
-
/* If profileStack, then there is one struct GC_profileStack for each
* function.
*/
@@ -47,15 +46,15 @@
uintmax_t numOccurrences;
} *GC_profileStack;
-/* GC_profile is used for both time and allocation profiling.
+/* GC_profileData is used for both time and allocation profiling.
* In the comments below, "ticks" mean clock ticks with time profiling and
* bytes allocated with allocation profiling.
*
- * All of the arrays in GC_profile are of length sourcesSize + sourceNamesSize.
- * The first sourceSizes entries are for handling the duplicate copies of
- * functions, and the next sourceNamesSize entries are for the master versions.
+ * All of the arrays in GC_profileData are of length sourcesSize + sourceNamesSize.
+ * The first sourceLength entries are for handling the duplicate copies of
+ * functions, and the next sourceNamesLength entries are for the master versions.
*/
-typedef struct GC_profile {
+typedef struct GC_profileData {
/* countTop is an array that counts for each function the number of
* ticks that occurred while the function was on top of the stack.
*/
@@ -68,30 +67,45 @@
uintmax_t total;
/* The total number of GC ticks. */
uintmax_t totalGC;
-} *GC_profile;
+} *GC_profileData;
-struct GC_profilingInfo {
+struct GC_profiling {
+ GC_profileData data;
+ /* frameSources is an array of cardinality frameLayoutsLength that
+ * for each stack frame, gives an index into sourceSeqs of the
+ * sequence of source functions corresponding to the frame.
+ */
+ uint32_t *frameSources;
+ uint32_t frameSourcesLength;
bool isOn;
- GC_profile profile;
GC_profileKind kind;
+ struct GC_sourceLabel *sourceLabels;
+ uint32_t sourceLabelsLength;
+ char **sourceNames;
+ uint32_t sourceNamesLength;
+ /* Each entry in sourceSeqs is a vector, whose first element is a
+ * length, and subsequent elements index into sources.
+ */
+ uint32_t **sourceSeqs;
+ uint32_t sourceSeqsLength;
+ /* sources is an array of cardinality sourcesLength. Each entry
+ * specifies an index into sourceNames and an index into sourceSeqs,
+ * giving the name of the function and the successors, respectively.
+ */
+ struct GC_source *sources;
+ uint32_t sourcesLength;
bool stack;
+ pointer textEnd;
+ /* An array of indices, one entry for each address in the text
+ * segment, giving and index into sourceSeqs.
+ */
+ uint32_t *textSources;
+ pointer textStart;
};
void GC_profileAllocInc (GC_state s, size_t bytes);
-void GC_profileDone (GC_state s);
-
void GC_profileEnter (GC_state s);
-void GC_profileFree (GC_state s, GC_profile p);
-
-void GC_profileInc (GC_state s, size_t bytes);
-
void GC_profileLeave (GC_state s);
-
-GC_profile GC_profileNew (GC_state s);
-
-void GC_profileWrite (GC_state s, GC_profile p, int fd);
-
-void showProf (GC_state s);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c (from rev 4119, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/read_write.c 2005-10-26 00:53:09 UTC (rev 4120)
@@ -0,0 +1,38 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+
+static void writeString (int fd, char* s) {
+ write_safe (fd, s, strlen(s));
+}
+
+static void writeUint32U (int fd, uint32_t u) {
+ char buf[(UINT32_MAX / 10) + 2];
+
+ sprintf (buf, "%"PRIu32, u);
+ writeString (fd, buf);
+}
+
+static void writeUintmaxU (int fd, uintmax_t u) {
+ // char buf[(UINTMAX_MAX / 10) + 2];
+ char buf[20];
+
+ sprintf (buf, "%"PRIuMAX, u);
+ writeString (fd, buf);
+}
+
+static void writeUint32X (int fd, uint32_t u) {
+ char buf[5 + (UINT32_MAX / 16) + 2];
+
+ sprintf (buf, "0x%08"PRIx32, u);
+ writeString (fd, buf);
+}
+
+static inline void writeNewline (int fd) {
+ writeString (fd, "\n");
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c 2005-10-26 00:53:09 UTC (rev 4120)
@@ -92,3 +92,21 @@
diee ("unlink (%s) failed.\n", pathname);
return;
}
+
+void read_safe (int fd, void *buf, size_t size) {
+ ssize_t res;
+
+ if (0 == size) return;
+ res = read (fd, buf, size);
+ if (res == -1 or (size_t)res != size)
+ diee ("read (_, _, _) failed.\n");
+}
+
+void write_safe (int fd, const void *buf, size_t size) {
+ ssize_t res;
+
+ if (0 == size) return;
+ res = write (fd, buf, size);
+ if (res == -1 or (size_t)res != size)
+ diee ("write (_, _, _) failed.\n");
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h 2005-10-26 00:53:09 UTC (rev 4120)
@@ -7,18 +7,20 @@
*/
struct GC_signalsInfo {
- bool amInSignalHandler; /* TRUE iff a signal handler is running. */
+ /* TRUE iff a signal handler is running. */
+ bool amInSignalHandler;
bool gcSignalHandled;
bool gcSignalPending;
- volatile bool signalIsPending; /* TRUE iff a signal has been received
- * but not handled by the mutator.
- */
- /* signalsHandled is the set of signals for which a mutator signal
- * handler needs to run in order to handle the signal.
+ /* TRUE iff a signal has been received but not handled by the
+ * mutator.
*/
+ volatile bool signalIsPending;
+ /* The signals for which a mutator signal handler needs to run in
+ * order to handle the signal.
+ */
sigset_t signalsHandled;
- /* The signals that have been recieved but not processed by the mutator
- * signal handler.
+ /* The signals that have been recieved but not processed by the
+ * mutator signal handler.
*/
sigset_t signalsPending;
};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-26 00:53:09 UTC (rev 4120)
@@ -27,6 +27,7 @@
#include <string.h>
#include <math.h>
+#include <fcntl.h>
#include <signal.h>
#include <unistd.h>
#include <sys/resource.h>
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-10-22 14:08:21 UTC (rev 4119)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-10-26 00:53:09 UTC (rev 4120)
@@ -21,3 +21,7 @@
void *GC_mremap (void *start, size_t oldLength, size_t newLength);
void GC_release (void *base, size_t length);
void GC_decommit (void *base, size_t length);
+
+void *getTextEnd (void);
+void *getTextStart (void);
+void setSigProfHandler (struct sigaction *sa);
|
|
From: Matthew F. <fl...@ml...> - 2005-10-22 07:08:24
|
Forwarding pointer sizes in arrays
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-10-22 02:32:10 UTC (rev 4118)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-10-22 14:08:21 UTC (rev 4119)
@@ -33,9 +33,9 @@
die ("Out of memory: cannot allocate array with %"PRIuMAX" bytes.",
/*ullongToCommaString*/(arraySizeMax));
arraySize = (size_t)arraySizeMax;
- if (arraySize < GC_ARRAY_HEADER_SIZE + WORD_SIZE)
+ if (arraySize < GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE)
/* Create space for forwarding pointer. */
- arraySize = GC_ARRAY_HEADER_SIZE + WORD_SIZE;
+ arraySize = GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE;
if (DEBUG_ARRAY)
fprintf (stderr, "array with "FMTARRLEN" elts of size %zu and total size %zu. Ensure %zu bytes free.\n",
numElements, bytesPerElement,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-22 02:32:10 UTC (rev 4118)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-22 14:08:21 UTC (rev 4119)
@@ -365,7 +365,7 @@
nurserySize = h->size - h->oldGenSize - oldGenBytesRequested;
s->limitPlusSlop = h->start + h->size;
s->limit = s->limitPlusSlop - LIMIT_SLOP;
- assert (isAligned (nurserySize, WORD_SIZE)); // FIXME
+ assert (isAligned (nurserySize, POINTER_SIZE));
if (/* The mutator marks cards. */
s->mutatorMarksCards
/* There is enough space in the nursery. */
@@ -393,7 +393,7 @@
)) {
s->canMinor = TRUE;
nurserySize /= 2;
- while (not (isAligned (nurserySize, WORD_SIZE))) {
+ while (not (isAligned (nurserySize, POINTER_SIZE))) {
nurserySize -= 2;
}
clearCardMap (s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-22 02:32:10 UTC (rev 4118)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-22 14:08:21 UTC (rev 4119)
@@ -97,7 +97,7 @@
s->lastMajorStatistics.bytesLive +=
align (GC_ARRAY_HEADER_SIZE
+ ((0 == numBytes)
- ? WORD_SIZE
+ ? OBJPTR_SIZE
: numBytes),
s->alignment);
}
|
|
From: Matthew F. <fl...@ml...> - 2005-10-21 19:32:16
|
GC_pack, GC_size, and beginnings of GC_init
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-22 02:32:10 UTC (rev 4118)
@@ -110,6 +110,9 @@
garbage-collection.c \
array-allocate.c \
copy-thread.c \
+ init.c \
+ pack.c \
+ size.c \
assumptions.c \
gc_suffix.c
@@ -136,6 +139,7 @@
hash-cons.h \
profiling.h \
signals.h \
+ init.h \
gc_state.h \
gc_suffix.h
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-22 02:32:10 UTC (rev 4118)
@@ -9,6 +9,8 @@
struct GC_controls {
size_t fixedHeap; /* If 0, then no fixed heap. */
size_t maxHeap; /* if zero, then unlimited, else limit total heap */
+ bool mayLoadWorld;
+ bool mayProcessAtMLton;
bool messages; /* Print a message at the start and end of each gc. */
size_t oldGenArraySize; /* Arrays larger are allocated in old gen, if possible. */
bool summary; /* Print a summary of gc info when program exits. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-22 02:32:10 UTC (rev 4118)
@@ -9,6 +9,7 @@
struct GC_state {
size_t alignment; /* */
bool amInGC;
+ bool amOriginal;
uint32_t atomicState;
objptr callFromCHandlerThread; /* Handler for exported C calls (in heap). */
bool canMinor; /* TRUE iff there is space for a minor gc. */
@@ -24,6 +25,8 @@
uint32_t globalsLength;
/*Bool*/bool hashConsDuringGC;
struct GC_heap heap;
+ struct GC_intInfInit *intInfInits;
+ uint32_t intInfInitsLength;
struct GC_lastMajorStatistics lastMajorStatistics;
pointer limit; /* limit = heap.start + heap.totalBytes */
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
@@ -46,5 +49,7 @@
pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
pointer stackTop; /* Top of stack in current thread. */
struct GC_sysvals sysvals;
+ struct GC_vectorInit *vectorInits;
+ uint32_t vectorInitsLength;
GC_weak weaks; /* Linked list of (live) weak pointers */
};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-10-22 02:32:10 UTC (rev 4118)
@@ -0,0 +1,676 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+/* ---------------------------------------------------------------- */
+/* Initialization */
+/* ---------------------------------------------------------------- */
+
+static void initSignalStack (GC_state s) {
+#if HAS_SIGALTSTACK
+ static stack_t altstack;
+ size_t ss_size = align (SIGSTKSZ, s->sysvals.pageSize);
+ size_t psize = s->sysvals.pageSize;
+ void *ss_sp = GC_mmap_safe_protect (NULL, 2 * ss_size, psize, psize);
+ altstack.ss_sp = (unsigned char*)ss_sp + ss_size;
+ altstack.ss_size = ss_size;
+ altstack.ss_flags = 0;
+ sigaltstack (&altstack, NULL);
+#endif
+}
+
+#if FALSE
+static bool stringToBool (char *s) {
+ if (0 == strcmp (s, "false"))
+ return FALSE;
+ if (0 == strcmp (s, "true"))
+ return TRUE;
+ die ("Invalid @MLton bool: %s.", s);
+}
+#endif
+
+static float stringToFloat (char *s) {
+ char *endptr;
+ float f;
+
+ f = strtof (s, &endptr);
+ if (s == endptr)
+ die ("Invalid @MLton float: %s.", s);
+ return f;
+}
+
+static size_t stringToBytes (char *s) {
+ double d;
+ char *endptr;
+ size_t factor;
+
+ d = strtod (s, &endptr);
+ if (s == endptr)
+ goto bad;
+ switch (*endptr++) {
+ case 'g':
+ case 'G':
+ factor = 1024 * 1024 * 1024;
+ break;
+ case 'k':
+ case 'K':
+ factor = 1024;
+ break;
+ case 'm':
+ case 'M':
+ factor = 1024 * 1024;
+ break;
+ default:
+ goto bad;
+ }
+ d *= factor;
+ unless (*endptr == '\0'
+ and 0.0 <= d
+ and d <= (double)SIZE_MAX)
+ goto bad;
+ return (size_t)d;
+bad:
+ die ("Invalid @MLton memory amount: %s.", s);
+}
+
+static void setInitialBytesLive (GC_state s) {
+ uint32_t i;
+ size_t numBytes;
+
+ s->lastMajorStatistics.bytesLive = 0;
+ for (i = 0; i < s->intInfInitsLength; ++i) {
+ numBytes =
+ WORD_SIZE // for the sign
+ + strlen (s->intInfInits[i].mlstr);
+ s->lastMajorStatistics.bytesLive +=
+ align (GC_ARRAY_HEADER_SIZE + numBytes,
+ s->alignment);
+ }
+ for (i = 0; i < s->vectorInitsLength; ++i) {
+ numBytes =
+ s->vectorInits[i].bytesPerElement
+ * s->vectorInits[i].numElements;
+ s->lastMajorStatistics.bytesLive +=
+ align (GC_ARRAY_HEADER_SIZE
+ + ((0 == numBytes)
+ ? WORD_SIZE
+ : numBytes),
+ s->alignment);
+ }
+}
+
+static void initIntInfs (GC_state s) {
+/* struct GC_intInfInit *inits; */
+/* pointer frontier; */
+/* char *str; */
+/* uint slen, */
+/* llen, */
+/* alen, */
+/* i, */
+/* index; */
+/* bool neg, */
+/* hex; */
+/* bignum *bp; */
+/* uchar *cp; */
+
+/* assert (isAlignedFrontier (s, s->frontier)); */
+/* frontier = s->frontier; */
+/* for (index = 0; index < s->intInfInitsSize; ++index) { */
+/* inits = &s->intInfInits[index]; */
+/* str = inits->mlstr; */
+/* assert (inits->globalIndex < s->globalsSize); */
+/* neg = *str == '~'; */
+/* if (neg) */
+/* ++str; */
+/* slen = strlen (str); */
+/* hex = str[0] == '0' && str[1] == 'x'; */
+/* if (hex) { */
+/* str += 2; */
+/* slen -= 2; */
+/* llen = (slen + 7) / 8; */
+/* } else */
+/* llen = (slen + 8) / 9; */
+/* assert (slen > 0); */
+/* bp = (bignum *)frontier; */
+/* cp = (uchar *)&bp->limbs[llen]; */
+/* for (i = 0; i != slen; ++i) */
+/* if ('0' <= str[i] && str[i] <= '9') */
+/* cp[i] = str[i] - '0' + 0; */
+/* else if ('a' <= str[i] && str[i] <= 'f') */
+/* cp[i] = str[i] - 'a' + 0xa; */
+/* else { */
+/* assert('A' <= str[i] && str[i] <= 'F'); */
+/* cp[i] = str[i] - 'A' + 0xA; */
+/* } */
+/* alen = mpn_set_str (bp->limbs, cp, slen, hex ? 0x10 : 10); */
+/* assert (alen <= llen); */
+/* if (alen <= 1) { */
+/* uint val, */
+/* ans; */
+
+/* if (alen == 0) */
+/* val = 0; */
+/* else */
+/* val = bp->limbs[0]; */
+/* if (neg) { */
+/* /\* */
+/* * We only fit if val in [1, 2^30]. */
+/* *\/ */
+/* ans = - val; */
+/* val = val - 1; */
+/* } else */
+/* /\* */
+/* * We only fit if val in [0, 2^30 - 1]. */
+/* *\/ */
+/* ans = val; */
+/* if (val < (uint)1<<30) { */
+/* s->globals[inits->globalIndex] = */
+/* (pointer)(ans<<1 | 1); */
+/* continue; */
+/* } */
+/* } */
+/* s->globals[inits->globalIndex] = (pointer)&bp->isneg; */
+/* bp->counter = 0; */
+/* bp->card = alen + 1; */
+/* bp->magic = BIGMAGIC; */
+/* bp->isneg = neg; */
+/* frontier = alignFrontier (s, (pointer)&bp->limbs[alen]); */
+/* } */
+/* assert (isAlignedFrontier (s, frontier)); */
+/* s->frontier = frontier; */
+/* GC_profileAllocInc (s, frontier - s->frontier); */
+/* s->bytesAllocated += frontier - s->frontier; */
+}
+
+static void initVectors (GC_state s) {
+ struct GC_vectorInit *inits;
+ pointer frontier;
+ uint32_t i;
+
+ assert (isAlignedFrontier (s, s->frontier));
+ inits = s->vectorInits;
+ frontier = s->frontier;
+ for (i = 0; i < s->vectorInitsLength; ++i) {
+ size_t bytesPerElement;
+ size_t numBytes;
+ size_t objectSize;
+ uint32_t typeIndex;
+
+ bytesPerElement = inits[i].bytesPerElement;
+ numBytes = bytesPerElement * inits[i].numElements;
+ objectSize = align (GC_ARRAY_HEADER_SIZE
+ + ((0 == numBytes)
+ ? POINTER_SIZE
+ : numBytes),
+ s->alignment);
+ assert (objectSize <= (size_t)(s->heap.start + s->heap.size - frontier));
+ *((GC_arrayCounter*)(frontier)) = 0;
+ frontier = frontier + GC_ARRAY_COUNTER_SIZE;
+ *((GC_arrayLength*)(frontier)) = inits[i].numElements;
+ frontier = frontier + GC_ARRAY_LENGTH_SIZE;
+ switch (bytesPerElement) {
+ case 1:
+ typeIndex = WORD8_VECTOR_TYPE_INDEX;
+ break;
+ case 2:
+ typeIndex = WORD16_VECTOR_TYPE_INDEX;
+ break;
+ case 4:
+ typeIndex = WORD32_VECTOR_TYPE_INDEX;
+ break;
+ default:
+ die ("unknown bytes per element in vectorInit: %zu",
+ bytesPerElement);
+ }
+ *((GC_header*)(frontier)) = objectHeader (typeIndex);
+ frontier = frontier + GC_HEADER_SIZE;
+ s->globals[inits[i].globalIndex] = pointerToObjptr(frontier, s->heap.start);
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "allocated vector at "FMTPTR"\n",
+ (uintptr_t)(s->globals[inits[i].globalIndex]));
+ GC_memcpy (inits[i].bytes, frontier, numBytes);
+ frontier += objectSize - GC_ARRAY_HEADER_SIZE;
+ }
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "frontier after string allocation is "FMTPTR"\n",
+ (uintptr_t)frontier);
+ GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
+ s->cumulativeStatistics.bytesAllocated += (size_t)(frontier - s->frontier);
+ assert (isAlignedFrontier (s, frontier));
+ s->frontier = frontier;
+}
+
+static void newWorld (GC_state s) {
+ uint32_t i;
+ pointer start;
+ GC_thread thread;
+
+ for (i = 0; i < s->globalsLength; ++i)
+ s->globals[i] = BOGUS_OBJPTR;
+ setInitialBytesLive (s);
+ heapCreate (s, &s->heap,
+ heapDesiredSize (s, s->lastMajorStatistics.bytesLive, 0),
+ s->lastMajorStatistics.bytesLive);
+ createCardMapAndCrossMap (s);
+ start = alignFrontier (s, s->heap.start);
+ s->frontier = start;
+ initIntInfs (s);
+ initVectors (s);
+ assert ((size_t)(s->frontier - start) <= s->lastMajorStatistics.bytesLive);
+ s->heap.oldGenSize = s->frontier - s->heap.start;
+ heapSetNursery (s, 0, 0);
+ thread = newThread (s, initialStackSize (s));
+ switchToThread (s, pointerToObjptr((pointer)thread, s->heap.start));
+}
+
+/* /\* worldTerminator is used to separate the human readable messages at the */
+/* * beginning of the world file from the machine readable data. */
+/* *\/ */
+/* static const char worldTerminator = '\000'; */
+
+/* static void loadWorld (GC_state s, char *fileName) { */
+/* FILE *file; */
+/* uint magic; */
+/* pointer oldGen; */
+/* int c; */
+
+/* if (DEBUG_WORLD) */
+/* fprintf (stderr, "loadWorld (%s)\n", fileName); */
+/* file = sfopen (fileName, "rb"); */
+/* until ((c = fgetc (file)) == worldTerminator or EOF == c); */
+/* if (EOF == c) die ("Invalid world."); */
+/* magic = sfreadUint (file); */
+/* unless (s->magic == magic) */
+/* die ("Invalid world: wrong magic number."); */
+/* oldGen = (pointer) sfreadUint (file); */
+/* s->oldGenSize = sfreadUint (file); */
+/* s->callFromCHandler = (GC_thread) sfreadUint (file); */
+/* s->canHandle = sfreadUint (file); */
+/* s->currentThread = (GC_thread) sfreadUint (file); */
+/* s->signalHandler = (GC_thread) sfreadUint (file); */
+/* heapCreate (s, &s->heap, heapDesiredSize (s, s->oldGenSize, 0), */
+/* s->oldGenSize); */
+/* createCardMapAndCrossMap (s); */
+/* sfread (s->heap.start, 1, s->oldGenSize, file); */
+/* (*s->loadGlobals) (file); */
+/* unless (EOF == fgetc (file)) */
+/* die ("Invalid world: junk at end of file."); */
+/* fclose (file); */
+/* /\* translateHeap must occur after loading the heap and globals, since it */
+/* * changes pointers in all of them. */
+/* *\/ */
+/* translateHeap (s, oldGen, s->heap.start, s->oldGenSize); */
+/* setNursery (s, 0, 0); */
+/* setStack (s); */
+/* } */
+
+/* ---------------------------------------------------------------- */
+/* GC_init */
+/* ---------------------------------------------------------------- */
+
+bool MLton_Platform_CygwinUseMmap;
+
+static int processAtMLton (GC_state s, int argc, char **argv,
+ char **worldFile) {
+ int i;
+
+ i = 1;
+ while (s->controls.mayProcessAtMLton
+ and i < argc
+ and (0 == strcmp (argv [i], "@MLton"))) {
+ bool done;
+
+ i++;
+ done = FALSE;
+ while (!done) {
+ if (i == argc)
+ die ("Missing -- at end of @MLton args.");
+ else {
+ char *arg;
+
+ arg = argv[i];
+ if (0 == strcmp (arg, "copy-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton copy-ratio missing argument.");
+ s->ratios.copy = stringToFloat (argv[i++]);
+ } else if (0 == strcmp(arg, "fixed-heap")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton fixed-heap missing argument.");
+ s->controls.fixedHeap = align (stringToBytes (argv[i++]),
+ 2 * s->sysvals.pageSize);
+ } else if (0 == strcmp (arg, "gc-messages")) {
+ ++i;
+ s->controls.messages = TRUE;
+ } else if (0 == strcmp (arg, "gc-summary")) {
+ ++i;
+#if (defined (__MINGW32__))
+ fprintf (stderr, "Warning: MinGW doesn't yet support gc-summary\n");
+#else
+ s->controls.summary = TRUE;
+#endif
+ } else if (0 == strcmp (arg, "copy-generational-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton copy-generational-ratio missing argument.");
+ s->ratios.copyGenerational = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "grow-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton grow-ratio missing argument.");
+ s->ratios.grow = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "hash-cons")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton hash-cons missing argument.");
+ s->ratios.hashCons = stringToFloat (argv[i++]);
+ unless (0.0 <= s->ratios.hashCons
+ and s->ratios.hashCons <= 1.0)
+ die ("@MLton hash-cons argument must be between 0.0 and 1.0");
+ } else if (0 == strcmp (arg, "live-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton live-ratio missing argument.");
+ s->ratios.live = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "load-world")) {
+ unless (s->controls.mayLoadWorld)
+ die ("May not load world.");
+ ++i;
+ s->amOriginal = FALSE;
+ if (i == argc)
+ die ("@MLton load-world missing argument.");
+ *worldFile = argv[i++];
+ } else if (0 == strcmp (arg, "max-heap")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton max-heap missing argument.");
+ s->controls.maxHeap = align (stringToBytes (argv[i++]),
+ 2 * s->sysvals.pageSize);
+ } else if (0 == strcmp (arg, "mark-compact-generational-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton mark-compact-generational-ratio missing argument.");
+ s->ratios.markCompactGenerational = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "mark-compact-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton mark-compact-ratio missing argument.");
+ s->ratios.markCompact = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "no-load-world")) {
+ ++i;
+ s->controls.mayLoadWorld = FALSE;
+ } else if (0 == strcmp (arg, "nursery-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton nursery-ratio missing argument.");
+ s->ratios.nursery = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "ram-slop")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton ram-slop missing argument.");
+ s->ratios.ramSlop = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "show-prof")) {
+ showProf (s);
+ exit (0);
+ } else if (0 == strcmp (arg, "stop")) {
+ ++i;
+ s->controls.mayProcessAtMLton = FALSE;
+ } else if (0 == strcmp (arg, "thread-shrink-ratio")) {
+ ++i;
+ if (i == argc)
+ die ("@MLton thread-shrink-ratio missing argument.");
+ s->ratios.threadShrink = stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "use-mmap")) {
+ ++i;
+ MLton_Platform_CygwinUseMmap = TRUE;
+ } else if (0 == strcmp (arg, "--")) {
+ ++i;
+ done = TRUE;
+ } else if (i > 1)
+ die ("Strange @MLton arg: %s", argv[i]);
+ else done = TRUE;
+ }
+ }
+ }
+ return i;
+}
+
+/* int GC_init (GC_state s, int argc, char **argv) { */
+/* char *worldFile; */
+/* int i; */
+
+/* assert (isAligned (sizeof (struct GC_stack), s->alignment)); */
+/* assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread), */
+/* s->alignment)); */
+/* assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak), */
+/* s->alignment)); */
+/* MLton_Platform_CygwinUseMmap = FALSE; */
+/* s->amInGC = TRUE; */
+/* s->amInMinorGC = FALSE; */
+/* s->bytesAllocated = 0; */
+/* s->bytesCopied = 0; */
+/* s->bytesCopiedMinor = 0; */
+/* s->bytesMarkCompacted = 0; */
+/* s->callFromCHandler = BOGUS_THREAD; */
+/* s->canHandle = 0; */
+/* s->cardSize = 0x1 << CARD_SIZE_LOG2; */
+/* s->copyRatio = 4.0; */
+/* s->copyGenerationalRatio = 4.0; */
+/* s->currentThread = BOGUS_THREAD; */
+/* s->fixedHeap = 0.0; */
+/* s->gcSignalIsPending = FALSE; */
+/* s->growRatio = 8.0; */
+/* s->handleGCSignal = FALSE; */
+/* s->hashConsDuringGC = FALSE; */
+/* s->hashConsFrequency = 0.0; */
+/* s->inSignalHandler = FALSE; */
+/* s->isOriginal = TRUE; */
+/* s->lastMajor = GC_COPYING; */
+/* s->liveRatio = 8.0; */
+/* s->markCompactRatio = 1.04; */
+/* s->markCompactGenerationalRatio = 8.0; */
+/* s->markedCards = 0; */
+/* s->maxBytesLive = 0; */
+/* s->maxHeap = 0; */
+/* s->maxHeapSizeSeen = 0; */
+/* s->maxPause = 0; */
+/* s->maxStackSizeSeen = 0; */
+/* s->mayLoadWorld = TRUE; */
+/* s->mayProcessAtMLton = TRUE; */
+/* s->messages = FALSE; */
+/* s->minorBytesScanned = 0; */
+/* s->minorBytesSkipped = 0; */
+/* s->numCopyingGCs = 0; */
+/* s->numLCs = 0; */
+/* s->numHashConsGCs = 0; */
+/* s->numMarkCompactGCs = 0; */
+/* s->numMinorGCs = 0; */
+/* s->numMinorsSinceLastMajor = 0; */
+/* s->nurseryRatio = 10.0; */
+/* s->oldGenArraySize = 0x100000; */
+/* s->pageSize = getpagesize (); */
+/* s->ramSlop = 0.5; */
+/* s->rusageIsEnabled = FALSE; */
+/* s->savedThread = BOGUS_THREAD; */
+/* s->signalHandler = BOGUS_THREAD; */
+/* s->signalIsPending = FALSE; */
+/* s->startTime = currentTime (); */
+/* s->summary = FALSE; */
+/* s->threadShrinkRatio = 0.5; */
+/* s->weaks = NULL; */
+/* heapInit (&s->heap); */
+/* heapInit (&s->heap2); */
+/* sigemptyset (&s->signalsHandled); */
+/* initSignalStack (s); */
+/* sigemptyset (&s->signalsPending); */
+/* rusageZero (&s->ru_gc); */
+/* rusageZero (&s->ru_gcCopy); */
+/* rusageZero (&s->ru_gcMarkCompact); */
+/* rusageZero (&s->ru_gcMinor); */
+/* worldFile = NULL; */
+/* unless (isAligned (s->pageSize, s->cardSize)) */
+/* die ("Page size must be a multiple of card size."); */
+/* processAtMLton (s, s->atMLtonsSize, s->atMLtons, &worldFile); */
+/* i = processAtMLton (s, argc, argv, &worldFile); */
+/* if (s->fixedHeap > 0 and s->maxHeap > 0) */
+/* die ("Cannot use both fixed-heap and max-heap.\n"); */
+/* unless (ratiosOk (s)) */
+/* die ("invalid ratios"); */
+/* s->totalRam = totalRam (s); */
+/* /\* We align s->ram by pageSize so that we can test whether or not we */
+/* * we are using mark-compact by comparing heap size to ram size. If */
+/* * we didn't round, the size might be slightly off. */
+/* *\/ */
+/* s->ram = align (s->ramSlop * s->totalRam, s->pageSize); */
+/* if (DEBUG or DEBUG_RESIZING or s->messages) */
+/* fprintf (stderr, "total RAM = %s RAM = %s\n", */
+/* uintToCommaString (s->totalRam), */
+/* uintToCommaString (s->ram)); */
+/* if (DEBUG_PROFILE) { */
+/* int i; */
+/* for (i = 0; i < s->frameSourcesSize; ++i) { */
+/* int j; */
+/* uint *sourceSeq; */
+/* fprintf (stderr, "%d\n", i); */
+/* sourceSeq = s->sourceSeqs[s->frameSources[i]]; */
+/* for (j = 1; j <= sourceSeq[0]; ++j) */
+/* fprintf (stderr, "\t%s\n", */
+/* s->sourceNames[s->sources[sourceSeq[j]].nameIndex]); */
+/* } */
+/* } */
+/* /\* Initialize profiling. This must occur after processing command-line */
+/* * arguments, because those may just be doing a show prof, in which */
+/* * case we don't want to initialize the atExit. */
+/* *\/ */
+/* if (PROFILE_NONE == s->profileKind) */
+/* s->profilingIsOn = FALSE; */
+/* else { */
+/* s->profilingIsOn = TRUE; */
+/* assert (s->frameSourcesSize == s->frameLayoutsSize); */
+/* switch (s->profileKind) { */
+/* case PROFILE_ALLOC: */
+/* case PROFILE_COUNT: */
+/* s->profile = GC_profileNew (s); */
+/* break; */
+/* case PROFILE_NONE: */
+/* die ("impossible PROFILE_NONE"); */
+/* case PROFILE_TIME: */
+/* profileTimeInit (s); */
+/* break; */
+/* } */
+/* profileEndState = s; */
+/* atexit (profileEnd); */
+/* } */
+/* if (s->isOriginal) { */
+/* newWorld (s); */
+/* /\* The mutator stack invariant doesn't hold, */
+/* * because the mutator has yet to run. */
+/* *\/ */
+/* assert (mutatorInvariant (s, TRUE, FALSE)); */
+/* } else { */
+/* loadWorld (s, worldFile); */
+/* if (s->profilingIsOn and s->profileStack) */
+/* GC_foreachStackFrame (s, enterFrame); */
+/* assert (mutatorInvariant (s, TRUE, TRUE)); */
+/* } */
+/* s->amInGC = FALSE; */
+/* return i; */
+/* } */
+
+/* extern char **environ; /\* for Posix_ProcEnv_environ *\/ */
+
+/* void MLton_init (int argc, char **argv, GC_state s) { */
+/* int start; */
+
+/* Posix_ProcEnv_environ = (CstringArray)environ; */
+/* start = GC_init (s, argc, argv); */
+/* /\* Setup argv and argc that SML sees. *\/ */
+/* /\* start is now the index of the first real arg. *\/ */
+/* CommandLine_commandName = (uint)(argv[0]); */
+/* CommandLine_argc = argc - start; */
+/* CommandLine_argv = (uint)(argv + start); */
+/* } */
+
+/* static void displayCol (FILE *out, int width, string s) { */
+/* int extra; */
+/* int i; */
+/* int len; */
+
+/* len = strlen (s); */
+/* if (len < width) { */
+/* extra = width - len; */
+/* for (i = 0; i < extra; ++i) */
+/* fprintf (out, " "); */
+/* } */
+/* fprintf (out, "%s\t", s); */
+/* } */
+
+/* static void displayCollectionStats (FILE *out, string name, struct rusage *ru, */
+/* uint num, ullong bytes) { */
+/* uint ms; */
+
+/* ms = rusageTime (ru); */
+/* fprintf (out, "%s", name); */
+/* displayCol (out, 7, uintToCommaString (ms)); */
+/* displayCol (out, 7, uintToCommaString (num)); */
+/* displayCol (out, 15, ullongToCommaString (bytes)); */
+/* displayCol (out, 15, */
+/* (ms > 0) */
+/* ? uintToCommaString (1000.0 * (float)bytes/(float)ms) */
+/* : "-"); */
+/* fprintf (out, "\n"); */
+/* } */
+
+/* void GC_done (GC_state s) { */
+/* FILE *out; */
+
+/* enter (s); */
+/* minorGC (s); */
+/* out = stderr; */
+/* if (s->summary) { */
+/* double time; */
+/* uint gcTime; */
+
+/* gcTime = rusageTime (&s->ru_gc); */
+/* fprintf (out, "GC type\t\ttime ms\t number\t\t bytes\t bytes/sec\n"); */
+/* fprintf (out, "-------------\t-------\t-------\t---------------\t---------------\n"); */
+/* displayCollectionStats */
+/* (out, "copying\t\t", &s->ru_gcCopy, s->numCopyingGCs, */
+/* s->bytesCopied); */
+/* displayCollectionStats */
+/* (out, "mark-compact\t", &s->ru_gcMarkCompact, */
+/* s->numMarkCompactGCs, s->bytesMarkCompacted); */
+/* displayCollectionStats */
+/* (out, "minor\t\t", &s->ru_gcMinor, s->numMinorGCs, */
+/* s->bytesCopiedMinor); */
+/* time = (double)(currentTime () - s->startTime); */
+/* fprintf (out, "total GC time: %s ms (%.1f%%)\n", */
+/* intToCommaString (gcTime), */
+/* (0.0 == time) */
+/* ? 0.0 */
+/* : 100.0 * ((double) gcTime) / time); */
+/* fprintf (out, "max pause: %s ms\n", */
+/* uintToCommaString (s->maxPause)); */
+/* fprintf (out, "total allocated: %s bytes\n", */
+/* ullongToCommaString (s->bytesAllocated)); */
+/* fprintf (out, "max live: %s bytes\n", */
+/* uintToCommaString (s->maxBytesLive)); */
+/* fprintf (out, "max semispace: %s bytes\n", */
+/* uintToCommaString (s->maxHeapSizeSeen)); */
+/* fprintf (out, "max stack size: %s bytes\n", */
+/* uintToCommaString (s->maxStackSizeSeen)); */
+/* fprintf (out, "marked cards: %s\n", */
+/* ullongToCommaString (s->markedCards)); */
+/* fprintf (out, "minor scanned: %s bytes\n", */
+/* uintToCommaString (s->minorBytesScanned)); */
+/* fprintf (out, "minor skipped: %s bytes\n", */
+/* uintToCommaString (s->minorBytesSkipped)); */
+/* } */
+/* heapRelease (s, &s->heap); */
+/* heapRelease (s, &s->heap2); */
+/* } */
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h 2005-10-22 02:32:10 UTC (rev 4118)
@@ -0,0 +1,32 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+
+/* GC_init uses the array of struct intInfInits in s at program start
+ * to allocate intInfs.
+ * The globalIndex'th entry of the globals array in s is set to the
+ * IntInf.int whose value corresponds to the mlstr string.
+ *
+ * The strings pointed to by the mlstr fields consist of
+ * an optional ~
+ * either one or more of [0-9] or
+ * 0x followed by one or more of [0-9a-fA-F]
+ * a trailing EOS
+ */
+struct GC_intInfInit {
+ uint32_t globalIndex;
+ char *mlstr;
+};
+
+/* GC_init allocates a collection of arrays/vectors in the heap. */
+struct GC_vectorInit {
+ pointer bytes;
+ size_t bytesPerElement;
+ uint32_t globalIndex;
+ GC_arrayLength numElements;
+};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.c 2005-10-22 02:32:10 UTC (rev 4118)
@@ -0,0 +1,54 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void GC_pack (GC_state s) {
+ size_t keep;
+
+ enter (s);
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr, "Packing heap of size %zu.\n",
+ /*uintToCommaString*/(s->heap.size));
+ /* Could put some code here to skip the GC if there hasn't been much
+ * allocated since the last collection. But you would still need to
+ * do a minor GC to make all objects contiguous.
+ */
+ doGC (s, 0, 0, TRUE, FALSE);
+ keep = s->heap.oldGenSize * 1.1;
+ if (keep <= s->heap.size) {
+ heapShrink (s, &s->heap, keep);
+ heapSetNursery (s, 0, 0);
+ setCurrentStack (s);
+ }
+ heapRelease (s, &s->secondaryHeap);
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr, "Packed heap to size %zu.\n",
+ /*uintToCommaString*/(s->heap.size));
+ leave (s);
+}
+
+void GC_unpack (GC_state s) {
+ enter (s);
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr, "Unpacking heap of size %zu.\n",
+ /*uintToCommaString*/(s->heap.size));
+ /* The enterGC is needed here because minorGC and resizeHeap might
+ * move the stack, and the SIGPROF catcher would then see a bogus
+ * stack. The leaveGC has to happen after the setStack.
+ */
+ enterGC (s);
+ minorGC (s);
+ heapResize (s, s->heap.oldGenSize);
+ secondaryHeapResize (s);
+ heapSetNursery (s, 0, 0);
+ setCurrentStack (s);
+ leaveGC (s);
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr, "Unpacked heap to size %zu.\n",
+ /*uintToCommaString*/(s->heap.size));
+ leave (s);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-10-22 02:32:10 UTC (rev 4118)
@@ -93,3 +93,5 @@
GC_profile GC_profileNew (GC_state s);
void GC_profileWrite (GC_state s, GC_profile p, int fd);
+
+void showProf (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h 2005-10-22 02:32:10 UTC (rev 4118)
@@ -28,5 +28,6 @@
* than nurseryRatio, use minor GCs.
*/
float nursery;
+ float ramSlop;
float threadShrink;
};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.c 2005-10-22 02:32:10 UTC (rev 4118)
@@ -0,0 +1,19 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+size_t GC_size (GC_state s, pointer root) {
+ size_t res;
+
+ if (DEBUG_SIZE)
+ fprintf (stderr, "GC_size marking\n");
+ res = dfsMark (s, root, MARK_MODE, FALSE);
+ if (DEBUG_SIZE)
+ fprintf (stderr, "GC_size unmarking\n");
+ dfsMark (s, root, UNMARK_MODE, FALSE);
+ return res;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-22 02:32:10 UTC (rev 4118)
@@ -26,6 +26,8 @@
#include <stdio.h>
#include <string.h>
#include <math.h>
+
+#include <signal.h>
#include <unistd.h>
#include <sys/resource.h>
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c 2005-10-22 02:32:10 UTC (rev 4118)
@@ -19,7 +19,7 @@
memcpy (dst, src, size);
}
-void *GC_mmapAnon_safe (pointer p, size_t length) {
+void *GC_mmapAnon_safe (void *p, size_t length) {
void *result;
result = GC_mmapAnon (p, length);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-10-22 00:34:28 UTC (rev 4117)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-10-22 02:32:10 UTC (rev 4118)
@@ -12,7 +12,11 @@
void showMem (void);
void *GC_mmapAnon (void *start, size_t length);
+void *GC_mmapAnon_safe (void *start, size_t length);
void *GC_mmap (void *start, size_t length);
+void *GC_mmap_safe (void *start, size_t length);
+void *GC_mmap_safe_protect (void *start, size_t length,
+ size_t dead_low, size_t dead_high);
void GC_munmap (void *start, size_t length);
void *GC_mremap (void *start, size_t oldLength, size_t newLength);
void GC_release (void *base, size_t length);
|
|
From: Matthew F. <fl...@ml...> - 2005-10-21 17:34:37
|
Some thread functions
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-22 00:34:28 UTC (rev 4117)
@@ -62,11 +62,11 @@
-Wpacked \
-Wredundant-decls \
-Wnested-externs
-## -Wshadow
-## -Wconversion
-## -Wmissing-prototypes
-## -Wmissing-declarations
-## -Winline -Wdisabled-optimization
+# -Wshadow \
+# -Wconversion \
+# -Wmissing-prototypes \
+# -Wmissing-declarations \
+# -Winline -Wdisabled-optimization
CFLAGS = -O2 $(CWFLAGS) -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
DEBUGFLAGS = $(CFLAGS) -Wunused -gstabs+ -g2
@@ -96,7 +96,6 @@
heap_predicates.c \
heap.c \
current.c \
- new_object.c \
ratios_predicates.c \
atomic.c \
gc_state.c \
@@ -107,7 +106,10 @@
dfs-mark.c \
share.c \
mark-compact.c \
+ new_object.c \
garbage-collection.c \
+ array-allocate.c \
+ copy-thread.c \
assumptions.c \
gc_suffix.c
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-22 00:34:28 UTC (rev 4117)
@@ -10,6 +10,10 @@
return 0 == a % b;
}
+static inline bool isAlignedMax (uintmax_t a, uintmax_t b) {
+ return 0 == a % b;
+}
+
static inline size_t alignDown (size_t a, size_t b) {
assert (b >= 1);
a -= a % b;
@@ -25,6 +29,14 @@
return a;
}
+static inline uintmax_t alignMax (uintmax_t a, uintmax_t b) {
+ assert (b >= 1);
+ a += b - 1;
+ a -= a % b;
+ assert (isAligned (a, b));
+ return a;
+}
+
static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
return align (bytes + extra, s->alignment) - extra;
}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-10-22 00:34:28 UTC (rev 4117)
@@ -0,0 +1,108 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+pointer GC_arrayAllocate (GC_state s,
+ size_t ensureBytesFree,
+ GC_arrayLength numElements,
+ GC_header header) {
+ uintmax_t arraySizeMax;
+ size_t arraySize;
+ size_t bytesPerElement;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
+ pointer frontier;
+ pointer last;
+ pointer res;
+
+ splitHeader(s, header, NULL, NULL, &numNonObjptrs, &numObjptrs);
+ if (DEBUG)
+ fprintf (stderr, "GC_arrayAllocate (%zu, "FMTARRLEN", "FMTHDR")\n",
+ ensureBytesFree, numElements, header);
+ bytesPerElement =
+ numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ arraySizeMax =
+ alignMax ((uintmax_t)bytesPerElement * (uintmax_t)numElements + GC_ARRAY_HEADER_SIZE,
+ s->alignment);
+ if (arraySizeMax >= (uintmax_t)SIZE_MAX)
+ die ("Out of memory: cannot allocate array with %"PRIuMAX" bytes.",
+ /*ullongToCommaString*/(arraySizeMax));
+ arraySize = (size_t)arraySizeMax;
+ if (arraySize < GC_ARRAY_HEADER_SIZE + WORD_SIZE)
+ /* Create space for forwarding pointer. */
+ arraySize = GC_ARRAY_HEADER_SIZE + WORD_SIZE;
+ if (DEBUG_ARRAY)
+ fprintf (stderr, "array with "FMTARRLEN" elts of size %zu and total size %zu. Ensure %zu bytes free.\n",
+ numElements, bytesPerElement,
+ /*uintToCommaString*/(arraySize),
+ /*uintToCommaString*/(ensureBytesFree));
+ if (arraySize >= s->controls.oldGenArraySize) {
+ enter (s);
+ doGC (s, arraySize, ensureBytesFree, FALSE, TRUE);
+ leave (s);
+ frontier = s->heap.start + s->heap.oldGenSize;
+ last = frontier + arraySize;
+ s->heap.oldGenSize += arraySize;
+ s->cumulativeStatistics.bytesAllocated += arraySize;
+ } else {
+ size_t bytesRequested;
+
+ bytesRequested = arraySize + ensureBytesFree;
+ if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier)) {
+ enter (s);
+ doGC (s, 0, bytesRequested, FALSE, TRUE);
+ leave (s);
+ }
+ frontier = s->frontier;
+ last = frontier + arraySize;
+ assert (isAlignedFrontier (s, last));
+ s->frontier = last;
+ }
+ *((GC_arrayCounter*)(frontier)) = 0;
+ frontier = frontier + GC_ARRAY_COUNTER_SIZE;
+ *((GC_arrayLength*)(frontier)) = numElements;
+ frontier = frontier + GC_ARRAY_LENGTH_SIZE;
+ *((GC_header*)(frontier)) = header;
+ frontier = frontier + GC_HEADER_SIZE;
+ res = frontier;
+ /* Initialize all pointers with BOGUS_OBJPTR. */
+ if (1 <= numObjptrs and 0 < numElements) {
+ pointer p;
+
+ if (0 == numNonObjptrs)
+ for (p = frontier;
+ p < last;
+ p += OBJPTR_SIZE)
+ *((objptr*)p) = BOGUS_OBJPTR;
+ else
+ for (p = frontier;
+ p < last; ) {
+ pointer next;
+
+ p += numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+ next = p + numObjptrs * OBJPTR_SIZE;
+ assert (next <= last);
+ while (p < next) {
+ *((objptr*)p) = BOGUS_OBJPTR;
+ p += OBJPTR_SIZE;
+ }
+ }
+ }
+ GC_profileAllocInc (s, arraySize);
+ if (DEBUG_ARRAY) {
+ fprintf (stderr, "GC_arrayAllocate done. res = "FMTPTR" frontier = "FMTPTR"\n",
+ (uintptr_t)res, (uintptr_t)s->frontier);
+ displayGCState (s, stderr);
+ }
+ assert (ensureBytesFree <= (size_t)(s->limitPlusSlop - s->frontier));
+ /* Unfortunately, the invariant isn't quite true here, because
+ * unless we did the GC, we never set s->currentThread->stack->used
+ * to reflect what the mutator did with stackTop.
+ */
+ return res;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-10-22 00:34:28 UTC (rev 4117)
@@ -20,6 +20,8 @@
*/
typedef uint32_t GC_arrayLength;
#define GC_ARRAY_LENGTH_SIZE sizeof(GC_arrayLength)
+#define PRIxARRLEN PRIu32
+#define FMTARRLEN "%"PRIxARRLEN
typedef GC_arrayLength GC_arrayCounter;
#define GC_ARRAY_COUNTER_SIZE GC_ARRAY_LENGTH_SIZE
#define GC_ARRAY_HEADER_SIZE (GC_ARRAY_COUNTER_SIZE + GC_ARRAY_LENGTH_SIZE + GC_HEADER_SIZE)
@@ -29,8 +31,7 @@
* Returns a pointer to the length for the array pointed to by p.
*/
static inline GC_arrayLength* getArrayLengthp (pointer a) {
- return (GC_arrayLength*)(a - GC_HEADER_SIZE
- - GC_ARRAY_LENGTH_SIZE);
+ return (GC_arrayLength*)(a - GC_HEADER_SIZE - GC_ARRAY_LENGTH_SIZE);
}
/* getArrayLength (p)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-22 00:34:28 UTC (rev 4117)
@@ -10,5 +10,6 @@
size_t fixedHeap; /* If 0, then no fixed heap. */
size_t maxHeap; /* if zero, then unlimited, else limit total heap */
bool messages; /* Print a message at the start and end of each gc. */
+ size_t oldGenArraySize; /* Arrays larger are allocated in old gen, if possible. */
bool summary; /* Print a summary of gc info when program exits. */
};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c 2005-10-22 00:34:28 UTC (rev 4117)
@@ -0,0 +1,106 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+static GC_thread newThread (GC_state s, size_t stackSize) {
+ GC_stack stack;
+ GC_thread thread;
+
+ ensureFree (s, stackSizeTotalAligned (s, stackSize) + threadSize (s));
+ stack = newStack (s, stackSize, FALSE);
+ thread = (GC_thread) newObject (s, GC_THREAD_HEADER,
+ threadSize (s),
+ FALSE);
+ thread->bytesNeeded = 0;
+ thread->exnStack = BOGUS_EXN_STACK;
+ thread->stack = pointerToObjptr((pointer)stack, s->heap.start);
+ if (DEBUG_THREADS)
+ fprintf (stderr, FMTPTR" = newThreadOfSize (%zu)\n",
+ (uintptr_t)thread, stackSize);;
+ return thread;
+}
+
+static GC_thread copyThread (GC_state s, GC_thread from, size_t size) {
+ GC_thread to;
+
+ if (DEBUG_THREADS)
+ fprintf (stderr, "copyThread ("FMTPTR")\n", (uintptr_t)from);
+ /* newThread may do a GC, which invalidates from.
+ * Hence we need to stash from where the GC can find it.
+ */
+ s->savedThread = pointerToObjptr((pointer)from, s->heap.start);
+ to = newThread (s, size);
+ from = (GC_thread)(objptrToPointer(s->savedThread, s->heap.start));
+ s->savedThread = BOGUS_OBJPTR;
+ if (DEBUG_THREADS) {
+ fprintf (stderr, FMTPTR" = copyThread ("FMTPTR")\n",
+ (uintptr_t)to, (uintptr_t)from);
+ }
+ stackCopy (s,
+ (GC_stack)(objptrToPointer(from->stack, s->heap.start)),
+ (GC_stack)(objptrToPointer(to->stack, s->heap.start)));
+ to->bytesNeeded = from->bytesNeeded;
+ to->exnStack = from->exnStack;
+ return to;
+}
+
+void GC_copyCurrentThread (GC_state s) {
+ GC_thread fromThread;
+ GC_stack fromStack;
+ GC_thread toThread;
+ GC_stack toStack;
+
+ if (DEBUG_THREADS)
+ fprintf (stderr, "GC_copyCurrentThread\n");
+ enter (s);
+ fromThread = (GC_thread)(objptrToPointer(s->currentThread, s->heap.start));
+ fromStack = (GC_stack)(objptrToPointer((objptr)(fromThread->stack), s->heap.start));
+ toThread = copyThread (s, fromThread, fromStack->used);
+ toStack = (GC_stack)(objptrToPointer((objptr)(toThread->stack), s->heap.start));
+ /* The following assert is no longer true, since alignment
+ * restrictions can force the reserved to be slightly larger than
+ * the used.
+ */
+ /* assert (fromStack->reserved == fromStack->used); */
+ assert (fromStack->reserved >= fromStack->used);
+ leave (s);
+ if (DEBUG_THREADS)
+ fprintf (stderr, FMTPTR" = GC_copyCurrentThread\n", (uintptr_t)toThread);
+ s->savedThread = pointerToObjptr((pointer)toThread, s->heap.start);
+}
+
+pointer GC_copyThread (GC_state s, pointer p) {
+ GC_thread fromThread;
+ GC_stack fromStack;
+ GC_thread toThread;
+ GC_stack toStack;
+
+ if (DEBUG_THREADS)
+ fprintf (stderr, "GC_copyThread ("FMTPTR")\n", (uintptr_t)p);
+ enter (s);
+ fromThread = (GC_thread)p;
+ fromStack = (GC_stack)(objptrToPointer((objptr)(fromThread->stack), s->heap.start));
+ /* The following assert is no longer true, since alignment
+ * restrictions can force the reserved to be slightly larger than
+ * the used.
+ */
+ /* assert (fromStack->reserved == fromStack->used); */
+ assert (fromStack->reserved >= fromStack->used);
+ toThread = copyThread (s, fromThread, fromStack->used);
+ /* The following assert is no longer true, since alignment
+ * restrictions can force the reserved to be slightly larger than
+ * the used.
+ */
+ toStack = (GC_stack)(objptrToPointer((objptr)(toThread->stack), s->heap.start));
+ /* assert (fromStack->reserved == fromStack->used); */
+ assert (fromStack->reserved >= fromStack->used);
+ leave (s);
+ if (DEBUG_THREADS)
+ fprintf (stderr, FMTPTR" = GC_copyThread ("FMTPTR")\n",
+ (uintptr_t)toThread, (uintptr_t)fromThread);
+ return (pointer)toThread;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-22 00:34:28 UTC (rev 4117)
@@ -57,7 +57,7 @@
}
#endif
-/* mark (s, r, m, shc)
+/* dfsMark (s, r, m, shc)
*
* Sets all the mark bits in the object graph pointed to by r.
*
@@ -68,8 +68,8 @@
*
* It returns the total size in bytes of the objects marked.
*/
-size_t mark (GC_state s, pointer root,
- GC_markMode mode, bool shouldHashCons) {
+size_t dfsMark (GC_state s, pointer root,
+ GC_markMode mode, bool shouldHashCons) {
GC_header mark; /* Used to set or clear the mark bit. */
size_t size; /* Total number of bytes marked. */
pointer cur; /* The current object being marked. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-10-22 00:34:28 UTC (rev 4117)
@@ -10,25 +10,25 @@
/* Jonkers Mark-compact Collection */
/* ---------------------------------------------------------------- */
-static inline void markGlobalTrue (GC_state s, objptr *opp) {
+static inline void dfsMarkTrue (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- mark (s, p, MARK_MODE, TRUE);
+ dfsMark (s, p, MARK_MODE, TRUE);
}
-static inline void markGlobalFalse (GC_state s, objptr *opp) {
+static inline void dfsMarkFalse (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- mark (s, p, MARK_MODE, FALSE);
+ dfsMark (s, p, MARK_MODE, FALSE);
}
-static inline void unmarkGlobal (GC_state s, objptr *opp) {
+static inline void dfsUnmark (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- mark (s, p, UNMARK_MODE, FALSE);
+ dfsMark (s, p, UNMARK_MODE, FALSE);
}
static inline void threadInternal (GC_state s, objptr *opp) {
@@ -284,10 +284,10 @@
s->cumulativeStatistics.bytesHashConsed = 0;
s->cumulativeStatistics.numHashConsGCs++;
s->objectHashTable = newHashTable (s);
- foreachGlobalObjptr (s, markGlobalTrue);
+ foreachGlobalObjptr (s, dfsMarkTrue);
destroyHashTable (s->objectHashTable);
} else {
- foreachGlobalObjptr (s, markGlobalFalse);
+ foreachGlobalObjptr (s, dfsMarkFalse);
}
/* foreachGlobal (s, threadInternal); */
/* updateForwardPointers (s); */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c 2005-10-22 00:34:28 UTC (rev 4117)
@@ -14,10 +14,10 @@
if (DEBUG_SHARE or s->controls.messages)
s->cumulativeStatistics.bytesHashConsed = 0;
// Don't hash cons during the first round of marking.
- total = mark (s, object, MARK_MODE, FALSE);
+ total = dfsMark (s, object, MARK_MODE, FALSE);
s->objectHashTable = newHashTable (s);
// Hash cons during the second round of marking.
- mark (s, object, UNMARK_MODE, TRUE);
+ dfsMark (s, object, UNMARK_MODE, TRUE);
destroyHashTable (s->objectHashTable);
if (DEBUG_SHARE or s->controls.messages)
bytesHashConsedMessage (s, total);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-10-22 00:34:28 UTC (rev 4117)
@@ -6,12 +6,14 @@
* See the file MLton-LICENSE for details.
*/
+#define BOGUS_EXN_STACK 0xFFFFFFFF
+
void displayThread (GC_state s,
GC_thread thread,
FILE *stream) {
fprintf(stream,
"\t\texnStack = %"PRIu32"\n"
- "\t\tbytesNeeded = %"PRIu32"\n"
+ "\t\tbytesNeeded = %zu\n"
"\t\tstack = "FMTOBJPTR"\n",
thread->exnStack,
thread->bytesNeeded,
@@ -19,3 +21,17 @@
displayStack (s, (GC_stack)(objptrToPointer (thread->stack, s->heap.start)),
stream);
}
+
+static inline size_t threadSize (GC_state s) {
+ size_t res;
+
+ res = GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread);
+ /* The following assert depends on struct GC_thread being the right
+ * size. Right now, it happens that res = 16, which is aligned mod
+ * 4 and mod 8, which is all that we need. If the struct every
+ * changes (possible) or we need more alignment (doubtful), we may
+ * need to put some padding at the beginning.
+ */
+ assert (isAligned (res, s->alignment));
+ return res;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h 2005-10-19 01:32:39 UTC (rev 4116)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h 2005-10-22 00:34:28 UTC (rev 4117)
@@ -13,11 +13,11 @@
* Furthermore, the exnStack field must be first, because the native
* codegen depends on this (which is bad and should be fixed).
*/
- uint32_t exnStack; /* An offset added to stackBottom that specifies
- * where the top of the exnStack is.
- */
- uint32_t bytesNeeded; /* The number of bytes needed when returning
- * to this thread.
- */
- objptr stack; /* The stack for this thread. */
+ uint32_t exnStack; /* An offset added to stackBottom that specifies
+ * where the top of the exnStack is.
+ */
+ size_t bytesNeeded; /* The number of bytes needed when returning
+ * to this thread.
+ */
+ objptr stack; /* The stack for this thread. */
} *GC_thread;
|
|
From: Matthew F. <fl...@ml...> - 2005-10-18 18:32:41
|
Makefile typo ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-19 01:29:26 UTC (rev 4115) +++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-19 01:32:39 UTC (rev 4116) @@ -168,7 +168,7 @@ ( \ for m in $(ALL_MODELS); do \ $(CC) $(CFLAGS) -DGC_MODEL_$$m -c -o gc.$$m.o gc.c; \ - $(CC) $(CFLAGS) $(DEBUGFLAGS) -O1 -DASSERT=1 -DGC_MODEL_$$m -c -o gc-gdb.$$m.o gc.c; \ + $(CC) $(DEBUGFLAGS) -O1 -DASSERT=1 -DGC_MODEL_$$m -c -o gc-gdb.$$m.o gc.c; \ done; \ ) |
|
From: Matthew F. <fl...@ml...> - 2005-10-18 18:29:29
|
Meant to rename, not copy
----------------------------------------------------------------------
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h
----------------------------------------------------------------------
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h 2005-10-19 01:28:35 UTC (rev 4114)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h 2005-10-19 01:29:26 UTC (rev 4115)
@@ -1,71 +0,0 @@
-/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- */
-
-typedef enum {
- PROFILE_ALLOC,
- PROFILE_COUNT,
- PROFILE_NONE,
- PROFILE_TIME,
-} GC_profileKind;
-
-typedef struct GC_source {
- uint32_t nameIndex;
- uint32_t successorsIndex;
-} *GC_source;
-
-typedef struct GC_sourceLabel {
- pointer label;
- uint32_t sourceSeqsIndex;
-} *GC_sourceLabel;
-
-
-/* If profileStack, then there is one struct GC_profileStack for each
- * function.
- */
-typedef struct GC_profileStack {
- /* ticks counts ticks while the function was on the stack. */
- uintmax_t ticks;
- /* ticksInGC counts ticks in GC while the function was on the stack. */
- uintmax_t ticksInGC;
- /* lastTotal is the value of total when the oldest occurrence of f
- * on the stack was pushed, i.e., the most recent time that
- * numTimesOnStack changed from 0 to 1. lastTotal is used to
- * compute the amount to attribute to f when the oldest occurrence
- * is finally popped.
- */
- uintmax_t lastTotal;
- /* lastTotalGC is like lastTotal, but for GC ticks. */
- uintmax_t lastTotalGC;
- /* numOccurrences is the number of times this function is on the
- * stack.
- */
- uintmax_t numOccurrences;
-} *GC_profileStack;
-
-/* GC_profile is used for both time and allocation profiling.
- * In the comments below, "ticks" mean clock ticks with time profiling and
- * bytes allocated with allocation profiling.
- *
- * All of the arrays in GC_profile are of length sourcesSize + sourceNamesSize.
- * The first sourceSizes entries are for handling the duplicate copies of
- * functions, and the next sourceNamesSize entries are for the master versions.
- */
-typedef struct GC_profile {
- /* countTop is an array that counts for each function the number of
- * ticks that occurred while the function was on top of the stack.
- */
- uintmax_t *countTop;
- /* stack is an array that gives stack info for each function. It is
- * only used if profileStack.
- */
- struct GC_profileStack *stack;
- /* The total number of mutator ticks. */
- uintmax_t total;
- /* The total number of GC ticks. */
- uintmax_t totalGC;
-} *GC_profile;
|
|
From: Matthew F. <fl...@ml...> - 2005-10-18 18:28:42
|
GC_gc functionality
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-19 01:28:35 UTC (rev 4114)
@@ -107,6 +107,7 @@
dfs-mark.c \
share.c \
mark-compact.c \
+ garbage-collection.c \
assumptions.c \
gc_suffix.c
@@ -131,8 +132,9 @@
sysvals.h \
ratios.h \
hash-cons.h \
+ profiling.h \
+ signals.h \
gc_state.h \
- profile.h \
gc_suffix.h
all: gc.o gc-gdb.o
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c 2005-10-19 01:28:35 UTC (rev 4114)
@@ -14,6 +14,7 @@
static inline void atomicEnd (GC_state s) {
s->atomicState--;
- if (0 == s->atomicState and s->signalIsPending)
+ if (0 == s->atomicState
+ and s->signalsInfo.signalIsPending)
s->limit = 0;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-19 01:28:35 UTC (rev 4114)
@@ -18,6 +18,7 @@
* It also updates the crossMap.
*/
struct forwardState {
+ bool amInMinorGC;
pointer back;
pointer toStart;
pointer toLimit;
@@ -127,7 +128,7 @@
fprintf (stderr, "forwarding weak "FMTPTR" ",
(uintptr_t)w);
if (isObjptr (w->objptr)
- and (not s->amInMinorGC
+ and (not forwardState.amInMinorGC
or objptrIsInNursery (s, w->objptr))) {
if (DEBUG_WEAK)
fprintf (stderr, "linking\n");
@@ -193,6 +194,7 @@
if (detailedGCTime (s))
startTiming (&ru_start);
s->cumulativeStatistics.numCopyingGCs++;
+ forwardState.amInMinorGC = FALSE;
forwardState.toStart = s->secondaryHeap.start;
forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.size;
if (DEBUG or s->controls.messages) {
@@ -360,7 +362,7 @@
fprintf (stderr, "Minor copying GC.\n");
if (detailedGCTime (s))
startTiming (&ru_start);
- s->amInMinorGC = TRUE;
+ forwardState.amInMinorGC = TRUE;
forwardState.toStart = s->heap.start + s->heap.oldGenSize;
if (DEBUG_GENERATIONAL)
fprintf (stderr, "toStart = "FMTPTR"\n", (uintptr_t)forwardState.toStart);
@@ -381,7 +383,6 @@
bytesCopied = forwardState.back - forwardState.toStart;
s->cumulativeStatistics.bytesCopiedMinor += bytesCopied;
s->heap.oldGenSize += bytesCopied;
- s->amInMinorGC = FALSE;
if (detailedGCTime (s))
stopTiming (&ru_start, &s->cumulativeStatistics.ru_gcMinor);
if (DEBUG_GENERATIONAL or s->controls.messages)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-10-19 01:28:35 UTC (rev 4114)
@@ -22,6 +22,7 @@
DEBUG_PROFILE = FALSE,
DEBUG_RESIZING = FALSE,
DEBUG_SHARE = FALSE,
+ DEBUG_SIGNALS = FALSE,
DEBUG_SIZE = FALSE,
DEBUG_STACKS = FALSE,
DEBUG_THREADS = FALSE,
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-10-19 01:28:35 UTC (rev 4114)
@@ -0,0 +1,284 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+static void minorGC (GC_state s) {
+ minorCheneyCopyGC (s);
+}
+
+static void majorGC (GC_state s, size_t bytesRequested, bool mayResize) {
+ uintmax_t numGCs;
+ size_t desiredSize;
+
+ s->cumulativeStatistics.numMinorGCs = 0;
+ numGCs =
+ s->cumulativeStatistics.numCopyingGCs
+ + s->cumulativeStatistics.numMarkCompactGCs;
+ if (0 < numGCs
+ and ((float)(s->cumulativeStatistics.numHashConsGCs) / (float)(numGCs)
+ < s->ratios.hashCons))
+ s->hashConsDuringGC = TRUE;
+ desiredSize =
+ heapDesiredSize (s, s->lastMajorStatistics.bytesLive + bytesRequested, 0);
+ if ((not FORCE_MARK_COMPACT)
+ and not s->hashConsDuringGC // only markCompact can hash cons
+ and s->heap.size < s->sysvals.ram
+ and (not heapIsInit (&s->secondaryHeap)
+ or secondaryHeapCreate (s, desiredSize)))
+ majorCheneyCopyGC (s);
+ else
+ majorMarkCompactGC (s);
+ s->hashConsDuringGC = FALSE;
+ s->lastMajorStatistics.bytesLive = s->heap.oldGenSize;
+ if (s->lastMajorStatistics.bytesLive > s->cumulativeStatistics.maxBytesLive)
+ s->cumulativeStatistics.maxBytesLive = s->lastMajorStatistics.bytesLive;
+ /* Notice that the s->bytesLive below is different than the s->bytesLive
+ * used as an argument to heapAllocateSecondSemi above. Above, it was
+ * an estimate. Here, it is exactly how much was live after the GC.
+ */
+ if (mayResize)
+ heapResize (s, s->lastMajorStatistics.bytesLive + bytesRequested);
+ secondaryHeapResize (s);
+ assert (s->heap.oldGenSize + bytesRequested <= s->heap.size);
+}
+
+static inline void enterGC (GC_state s) {
+ if (s->profilingInfo.isOn) {
+ /* We don't need to profileEnter for count profiling because it
+ * has already bumped the counter. If we did allow the bump, then
+ * the count would look like function(s) had run an extra time.
+ */
+ if (s->profilingInfo.stack
+ and not (PROFILE_COUNT == s->profilingInfo.kind))
+ GC_profileEnter (s);
+ }
+ s->amInGC = TRUE;
+}
+
+static inline void leaveGC (GC_state s) {
+ if (s->profilingInfo.isOn) {
+ if (s->profilingInfo.stack
+ and not (PROFILE_COUNT == s->profilingInfo.kind))
+ GC_profileLeave (s);
+ }
+ s->amInGC = FALSE;
+}
+
+static inline bool needGCTime (GC_state s) {
+ return
+ DEBUG
+ or s->controls.summary
+ or s->controls.messages
+ or s->rusageIsEnabled;
+}
+
+static void doGC (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested,
+ bool forceMajor,
+ bool mayResize) {
+ uintmax_t gcTime;
+ bool stackTopOk;
+ size_t stackBytesRequested;
+ struct rusage ru_start;
+ size_t totalBytesRequested;
+
+ enterGC (s);
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr, "Starting gc. Request %zu nursery bytes and %zu old gen bytes.\n",
+ /*uintToCommaString*/(nurseryBytesRequested),
+ /*uintToCommaString*/(oldGenBytesRequested));
+ assert (invariant (s));
+ if (needGCTime (s))
+ startTiming (&ru_start);
+ minorGC (s);
+ stackTopOk = mutatorStackInvariant (s);
+ stackBytesRequested =
+ stackTopOk ? 0 : stackSizeTotalAligned (s, stackGrowSize (s));
+ totalBytesRequested =
+ oldGenBytesRequested
+ + nurseryBytesRequested
+ + stackBytesRequested;
+ if (forceMajor
+ or totalBytesRequested > s->heap.size - s->heap.oldGenSize)
+ majorGC (s, totalBytesRequested, mayResize);
+ heapSetNursery (s, oldGenBytesRequested + stackBytesRequested,
+ nurseryBytesRequested);
+ assert (heapHasBytesFree (s, oldGenBytesRequested + stackBytesRequested,
+ nurseryBytesRequested));
+ unless (stackTopOk)
+ stackGrow (s);
+ setCurrentStack (s);
+ if (needGCTime (s)) {
+ gcTime = stopTiming (&ru_start, &s->cumulativeStatistics.ru_gc);
+ s->cumulativeStatistics.maxPause =
+ max (s->cumulativeStatistics.maxPause, gcTime);
+ } else
+ gcTime = 0; /* Assign gcTime to quell gcc warning. */
+ if (DEBUG or s->controls.messages) {
+ fprintf (stderr, "Finished gc.\n");
+ fprintf (stderr, "time: %"PRIuMAX" ms\n", /*intToCommaString*/(gcTime));
+ fprintf (stderr, "old gen size: %zu bytes (%.1f%%)\n",
+ /*intToCommaString*/(s->heap.oldGenSize),
+ 100.0 * ((double)(s->heap.oldGenSize)
+ / (double)(s->heap.size)));
+ }
+ /* Send a GC signal. */
+ if (s->signalsInfo.gcSignalHandled
+ and s->signalHandlerThread != BOGUS_OBJPTR) {
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC Signal pending.\n");
+ s->signalsInfo.gcSignalPending = TRUE;
+ unless (s->signalsInfo.amInSignalHandler)
+ s->signalsInfo.signalIsPending = TRUE;
+ }
+ if (DEBUG)
+ displayGCState (s, stderr);
+ assert (heapHasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+ assert (invariant (s));
+ leaveGC (s);
+}
+
+static inline void ensureMutatorInvariant (GC_state s, bool force) {
+ if (force
+ or not (mutatorFrontierInvariant(s))
+ or not (mutatorStackInvariant(s))) {
+ /* This GC will grow the stack, if necessary. */
+ doGC (s, 0, currentThread(s)->bytesNeeded, force, TRUE);
+ }
+ assert (mutatorFrontierInvariant(s));
+ assert (mutatorStackInvariant(s));
+}
+
+/* ensureFree (s, b) ensures that upon return
+ * b <= s->limitPlusSlop - s->frontier
+ */
+static inline void ensureFree (GC_state s, size_t bytesRequested) {
+ assert (s->frontier <= s->limitPlusSlop);
+ if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier))
+ doGC (s, 0, bytesRequested, FALSE, TRUE);
+ assert (bytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
+}
+
+static void switchToThread (GC_state s, objptr op) {
+ if (DEBUG_THREADS) {
+ GC_thread thread;
+ GC_stack stack;
+
+ thread = (GC_thread)(objptrToPointer (op, s->heap.start));
+ stack = (GC_stack)(objptrToPointer (thread->stack, s->heap.start));
+
+ fprintf (stderr, "switchToThread ("FMTOBJPTR") used = %zu reserved = %zu\n",
+ op, stack->used, stack->reserved);
+ }
+ s->currentThread = op;
+ setCurrentStack (s);
+}
+
+/* GC_startHandler does not do an enter()/leave(), even though it is
+ * exported. The basis library uses it via _import, not _prim, and so
+ * does not treat it as a runtime call -- so the invariant in enter
+ * would fail miserably. It is OK because GC_startHandler must be
+ * called from within a critical section.
+ *
+ * Don't make it inline, because it is also called in basis/Thread.c,
+ * and when compiling with COMPILE_FAST, they may appear out of order.
+ */
+void GC_startHandler (GC_state s) {
+ /* Switch to the signal handler thread. */
+ if (DEBUG_SIGNALS) {
+ fprintf (stderr, "GC_startHandler\n");
+ }
+ assert (s->atomicState == 1);
+ assert (s->signalsInfo.signalIsPending);
+ s->signalsInfo.signalIsPending = FALSE;
+ s->signalsInfo.amInSignalHandler = TRUE;
+ s->savedThread = s->currentThread;
+ /* Set s->atomicState to 2 when switching to the signal handler
+ * thread; leaving the runtime will decrement s->atomicState to 1,
+ * the signal handler will then run atomically and will finish by
+ * switching to the thread to continue with, which will decrement
+ * s->atomicState to 0.
+ */
+ s->atomicState = 2;
+}
+
+void GC_finishHandler (GC_state s) {
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC_finishHandler ()\n");
+ assert (s->atomicState == 1);
+ s->signalsInfo.amInSignalHandler = FALSE;
+}
+
+static inline void maybeSwitchToHandler (GC_state s) {
+ if (s->atomicState == 1
+ and s->signalsInfo.signalIsPending) {
+ GC_startHandler (s);
+ switchToThread (s, s->signalHandlerThread);
+ }
+}
+
+/* void GC_switchToThread (GC_state s, GC_thread t, uint ensureBytesFree) { */
+/* if (DEBUG_THREADS) */
+/* fprintf (stderr, "GC_switchToThread (0x%08x, %u)\n", (uint)t, ensureBytesFree); */
+/* if (FALSE) { */
+/* /\* This branch is slower than the else branch, especially */
+/* * when debugging is turned on, because it does an invariant */
+/* * check on every thread switch. */
+/* * So, we'll stick with the else branch for now. */
+/* *\/ */
+/* enter (s); */
+/* s->currentThread->bytesNeeded = ensureBytesFree; */
+/* switchToThread (s, t); */
+/* s->canHandle--; */
+/* maybeSwitchToHandler (s); */
+/* ensureMutatorInvariant (s, FALSE); */
+/* assert (mutatorFrontierInvariant(s)); */
+/* assert (mutatorStackInvariant(s)); */
+/* leave (s); */
+/* } else { */
+/* /\* BEGIN: enter(s); *\/ */
+/* s->currentThread->stack->used = currentStackUsed (s); */
+/* s->currentThread->exnStack = s->exnStack; */
+/* atomicBegin (s); */
+/* /\* END: enter(s); *\/ */
+/* s->currentThread->bytesNeeded = ensureBytesFree; */
+/* switchToThread (s, t); */
+/* s->canHandle--; */
+/* maybeSwitchToHandler (s); */
+/* /\* BEGIN: ensureMutatorInvariant *\/ */
+/* if (not (mutatorFrontierInvariant(s)) */
+/* or not (mutatorStackInvariant(s))) { */
+/* /\* This GC will grow the stack, if necessary. *\/ */
+/* doGC (s, 0, s->currentThread->bytesNeeded, FALSE, TRUE); */
+/* } */
+/* /\* END: ensureMutatorInvariant *\/ */
+/* /\* BEGIN: leave(s); *\/ */
+/* atomicEnd (s); */
+/* /\* END: leave(s); *\/ */
+/* } */
+/* assert (mutatorFrontierInvariant(s)); */
+/* assert (mutatorStackInvariant(s)); */
+/* } */
+
+void GC_gc (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);
+ enter (s);
+ /* When the mutator requests zero bytes, it may actually need as
+ * much as LIMIT_SLOP.
+ */
+ if (0 == bytesRequested)
+ bytesRequested = LIMIT_SLOP;
+ currentThread(s)->bytesNeeded = bytesRequested;
+ maybeSwitchToHandler (s);
+ ensureMutatorInvariant (s, force);
+ assert (mutatorFrontierInvariant(s));
+ assert (mutatorStackInvariant(s));
+ leave (s);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -1,2 +1,5 @@
#ifndef _MLTON_GC_H_
#define _MLTON_GC_H_
+
+struct GC_state;
+typedef struct GC_state *GC_state;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -1,8 +1,14 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
-typedef struct GC_state {
+struct GC_state {
size_t alignment; /* */
bool amInGC;
- bool amInMinorGC;
uint32_t atomicState;
objptr callFromCHandlerThread; /* Handler for exported C calls (in heap). */
bool canMinor; /* TRUE iff there is space for a minor gc. */
@@ -26,17 +32,19 @@
GC_objectHashTable objectHashTable;
GC_objectType *objectTypes; /* Array of object types. */
uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
+ struct GC_profilingInfo profilingInfo;
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
struct GC_ratios ratios;
+ bool rusageIsEnabled;
objptr savedThread; /* Result of GC_copyCurrentThread.
* Thread interrupted by arrival of signal.
*/
struct GC_heap secondaryHeap; /* Used for major copying collection. */
objptr signalHandlerThread; /* Handler for signals (in heap). */
- /*Bool*/bool signalIsPending;
+ struct GC_signalsInfo signalsInfo;
pointer stackBottom; /* Bottom of stack in current thread. */
pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
pointer stackTop; /* Top of stack in current thread. */
struct GC_sysvals sysvals;
GC_weak weaks; /* Linked list of (live) weak pointers */
-} *GC_state;
+};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-19 01:28:35 UTC (rev 4114)
@@ -127,6 +127,17 @@
return FALSE;
}
+/* secondaryHeapCreate (s, desiredSize)
+ */
+static bool secondaryHeapCreate (GC_state s, size_t desiredSize) {
+ if ((s->controls.fixedHeap > 0
+ and s->heap.size + desiredSize > s->controls.fixedHeap)
+ or (s->controls.maxHeap > 0
+ and s->heap.size + desiredSize > s->controls.maxHeap))
+ return FALSE;
+ return heapCreate (s, &s->secondaryHeap, desiredSize, s->heap.oldGenSize);
+}
+
/* heapRemap (s, h, desiredSize, minSize)
*/
static bool heapRemap (GC_state s, GC_heap h,
@@ -346,7 +357,7 @@
size_t nurserySize;
if (DEBUG_DETAILED)
- fprintf (stderr, "setNursery(%zu, %zu)\n",
+ fprintf (stderr, "heapSetNursery(%zu, %zu)\n",
/*uintToCommaString*/(oldGenBytesRequested),
/*uintToCommaString*/(nurseryBytesRequested));
h = &s->heap;
@@ -449,14 +460,3 @@
assert (0 == s->secondaryHeap.size
or s->heap.size == s->secondaryHeap.size);
}
-
-/* secondaryHeapCreate (s, desiredSize)
- */
-static bool secondaryHeapCreate (GC_state s, size_t desiredSize) {
- if ((s->controls.fixedHeap > 0
- and s->heap.size + desiredSize > s->controls.fixedHeap)
- or (s->controls.maxHeap > 0
- and s->heap.size + desiredSize > s->controls.maxHeap))
- return FALSE;
- return heapCreate (s, &s->secondaryHeap, desiredSize, s->heap.oldGenSize);
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-10-19 01:28:35 UTC (rev 4114)
@@ -81,6 +81,8 @@
return TRUE;
}
+#endif /* #if ASSERT */
+
static bool mutatorFrontierInvariant (GC_state s) {
GC_thread ct = currentThread(s);
return (ct->bytesNeeded <= (size_t)(s->limitPlusSlop - s->frontier));
@@ -101,5 +103,3 @@
assert (invariant (s));
return TRUE;
}
-
-#endif /* #if ASSERT */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -6,18 +6,66 @@
* See the file MLton-LICENSE for details.
*/
-void GC_profileAllocInc (GC_state s, size_t bytes);
+typedef enum {
+ PROFILE_ALLOC,
+ PROFILE_COUNT,
+ PROFILE_NONE,
+ PROFILE_TIME,
+} GC_profileKind;
-void GC_profileDone (GC_state s);
+typedef struct GC_source {
+ uint32_t nameIndex;
+ uint32_t successorsIndex;
+} *GC_source;
-void GC_profileEnter (GC_state s);
+typedef struct GC_sourceLabel {
+ pointer label;
+ uint32_t sourceSeqsIndex;
+} *GC_sourceLabel;
-// void GC_profileFree (GC_state s, GC_profile p);
-void GC_profileInc (GC_state s, size_t bytes);
+/* If profileStack, then there is one struct GC_profileStack for each
+ * function.
+ */
+typedef struct GC_profileStack {
+ /* ticks counts ticks while the function was on the stack. */
+ uintmax_t ticks;
+ /* ticksInGC counts ticks in GC while the function was on the stack. */
+ uintmax_t ticksInGC;
+ /* lastTotal is the value of total when the oldest occurrence of f
+ * on the stack was pushed, i.e., the most recent time that
+ * numTimesOnStack changed from 0 to 1. lastTotal is used to
+ * compute the amount to attribute to f when the oldest occurrence
+ * is finally popped.
+ */
+ uintmax_t lastTotal;
+ /* lastTotalGC is like lastTotal, but for GC ticks. */
+ uintmax_t lastTotalGC;
+ /* numOccurrences is the number of times this function is on the
+ * stack.
+ */
+ uintmax_t numOccurrences;
+} *GC_profileStack;
-void GC_profileLeave (GC_state s);
-
-// GC_profile GC_profileNew (GC_state s);
-
-// void GC_profileWrite (GC_state s, GC_profile p, int fd);
+/* GC_profile is used for both time and allocation profiling.
+ * In the comments below, "ticks" mean clock ticks with time profiling and
+ * bytes allocated with allocation profiling.
+ *
+ * All of the arrays in GC_profile are of length sourcesSize + sourceNamesSize.
+ * The first sourceSizes entries are for handling the duplicate copies of
+ * functions, and the next sourceNamesSize entries are for the master versions.
+ */
+typedef struct GC_profile {
+ /* countTop is an array that counts for each function the number of
+ * ticks that occurred while the function was on top of the stack.
+ */
+ uintmax_t *countTop;
+ /* stack is an array that gives stack info for each function. It is
+ * only used if profileStack.
+ */
+ struct GC_profileStack *stack;
+ /* The total number of mutator ticks. */
+ uintmax_t total;
+ /* The total number of GC ticks. */
+ uintmax_t totalGC;
+} *GC_profile;
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -0,0 +1,95 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+typedef enum {
+ PROFILE_ALLOC,
+ PROFILE_COUNT,
+ PROFILE_NONE,
+ PROFILE_TIME,
+} GC_profileKind;
+
+typedef struct GC_source {
+ uint32_t nameIndex;
+ uint32_t successorsIndex;
+} *GC_source;
+
+typedef struct GC_sourceLabel {
+ pointer label;
+ uint32_t sourceSeqsIndex;
+} *GC_sourceLabel;
+
+
+/* If profileStack, then there is one struct GC_profileStack for each
+ * function.
+ */
+typedef struct GC_profileStack {
+ /* ticks counts ticks while the function was on the stack. */
+ uintmax_t ticks;
+ /* ticksInGC counts ticks in GC while the function was on the stack. */
+ uintmax_t ticksInGC;
+ /* lastTotal is the value of total when the oldest occurrence of f
+ * on the stack was pushed, i.e., the most recent time that
+ * numTimesOnStack changed from 0 to 1. lastTotal is used to
+ * compute the amount to attribute to f when the oldest occurrence
+ * is finally popped.
+ */
+ uintmax_t lastTotal;
+ /* lastTotalGC is like lastTotal, but for GC ticks. */
+ uintmax_t lastTotalGC;
+ /* numOccurrences is the number of times this function is on the
+ * stack.
+ */
+ uintmax_t numOccurrences;
+} *GC_profileStack;
+
+/* GC_profile is used for both time and allocation profiling.
+ * In the comments below, "ticks" mean clock ticks with time profiling and
+ * bytes allocated with allocation profiling.
+ *
+ * All of the arrays in GC_profile are of length sourcesSize + sourceNamesSize.
+ * The first sourceSizes entries are for handling the duplicate copies of
+ * functions, and the next sourceNamesSize entries are for the master versions.
+ */
+typedef struct GC_profile {
+ /* countTop is an array that counts for each function the number of
+ * ticks that occurred while the function was on top of the stack.
+ */
+ uintmax_t *countTop;
+ /* stack is an array that gives stack info for each function. It is
+ * only used if profileStack.
+ */
+ struct GC_profileStack *stack;
+ /* The total number of mutator ticks. */
+ uintmax_t total;
+ /* The total number of GC ticks. */
+ uintmax_t totalGC;
+} *GC_profile;
+
+struct GC_profilingInfo {
+ bool isOn;
+ GC_profile profile;
+ GC_profileKind kind;
+ bool stack;
+};
+
+
+void GC_profileAllocInc (GC_state s, size_t bytes);
+
+void GC_profileDone (GC_state s);
+
+void GC_profileEnter (GC_state s);
+
+void GC_profileFree (GC_state s, GC_profile p);
+
+void GC_profileInc (GC_state s, size_t bytes);
+
+void GC_profileLeave (GC_state s);
+
+GC_profile GC_profileNew (GC_state s);
+
+void GC_profileWrite (GC_state s, GC_profile p, int fd);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -14,6 +14,7 @@
/* Minimum live ratio to use copying GC. */
float copy;
float grow;
+ float hashCons;
/* Desired ratio of heap size to live data. */
float live;
/* Minimum live ratio to us mark-compact GC. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c 2005-10-19 01:28:35 UTC (rev 4114)
@@ -77,7 +77,7 @@
getrusage (RUSAGE_SELF, ru_start);
}
-static uint stopTiming (struct rusage *ru_start, struct rusage *ru_gc) {
+static uintmax_t stopTiming (struct rusage *ru_start, struct rusage *ru_gc) {
struct rusage ru_finish, ru_total;
getrusage (RUSAGE_SELF, &ru_finish);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h (from rev 4113, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -0,0 +1,24 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+struct GC_signalsInfo {
+ bool amInSignalHandler; /* TRUE iff a signal handler is running. */
+ bool gcSignalHandled;
+ bool gcSignalPending;
+ volatile bool signalIsPending; /* TRUE iff a signal has been received
+ * but not handled by the mutator.
+ */
+ /* signalsHandled is the set of signals for which a mutator signal
+ * handler needs to run in order to handle the signal.
+ */
+ sigset_t signalsHandled;
+ /* The signals that have been recieved but not processed by the mutator
+ * signal handler.
+ */
+ sigset_t signalsPending;
+};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -29,6 +29,7 @@
uintmax_t numMarkCompactGCs;
uintmax_t numMinorGCs;
+ uintmax_t maxPause;
struct rusage ru_gc; /* total resource usage spent in gc */
struct rusage ru_gcCopy; /* resource usage in major copying gcs. */
struct rusage ru_gcMarkCompact; /* resource usage in mark-compact gcs. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h 2005-10-18 17:12:55 UTC (rev 4113)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h 2005-10-19 01:28:35 UTC (rev 4114)
@@ -21,5 +21,3 @@
*/
objptr stack; /* The stack for this thread. */
} *GC_thread;
-
-#define BOGUS_THREAD (GC_thread)BOGUS_POINTER
|
|
From: Stephen W. <sw...@ml...> - 2005-10-18 10:12:58
|
Another patch from John Reppy for OpenGL. This one makes sure that
glutInit gets called.
----------------------------------------------------------------------
U mlton/trunk/lib/opengl/atom.sml
U mlton/trunk/lib/opengl/hello.sml
U mlton/trunk/lib/opengl/points.sml
U mlton/trunk/lib/opengl/shortest.sml
U mlton/trunk/lib/opengl/solar.sml
U mlton/trunk/lib/opengl/spin_cube.sml
U mlton/trunk/lib/opengl/triangle.sml
----------------------------------------------------------------------
Modified: mlton/trunk/lib/opengl/atom.sml
===================================================================
--- mlton/trunk/lib/opengl/atom.sml 2005-10-18 05:44:47 UTC (rev 4112)
+++ mlton/trunk/lib/opengl/atom.sml 2005-10-18 17:12:55 UTC (rev 4113)
@@ -43,7 +43,7 @@
fun initialise () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGBA);
glutInitWindowPosition 100 100;
glutInitWindowSize 250 250;
Modified: mlton/trunk/lib/opengl/hello.sml
===================================================================
--- mlton/trunk/lib/opengl/hello.sml 2005-10-18 05:44:47 UTC (rev 4112)
+++ mlton/trunk/lib/opengl/hello.sml 2005-10-18 17:12:55 UTC (rev 4113)
@@ -64,7 +64,7 @@
fun main () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_SINGLE + GLUT_RGB);
glutInitWindowSize 200 200;
glutCreateWindow "Font Test";
Modified: mlton/trunk/lib/opengl/points.sml
===================================================================
--- mlton/trunk/lib/opengl/points.sml 2005-10-18 05:44:47 UTC (rev 4112)
+++ mlton/trunk/lib/opengl/points.sml 2005-10-18 17:12:55 UTC (rev 4113)
@@ -86,6 +86,7 @@
fun main () =
(
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGBA);
glutInitWindowSize 400 400;
glutCreateWindow "Animating rectangle";
@@ -101,4 +102,4 @@
val _ = main();
-
\ No newline at end of file
+
Modified: mlton/trunk/lib/opengl/shortest.sml
===================================================================
--- mlton/trunk/lib/opengl/shortest.sml 2005-10-18 05:44:47 UTC (rev 4112)
+++ mlton/trunk/lib/opengl/shortest.sml 2005-10-18 17:12:55 UTC (rev 4113)
@@ -9,7 +9,7 @@
fun main () =
(
- glutInit;
+ glutInit();
glutCreateWindow "Short Test";
glutDisplayFunc display;
print("Click the close icon to close the window.");
Modified: mlton/trunk/lib/opengl/solar.sml
===================================================================
--- mlton/trunk/lib/opengl/solar.sml 2005-10-18 05:44:47 UTC (rev 4112)
+++ mlton/trunk/lib/opengl/solar.sml 2005-10-18 17:12:55 UTC (rev 4113)
@@ -29,7 +29,7 @@
fun initialise () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGB);
glutInitWindowSize 200 200;
glutCreateWindow "Solar";
Modified: mlton/trunk/lib/opengl/spin_cube.sml
===================================================================
--- mlton/trunk/lib/opengl/spin_cube.sml 2005-10-18 05:44:47 UTC (rev 4112)
+++ mlton/trunk/lib/opengl/spin_cube.sml 2005-10-18 17:12:55 UTC (rev 4113)
@@ -42,7 +42,7 @@
fun initialise () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE+GLUT_RGB);
glutInitWindowSize 400 400;
glutCreateWindow "Spinning Cube";
Modified: mlton/trunk/lib/opengl/triangle.sml
===================================================================
--- mlton/trunk/lib/opengl/triangle.sml 2005-10-18 05:44:47 UTC (rev 4112)
+++ mlton/trunk/lib/opengl/triangle.sml 2005-10-18 17:12:55 UTC (rev 4113)
@@ -43,6 +43,7 @@
fun initialise () =
(
+ glutInit ();
glutInitDisplayMode(GLUT_DOUBLE + GLUT_RGBA);
glutInitWindowPosition 100 100;
glutInitWindowSize 250 250;
@@ -201,4 +202,4 @@
val _ = main();
-
\ No newline at end of file
+
|
|
From: Stephen W. <sw...@ml...> - 2005-10-17 22:44:49
|
Applied patch from John Reppy for Mac OS.
Caught up with changes to MLB annotations and _export.
----------------------------------------------------------------------
U mlton/trunk/lib/opengl/GLUT.sml
U mlton/trunk/lib/opengl/GLUT_c.c
U mlton/trunk/lib/opengl/GLU_c.c
U mlton/trunk/lib/opengl/GL_c.c
U mlton/trunk/lib/opengl/Makefile
A mlton/trunk/lib/opengl/platform.h
----------------------------------------------------------------------
Modified: mlton/trunk/lib/opengl/GLUT.sml
===================================================================
--- mlton/trunk/lib/opengl/GLUT.sml 2005-10-17 00:44:33 UTC (rev 4111)
+++ mlton/trunk/lib/opengl/GLUT.sml 2005-10-18 05:44:47 UTC (rev 4112)
@@ -243,35 +243,35 @@
(* Create Menu callback *)
- val gCreateMenuFA = _export "glutCreateMenuArgument": int -> unit;
+ val gCreateMenuFA = _export "glutCreateMenuArgument": (int -> unit) -> unit;
val callGCreateMenuF = _import "callGlutCreateMenu": unit -> int;
(* Display function callback *)
- val gDisplayFA = _export "glutDisplayFuncArgument": unit -> unit;
+ val gDisplayFA = _export "glutDisplayFuncArgument": (unit -> unit) -> unit;
val callGDisplayF = _import "callGlutDisplayFunc": unit -> unit;
(* Idle function callback *)
- val gIdleFA = _export "glutIdleFuncArgument": unit -> unit;
+ val gIdleFA = _export "glutIdleFuncArgument": (unit -> unit) -> unit;
val callGIdleF = _import "callGlutIdleFunc": unit -> unit;
(* Reshape function callback *)
- val gReshapeFA = _export "glutReshapeFuncArgument": int * int -> unit;
+ val gReshapeFA = _export "glutReshapeFuncArgument": (int * int -> unit) -> unit;
val callGReshapeF = _import "callGlutReshapeFunc": unit -> unit;
(* Keyboard function callback *)
- val gKbdFA = _export "glutKeyboardFuncArgument": char * int * int -> unit;
+ val gKbdFA = _export "glutKeyboardFuncArgument": (char * int * int -> unit) -> unit;
val callGKbdF = _import "callGlutKeyboardFunc": unit -> unit;
(* Mouse function callback *)
- val gMouseFA = _export "glutMouseFuncArgument": GLenum * GLenum * int * int -> unit;
+ val gMouseFA = _export "glutMouseFuncArgument": (GLenum * GLenum * int * int -> unit) -> unit;
val callGMouseF = _import "callGlutMouseFunc": unit -> unit;
(* Special function callback *)
- val gSpecFA = _export "glutSpecialFuncArgument": int * int * int -> unit;
+ val gSpecFA = _export "glutSpecialFuncArgument": (int * int * int -> unit) -> unit;
val callGSpecF = _import "callGlutSpecialFunc": unit -> unit;
(* Visibility function callback *)
- val gVisibilityFA = _export "glutVisibilityFuncArgument": Word32.word -> unit;
+ val gVisibilityFA = _export "glutVisibilityFuncArgument": (Word32.word -> unit) -> unit;
val callGVisibilityF = _import "callGlutVisibilityFunc": unit -> unit;
Modified: mlton/trunk/lib/opengl/GLUT_c.c
===================================================================
--- mlton/trunk/lib/opengl/GLUT_c.c 2005-10-17 00:44:33 UTC (rev 4111)
+++ mlton/trunk/lib/opengl/GLUT_c.c 2005-10-18 05:44:47 UTC (rev 4112)
@@ -1,6 +1,5 @@
/* Glut-export.c */
-#include <GL/gl.h>
-#include <GL/glut.h>
+#include "platform.h"
#include "GLUT_h.h"
int callGlutCreateMenu ()
Modified: mlton/trunk/lib/opengl/GLU_c.c
===================================================================
--- mlton/trunk/lib/opengl/GLU_c.c 2005-10-17 00:44:33 UTC (rev 4111)
+++ mlton/trunk/lib/opengl/GLU_c.c 2005-10-18 05:44:47 UTC (rev 4112)
@@ -1,5 +1,5 @@
/* GLU-export.c */
-#include <GL/glu.h>
+#include "platform.h"
#include "GLU_h.h"
Modified: mlton/trunk/lib/opengl/GL_c.c
===================================================================
--- mlton/trunk/lib/opengl/GL_c.c 2005-10-17 00:44:33 UTC (rev 4111)
+++ mlton/trunk/lib/opengl/GL_c.c 2005-10-18 05:44:47 UTC (rev 4112)
@@ -1,5 +1,5 @@
/* Gl-export.c */
-#include <GL/gl.h>
+#include "platform.h"
#include "GL_h.h"
Modified: mlton/trunk/lib/opengl/Makefile
===================================================================
--- mlton/trunk/lib/opengl/Makefile 2005-10-17 00:44:33 UTC (rev 4111)
+++ mlton/trunk/lib/opengl/Makefile 2005-10-18 05:44:47 UTC (rev 4112)
@@ -1,8 +1,8 @@
mlton = mlton
MLTON_FLAGS = \
- -default-ann 'allowExport true' \
- -default-ann 'allowImport true' \
+ -default-ann 'allowFFI true' \
-target-link-opt cygwin '-L/lib/w32api -lglut32 -lglu32 -lopengl32' \
+ -target-link-opt darwin '-framework GLUT -framework OpenGL -framework Foundation' \
-target-link-opt linux '-lglut -lGLU -lGL'
GL_OBJS = GL_c.o GLUT_c.o
Added: mlton/trunk/lib/opengl/platform.h
===================================================================
--- mlton/trunk/lib/opengl/platform.h 2005-10-17 00:44:33 UTC (rev 4111)
+++ mlton/trunk/lib/opengl/platform.h 2005-10-18 05:44:47 UTC (rev 4112)
@@ -0,0 +1,9 @@
+#if defined(__APPLE__) && defined(__MACH__)
+#include <GLUT/glut.h>
+#include <OpenGL/gl.h>
+#include <OpenGL/glu.h>
+#else
+#include <GL/gl.h>
+#include <GL/glu.h>
+#include <GL/glut.h>
+#endif
|
|
From: Matthew F. <fl...@ml...> - 2005-10-16 17:44:43
|
More heap manipulations
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-16 23:34:20 UTC (rev 4110)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-17 00:44:33 UTC (rev 4111)
@@ -75,10 +75,10 @@
gc_prefix.c \
util.c \
safe.c \
+ rusage.c \
debug.c \
align.c \
virtual-memory.c \
- rusage.c \
pointer_predicates.c \
pointer.c \
model_predicates.c \
@@ -95,11 +95,11 @@
generational.c \
heap_predicates.c \
heap.c \
- gc_state.c \
+ current.c \
new_object.c \
ratios_predicates.c \
- current.c \
atomic.c \
+ gc_state.c \
invariant.c \
enter_leave.c \
cheney-copy.c \
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-16 23:34:20 UTC (rev 4110)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-17 00:44:33 UTC (rev 4111)
@@ -339,7 +339,7 @@
fprintf (stderr, "Forwarding inter-generational pointers done.\n");
}
-static void minorGC (GC_state s) {
+static void minorCheneyCopyGC (GC_state s) {
size_t bytesAllocated;
size_t bytesCopied;
struct rusage ru_start;
@@ -357,7 +357,7 @@
bytesCopied = 0;
} else {
if (DEBUG_GENERATIONAL or s->controls.messages)
- fprintf (stderr, "Minor GC.\n");
+ fprintf (stderr, "Minor copying GC.\n");
if (detailedGCTime (s))
startTiming (&ru_start);
s->amInMinorGC = TRUE;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-10-16 23:34:20 UTC (rev 4110)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-10-17 00:44:33 UTC (rev 4111)
@@ -29,6 +29,8 @@
return s->stackTop - s->stackBottom;
}
+
+
static void setCurrentStack (GC_state s) {
GC_thread thread;
GC_stack stack;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-16 23:34:20 UTC (rev 4110)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-17 00:44:33 UTC (rev 4111)
@@ -405,3 +405,58 @@
assert (heapHasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
}
+/* heapResize (s, minSize)
+ */
+static void heapResize (GC_state s, size_t minSize) {
+ size_t desiredSize;
+
+ if (DEBUG_RESIZING)
+ fprintf (stderr, "heapResize minSize = %zu size = %zu\n",
+ /*ullongToCommaString*/(minSize),
+ /*uintToCommaString*/(s->heap.size));
+ desiredSize = heapDesiredSize (s, minSize, s->heap.size);
+ assert (minSize <= desiredSize);
+ if (desiredSize <= s->heap.size)
+ heapShrink (s, &s->heap, desiredSize);
+ else {
+ heapRelease (s, &s->secondaryHeap);
+ heapGrow (s, desiredSize, minSize);
+ }
+ resizeCardMapAndCrossMap (s);
+ assert (s->heap.size >= minSize);
+}
+
+/* secondaryHeapResize (s)
+ */
+static void secondaryHeapResize (GC_state s) {
+ size_t primarySize;
+ size_t secondarySize;
+
+ primarySize = s->heap.size;
+ secondarySize = s->secondaryHeap.size;
+ if (DEBUG_RESIZING)
+ fprintf (stderr, "secondaryHeapResize\n");
+ if (0 == secondarySize)
+ return;
+ if (2 * primarySize > s->sysvals.ram)
+ /* Holding on to heap2 might cause paging. So don't. */
+ heapRelease (s, &s->secondaryHeap);
+ else if (secondarySize < primarySize) {
+ unless (heapRemap (s, &s->secondaryHeap, primarySize, primarySize))
+ heapRelease (s, &s->secondaryHeap);
+ } else if (secondarySize > primarySize)
+ heapShrink (s, &s->secondaryHeap, primarySize);
+ assert (0 == s->secondaryHeap.size
+ or s->heap.size == s->secondaryHeap.size);
+}
+
+/* secondaryHeapCreate (s, desiredSize)
+ */
+static bool secondaryHeapCreate (GC_state s, size_t desiredSize) {
+ if ((s->controls.fixedHeap > 0
+ and s->heap.size + desiredSize > s->controls.fixedHeap)
+ or (s->controls.maxHeap > 0
+ and s->heap.size + desiredSize > s->controls.maxHeap))
+ return FALSE;
+ return heapCreate (s, &s->secondaryHeap, desiredSize, s->heap.oldGenSize);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c 2005-10-16 23:34:20 UTC (rev 4110)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c 2005-10-17 00:44:33 UTC (rev 4111)
@@ -55,7 +55,7 @@
if (reserved > s->cumulativeStatistics.maxStackSizeSeen)
s->cumulativeStatistics.maxStackSizeSeen = reserved;
stack = (GC_stack) newObject (s, GC_STACK_HEADER,
- stackNumBytes (s, reserved),
+ stackSizeTotalAligned (s, reserved),
allocInOldGen);
stack->reserved = reserved;
stack->used = 0;
@@ -65,3 +65,23 @@
reserved);
return stack;
}
+
+static inline size_t stackGrowSize (GC_state s) {
+ return max (2 * currentThreadStack(s)->reserved,
+ stackMinimumReserved (s, currentThreadStack(s)));
+}
+
+static void stackGrow (GC_state s) {
+ size_t size;
+ GC_stack stack;
+
+ size = stackGrowSize (s);
+ if (DEBUG_STACKS or s->controls.messages)
+ fprintf (stderr, "Growing stack to size %zu.\n",
+ /*uintToCommaString*/(stackSizeTotalAligned (s, size)));
+ assert (heapHasBytesFree (s, stackSizeTotalAligned (s, size), 0));
+ stack = newStack (s, size, TRUE);
+ stackCopy (s, currentThreadStack(s), stack);
+ currentThread(s)->stack = pointerToObjptr ((pointer)stack, s->heap.start);
+ markCard (s, objptrToPointer (currentThreadObjptr(s), s->heap.start));
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c 2005-10-16 23:34:20 UTC (rev 4110)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c 2005-10-17 00:44:33 UTC (rev 4111)
@@ -20,6 +20,17 @@
}
}
+static inline size_t normalSizeNoHeader (__attribute__ ((unused)) GC_state s,
+ uint16_t numNonObjptrs,
+ uint16_t numObjptrs) {
+ size_t result;
+
+ result =
+ numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ return result;
+}
+
static inline size_t arraySizeNoHeader (GC_state s,
pointer p,
uint16_t numNonObjptrs,
@@ -39,6 +50,25 @@
return pad (s, result, GC_ARRAY_HEADER_SIZE);
}
+static inline size_t weakSizeNoHeader (__attribute__ ((unused)) GC_state s,
+ uint16_t numNonObjptrs,
+ uint16_t numObjptrs) {
+ size_t result;
+
+ result =
+ numNonObjptrsToBytes (numNonObjptrs, WEAK_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ return result;
+}
+
+static inline size_t stackSizeNoHeader (__attribute__ ((unused)) GC_state s,
+ pointer p) {
+ size_t result;
+
+ result = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+ return result;
+}
+
static inline size_t objectSize (GC_state s, pointer p) {
size_t headerBytes, objectBytes;
GC_header header;
@@ -47,34 +77,19 @@
header = getHeader (p);
splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
- if (NORMAL_TAG == tag) { /* Fixed size object. */
+ if (NORMAL_TAG == tag) {
headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes =
- numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
- + (numObjptrs * OBJPTR_SIZE);
+ objectBytes = normalSizeNoHeader (s, numNonObjptrs, numObjptrs);
} else if (ARRAY_TAG == tag) {
headerBytes = GC_ARRAY_HEADER_SIZE;
objectBytes = arraySizeNoHeader (s, p, numNonObjptrs, numObjptrs);
} else if (WEAK_TAG == tag) {
headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes =
- numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
- + (numObjptrs * OBJPTR_SIZE);
+ objectBytes = weakSizeNoHeader (s, numNonObjptrs, numObjptrs);
} else { /* Stack. */
assert (STACK_TAG == tag);
headerBytes = GC_STACK_HEADER_SIZE;
- objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+ objectBytes = stackSizeNoHeader (s, p);
}
return headerBytes + objectBytes;
}
-
-
-static inline size_t stackNumBytes (GC_state s, size_t size) {
- size_t res;
-
- res = align (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + size,
- s->alignment);
- if (DEBUG_STACKS)
- fprintf (stderr, "%zu = stackNumBytes (%zu)\n", res, size);
- return res;
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-10-16 23:34:20 UTC (rev 4110)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-10-17 00:44:33 UTC (rev 4111)
@@ -96,3 +96,13 @@
from->used);
GC_memcpy (fromBottom, toBottom, from->used);
}
+
+static inline size_t stackSizeTotalAligned (GC_state s, size_t reserved) {
+ size_t res;
+
+ res = align (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved,
+ s->alignment);
+ if (DEBUG_STACKS)
+ fprintf (stderr, "%zu = stackSizeTotalAligned (%zu)\n", res, reserved);
+ return res;
+}
|
