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: Matthew F. <fl...@ml...> - 2005-10-16 16:34:24
|
More heap manipulation functions
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.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-16 22:05:00 UTC (rev 4109)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-16 23:34:20 UTC (rev 4110)
@@ -74,6 +74,7 @@
CFILES = \
gc_prefix.c \
util.c \
+ safe.c \
debug.c \
align.c \
virtual-memory.c \
@@ -89,6 +90,8 @@
stack_predicates.c \
stack.c \
thread.c \
+ foreach.c \
+ translate.c \
generational.c \
heap_predicates.c \
heap.c \
@@ -96,7 +99,6 @@
new_object.c \
ratios_predicates.c \
current.c \
- foreach.c \
atomic.c \
invariant.c \
enter_leave.c \
@@ -105,7 +107,6 @@
dfs-mark.c \
share.c \
mark-compact.c \
- translate.c \
assumptions.c \
gc_suffix.c
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 22:05:00 UTC (rev 4109)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-16 23:34:20 UTC (rev 4110)
@@ -127,8 +127,140 @@
return FALSE;
}
+/* heapRemap (s, h, desiredSize, minSize)
+ */
+static bool heapRemap (GC_state s, GC_heap h,
+ size_t desiredSize,
+ size_t minSize) {
+ size_t backoff;
+ size_t size;
+#if not HAS_REMAP
+ return FALSE;
+#endif
+ assert (minSize <= desiredSize);
+ assert (desiredSize >= h->size);
+ desiredSize = align (desiredSize, s->sysvals.pageSize);
+ backoff = (desiredSize - minSize) / 20;
+ if (0 == backoff)
+ backoff = 1; /* enough to terminate the loop below */
+ backoff = align (backoff, s->sysvals.pageSize);
+ for (size = desiredSize; size >= minSize; size -= backoff) {
+ pointer new;
+ new = GC_mremap (h->start, h->size, size);
+ unless ((void*)-1 == new) {
+ h->start = new;
+ h->size = size;
+ if (h->size > s->cumulativeStatistics.maxHeapSizeSeen)
+ s->cumulativeStatistics.maxHeapSizeSeen = h->size;
+ assert (minSize <= h->size and h->size <= desiredSize);
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
+enum {
+ COPY_CHUNK_SIZE = 0x2000000, /* 32M */
+};
+
+/* heapGrow (s, desiredSize, minSize)
+ */
+static void heapGrow (GC_state s, size_t desiredSize, size_t minSize) {
+ GC_heap curHeapp;
+ struct GC_heap newHeap;
+
+ pointer orig;
+ size_t size;
+
+ curHeapp = &s->heap;
+ assert (desiredSize >= s->heap.size);
+ if (DEBUG_RESIZING)
+ fprintf (stderr, "Growing heap at "FMTPTR" of size %zu to %zu bytes.\n",
+ (uintptr_t)s->heap.start,
+ /*uintToCommaString*/(s->heap.size),
+ /*uintToCommaString*/(desiredSize));
+ orig = curHeapp->start;
+ size = curHeapp->oldGenSize;
+ assert (size <= s->heap.size);
+ if (heapRemap (s, curHeapp, desiredSize, minSize))
+ goto done;
+ heapShrink (s, curHeapp, size);
+ heapInit (&newHeap);
+ /* Allocate a space of the desired size. */
+ if (heapCreate (s, &newHeap, desiredSize, minSize)) {
+ pointer from;
+ pointer to;
+ size_t remaining;
+
+ from = curHeapp->start + size;
+ to = newHeap.start + size;
+ remaining = size;
+copy:
+ assert (remaining == (size_t)(from - curHeapp->start)
+ and from >= curHeapp->start
+ and to >= newHeap.start);
+ if (remaining < COPY_CHUNK_SIZE) {
+ GC_memcpy (orig, newHeap.start, remaining);
+ } else {
+ remaining -= COPY_CHUNK_SIZE;
+ from -= COPY_CHUNK_SIZE;
+ to -= COPY_CHUNK_SIZE;
+ GC_memcpy (from, to, COPY_CHUNK_SIZE);
+ heapShrink (s, curHeapp, remaining);
+ goto copy;
+ }
+ heapRelease (s, curHeapp);
+ *curHeapp = newHeap;
+ } else {
+ /* Write the heap to a file and try again. */
+ int fd;
+ FILE *stream;
+ char template[80];
+ char *tmpDefault;
+ char *tmpDir;
+ char *tmpVar;
+
+#if (defined (__MSVCRT__))
+ tmpVar = "TEMP";
+ tmpDefault = "C:/WINNT/TEMP";
+#else
+ tmpVar = "TMPDIR";
+ tmpDefault = "/tmp";
+#endif
+ tmpDir = getenv (tmpVar);
+ strcpy (template, (NULL == tmpDir) ? tmpDefault : tmpDir);
+ strcat (template, "/FromSpaceXXXXXX");
+ fd = mkstemp_safe (template);
+ close_safe (fd);
+ 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);
+ heapRelease (s, curHeapp);
+ if (heapCreate (s, curHeapp, desiredSize, minSize)) {
+ stream = fopen_safe (template, "rb");
+ fread_safe (curHeapp->start, 1, size, stream);
+ fclose_safe (stream);
+ unlink_safe (template);
+ } else {
+ unlink_safe (template);
+ if (s->controls.messages)
+ showMem ();
+ die ("Out of memory. Unable to allocate %zu bytes.\n",
+ /*uintToCommaString*/(minSize));
+ }
+ }
+done:
+ unless (orig == s->heap.start) {
+ translateHeap (s, orig, s->heap.start, s->heap.oldGenSize);
+ setCardMapAbsolute (s);
+ }
+}
+
/* heapDesiredSize (s, l, cs)
*
* returns the desired heap size for a heap with l bytes live, given
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c 2005-10-16 22:05:00 UTC (rev 4109)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/safe.c 2005-10-16 23:34:20 UTC (rev 4110)
@@ -0,0 +1,94 @@
+/* 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 *calloc_safe (size_t count, size_t size) {
+ void *res;
+
+ res = calloc (count, size);
+ if (NULL == res)
+ die ("calloc (%zu, %zu) failed.\n",
+ count, size);
+ return res;
+}
+
+void *malloc_safe (size_t size) {
+ void *res;
+
+ res = malloc (size);
+ if (NULL == res)
+ die ("malloc (%zu) failed.\n", size);
+ return res;
+}
+
+int mkstemp_safe (char *template) {
+ int fd;
+
+ fd = mkstemp (template);
+ if (-1 == fd)
+ diee ("mkstemp (%s) failed.\n", template);
+ return fd;
+}
+
+void close_safe (int fd) {
+ int res;
+
+ res = close (fd);
+ if (-1 == res)
+ diee ("close (%d) failed.\n", fd);
+ return;
+}
+
+FILE *fopen_safe (char *fileName, char *mode) {
+ FILE *file;
+
+ file = fopen (fileName, mode);
+ if (NULL == file)
+ diee ("fopen (%s) failed.\n", fileName);
+ return file;
+}
+
+void fwrite_safe (const void *data, size_t size, size_t count, FILE *stream) {
+ size_t bytes;
+ size_t res;
+
+ bytes = size * count;
+ if (0 == bytes) return;
+ res = fwrite (data, bytes, 1, stream);
+ if (1 != res)
+ diee ("fwrite (_, _, _, _) failed.\n");
+ return;
+}
+
+void fclose_safe (FILE *stream) {
+ int res;
+
+ res = fclose (stream);
+ if (-1 == res)
+ diee ("fclose (_) failed.\n");
+ return;
+}
+
+void fread_safe (void *data, size_t size, size_t count, FILE *stream) {
+ size_t bytes;
+ size_t res;
+
+ bytes = size * count;
+ res = fread (data, bytes, 1, stream);
+ if (1 != res)
+ diee ("fread (_, _, _, _) failed.\n");
+ return;
+}
+
+void unlink_safe (const char *pathname) {
+ int res;
+
+ res = unlink (pathname);
+ if (-1 == res)
+ diee ("unlink (%s) failed.\n", pathname);
+ return;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.c 2005-10-16 22:05:00 UTC (rev 4109)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.c 2005-10-16 23:34:20 UTC (rev 4110)
@@ -31,7 +31,7 @@
pointer limit;
if (DEBUG or s->controls.messages)
- fprintf (stderr, "Translating heap of size %zd from "FMTPTR" to "FMTPTR".\n",
+ fprintf (stderr, "Translating heap of size %zu from "FMTPTR" to "FMTPTR".\n",
/*uintToCommaString*/(size),
(uintptr_t)from, (uintptr_t)to);
if (from == to)
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-16 22:05:00 UTC (rev 4109)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-16 23:34:20 UTC (rev 4110)
@@ -26,6 +26,7 @@
#include <stdio.h>
#include <string.h>
#include <math.h>
+#include <unistd.h>
#include <sys/resource.h>
#include "../assert.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-16 22:05:00 UTC (rev 4109)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c 2005-10-16 23:34:20 UTC (rev 4110)
@@ -29,22 +29,3 @@
}
return result;
}
-
-void *calloc_safe (size_t count, size_t size) {
- void *res;
-
- res = calloc (count, size);
- if (NULL == res)
- die ("calloc (%zu, %zu) failed.\n",
- count, size);
- return res;
-}
-
-void *malloc_safe (size_t size) {
- void *res;
-
- res = malloc (size);
- if (NULL == res)
- die ("malloc (%zu) failed.\n", size);
- return res;
-}
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-16 22:05:00 UTC (rev 4109)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-10-16 23:34:20 UTC (rev 4110)
@@ -14,5 +14,6 @@
void *GC_mmapAnon (void *start, size_t length);
void *GC_mmap (void *start, size_t length);
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);
void GC_decommit (void *base, size_t length);
|
|
From: Matthew F. <fl...@ml...> - 2005-10-16 15:05:05
|
translateHeap
----------------------------------------------------------------------
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/hash-cons.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.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 01:46:06 UTC (rev 4108)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-16 22:05:00 UTC (rev 4109)
@@ -105,6 +105,7 @@
dfs-mark.c \
share.c \
mark-compact.c \
+ translate.c \
assumptions.c \
gc_suffix.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 01:46:06 UTC (rev 4108)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-16 22:05:00 UTC (rev 4109)
@@ -38,7 +38,7 @@
return pointerIsInToSpace (p);
}
-static void forward (GC_state s, objptr *opp) {
+static void forwardObjptr (GC_state s, objptr *opp) {
objptr op;
pointer p;
GC_header header;
@@ -47,7 +47,7 @@
p = objptrToPointer (op, s->heap.start);
if (DEBUG_DETAILED)
fprintf (stderr,
- "forward opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
+ "forwardObjptr opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
(uintptr_t)opp, op, (uintptr_t)p);
assert (objptrIsInFromSpace (s, *opp));
header = getHeader (p);
@@ -213,8 +213,8 @@
assert (s->secondaryHeap.size >= s->heap.oldGenSize);
toStart = alignFrontier (s, s->secondaryHeap.start);
forwardState.back = toStart;
- foreachGlobalObjptr (s, forward);
- foreachObjptrInRange (s, toStart, &forwardState.back, TRUE, forward);
+ foreachGlobalObjptr (s, forwardObjptr);
+ foreachObjptrInRange (s, toStart, &forwardState.back, TRUE, forwardObjptr);
updateWeaks (s);
s->secondaryHeap.oldGenSize = forwardState.back - s->secondaryHeap.start;
s->cumulativeStatistics.bytesCopied += s->secondaryHeap.oldGenSize;
@@ -234,7 +234,7 @@
/* Minor Cheney Copying Collection */
/* ---------------------------------------------------------------- */
-static inline void forwardIfInNursery (GC_state s, objptr *opp) {
+static inline void forwardObjptrIfInNursery (GC_state s, objptr *opp) {
objptr op;
pointer p;
@@ -244,10 +244,10 @@
return;
if (DEBUG_GENERATIONAL)
fprintf (stderr,
- "forwardIfInNursery opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
+ "forwardObjptrIfInNursery opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
(uintptr_t)opp, op, (uintptr_t)p);
assert (s->heap.nursery <= p and p < s->limitPlusSlop);
- forward (s, opp);
+ forwardObjptr (s, opp);
}
/* Walk through all the cards and forward all intergenerational pointers. */
@@ -312,7 +312,7 @@
* weaks, since the weak pointer will never be into the nursery.
*/
objectStart = foreachObjptrInRange (s, objectStart, &cardEnd,
- FALSE, forwardIfInNursery);
+ FALSE, forwardObjptrIfInNursery);
s->cumulativeStatistics.minorBytesScanned += objectStart - lastObject;
if (objectStart == oldGenEnd)
goto done;
@@ -373,10 +373,10 @@
/* Forward all globals. Would like to avoid doing this once all
* the globals have been assigned.
*/
- foreachGlobalObjptr (s, forwardIfInNursery);
+ foreachGlobalObjptr (s, forwardObjptrIfInNursery);
forwardInterGenerationalObjptrs (s);
foreachObjptrInRange (s, forwardState.toStart, &forwardState.back,
- TRUE, forwardIfInNursery);
+ TRUE, forwardObjptrIfInNursery);
updateWeaks (s);
bytesCopied = forwardState.back - forwardState.toStart;
s->cumulativeStatistics.bytesCopiedMinor += bytesCopied;
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-16 01:46:06 UTC (rev 4108)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c 2005-10-16 22:05:00 UTC (rev 4109)
@@ -94,7 +94,8 @@
}
static inline pointer
-tableInsert (GC_state s, GC_objectHashTable t,
+tableInsert (__attribute__ ((unused)) GC_state s,
+ GC_objectHashTable t,
GC_hash hash, pointer object,
bool mightBeThere, GC_header header, GC_objectTypeTag tag, pointer max) {
static bool init = FALSE;
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.c (from rev 4108, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-10-16 01:46:06 UTC (rev 4108)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/translate.c 2005-10-16 22:05:00 UTC (rev 4109)
@@ -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.
+ */
+
+/* ---------------------------------------------------------------- */
+/* translateHeap */
+/* ---------------------------------------------------------------- */
+
+struct translateState {
+ pointer from;
+ pointer to;
+};
+static struct translateState translateState;
+
+static void translateObjptr (__attribute__ ((unused)) GC_state s,
+ objptr *opp) {
+ pointer p;
+
+ p = objptrToPointer (*opp, translateState.from);
+ p = (p - translateState.from) + translateState.to;
+ *opp = pointerToObjptr (p, translateState.to);
+}
+
+/* translateHeap (s, from, to, size)
+ */
+static void translateHeap (GC_state s, pointer from, pointer to, size_t size) {
+ pointer limit;
+
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr, "Translating heap of size %zd from "FMTPTR" to "FMTPTR".\n",
+ /*uintToCommaString*/(size),
+ (uintptr_t)from, (uintptr_t)to);
+ if (from == to)
+ return;
+ else {
+ translateState.from = from;
+ translateState.to = to;
+ }
+ /* Translate globals and heap. */
+ foreachGlobalObjptr (s, translateObjptr);
+ limit = to + size;
+ foreachObjptrInRange (s, alignFrontier (s, to), &limit, FALSE, translateObjptr);
+}
|
|
From: Matthew F. <fl...@ml...> - 2005-10-15 18:46:10
|
Very preliminary mark-compact code
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.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 00:47:35 UTC (rev 4107)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-16 01:46:06 UTC (rev 4108)
@@ -104,6 +104,7 @@
hash-cons.c \
dfs-mark.c \
share.c \
+ mark-compact.c \
assumptions.c \
gc_suffix.c
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-16 00:47:35 UTC (rev 4107)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-16 01:46:06 UTC (rev 4108)
@@ -16,6 +16,7 @@
struct GC_generationalMaps generationalMaps;
objptr *globals;
uint32_t globalsLength;
+ /*Bool*/bool hashConsDuringGC;
struct GC_heap heap;
struct GC_lastMajorStatistics lastMajorStatistics;
pointer limit; /* limit = heap.start + heap.totalBytes */
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-16 00:47:35 UTC (rev 4107)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-10-16 01:46:06 UTC (rev 4108)
@@ -10,273 +10,298 @@
/* Jonkers Mark-compact Collection */
/* ---------------------------------------------------------------- */
-static inline void markGlobalTrue (GC_state s, pointer *pp) {
- mark (s, *pp, MARK_MODE, TRUE);
+static inline void markGlobalTrue (GC_state s, objptr *opp) {
+ pointer p;
+
+ p = objptrToPointer (*opp, s->heap.start);
+ mark (s, p, MARK_MODE, TRUE);
}
-static inline void markGlobalFalse (GC_state s, pointer *pp) {
- mark (s, *pp, MARK_MODE, FALSE);
+static inline void markGlobalFalse (GC_state s, objptr *opp) {
+ pointer p;
+
+ p = objptrToPointer (*opp, s->heap.start);
+ mark (s, p, MARK_MODE, FALSE);
}
-static inline void unmarkGlobal (GC_state s, pointer *pp) {
- mark (s, *pp, UNMARK_MODE, FALSE);
+static inline void unmarkGlobal (GC_state s, objptr *opp) {
+ pointer p;
+
+ p = objptrToPointer (*opp, s->heap.start);
+ mark (s, p, UNMARK_MODE, FALSE);
}
-static inline void threadInternal (GC_state s, pointer *pp) {
- Header *headerp;
+static inline void threadInternal (GC_state s, objptr *opp) {
+ pointer p;
+ GC_header *headerp;
- 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;
+ 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);
}
-/* 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 inline void threadInternal (GC_state s, pointer *pp) { */
+/* Header *headerp; */
- headerp = GC_getHeaderp (p);
- header = *headerp;
- SPLIT_HEADER();
- if (WEAK_TAG == tag and 1 == numPointers) {
- Header h2;
+/* 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; */
+/* } */
- 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;
- }
- }
-}
+/* /\* 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 front;
- uint gap;
- pointer endOfLastMarked;
- Header header;
- Header *headerp;
- pointer p;
- uint 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->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;
+/* 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 == (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;
+/* static void updateForwardPointers (GC_state s) { */
+/* pointer back; */
+/* pointer front; */
+/* uint gap; */
+/* pointer endOfLastMarked; */
+/* Header header; */
+/* Header *headerp; */
+/* pointer p; */
+/* uint size; */
- cur = (pointer)header;
- header = *(word*)cur;
- *(word*)cur = (word)new;
- } while (0 == (1 & header));
- *headerp = header;
- goto thread;
- }
- assert (FALSE);
-done:
- return;
-}
+/* 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; */
-static void updateBackwardPointersAndSlide (GC_state s) {
- pointer back;
- pointer front;
- uint gap;
- Header header;
- pointer p;
- uint size;
+/* 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; */
- 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;
+/* cur = (pointer)header; */
+/* header = *(word*)cur; */
+/* *(word*)cur = (word)new; */
+/* } while (0 == (1 & header)); */
+/* *headerp = header; */
+/* goto thread; */
+/* } */
+/* assert (FALSE); */
+/* done: */
+/* return; */
+/* } */
- /* 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;
+/* static void updateBackwardPointersAndSlide (GC_state s) { */
+/* pointer back; */
+/* pointer front; */
+/* uint gap; */
+/* Header header; */
+/* pointer p; */
+/* uint size; */
- 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;
-}
+/* 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; */
-static void markCompact (GC_state s) {
- struct rusage ru_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; */
- if (DEBUG or s->messages)
- fprintf (stderr, "Major mark-compact GC.\n");
- if (detailedGCTime (s))
- startTiming (&ru_start);
- s->numMarkCompactGCs++;
- if (s->hashConsDuringGC) {
- s->bytesHashConsed = 0;
- s->numHashConsGCs++;
- s->objectHashTable = newTable (s);
- }
- foreachGlobal (s, s->hashConsDuringGC
- ? markGlobalTrue
- : markGlobalFalse);
- if (s->hashConsDuringGC)
- destroyTable (s->objectHashTable);
- foreachGlobal (s, threadInternal);
- updateForwardPointers (s);
- updateBackwardPointersAndSlide (s);
- clearCrossMap (s);
- s->bytesMarkCompacted += s->oldGenSize;
- s->lastMajor = GC_MARK_COMPACT;
- if (detailedGCTime (s))
- stopTiming (&ru_start, &s->ru_gcMarkCompact);
- if (DEBUG or s->messages) {
- fprintf (stderr, "Major mark-compact GC done.\n");
- if (s->hashConsDuringGC)
- bytesHashConsedMessage
- (s, s->bytesHashConsed + s->oldGenSize);
- }
+/* 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; */
+/* } */
+
+static void majorMarkCompactGC (GC_state s) {
+ struct rusage ru_start;
+
+ if (detailedGCTime (s))
+ startTiming (&ru_start);
+ s->cumulativeStatistics.numMarkCompactGCs++;
+ if (DEBUG or s->controls.messages) {
+ fprintf (stderr, "Major mark-compact GC.\n");
+ fprintf (stderr, "heap = "FMTPTR" of size %zu\n",
+ (uintptr_t) s->heap.start,
+ /*uintToCommaString*/(s->heap.size));
+ }
+ if (s->hashConsDuringGC) {
+ s->cumulativeStatistics.bytesHashConsed = 0;
+ s->cumulativeStatistics.numHashConsGCs++;
+ s->objectHashTable = newHashTable (s);
+ foreachGlobalObjptr (s, markGlobalTrue);
+ destroyHashTable (s->objectHashTable);
+ } else {
+ foreachGlobalObjptr (s, markGlobalFalse);
+ }
+/* foreachGlobal (s, threadInternal); */
+/* updateForwardPointers (s); */
+/* updateBackwardPointersAndSlide (s); */
+ clearCrossMap (s);
+ s->cumulativeStatistics.bytesMarkCompacted += s->heap.oldGenSize;
+ s->lastMajorStatistics.kind = GC_MARK_COMPACT;
+ if (detailedGCTime (s))
+ stopTiming (&ru_start, &s->cumulativeStatistics.ru_gcMarkCompact);
+ if (DEBUG or s->controls.messages) {
+ fprintf (stderr, "Major mark-compact GC done.\n");
+ if (s->hashConsDuringGC)
+ bytesHashConsedMessage(s,
+ s->cumulativeStatistics.bytesHashConsed
+ + s->heap.oldGenSize);
+ }
}
|
|
From: Matthew F. <fl...@ml...> - 2005-10-15 17:47:39
|
Hash consing and sharing
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
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
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.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
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-16 00:47:35 UTC (rev 4107)
@@ -101,7 +101,9 @@
invariant.c \
enter_leave.c \
cheney-copy.c \
+ hash-cons.c \
dfs-mark.c \
+ share.c \
assumptions.c \
gc_suffix.c
@@ -125,8 +127,8 @@
controls.h \
sysvals.h \
ratios.h \
+ hash-cons.h \
gc_state.h \
- hash-cons.h \
profile.h \
gc_suffix.h
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-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-16 00:47:35 UTC (rev 4107)
@@ -22,6 +22,7 @@
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
uint32_t maxFrameSize;
/*Bool*/bool mutatorMarksCards;
+ GC_objectHashTable objectHashTable;
GC_objectType *objectTypes; /* Array of object types. */
uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
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-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c 2005-10-16 00:47:35 UTC (rev 4107)
@@ -25,277 +25,282 @@
* we ensure by making it odd and keeping the table size as a power of 2.
*/
-static GC_ObjectHashTable newTable (GC_state s) {
- int i;
- uint maxElementsSize;
- pointer regionStart;
- pointer regionEnd;
- GC_ObjectHashTable t;
-
- NEW (GC_ObjectHashTable, t);
- // Try to use space in the heap for the elements.
- if (not (heapIsInit (&s->heap2))) {
- if (DEBUG_SHARE)
- fprintf (stderr, "using heap2\n");
- // We have all of heap2 available. Use it.
- regionStart = s->heap2.start;
- regionEnd = s->heap2.start + s->heap2.size;
- } else if (s->amInGC or not s->canMinor) {
- if (DEBUG_SHARE)
- fprintf (stderr, "using end of heap\n");
- regionStart = s->frontier;
- regionEnd = s->limitPlusSlop;
- } else {
- if (DEBUG_SHARE)
- fprintf (stderr, "using minor space\n");
- // Use the space available for a minor GC.
- assert (s->canMinor);
- regionStart = s->heap.start + s->oldGenSize;
- regionEnd = s->nursery;
- }
- maxElementsSize = (regionEnd - regionStart) / sizeof (*(t->elements));
- if (DEBUG_SHARE)
- fprintf (stderr, "maxElementsSize = %u\n", maxElementsSize);
- t->elementsSize = 64; // some small power of two
- t->log2ElementsSize = 6; // and its log base 2
- if (maxElementsSize < t->elementsSize) {
- if (DEBUG_SHARE)
- fprintf (stderr, "too small -- using malloc\n");
- t->elementsIsInHeap = FALSE;
- ARRAY (struct GC_ObjectHashElement *, t->elements, t->elementsSize);
- } else {
- t->elementsIsInHeap = TRUE;
- t->elements = (struct GC_ObjectHashElement*)regionStart;
- // Find the largest power of two that fits.
- for (; t->elementsSize <= maxElementsSize;
- t->elementsSize <<= 1, t->log2ElementsSize++)
- ; // nothing
- t->elementsSize >>= 1;
- t->log2ElementsSize--;
- assert (t->elementsSize <= maxElementsSize);
- for (i = 0; i < t->elementsSize; ++i)
- t->elements[i].object = NULL;
- }
- t->numElements = 0;
- t->mayInsert = TRUE;
- if (DEBUG_SHARE) {
- fprintf (stderr, "elementsIsInHeap = %s\n",
- boolToString (t->elementsIsInHeap));
- fprintf (stderr, "elementsSize = %u\n", t->elementsSize);
- fprintf (stderr, "0x%08x = newTable ()\n", (uint)t);
- }
- return t;
+static GC_objectHashTable newHashTable (GC_state s) {
+ uint32_t elementsLengthMax;
+ pointer regionStart;
+ pointer regionEnd;
+ GC_objectHashTable t;
+
+ t = (GC_objectHashTable)(malloc_safe (sizeof(*t)));
+ // Try to use space in the heap for the elements.
+ if (not (heapIsInit (&s->secondaryHeap))) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "using secondaryHeap\n");
+ regionStart = s->secondaryHeap.start;
+ regionEnd = s->secondaryHeap.start + s->secondaryHeap.size;
+ } else if (s->amInGC or not s->canMinor) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "using end of heap\n");
+ regionStart = s->frontier;
+ regionEnd = s->limitPlusSlop;
+ } else {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "using minor space\n");
+ assert (s->canMinor);
+ regionStart = s->heap.start + s->heap.oldGenSize;
+ regionEnd = s->heap.nursery;
+ }
+ elementsLengthMax = (regionEnd - regionStart) / sizeof (*(t->elements));
+ if (DEBUG_SHARE)
+ fprintf (stderr, "elementsLengthMax = %"PRIu32"\n", elementsLengthMax);
+ t->elementsLengthMax = 64; // some small power of two
+ t->elementsLengthMaxLog2 = 6; // and its log base 2
+ if (elementsLengthMax < t->elementsLengthMax) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "too small -- using malloc\n");
+ t->elementsIsInHeap = FALSE;
+ t->elements =
+ (struct GC_objectHashElement *)
+ (calloc_safe(t->elementsLengthMax, sizeof(*(t->elements))));
+ } else {
+ t->elementsIsInHeap = TRUE;
+ t->elements = (struct GC_objectHashElement*)regionStart;
+ // Find the largest power of two that fits.
+ for ( ;
+ t->elementsLengthMax <= elementsLengthMax;
+ t->elementsLengthMax <<= 1, t->elementsLengthMaxLog2++)
+ ; // nothing
+ t->elementsLengthMax >>= 1;
+ t->elementsLengthMaxLog2--;
+ assert (t->elementsLengthMax <= elementsLengthMax);
+ for (unsigned int i = 0; i < t->elementsLengthMax; ++i)
+ t->elements[i].object = NULL;
+ }
+ t->elementsLengthCur = 0;
+ t->mayInsert = TRUE;
+ if (DEBUG_SHARE) {
+ fprintf (stderr, "elementsIsInHeap = %s\n",
+ boolToString (t->elementsIsInHeap));
+ fprintf (stderr, "elementsLengthMax = %"PRIu32"\n", t->elementsLengthMax);
+ fprintf (stderr, FMTPTR" = newHashTable ()\n", (uintptr_t)t);
+ }
+ return t;
}
-static void destroyTable (GC_ObjectHashTable t) {
- unless (t->elementsIsInHeap)
- free (t->elements);
- free (t);
+static void destroyHashTable (GC_objectHashTable t) {
+ unless (t->elementsIsInHeap)
+ free (t->elements);
+ free (t);
}
-static inline Pointer tableInsert
- (GC_state s, GC_ObjectHashTable t, W32 hash, Pointer object,
- Bool mightBeThere, Header header, W32 tag, Pointer max) {
- GC_ObjectHashElement e;
- Header header2;
- static Bool init = FALSE;
- static int maxNumProbes = 0;
- static W64 mult; // magic multiplier for hashing
- int numProbes;
- W32 probe;
- word *p;
- word *p2;
- W32 slot; // slot in hash table we are considering
+static inline pointer
+tableInsert (GC_state s, GC_objectHashTable t,
+ GC_hash hash, pointer object,
+ bool mightBeThere, GC_header header, GC_objectTypeTag tag, pointer max) {
+ static bool init = FALSE;
+ static uint64_t mult; // magic multiplier for hashing
+ static uint32_t maxNumProbes = 0;
- if (DEBUG_SHARE)
- fprintf (stderr, "tableInsert (%u, 0x%08x, %s, 0x%08x, 0x%08x)\n",
- (uint)hash, (uint)object,
- boolToString (mightBeThere),
- (uint)header, (uint)max);
- if (! init) {
- init = TRUE;
- mult = floor (((sqrt (5.0) - 1.0) / 2.0)
- * (double)0x100000000llu);
- }
- slot = (W32)(mult * (W64)hash) >> (32 - t->log2ElementsSize);
- probe = (1 == slot % 2) ? slot : slot - 1;
- if (DEBUG_SHARE)
- fprintf (stderr, "probe = 0x%08x\n", (uint)probe);
- assert (1 == probe % 2);
- numProbes = 0;
+ GC_objectHashElement e;
+ uint32_t numProbes;
+ uint32_t probe;
+ uint32_t slot; // slot in the hash table we are considering
+ unsigned int *p1;
+ 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);
+ if (! init) {
+ init = TRUE;
+ mult = floor (((sqrt (5.0) - 1.0) / 2.0)
+ * (double)0x100000000llu);
+ }
+ slot = (uint32_t)(mult * (uint64_t)hash) >> (32 - t->elementsLengthMaxLog2);
+ probe = (1 == slot % 2) ? slot : slot - 1;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "probe = 0x%08x\n", (uint)probe);
+ assert (1 == probe % 2);
+ numProbes = 0;
look:
- if (DEBUG_SHARE)
- fprintf (stderr, "slot = 0x%08x\n", (uint)slot);
- assert (0 <= slot and slot < t->elementsSize);
- numProbes++;
- e = &t->elements[slot];
- if (NULL == e->object) {
- /* It's not in the table. Add it. */
- unless (t->mayInsert) {
- if (DEBUG_SHARE)
- fprintf (stderr, "not inserting\n");
- return object;
- }
- e->hash = hash;
- e->object = object;
- t->numElements++;
- if (numProbes > maxNumProbes) {
- maxNumProbes = numProbes;
- if (DEBUG_SHARE)
- fprintf (stderr, "numProbes = %d\n", numProbes);
- }
- return object;
- }
- unless (hash == e->hash) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "slot = 0x%"PRIx32"\n", slot);
+ assert (slot < t->elementsLengthMax);
+ numProbes++;
+ e = &t->elements[slot];
+ if (NULL == e->object) {
+ /* It's not in the table. Add it. */
+ unless (t->mayInsert) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "not inserting\n");
+ return object;
+ }
+ e->hash = hash;
+ e->object = object;
+ t->elementsLengthCur++;
+ if (numProbes > maxNumProbes) {
+ maxNumProbes = numProbes;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "numProbes = %"PRIu32"\n", numProbes);
+ }
+ return object;
+ }
+ unless (hash == e->hash) {
lookNext:
- slot = (slot + probe) % t->elementsSize;
- goto look;
- }
- unless (mightBeThere)
- goto lookNext;
- if (DEBUG_SHARE)
- fprintf (stderr, "comparing 0x%08x to 0x%08x\n",
- (uint)object, (uint)e->object);
- /* Compare object to e->object. */
- unless (object == e->object) {
- header2 = GC_getHeader (e->object);
- unless (header == header2)
- goto lookNext;
- for (p = (word*)object, p2 = (word*)e->object;
- p < (word*)max;
- ++p, ++p2)
- unless (*p == *p2)
- goto lookNext;
- if (ARRAY_TAG == tag
- and (GC_arrayNumElements (object)
- != GC_arrayNumElements (e->object)))
- goto lookNext;
- }
- /* object is equal to e->object. */
- return e->object;
+ slot = (slot + probe) % t->elementsLengthMax;
+ goto look;
+ }
+ unless (mightBeThere)
+ goto lookNext;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "comparing "FMTPTR" to "FMTPTR"\n",
+ (uintptr_t)object, (uintptr_t)e->object);
+ /* Compare object to e->object. */
+ unless (object == e->object) {
+ unless (header == getHeader (e->object))
+ goto lookNext;
+ for (p1 = (unsigned int*)object,
+ p2 = (unsigned int*)e->object;
+ p1 < (unsigned int*)max;
+ ++p1, ++p2)
+ unless (*p1 == *p2)
+ goto lookNext;
+ if (ARRAY_TAG == tag
+ and (getArrayLength (object) != getArrayLength (e->object)))
+ goto lookNext;
+ }
+ /* object is equal to e->object. */
+ return e->object;
}
-static void maybeGrowTable (GC_state s, GC_ObjectHashTable t) {
- int i;
- GC_ObjectHashElement oldElement;
- struct GC_ObjectHashElement *oldElements;
- uint oldSize;
- uint newSize;
-
- if (not t->mayInsert or t->numElements * 2 <= t->elementsSize)
- return;
- oldElements = t->elements;
- oldSize = t->elementsSize;
- newSize = oldSize * 2;
- if (DEBUG_SHARE)
- fprintf (stderr, "trying to grow table to size %d\n", newSize);
- // Try to alocate the new table.
- ARRAY_UNSAFE (struct GC_ObjectHashElement *, t->elements, newSize);
- if (NULL == t->elements) {
- t->mayInsert = FALSE;
- t->elements = oldElements;
- if (DEBUG_SHARE)
- fprintf (stderr, "unable to grow table\n");
- return;
- }
- t->elementsSize = newSize;
- t->log2ElementsSize++;
- for (i = 0; i < oldSize; ++i) {
- oldElement = &oldElements[i];
- unless (NULL == oldElement->object)
- tableInsert (s, t, oldElement->hash, oldElement->object,
- FALSE, 0, 0, 0);
- }
- if (t->elementsIsInHeap)
- t->elementsIsInHeap = FALSE;
- else
- free (oldElements);
- if (DEBUG_SHARE)
- fprintf (stderr, "done growing table\n");
+static void maybeGrowTable (GC_state s, GC_objectHashTable t) {
+ GC_objectHashElement oldElement;
+ struct GC_objectHashElement *oldElements;
+ uint32_t oldElementsLengthMax;
+ uint32_t newElementsLengthMax;
+
+ if (not t->mayInsert or t->elementsLengthCur * 2 <= t->elementsLengthMax)
+ return;
+ oldElements = t->elements;
+ oldElementsLengthMax = t->elementsLengthMax;
+ newElementsLengthMax = oldElementsLengthMax * 2;
+ if (DEBUG_SHARE)
+ fprintf (stderr,
+ "trying to grow table to cardinality %"PRIu32"\n",
+ newElementsLengthMax);
+ // Try to alocate the new table.
+ t->elements =
+ (struct GC_objectHashElement *)
+ (calloc(newElementsLengthMax, sizeof(*(t->elements))));
+ if (NULL == t->elements) {
+ t->mayInsert = FALSE;
+ t->elements = oldElements;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "unable to grow table\n");
+ return;
+ }
+ t->elementsLengthMax = newElementsLengthMax;
+ t->elementsLengthMaxLog2++;
+ 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);
+ }
+ if (t->elementsIsInHeap)
+ t->elementsIsInHeap = FALSE;
+ else
+ free (oldElements);
+ if (DEBUG_SHARE)
+ fprintf (stderr, "done growing table\n");
}
-static Pointer hashCons (GC_state s, Pointer object, Bool countBytesHashConsed) {
- Bool hasIdentity;
- Word32 hash;
- Header header;
- pointer max;
- uint numNonPointers;
- uint numPointers;
- word *p;
- Pointer res;
- GC_ObjectHashTable t;
- uint tag;
+static pointer hashCons (GC_state s, pointer object, bool countBytesHashConsed) {
+ GC_objectHashTable t;
+ GC_header header;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
+ bool hasIdentity;
+ GC_objectTypeTag tag;
+ pointer max;
+ GC_hash hash;
+ GC_hash* p;
+ pointer res;
- if (DEBUG_SHARE)
- fprintf (stderr, "hashCons (0x%08x)\n", (uint)object);
- t = s->objectHashTable;
- header = GC_getHeader (object);
- SPLIT_HEADER ();
- if (hasIdentity) {
- /* Don't hash cons. */
- res = object;
- goto done;
- }
- assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
- max = object
- + (ARRAY_TAG == tag
- ? arrayNumBytes (s, object,
- numPointers, numNonPointers)
- : toBytes (numPointers + numNonPointers));
- // Compute the hash.
- hash = header;
- for (p = (word*)object; p < (word*)max; ++p)
- hash = hash * 31 + *p;
- /* Insert into table. */
- res = tableInsert (s, t, hash, object, TRUE, header, tag, (Pointer)max);
- maybeGrowTable (s, t);
- if (countBytesHashConsed and res != object) {
- uint amount;
-
- amount = max - object;
- if (ARRAY_TAG == tag)
- amount += GC_ARRAY_HEADER_SIZE;
- else
- amount += GC_NORMAL_HEADER_SIZE;
- s->bytesHashConsed += amount;
- }
+ if (DEBUG_SHARE)
+ fprintf (stderr, "hashCons ("FMTPTR")\n", (uintptr_t)object);
+ t = s->objectHashTable;
+ header = getHeader (object);
+ splitHeader(s, header, &tag, &hasIdentity, &numNonObjptrs, &numObjptrs);
+ if (hasIdentity) {
+ /* Don't hash cons. */
+ res = object;
+ goto done;
+ }
+ assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
+ max =
+ object
+ + (ARRAY_TAG == tag
+ ? arraySizeNoHeader (s, object,
+ numNonObjptrs, numObjptrs)
+ : (numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+ + (numObjptrs * OBJPTR_SIZE)));
+ // 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);
+ if (countBytesHashConsed and res != object) {
+ size_t amount;
+
+ amount = max - object;
+ if (ARRAY_TAG == tag)
+ amount += GC_ARRAY_HEADER_SIZE;
+ else
+ amount += GC_NORMAL_HEADER_SIZE;
+ s->cumulativeStatistics.bytesHashConsed += amount;
+ }
done:
- if (DEBUG_SHARE)
- fprintf (stderr, "0x%08x = hashCons (0x%08x)\n",
- (uint)res, (uint)object);
- return res;
+ if (DEBUG_SHARE)
+ fprintf (stderr, FMTPTR" = hashCons ("FMTPTR")\n",
+ (uintptr_t)res, (uintptr_t)object);
+ return res;
}
static inline void maybeSharePointer (GC_state s,
- Pointer *pp,
- Bool shouldHashCons) {
- unless (shouldHashCons)
- return;
- if (DEBUG_SHARE)
- fprintf (stderr, "maybeSharePointer pp = 0x%08x *pp = 0x%08x\n",
- (uint)pp, (uint)*pp);
- *pp = hashCons (s, *pp, FALSE);
+ 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);
}
-static void bytesHashConsedMessage (GC_state s, ullong total) {
- fprintf (stderr, "%s bytes hash consed (%.1f%%).\n",
- ullongToCommaString (s->bytesHashConsed),
- 100.0 * ((double)s->bytesHashConsed / (double)total));
+static inline void maybeShareObjptr (GC_state s,
+ objptr *opp,
+ bool shouldHashCons) {
+ pointer p;
+
+ unless (shouldHashCons)
+ return;
+ p = objptrToPointer (*opp, s->heap.start);
+ if (DEBUG_SHARE)
+ fprintf (stderr, "maybeShareObjptr opp = "FMTPTR" *opp = "FMTOBJPTR"\n",
+ (uintptr_t)opp, *opp);
+ p = hashCons (s, p, FALSE);
+ *opp = pointerToObjptr (p, s->heap.start);
}
-void GC_share (GC_state s, Pointer object) {
- W32 total;
-
- if (DEBUG_SHARE)
- fprintf (stderr, "GC_share 0x%08x\n", (uint)object);
- if (DEBUG_SHARE or s->messages)
- s->bytesHashConsed = 0;
- // Don't hash cons during the first round of marking.
- total = mark (s, object, MARK_MODE, FALSE);
- s->objectHashTable = newTable (s);
- // Hash cons during the second round of marking.
- mark (s, object, UNMARK_MODE, TRUE);
- destroyTable (s->objectHashTable);
- if (DEBUG_SHARE or s->messages)
- bytesHashConsedMessage (s, total);
+static void bytesHashConsedMessage (GC_state s, uintmax_t total) {
+ fprintf (stderr, "%"PRIuMAX" bytes hash consed (%.1f%%).\n",
+ /*ullongToCommaString*/(s->cumulativeStatistics.bytesHashConsed),
+ (100.0
+ * ((double)s->cumulativeStatistics.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-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h 2005-10-16 00:47:35 UTC (rev 4107)
@@ -11,6 +11,9 @@
/* ---------------------------------------------------------------- */
typedef uint32_t GC_hash;
+#define GC_HASH_SIZE sizeof(GC_hash)
+#define PRIxHASH PRIx32
+#define FMTHASH "0x%08"PRIxHASH
typedef struct GC_objectHashElement {
GC_hash hash;
@@ -20,14 +23,14 @@
typedef struct GC_objectHashTable {
struct GC_objectHashElement *elements;
bool elementsIsInHeap;
- size_t elementsSize;
- int log2ElementsSize;
+ uint32_t elementsLengthCur;
+ uint32_t elementsLengthMax;
+ uint32_t elementsLengthMaxLog2;
bool mayInsert;
- int32_t numElements;
-} *GC_ObjectHashTable;
+} *GC_objectHashTable;
-pointer hashCons (GC_state s, pointer object,
- bool countBytesHashConsed);
+/*
void maybeShareObjptr (GC_state s,
objptr *opp,
bool shouldHashCons);
+*/
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c (from rev 4106, 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-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c 2005-10-16 00:47:35 UTC (rev 4107)
@@ -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.
+ */
+
+void GC_share (GC_state s, pointer object) {
+ size_t total;
+
+ if (DEBUG_SHARE)
+ fprintf (stderr, "GC_share "FMTPTR"\n", (uintptr_t)object);
+ 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);
+ s->objectHashTable = newHashTable (s);
+ // Hash cons during the second round of marking.
+ mark (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/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-16 00:47:35 UTC (rev 4107)
@@ -25,6 +25,7 @@
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
+#include <math.h>
#include <sys/resource.h>
#include "../assert.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-13 22:44:55 UTC (rev 4106)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c 2005-10-16 00:47:35 UTC (rev 4107)
@@ -29,3 +29,22 @@
}
return result;
}
+
+void *calloc_safe (size_t count, size_t size) {
+ void *res;
+
+ res = calloc (count, size);
+ if (NULL == res)
+ die ("calloc (%zu, %zu) failed.\n",
+ count, size);
+ return res;
+}
+
+void *malloc_safe (size_t size) {
+ void *res;
+
+ res = malloc (size);
+ if (NULL == res)
+ die ("malloc (%zu) failed.\n", size);
+ return res;
+}
|
|
From: Stephen W. <sw...@ml...> - 2005-10-13 15:44:57
|
Cleaned up libraries target. This also fixed a packaging bug that was leaving .svn files around in mlyacc-lib. ---------------------------------------------------------------------- U mlton/trunk/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/Makefile =================================================================== --- mlton/trunk/Makefile 2005-10-12 03:13:52 UTC (rev 4105) +++ mlton/trunk/Makefile 2005-10-13 22:44:55 UTC (rev 4106) @@ -159,33 +159,26 @@ # vvvv do not change make to $(MAKE) cd $(BSDSRC)/freebsd && make build-package +LIBRARIES = ckit-lib cml mlnlffi-lib mlyacc-lib smlnj-lib + .PHONY: libraries-no-check libraries-no-check: mkdir -p $(LIB)/sml - cd $(LIB)/sml && rm -rf mlyacc-lib - $(CP) $(SRC)/lib/mlyacc/. $(LIB)/sml/mlyacc-lib - find $(LIB)/sml/mlyacc -type d -name .svn | xargs rm -rf - find $(LIB)/sml/mlyacc -type f -name .ignore | xargs rm -rf - cd $(LIB)/sml && rm -rf cml - $(CP) $(SRC)/lib/cml/. $(LIB)/sml/cml - find $(LIB)/sml/cml -type d -name .svn | xargs rm -rf - find $(LIB)/sml/cml -type f -name .ignore | xargs rm -rf - cd $(LIB)/sml && rm -rf smlnj-lib - $(MAKE) -C $(SRC)/lib/smlnj-lib - $(CP) $(SRC)/lib/smlnj-lib/smlnj-lib/. $(LIB)/sml/smlnj-lib - cd $(LIB)/sml && rm -rf ckit-lib + cd $(LIB)/sml && rm -rf $(LIBRARIES) $(MAKE) -C $(SRC)/lib/ckit-lib + $(MAKE) -C $(SRC)/lib/smlnj-lib + $(CP) $(SRC)/lib/cml/. $(LIB)/sml/cml $(CP) $(SRC)/lib/ckit-lib/ckit/. $(LIB)/sml/ckit-lib - cd $(LIB)/sml && rm -rf mlnlffi-lib $(CP) $(SRC)/lib/mlnlffi/. $(LIB)/sml/mlnlffi-lib - find $(LIB)/sml/mlnlffi-lib -type d -name .svn | xargs rm -rf - find $(LIB)/sml/mlnlffi-lib -type f -name .ignore | xargs rm -rf + $(CP) $(SRC)/lib/mlyacc/. $(LIB)/sml/mlyacc-lib + $(CP) $(SRC)/lib/smlnj-lib/smlnj-lib/. $(LIB)/sml/smlnj-lib + find $(LIB)/sml -type d -name .svn | xargs rm -rf + find $(LIB)/sml -type f -name .ignore | xargs rm -rf - .PHONY: libraries libraries: $(MAKE) libraries-no-check - for f in mlyacc-lib cml smlnj-lib ckit-lib mlnlffi-lib; do \ + for f in $(LIBRARIES); do \ echo "Type checking $$f library."; \ $(MLTON) -disable-ann deadCode \ -stop tc \ |
|
From: Matthew F. <fl...@ml...> - 2005-10-11 20:13:58
|
Warnings
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
----------------------------------------------------------------------
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-12 00:55:18 UTC (rev 4104)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-12 03:13:52 UTC (rev 4105)
@@ -163,7 +163,7 @@
index = 0;
markInNormal:
if (DEBUG_MARK_COMPACT)
- fprintf (stderr, "markInNormal index = %d\n", index);
+ fprintf (stderr, "markInNormal index = %"PRIu32"\n", index);
assert (index < numObjptrs);
// next = *(pointer*)todo;
next = fetchObjptrToPointer (todo, s->heap.start);
@@ -218,7 +218,7 @@
todo += numNonObjptrsToBytes (numNonObjptrs, ARRAY_TAG);
markInArray:
if (DEBUG_MARK_COMPACT)
- fprintf (stderr, "markInArray arrayIndex = %u index = %u\n",
+ fprintf (stderr, "markInArray arrayIndex = %"PRIu32" index = %"PRIu32"\n",
arrayIndex, index);
assert (arrayIndex < getArrayLength (cur));
assert (index < numObjptrs);
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-12 00:55:18 UTC (rev 4104)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-10-12 03:13:52 UTC (rev 4105)
@@ -83,7 +83,7 @@
static bool mutatorFrontierInvariant (GC_state s) {
GC_thread ct = currentThread(s);
- return (ct->bytesNeeded <= s->limitPlusSlop - s->frontier);
+ return (ct->bytesNeeded <= (size_t)(s->limitPlusSlop - s->frontier));
}
static bool mutatorStackInvariant (GC_state s) {
|
|
From: Stephen W. <sw...@ml...> - 2005-10-11 17:55:23
|
Got things working on Cygwin. The main change was one line in gc.c,
changing MLton_Platform_CygwinUseMmap from FALSE to TRUE. With that,
all regressions work fine, except for a case-sensitivity problem with
exnHistory and a not-enough-memory problem with hamlet.
The other, minor, changes were to remove calls to "size" from the
Makefiles and the call to strip, since those fail on Cygwin due to the
executable having the .exe suffix. Also, I added the obvious
MLNLFFIGEN platform/memory file for Cygwin.
----------------------------------------------------------------------
U mlton/trunk/Makefile
U mlton/trunk/benchmark/Makefile
A mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-cygwin.mlb
U mlton/trunk/mllex/Makefile
U mlton/trunk/mlnlffigen/Makefile
U mlton/trunk/mlprof/Makefile
U mlton/trunk/mlton/Makefile
U mlton/trunk/mlyacc/Makefile
U mlton/trunk/runtime/gc.c
----------------------------------------------------------------------
Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/Makefile 2005-10-12 00:55:18 UTC (rev 4104)
@@ -389,7 +389,7 @@
cd $(TMAN) && $(GZIP) $(MAN_PAGES); \
fi
case "$(TARGET_OS)" in \
- darwin|solaris) \
+ cygwin|darwin|solaris) \
;; \
*) \
for f in $(TLIB)/$(AOUT) $(TBIN)/$(LEX) \
Modified: mlton/trunk/benchmark/Makefile
===================================================================
--- mlton/trunk/benchmark/Makefile 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/benchmark/Makefile 2005-10-12 00:55:18 UTC (rev 4104)
@@ -23,7 +23,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Added: mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-cygwin.mlb
===================================================================
--- mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-cygwin.mlb 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-cygwin.mlb 2005-10-12 00:55:18 UTC (rev 4104)
@@ -0,0 +1 @@
+../memory.32bit-unix.mlb
Modified: mlton/trunk/mllex/Makefile
===================================================================
--- mlton/trunk/mllex/Makefile 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/mllex/Makefile 2005-10-12 00:55:18 UTC (rev 4104)
@@ -21,7 +21,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Modified: mlton/trunk/mlnlffigen/Makefile
===================================================================
--- mlton/trunk/mlnlffigen/Makefile 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/mlnlffigen/Makefile 2005-10-12 00:55:18 UTC (rev 4104)
@@ -20,7 +20,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
.PHONY: clean
clean:
Modified: mlton/trunk/mlprof/Makefile
===================================================================
--- mlton/trunk/mlprof/Makefile 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/mlprof/Makefile 2005-10-12 00:55:18 UTC (rev 4104)
@@ -21,7 +21,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Modified: mlton/trunk/mlton/Makefile
===================================================================
--- mlton/trunk/mlton/Makefile 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/mlton/Makefile 2005-10-12 00:55:18 UTC (rev 4104)
@@ -74,7 +74,6 @@
$(MAKE) $(UP)
@echo 'Compiling mlton (takes a while)'
mlton $(FLAGS) $(FILE)
- size $(AOUT)
#! Pass $(PATH) to upgrade-basis because it is run via #!/usr/bin/env
# bash, which resets the path.
Modified: mlton/trunk/mlyacc/Makefile
===================================================================
--- mlton/trunk/mlyacc/Makefile 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/mlyacc/Makefile 2005-10-12 00:55:18 UTC (rev 4104)
@@ -21,7 +21,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Modified: mlton/trunk/runtime/gc.c
===================================================================
--- mlton/trunk/runtime/gc.c 2005-10-12 00:51:01 UTC (rev 4103)
+++ mlton/trunk/runtime/gc.c 2005-10-12 00:55:18 UTC (rev 4104)
@@ -4430,7 +4430,7 @@
s->alignment));
assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
s->alignment));
- MLton_Platform_CygwinUseMmap = FALSE;
+ MLton_Platform_CygwinUseMmap = TRUE;
s->amInGC = TRUE;
s->amInMinorGC = FALSE;
s->bytesAllocated = 0;
|
|
From: Stephen W. <sw...@ml...> - 2005-10-11 17:51:04
|
Used a more robust solution to eliminating the "noisy" stack frames at
the top of the stack in MLton.Exn.history. For some reason, I was
seeing an extra frame on Cygwin, which is now gone with the more
robust solution.
----------------------------------------------------------------------
U mlton/trunk/basis-library/mlton/exn.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/mlton/exn.sml
===================================================================
--- mlton/trunk/basis-library/mlton/exn.sml 2005-10-11 19:17:45 UTC (rev 4102)
+++ mlton/trunk/basis-library/mlton/exn.sml 2005-10-12 00:51:01 UTC (rev 4103)
@@ -14,19 +14,31 @@
val addExnMessager = General.addExnMessager
val history: t -> string list =
- if keepHistory
- then (setInitExtra (NONE: extra)
- ; setExtendExtra (fn e =>
- case e of
- NONE => SOME (MLtonCallStack.current ())
- | SOME _ => e)
- ; fn e => (case extra e of
- NONE => []
- | SOME cs =>
- (* The tl gets rid of the anonymous function
- * passed to setExtendExtra above.
- *)
- tl (MLtonCallStack.toStrings cs)))
+ if keepHistory then
+ (setInitExtra (NONE: extra)
+ ; setExtendExtra (fn e =>
+ case e of
+ NONE => SOME (MLtonCallStack.current ())
+ | SOME _ => e)
+ ; (fn e =>
+ case extra e of
+ NONE => []
+ | SOME cs =>
+ let
+ (* Gets rid of the anonymous function passed to
+ * setExtendExtra above.
+ *)
+ fun loop xs =
+ case xs of
+ [] => []
+ | x :: xs =>
+ if String.isPrefix "MLtonExn.fn " x then
+ xs
+ else
+ loop xs
+ in
+ loop (MLtonCallStack.toStrings cs)
+ end))
else fn _ => []
local
|
|
From: Stephen W. <sw...@ml...> - 2005-10-11 12:17:47
|
New Debian package. ---------------------------------------------------------------------- U mlton/trunk/package/debian/changelog ---------------------------------------------------------------------- Modified: mlton/trunk/package/debian/changelog =================================================================== --- mlton/trunk/package/debian/changelog 2005-10-10 01:59:41 UTC (rev 4101) +++ mlton/trunk/package/debian/changelog 2005-10-11 19:17:45 UTC (rev 4102) @@ -1,3 +1,9 @@ +mlton (20050930-1) unstable; urgency=low + + * Fixed postinst problem. closes: #329692 + + -- Stephen Weeks <sw...@sw...> Fri, 30 Sep 2005 09:19:50 -0700 + mlton (20050906-1) unstable; urgency=low * Replaces -mv8 with -mcpu=v8 for Sparc. |
|
From: Matthew F. <fl...@ml...> - 2005-10-09 18:59:43
|
typos
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
----------------------------------------------------------------------
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-10 01:54:23 UTC (rev 4100)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-10 01:59:41 UTC (rev 4101)
@@ -9,6 +9,6 @@
struct GC_controls {
size_t fixedHeap; /* If 0, then no fixed heap. */
size_t maxHeap; /* if zero, then unlimited, else limit total heap */
- bool messages;
- bool summary;
+ bool messages; /* Print a message at the start and end of each gc. */
+ bool summary; /* Print a summary of gc info when program exits. */
};
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-10 01:54:23 UTC (rev 4100)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-10 01:59:41 UTC (rev 4101)
@@ -119,7 +119,7 @@
assert (nextHeaderp == getHeaderp (next));
assert (nextHeader == getHeader (next));
// assert (*(pointer*) todo == next);
- assert (fetchObjptrFromPointer (todo, s->heap.start) == next);
+ assert (fetchObjptrToPointer (todo, s->heap.start) == next);
headerp = nextHeaderp;
header = nextHeader;
// *(pointer*)todo = prev;
|
|
From: Matthew F. <fl...@ml...> - 2005-10-09 18:54:42
|
Some reorganization; additional heap functions, including model agnostic heapCreate; ported Depth-First mark
----------------------------------------------------------------------
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.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
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/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
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-sweep.c
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-sweep.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/model_predicates.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.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer_predicates.c
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios_predicates.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.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/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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-10 01:54:23 UTC (rev 4100)
@@ -49,7 +49,7 @@
endif
CC = gcc -std=gnu99
-CWFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter \
+CWFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter -Wno-unused-function \
-Wformat-nonliteral \
-Wuninitialized -Winit-self \
-Wstrict-aliasing=2 \
@@ -77,25 +77,31 @@
debug.c \
align.c \
virtual-memory.c \
+ rusage.c \
+ pointer_predicates.c \
pointer.c \
+ model_predicates.c \
model.c \
object.c \
array.c \
object_size.c \
frame.c \
+ stack_predicates.c \
stack.c \
thread.c \
generational.c \
- heap.c \
+ heap_predicates.c \
+ heap.c \
gc_state.c \
new_object.c \
- ratios.c \
+ ratios_predicates.c \
current.c \
foreach.c \
atomic.c \
invariant.c \
enter_leave.c \
cheney-copy.c \
+ dfs-mark.c \
assumptions.c \
gc_suffix.c
@@ -116,10 +122,11 @@
major.h \
generational.h \
statistics.h \
- control.h \
+ controls.h \
sysvals.h \
ratios.h \
gc_state.h \
+ hash-cons.h \
profile.h \
gc_suffix.h
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -6,45 +6,64 @@
* See the file MLton-LICENSE for details.
*/
-static inline size_t roundDown (size_t a, size_t b) {
- return a - (a % b);
+static inline bool isAligned (size_t a, size_t b) {
+ return 0 == a % b;
}
+static inline size_t alignDown (size_t a, size_t b) {
+ assert (b >= 1);
+ a -= a % b;
+ assert (isAligned (a, b));
+ return a;
+}
+
static inline size_t align (size_t a, size_t b) {
assert (b >= 1);
a += b - 1;
a -= a % b;
+ assert (isAligned (a, b));
return a;
}
-static inline bool isAligned (size_t a, size_t b) {
- return 0 == a % b;
+static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
+ return align (bytes + extra, s->alignment) - extra;
}
#if ASSERT
static inline bool isAlignedFrontier (GC_state s, pointer p) {
- return isAligned ((uintptr_t)p + GC_NORMAL_HEADER_SIZE,
+ return isAligned ((size_t)p + GC_NORMAL_HEADER_SIZE,
s->alignment);
}
-
-static inline bool isAlignedReserved (GC_state s, size_t reserved) {
- return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved,
- s->alignment);
-}
#endif
-static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
- return align (bytes + extra, s->alignment) - extra;
-}
-
static inline pointer alignFrontier (GC_state s, pointer p) {
- size_t bytes, res;
+ size_t res;
- bytes = (size_t) p;
res = pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
+ if (DEBUG_STACKS)
+ fprintf (stderr, FMTPTR" = stackReserved ("FMTPTR")\n",
+ (uintptr_t)p, (uintptr_t)res);
+ assert (isAlignedFrontier (s, (pointer)res));
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,
+ s->alignment);
+}
+#endif
+
+static inline size_t alignStackReserved (GC_state s, size_t reserved) {
+ size_t res;
+
+ res = pad (s, reserved, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
+ if (DEBUG_STACKS)
+ fprintf (stderr, "%zu = stackReserved (%zu)\n", res, reserved);
+ assert (isAlignedStackReserved (s, res));
+ return res;
+}
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -6,49 +6,19 @@
* See the file MLton-LICENSE for details.
*/
-#if ASSERT
-static inline pointer arrayIndexAtPointer (GC_state s,
- pointer a,
- uint32_t arrayIndex,
- uint32_t pointerIndex) {
- GC_header header;
- uint16_t numNonObjptrs;
- uint16_t numObjptrs;
- GC_objectTypeTag tag;
-
- header = getHeader (a);
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
- assert (tag == ARRAY_TAG);
-
- size_t nonObjptrBytesPerElement =
- numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
- size_t bytesPerElement =
- nonObjptrBytesPerElement
- + (numObjptrs * OBJPTR_SIZE);
-
- return a
- + arrayIndex * bytesPerElement
- + nonObjptrBytesPerElement
- + pointerIndex * OBJPTR_SIZE;
+/* 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);
}
-#endif
-/* The number of bytes in an array, not including the header. */
-static inline size_t arrayNumBytes (GC_state s,
- pointer p,
- uint16_t numNonObjptrs,
- uint16_t numObjptrs) {
- size_t bytesPerElement;
- GC_arrayLength numElements;
- size_t result;
-
- numElements = getArrayLength (p);
- bytesPerElement =
- numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
- + (numObjptrs * OBJPTR_SIZE);
- result = numElements * bytesPerElement;
- /* Empty arrays have OBJPTR_SIZE bytes for the forwarding pointer. */
- if (0 == result)
- result = OBJPTR_SIZE;
- return pad (s, result, GC_ARRAY_HEADER_SIZE);
+/* getArrayCounter (p)
+ *
+ * Returns the counter for the array pointed to by p.
+ */
+static inline 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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-10-10 01:54:23 UTC (rev 4100)
@@ -20,18 +20,20 @@
*/
typedef uint32_t GC_arrayLength;
#define GC_ARRAY_LENGTH_SIZE sizeof(GC_arrayLength)
+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)
-/* getArrayNumElementsp (p)
+/* 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);
+ return (GC_arrayLength*)(a - GC_HEADER_SIZE
+ - GC_ARRAY_LENGTH_SIZE);
}
-/* getArrayNumElements (p)
+/* getArrayLength (p)
*
* Returns the length for the array pointed to by p.
*/
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c 2005-10-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -1,54 +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.
- */
-
-#if ASSERT
-static inline pointer arrayIndexAtPointer (GC_state s,
- pointer a,
- uint32_t arrayIndex,
- uint32_t pointerIndex) {
- GC_header header;
- uint16_t numNonObjptrs;
- uint16_t numObjptrs;
- GC_objectTypeTag tag;
-
- header = getHeader (a);
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
- assert (tag == ARRAY_TAG);
-
- size_t nonObjptrBytesPerElement =
- numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
- size_t bytesPerElement =
- nonObjptrBytesPerElement
- + (numObjptrs * OBJPTR_SIZE);
-
- return a
- + arrayIndex * bytesPerElement
- + nonObjptrBytesPerElement
- + pointerIndex * OBJPTR_SIZE;
-}
-#endif
-
-/* The number of bytes in an array, not including the header. */
-static inline size_t arrayNumBytes (GC_state s,
- pointer p,
- uint16_t numNonObjptrs,
- uint16_t numObjptrs) {
- size_t bytesPerElement;
- GC_arrayLength numElements;
- size_t result;
-
- numElements = getArrayLength (p);
- bytesPerElement =
- numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
- + (numObjptrs * OBJPTR_SIZE);
- result = numElements * bytesPerElement;
- /* Empty arrays have OBJPTR_SIZE bytes for the forwarding pointer. */
- if (0 == result)
- result = OBJPTR_SIZE;
- return pad (s, result, GC_ARRAY_HEADER_SIZE);
-}
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -70,7 +70,7 @@
skip = 0;
} else if (ARRAY_TAG == tag) {
headerBytes = GC_ARRAY_HEADER_SIZE;
- objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
+ objectBytes = arraySizeNoHeader (s, p, numNonObjptrs, numObjptrs);
skip = 0;
} else { /* Stack. */
GC_stack stack;
@@ -85,8 +85,8 @@
*/
if (stack->used <= stack->reserved / 4) {
size_t new =
- stackReserved (s, maxZ (stack->reserved / 2,
- stackNeedsReserved (s, stack)));
+ alignStackReserved
+ (s, max (stack->reserved / 2, stackMinimumReserved (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
@@ -96,17 +96,17 @@
if (new <= stack->reserved) {
stack->reserved = new;
if (DEBUG_STACKS)
- fprintf (stderr, "Shrinking stack to size %zd.\n",
+ fprintf (stderr, "Shrinking stack to size %zu.\n",
/*uintToCommaString*/(stack->reserved));
}
}
} else {
/* Shrink heap stacks. */
stack->reserved =
- stackReserved (s, maxZ((size_t)(s->ratios.threadShrink * stack->reserved),
- stack->used));
+ alignStackReserved
+ (s, max((size_t)(s->ratios.threadShrink * stack->reserved), stack->used));
if (DEBUG_STACKS)
- fprintf (stderr, "Shrinking stack to size %zd.\n",
+ fprintf (stderr, "Shrinking stack to size %zu.\n",
/*uintToCommaString*/(stack->reserved));
}
objectBytes = sizeof (struct GC_stack) + stack->used;
@@ -143,7 +143,7 @@
*(objptr*)p = pointerToObjptr(forwardState.back + headerBytes, forwardState.toStart);
/* Update the back of the queue. */
forwardState.back += size + skip;
- assert (isAligned ((uintptr_t)forwardState.back + GC_NORMAL_HEADER_SIZE,
+ assert (isAligned ((size_t)forwardState.back + GC_NORMAL_HEADER_SIZE,
s->alignment));
}
*opp = *(objptr*)p;
@@ -185,26 +185,22 @@
setCardMapAbsolute (s);
}
-/* static inline bool detailedGCTime (GC_state s) { */
-/* return s->summary; */
-/* } */
-
static void majorCheneyCopyGC (GC_state s) {
- // struct rusage ru_start;
+ struct rusage ru_start;
pointer toStart;
assert (s->secondaryHeap.size >= s->heap.oldGenSize);
-/* if (detailedGCTime (s)) */
-/* startTiming (&ru_start); */
+ if (detailedGCTime (s))
+ startTiming (&ru_start);
s->cumulativeStatistics.numCopyingGCs++;
forwardState.toStart = s->secondaryHeap.start;
forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.size;
- if (DEBUG or s->messages) {
+ if (DEBUG or s->controls.messages) {
fprintf (stderr, "Major copying GC.\n");
- fprintf (stderr, "fromSpace = "FMTPTR" of size %zd\n",
+ fprintf (stderr, "fromSpace = "FMTPTR" of size %zu\n",
(uintptr_t) s->heap.start,
/*uintToCommaString*/(s->heap.size));
- fprintf (stderr, "toSpace = "FMTPTR" of size %zd\n",
+ fprintf (stderr, "toSpace = "FMTPTR" of size %zu\n",
(uintptr_t) s->secondaryHeap.start,
/*uintToCommaString*/(s->secondaryHeap.size));
}
@@ -223,14 +219,14 @@
s->secondaryHeap.oldGenSize = forwardState.back - s->secondaryHeap.start;
s->cumulativeStatistics.bytesCopied += s->secondaryHeap.oldGenSize;
if (DEBUG)
- fprintf (stderr, "%zd bytes live.\n",
+ fprintf (stderr, "%zu bytes live.\n",
/*uintToCommaString*/(s->secondaryHeap.oldGenSize));
swapHeaps (s);
clearCrossMap (s);
s->lastMajorStatistics.kind = GC_COPYING;
-/* if (detailedGCTime (s)) */
-/* stopTiming (&ru_start, &s->ru_gcCopy); */
- if (DEBUG or s->messages)
+ if (detailedGCTime (s))
+ stopTiming (&ru_start, &s->cumulativeStatistics.ru_gcCopy);
+ if (DEBUG or s->controls.messages)
fprintf (stderr, "Major copying GC done.\n");
}
@@ -346,7 +342,7 @@
static void minorGC (GC_state s) {
size_t bytesAllocated;
size_t bytesCopied;
- // struct rusage ru_start;
+ struct rusage ru_start;
if (DEBUG_GENERATIONAL)
fprintf (stderr, "minorGC nursery = "FMTPTR" frontier = "FMTPTR"\n",
@@ -360,10 +356,10 @@
s->heap.oldGenSize += bytesAllocated;
bytesCopied = 0;
} else {
- if (DEBUG_GENERATIONAL or s->messages)
+ if (DEBUG_GENERATIONAL or s->controls.messages)
fprintf (stderr, "Minor GC.\n");
-/* if (detailedGCTime (s)) */
-/* startTiming (&ru_start); */
+ if (detailedGCTime (s))
+ startTiming (&ru_start);
s->amInMinorGC = TRUE;
forwardState.toStart = s->heap.start + s->heap.oldGenSize;
if (DEBUG_GENERATIONAL)
@@ -386,10 +382,10 @@
s->cumulativeStatistics.bytesCopiedMinor += bytesCopied;
s->heap.oldGenSize += bytesCopied;
s->amInMinorGC = FALSE;
-/* if (detailedGCTime (s)) */
-/* stopTiming (&ru_start, &s->ru_gcMinor); */
- if (DEBUG_GENERATIONAL or s->messages)
- fprintf (stderr, "Minor GC done. %zd bytes copied.\n",
+ if (detailedGCTime (s))
+ stopTiming (&ru_start, &s->cumulativeStatistics.ru_gcMinor);
+ if (DEBUG_GENERATIONAL or s->controls.messages)
+ fprintf (stderr, "Minor GC done. %zu bytes copied.\n",
/*uintToCommaString*/(bytesCopied));
}
}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h 2005-10-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h 2005-10-10 01:54:23 UTC (rev 4100)
@@ -1,12 +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.
- */
-
-struct GC_control {
- size_t fixedHeap; /* If 0, then no fixed heap. */
- size_t maxHeap; /* if zero, then unlimited, else limit total heap */
-};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h (from rev 4098, mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h 2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-10-10 01:54:23 UTC (rev 4100)
@@ -0,0 +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.
+ */
+
+struct GC_controls {
+ size_t fixedHeap; /* If 0, then no fixed heap. */
+ size_t maxHeap; /* if zero, then unlimited, else limit total heap */
+ bool messages;
+ bool summary;
+};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -0,0 +1,362 @@
+/* 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.
+ */
+
+/* ---------------------------------------------------------------- */
+/* Depth-first Marking */
+/* ---------------------------------------------------------------- */
+
+typedef enum {
+ MARK_MODE,
+ UNMARK_MODE,
+} GC_markMode;
+
+static inline bool isMarked (pointer p) {
+ return MARK_MASK & getHeader (p);
+}
+
+static bool isMarkedMode (GC_markMode m, pointer p) {
+ switch (m) {
+ case MARK_MODE:
+ return isMarked (p);
+ case UNMARK_MODE:
+ return not isMarked (p);
+ default:
+ die ("bad mark mode %u", m);
+ }
+}
+
+#if ASSERT
+static inline pointer arrayIndexAtPointer (GC_state s,
+ pointer a,
+ GC_arrayCounter arrayIndex,
+ uint32_t pointerIndex) {
+ GC_header header;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
+ GC_objectTypeTag tag;
+
+ header = getHeader (a);
+ splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ assert (tag == ARRAY_TAG);
+
+ size_t nonObjptrBytesPerElement =
+ numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+ size_t bytesPerElement =
+ nonObjptrBytesPerElement
+ + (numObjptrs * OBJPTR_SIZE);
+
+ return a
+ + arrayIndex * bytesPerElement
+ + nonObjptrBytesPerElement
+ + pointerIndex * OBJPTR_SIZE;
+}
+#endif
+
+/* mark (s, r, m, shc)
+ *
+ * Sets all the mark bits in the object graph pointed to by r.
+ *
+ * If m is MARK_MODE, it sets the bits to 1.
+ * If m is UNMARK_MODE, it sets the bits to 0.
+ *
+ * If shc, it hash-conses the objects marked.
+ *
+ * It returns the total size in bytes of the objects marked.
+ */
+size_t mark (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. */
+ pointer prev; /* The previous object on the mark stack. */
+ pointer next; /* The next object to mark. */
+ pointer todo; /* A pointer to the pointer in cur to next. */
+ GC_header header;
+ GC_header* headerp;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
+ GC_objectTypeTag tag;
+ uint32_t index; /* The i'th pointer in the object (element) being marked. */
+ GC_header nextHeader;
+ GC_header* nextHeaderp;
+ GC_arrayCounter arrayIndex;
+ pointer top; /* The top of the next stack frame to mark. */
+ GC_returnAddress returnAddress;
+ GC_frameLayout *frameLayout;
+ GC_frameOffsets frameOffsets;
+
+ if (isMarkedMode (mode, root))
+ /* Object has already been marked. */
+ return 0;
+ mark = (MARK_MODE == mode) ? MARK_MASK : 0;
+ size = 0;
+ cur = root;
+ prev = NULL;
+ headerp = getHeaderp (cur);
+ header = *headerp;
+ goto mark;
+markNext:
+ /* cur is the object that was being marked.
+ * prev is the mark stack.
+ * next is the unmarked object to be marked.
+ * nextHeaderp points to the header of next.
+ * nextHeader is the header of next.
+ * todo is a pointer to the pointer inside cur that points to next.
+ */
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr,
+ "markNext"
+ " cur = "FMTPTR" next = "FMTPTR
+ " prev = "FMTPTR" todo = "FMTPTR"\n",
+ (uintptr_t)cur, (uintptr_t)next,
+ (uintptr_t)prev, (uintptr_t)todo);
+ assert (not isMarkedMode (mode, next));
+ assert (nextHeaderp == getHeaderp (next));
+ assert (nextHeader == getHeader (next));
+ // assert (*(pointer*) todo == next);
+ assert (fetchObjptrFromPointer (todo, s->heap.start) == next);
+ headerp = nextHeaderp;
+ header = nextHeader;
+ // *(pointer*)todo = prev;
+ storeObjptrFromPointer (todo, prev, s->heap.start);
+ prev = cur;
+ cur = next;
+mark:
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "mark cur = "FMTPTR" prev = "FMTPTR" mode = %s\n",
+ (uintptr_t)cur, (uintptr_t)prev,
+ (mode == MARK_MODE) ? "mark" : "unmark");
+ /* cur is the object to mark.
+ * prev is the mark stack.
+ * headerp points to the header of cur.
+ * header is the header of cur.
+ */
+ assert (not isMarkedMode (mode, cur));
+ assert (header == getHeader (cur));
+ assert (headerp == getHeaderp (cur));
+ header ^= MARK_MASK;
+ /* Store the mark. In the case of an object that contains a pointer to
+ * itself, it is essential that we store the marked header before marking
+ * the internal pointers (markInNormal below). If we didn't, then we
+ * would see the object as unmarked and traverse it again.
+ */
+ *headerp = header;
+ splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ if (NORMAL_TAG == tag) {
+ size +=
+ GC_NORMAL_HEADER_SIZE
+ + numNonObjptrsToBytes (numNonObjptrs, tag)
+ + (numObjptrs * OBJPTR_SIZE);
+ if (0 == numObjptrs) {
+ /* There is nothing to mark. */
+normalDone:
+ if (shouldHashCons)
+ cur = hashCons (s, cur, TRUE);
+ goto ret;
+ }
+ todo = cur + numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG);
+ index = 0;
+markInNormal:
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "markInNormal index = %d\n", index);
+ assert (index < numObjptrs);
+ // next = *(pointer*)todo;
+ next = fetchObjptrToPointer (todo, s->heap.start);
+ if (not isPointer (next)) {
+markNextInNormal:
+ assert (index < numObjptrs);
+ index++;
+ if (index == numObjptrs) {
+ /* Done. Clear out the counters and return. */
+ *headerp = header & ~COUNTER_MASK;
+ goto normalDone;
+ }
+ todo += OBJPTR_SIZE;
+ goto markInNormal;
+ }
+ nextHeaderp = getHeaderp (next);
+ nextHeader = *nextHeaderp;
+ if (mark == (nextHeader & MARK_MASK)) {
+ maybeShareObjptr (s, (objptr*)todo, shouldHashCons);
+ goto markNextInNormal;
+ }
+ *headerp = (header & ~COUNTER_MASK) | (index << COUNTER_SHIFT);
+ goto markNext;
+ } else if (WEAK_TAG == tag) {
+ /* Store the marked header and don't follow any pointers. */
+ goto ret;
+ } else if (ARRAY_TAG == tag) {
+ /* When marking arrays:
+ * arrayIndex is the index of the element to mark.
+ * cur is the pointer to the array.
+ * index is the index of the pointer within the element
+ * (i.e. the i'th pointer is at index i).
+ * todo is the start of the element.
+ */
+ size +=
+ GC_ARRAY_HEADER_SIZE
+ + arraySizeNoHeader (s, cur, numNonObjptrs, numObjptrs);
+ if (0 == numObjptrs or 0 == getArrayLength (cur)) {
+ /* There is nothing to mark. */
+arrayDone:
+ if (shouldHashCons)
+ cur = hashCons (s, cur, TRUE);
+ goto ret;
+ }
+ /* Begin marking first element. */
+ arrayIndex = 0;
+ todo = cur;
+markArrayElt:
+ assert (arrayIndex < getArrayLength (cur));
+ index = 0;
+ /* Skip to the first pointer. */
+ todo += numNonObjptrsToBytes (numNonObjptrs, ARRAY_TAG);
+markInArray:
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "markInArray arrayIndex = %u index = %u\n",
+ arrayIndex, index);
+ assert (arrayIndex < getArrayLength (cur));
+ assert (index < numObjptrs);
+ assert (todo == arrayIndexAtPointer (s, cur, arrayIndex, index));
+ // next = *(pointer*)todo;
+ next = fetchObjptrToPointer (todo, s->heap.start);
+ if (not (isPointer(next))) {
+markNextInArray:
+ assert (arrayIndex < getArrayLength (cur));
+ assert (index < numObjptrs);
+ assert (todo == arrayIndexAtPointer (s, cur, arrayIndex, index));
+ todo += OBJPTR_SIZE;
+ index++;
+ if (index < numObjptrs)
+ goto markInArray;
+ arrayIndex++;
+ if (arrayIndex < getArrayLength (cur))
+ goto markArrayElt;
+ /* Done. Clear out the counters and return. */
+ *getArrayCounterp (cur) = 0;
+ *headerp = header & ~COUNTER_MASK;
+ goto arrayDone;
+ }
+ nextHeaderp = getHeaderp (next);
+ nextHeader = *nextHeaderp;
+ if (mark == (nextHeader & MARK_MASK)) {
+ maybeShareObjptr (s, (objptr*)todo, shouldHashCons);
+ goto markNextInArray;
+ }
+ /* Recur and mark next. */
+ *getArrayCounterp (cur) = arrayIndex;
+ *headerp = (header & ~COUNTER_MASK) | (index << COUNTER_SHIFT);
+ goto markNext;
+ } else {
+ assert (STACK_TAG == tag);
+ size +=
+ GC_STACK_HEADER_SIZE
+ + sizeof (struct GC_stack) + ((GC_stack)cur)->reserved;
+ top = stackTop (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);
+ 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)))
+ goto ret;
+ index = 0;
+ returnAddress = *(GC_returnAddress*) (top - GC_RETURNADDRESS_SIZE);
+ frameLayout = getFrameLayoutFromReturnAddress (s, returnAddress);
+ frameOffsets = frameLayout->offsets;
+ ((GC_stack)cur)->markTop = top;
+markInFrame:
+ if (index == frameOffsets [0]) {
+ top -= frameLayout->size;
+ goto markInStack;
+ }
+ todo = top - frameLayout->size + frameOffsets [index + 1];
+ // next = *(pointer*)todo;
+ next = fetchObjptrToPointer (todo, s->heap.start);
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr,
+ " offset %u todo "FMTPTR" next = "FMTPTR"\n",
+ frameOffsets [index + 1],
+ (uintptr_t)todo, (uintptr_t)next);
+ if (not isPointer (next)) {
+ index++;
+ goto markInFrame;
+ }
+ nextHeaderp = getHeaderp (next);
+ nextHeader = *nextHeaderp;
+ if (mark == (nextHeader & MARK_MASK)) {
+ index++;
+ maybeShareObjptr (s, (objptr*)todo, shouldHashCons);
+ goto markInFrame;
+ }
+ ((GC_stack)cur)->markIndex = index;
+ goto markNext;
+ }
+ assert (FALSE);
+ret:
+ /* Done marking cur, continue with prev.
+ * Need to set the pointer in the prev object that pointed to cur
+ * to point back to prev, and restore prev.
+ */
+ if (DEBUG_MARK_COMPACT)
+ fprintf (stderr, "return cur = "FMTPTR" prev = "FMTPTR"\n",
+ (uintptr_t)cur, (uintptr_t)prev);
+ assert (isMarkedMode (mode, cur));
+ if (NULL == prev)
+ return size;
+ next = cur;
+ cur = prev;
+ headerp = getHeaderp (cur);
+ header = *headerp;
+ splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ /* It's impossible to get a WEAK_TAG here, since we would never
+ * follow the weak object pointer.
+ */
+ assert (WEAK_TAG != tag);
+ if (NORMAL_TAG == tag) {
+ todo = cur + numNonObjptrsToBytes (numNonObjptrs, tag);
+ index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
+ todo += index * OBJPTR_SIZE;
+ // prev = *(pointer*)todo;
+ prev = fetchObjptrToPointer (todo, s->heap.start);
+ // *(pointer*)todo = next;
+ storeObjptrFromPointer (todo, next, s->heap.start);
+ goto markNextInNormal;
+ } else if (ARRAY_TAG == tag) {
+ arrayIndex = getArrayCounter (cur);
+ todo = cur + arrayIndex * (numNonObjptrsToBytes (numNonObjptrs, ARRAY_TAG)
+ + (numObjptrs * OBJPTR_SIZE));
+ index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
+ todo += numNonObjptrsToBytes (numNonObjptrs, ARRAY_TAG) + index * OBJPTR_SIZE;
+ // prev = *(pointer*)todo;
+ prev = fetchObjptrToPointer (todo, s->heap.start);
+ // *(pointer*)todo = next;
+ storeObjptrFromPointer (todo, next, s->heap.start);
+ goto markNextInArray;
+ } else {
+ assert (STACK_TAG == tag);
+ index = ((GC_stack)cur)->markIndex;
+ top = ((GC_stack)cur)->markTop;
+ /* Invariant: top points just past a "return address". */
+ returnAddress = *(GC_returnAddress*) (top - GC_RETURNADDRESS_SIZE);
+ frameLayout = getFrameLayoutFromReturnAddress (s, returnAddress);
+ frameOffsets = frameLayout->offsets;
+ todo = top - frameLayout->size + frameOffsets [index + 1];
+ // prev = *(pointer*)todo;
+ prev = fetchObjptrToPointer (todo, s->heap.start);
+ // *(pointer*)todo = next;
+ storeObjptrFromPointer (todo, next, s->heap.start);
+ index++;
+ goto markInFrame;
+ }
+ assert (FALSE);
+}
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -196,7 +196,7 @@
assert (front <= b);
while (front < b) {
while (front < b) {
- assert (isAligned ((uintptr_t)front, GC_MODEL_MINALIGN));
+ assert (isAligned ((size_t)front, GC_MODEL_MINALIGN));
if (DEBUG_DETAILED)
fprintf (stderr,
" front = "FMTPTR" *back = "FMTPTR"\n",
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -6,24 +6,24 @@
* See the file MLton-LICENSE for details.
*/
-static inline uint32_t
+static inline GC_frameIndex
getFrameIndexFromReturnAddress (GC_state s, GC_returnAddress ra) {
- uint32_t res;
+ GC_frameIndex res;
res = s->returnAddressToFrameIndex (ra);
if (DEBUG_DETAILED)
- fprintf (stderr, "%"PRIu32" = getFrameIndexFromReturnAddress ("FMTRA")\n",
+ fprintf (stderr, FMTFI" = getFrameIndexFromReturnAddress ("FMTRA")\n",
res, ra);
return res;
}
static inline GC_frameLayout *
-getFrameLayoutFromFrameIndex (GC_state s, uint32_t index) {
+getFrameLayoutFromFrameIndex (GC_state s, GC_frameIndex index) {
GC_frameLayout *layout;
if (DEBUG_DETAILED)
fprintf (stderr,
- "index = %"PRIu32
+ "index = "FMTFI
" frameLayoutsLength = %"PRIu32"\n",
index, s->frameLayoutsLength);
assert (index < s->frameLayoutsLength);
@@ -35,7 +35,7 @@
static inline GC_frameLayout *
getFrameLayoutFromReturnAddress (GC_state s, GC_returnAddress ra) {
GC_frameLayout *layout;
- uint32_t index;
+ GC_frameIndex index;
index = getFrameIndexFromReturnAddress (s, ra);
layout = getFrameLayoutFromFrameIndex(s, index);
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h 2005-10-10 01:54:23 UTC (rev 4100)
@@ -37,6 +37,9 @@
uint16_t size;
GC_frameOffsets offsets;
} GC_frameLayout;
+typedef uint32_t GC_frameIndex;
+#define PRIFI PRIu32
+#define FMTFI "%"PRIFI
typedef uintptr_t GC_returnAddress;
#define GC_RETURNADDRESS_SIZE sizeof(GC_returnAddress)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c 2005-10-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -1,9 +1,5 @@
#include "gc.h"
-static inline size_t maxZ (size_t x, size_t y) {
- return ((x < y) ? x : y);
-}
-
static inline size_t meg (size_t n) {
return n / (1024ul * 1024ul);
}
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-10 01:54:23 UTC (rev 4100)
@@ -6,7 +6,7 @@
uint32_t atomicState;
objptr callFromCHandlerThread; /* Handler for exported C calls (in heap). */
bool canMinor; /* TRUE iff there is space for a minor gc. */
- struct GC_control control;
+ struct GC_controls controls;
struct GC_cumulativeStatistics cumulativeStatistics;
objptr currentThread; /* Currently executing thread (in heap). */
uint32_t exnStack;
@@ -21,11 +21,9 @@
pointer limit; /* limit = heap.start + heap.totalBytes */
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
uint32_t maxFrameSize;
- /*Bool*/bool messages; /* Print a message at the start and end of each gc. */
/*Bool*/bool mutatorMarksCards;
GC_objectType *objectTypes; /* Array of object types. */
uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
- size_t pageSize;
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
struct GC_ratios ratios;
objptr savedThread; /* Result of GC_copyCurrentThread.
@@ -37,7 +35,6 @@
pointer stackBottom; /* Bottom of stack in current thread. */
pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
pointer stackTop; /* Top of stack in current thread. */
- /*Bool*/bool summary; /* Print a summary of gc info when program exits. */
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/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-10-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -8,6 +8,34 @@
#define CROSS_MAP_EMPTY ((GC_crossMapElem)255)
+void displayGenerationalMaps (__attribute__ ((unused)) GC_state s,
+ struct GC_generationalMaps *generational,
+ FILE *stream) {
+ fprintf(stream,
+ "\t\tcardMap ="FMTPTR"\n"
+ "\t\tcardMapAbsolute = "FMTPTR"\n"
+ "\t\tcardMapLength = %zu\n"
+ "\t\tcrossMap = "FMTPTR"\n"
+ "\t\tcrossMapLength = %zu\n"
+ "\t\tcrossMapValidSize = %zu\n",
+ (uintptr_t)generational->cardMap,
+ (uintptr_t)generational->cardMapAbsolute,
+ generational->cardMapLength,
+ (uintptr_t)generational->crossMap,
+ generational->crossMapLength,
+ generational->crossMapValidSize);
+ if (DEBUG_GENERATIONAL and DEBUG_DETAILED) {
+ unsigned int i;
+
+ fprintf (stderr, "crossMap trues\n");
+ for (i = 0; i < generational->crossMapLength; ++i)
+ unless (CROSS_MAP_EMPTY == generational->crossMap[i])
+ fprintf (stderr, "\t%u\n", i);
+ fprintf (stderr, "\n");
+ }
+}
+
+
static inline uintptr_t pointerToCardIndex (pointer p) {
return (uintptr_t)p >> CARD_SIZE_LOG2;
}
@@ -84,21 +112,21 @@
size_t totalMapSize;
cardMapLength = sizeToCardIndex (s->heap.size);
- cardMapSize = align (cardMapLength * CARD_MAP_ELEM_SIZE, s->pageSize);
+ cardMapSize = align (cardMapLength * CARD_MAP_ELEM_SIZE, s->sysvals.pageSize);
cardMapLength = cardMapSize / CARD_MAP_ELEM_SIZE;
s->generationalMaps.cardMapLength = cardMapLength;
crossMapLength = sizeToCardIndex (s->heap.size);
- crossMapSize = align (crossMapLength * CROSS_MAP_ELEM_SIZE, s->pageSize);
+ crossMapSize = align (crossMapLength * CROSS_MAP_ELEM_SIZE, s->sysvals.pageSize);
crossMapLength = crossMapSize / CROSS_MAP_ELEM_SIZE;
s->generationalMaps.crossMapLength = crossMapLength;
totalMapSize = cardMapSize + crossMapSize;
if (DEBUG_MEM)
- fprintf (stderr, "Creating card/cross map of size %zd\n",
+ fprintf (stderr, "Creating card/cross map of size %zu\n",
/*uintToCommaString*/(totalMapSize));
s->generationalMaps.cardMap =
- GC_mmapAnon (totalMapSize);
+ GC_mmapAnon_safe (NULL, totalMapSize);
s->generationalMaps.crossMap =
(GC_crossMapElem*)((pointer)s->generationalMaps.cardMap + cardMapSize);
if (DEBUG_CARD_MARKING)
@@ -140,7 +168,7 @@
if (DEBUG)
fprintf (stderr, "crossMapIsOK ()\n");
mapSize = s->generationalMaps.crossMapLength * CROSS_MAP_ELEM_SIZE;
- map = GC_mmapAnon (mapSize);
+ map = GC_mmapAnon_safe (NULL, mapSize);
memset (map, CROSS_MAP_EMPTY, mapSize);
back = s->heap.start + s->heap.oldGenSize;
cardIndex = 0;
@@ -216,7 +244,7 @@
static inline void resizeCardMapAndCrossMap (GC_state s) {
if (s->mutatorMarksCards
and (s->generationalMaps.cardMapLength * CARD_MAP_ELEM_SIZE)
- != align (sizeToCardIndex (s->heap.size), s->pageSize)) {
+ != align (sizeToCardIndex (s->heap.size), s->sysvals.pageSize)) {
GC_cardMapElem *oldCardMap;
size_t oldCardMapSize;
GC_crossMapElem *oldCrossMap;
@@ -235,30 +263,3 @@
GC_munmap (oldCardMap, oldCardMapSize + oldCrossMapSize);
}
}
-
-void displayGenerationalMaps (__attribute__ ((unused)) GC_state s,
- struct GC_generationalMaps *generational,
- FILE *stream) {
- fprintf(stream,
- "\t\tcardMap ="FMTPTR"\n"
- "\t\tcardMapAbsolute = "FMTPTR"\n"
- "\t\tcardMapLength = %zu\n"
- "\t\tcrossMap = "FMTPTR"\n"
- "\t\tcrossMapLength = %zu\n"
- "\t\tcrossMapValidSize = %zu\n",
- (uintptr_t)generational->cardMap,
- (uintptr_t)generational->cardMapAbsolute,
- generational->cardMapLength,
- (uintptr_t)generational->crossMap,
- generational->crossMapLength,
- generational->crossMapValidSize);
- if (DEBUG_GENERATIONAL and DEBUG_DETAILED) {
- unsigned int i;
-
- fprintf (stderr, "crossMap trues\n");
- for (i = 0; i < generational->crossMapLength; ++i)
- unless (CROSS_MAP_EMPTY == generational->crossMap[i])
- fprintf (stderr, "\t%u\n", i);
- fprintf (stderr, "\n");
- }
-}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -0,0 +1,301 @@
+/* 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.
+ */
+
+/* ---------------------------------------------------------------- */
+/* Object hash consing */
+/* ---------------------------------------------------------------- */
+
+/* Hashing based on Introduction to Algorithms by Cormen, Leiserson, and Rivest.
+ * Section numbers in parens.
+ * k is key to be hashed.
+ * table is of size 2^p (it must be a power of two)
+ * Open addressing (12.4), meaning that we stick the entries directly in the
+ * table and probe until we find what we want.
+ * Multiplication method (12.3.2), meaning that we compute the hash by
+ * multiplying by a magic number, chosen by Knuth, and take the high-order p
+ * bits of the low order 32 bits.
+ * Double hashing (12.4), meaning that we use two hash functions, the first to
+ * decide where to start looking and a second to decide at what offset to
+ * probe. The second hash must be relatively prime to the table size, which
+ * we ensure by making it odd and keeping the table size as a power of 2.
+ */
+
+static GC_ObjectHashTable newTable (GC_state s) {
+ int i;
+ uint maxElementsSize;
+ pointer regionStart;
+ pointer regionEnd;
+ GC_ObjectHashTable t;
+
+ NEW (GC_ObjectHashTable, t);
+ // Try to use space in the heap for the elements.
+ if (not (heapIsInit (&s->heap2))) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "using heap2\n");
+ // We have all of heap2 available. Use it.
+ regionStart = s->heap2.start;
+ regionEnd = s->heap2.start + s->heap2.size;
+ } else if (s->amInGC or not s->canMinor) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "using end of heap\n");
+ regionStart = s->frontier;
+ regionEnd = s->limitPlusSlop;
+ } else {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "using minor space\n");
+ // Use the space available for a minor GC.
+ assert (s->canMinor);
+ regionStart = s->heap.start + s->oldGenSize;
+ regionEnd = s->nursery;
+ }
+ maxElementsSize = (regionEnd - regionStart) / sizeof (*(t->elements));
+ if (DEBUG_SHARE)
+ fprintf (stderr, "maxElementsSize = %u\n", maxElementsSize);
+ t->elementsSize = 64; // some small power of two
+ t->log2ElementsSize = 6; // and its log base 2
+ if (maxElementsSize < t->elementsSize) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "too small -- using malloc\n");
+ t->elementsIsInHeap = FALSE;
+ ARRAY (struct GC_ObjectHashElement *, t->elements, t->elementsSize);
+ } else {
+ t->elementsIsInHeap = TRUE;
+ t->elements = (struct GC_ObjectHashElement*)regionStart;
+ // Find the largest power of two that fits.
+ for (; t->elementsSize <= maxElementsSize;
+ t->elementsSize <<= 1, t->log2ElementsSize++)
+ ; // nothing
+ t->elementsSize >>= 1;
+ t->log2ElementsSize--;
+ assert (t->elementsSize <= maxElementsSize);
+ for (i = 0; i < t->elementsSize; ++i)
+ t->elements[i].object = NULL;
+ }
+ t->numElements = 0;
+ t->mayInsert = TRUE;
+ if (DEBUG_SHARE) {
+ fprintf (stderr, "elementsIsInHeap = %s\n",
+ boolToString (t->elementsIsInHeap));
+ fprintf (stderr, "elementsSize = %u\n", t->elementsSize);
+ fprintf (stderr, "0x%08x = newTable ()\n", (uint)t);
+ }
+ return t;
+}
+
+static void destroyTable (GC_ObjectHashTable t) {
+ unless (t->elementsIsInHeap)
+ free (t->elements);
+ free (t);
+}
+
+static inline Pointer tableInsert
+ (GC_state s, GC_ObjectHashTable t, W32 hash, Pointer object,
+ Bool mightBeThere, Header header, W32 tag, Pointer max) {
+ GC_ObjectHashElement e;
+ Header header2;
+ static Bool init = FALSE;
+ static int maxNumProbes = 0;
+ static W64 mult; // magic multiplier for hashing
+ int numProbes;
+ W32 probe;
+ word *p;
+ word *p2;
+ W32 slot; // slot in hash table we are considering
+
+ if (DEBUG_SHARE)
+ fprintf (stderr, "tableInsert (%u, 0x%08x, %s, 0x%08x, 0x%08x)\n",
+ (uint)hash, (uint)object,
+ boolToString (mightBeThere),
+ (uint)header, (uint)max);
+ if (! init) {
+ init = TRUE;
+ mult = floor (((sqrt (5.0) - 1.0) / 2.0)
+ * (double)0x100000000llu);
+ }
+ slot = (W32)(mult * (W64)hash) >> (32 - t->log2ElementsSize);
+ probe = (1 == slot % 2) ? slot : slot - 1;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "probe = 0x%08x\n", (uint)probe);
+ assert (1 == probe % 2);
+ numProbes = 0;
+look:
+ if (DEBUG_SHARE)
+ fprintf (stderr, "slot = 0x%08x\n", (uint)slot);
+ assert (0 <= slot and slot < t->elementsSize);
+ numProbes++;
+ e = &t->elements[slot];
+ if (NULL == e->object) {
+ /* It's not in the table. Add it. */
+ unless (t->mayInsert) {
+ if (DEBUG_SHARE)
+ fprintf (stderr, "not inserting\n");
+ return object;
+ }
+ e->hash = hash;
+ e->object = object;
+ t->numElements++;
+ if (numProbes > maxNumProbes) {
+ maxNumProbes = numProbes;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "numProbes = %d\n", numProbes);
+ }
+ return object;
+ }
+ unless (hash == e->hash) {
+lookNext:
+ slot = (slot + probe) % t->elementsSize;
+ goto look;
+ }
+ unless (mightBeThere)
+ goto lookNext;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "comparing 0x%08x to 0x%08x\n",
+ (uint)object, (uint)e->object);
+ /* Compare object to e->object. */
+ unless (object == e->object) {
+ header2 = GC_getHeader (e->object);
+ unless (header == header2)
+ goto lookNext;
+ for (p = (word*)object, p2 = (word*)e->object;
+ p < (word*)max;
+ ++p, ++p2)
+ unless (*p == *p2)
+ goto lookNext;
+ if (ARRAY_TAG == tag
+ and (GC_arrayNumElements (object)
+ != GC_arrayNumElements (e->object)))
+ goto lookNext;
+ }
+ /* object is equal to e->object. */
+ return e->object;
+}
+
+static void maybeGrowTable (GC_state s, GC_ObjectHashTable t) {
+ int i;
+ GC_ObjectHashElement oldElement;
+ struct GC_ObjectHashElement *oldElements;
+ uint oldSize;
+ uint newSize;
+
+ if (not t->mayInsert or t->numElements * 2 <= t->elementsSize)
+ return;
+ oldElements = t->elements;
+ oldSize = t->elementsSize;
+ newSize = oldSize * 2;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "trying to grow table to size %d\n", newSize);
+ // Try to alocate the new table.
+ ARRAY_UNSAFE (struct GC_ObjectHashElement *, t->elements, newSize);
+ if (NULL == t->elements) {
+ t->mayInsert = FALSE;
+ t->elements = oldElements;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "unable to grow table\n");
+ return;
+ }
+ t->elementsSize = newSize;
+ t->log2ElementsSize++;
+ for (i = 0; i < oldSize; ++i) {
+ oldElement = &oldElements[i];
+ unless (NULL == oldElement->object)
+ tableInsert (s, t, oldElement->hash, oldElement->object,
+ FALSE, 0, 0, 0);
+ }
+ if (t->elementsIsInHeap)
+ t->elementsIsInHeap = FALSE;
+ else
+ free (oldElements);
+ if (DEBUG_SHARE)
+ fprintf (stderr, "done growing table\n");
+}
+
+static Pointer hashCons (GC_state s, Pointer object, Bool countBytesHashConsed) {
+ Bool hasIdentity;
+ Word32 hash;
+ Header header;
+ pointer max;
+ uint numNonPointers;
+ uint numPointers;
+ word *p;
+ Pointer res;
+ GC_ObjectHashTable t;
+ uint tag;
+
+ if (DEBUG_SHARE)
+ fprintf (stderr, "hashCons (0x%08x)\n", (uint)object);
+ t = s->objectHashTable;
+ header = GC_getHeader (object);
+ SPLIT_HEADER ();
+ if (hasIdentity) {
+ /* Don't hash cons. */
+ res = object;
+ goto done;
+ }
+ assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
+ max = object
+ + (ARRAY_TAG == tag
+ ? arrayNumBytes (s, object,
+ numPointers, numNonPointers)
+ : toBytes (numPointers + numNonPointers));
+ // Compute the hash.
+ hash = header;
+ for (p = (word*)object; p < (word*)max; ++p)
+ hash = hash * 31 + *p;
+ /* Insert into table. */
+ res = tableInsert (s, t, hash, object, TRUE, header, tag, (Pointer)max);
+ maybeGrowTable (s, t);
+ if (countBytesHashConsed and res != object) {
+ uint amount;
+
+ amount = max - object;
+ if (ARRAY_TAG == tag)
+ amount += GC_ARRAY_HEADER_SIZE;
+ else
+ amount += GC_NORMAL_HEADER_SIZE;
+ s->bytesHashConsed += amount;
+ }
+done:
+ if (DEBUG_SHARE)
+ fprintf (stderr, "0x%08x = hashCons (0x%08x)\n",
+ (uint)res, (uint)object);
+ return res;
+}
+
+static inline void maybeSharePointer (GC_state s,
+ Pointer *pp,
+ Bool shouldHashCons) {
+ unless (shouldHashCons)
+ return;
+ if (DEBUG_SHARE)
+ fprintf (stderr, "maybeSharePointer pp = 0x%08x *pp = 0x%08x\n",
+ (uint)pp, (uint)*pp);
+ *pp = hashCons (s, *pp, FALSE);
+}
+
+static void bytesHashConsedMessage (GC_state s, ullong total) {
+ fprintf (stderr, "%s bytes hash consed (%.1f%%).\n",
+ ullongToCommaString (s->bytesHashConsed),
+ 100.0 * ((double)s->bytesHashConsed / (double)total));
+}
+
+void GC_share (GC_state s, Pointer object) {
+ W32 total;
+
+ if (DEBUG_SHARE)
+ fprintf (stderr, "GC_share 0x%08x\n", (uint)object);
+ if (DEBUG_SHARE or s->messages)
+ s->bytesHashConsed = 0;
+ // Don't hash cons during the first round of marking.
+ total = mark (s, object, MARK_MODE, FALSE);
+ s->objectHashTable = newTable (s);
+ // Hash cons during the second round of marking.
+ mark (s, object, UNMARK_MODE, TRUE);
+ destroyTable (s->objectHashTable);
+ if (DEBUG_SHARE or s->messages)
+ bytesHashConsedMessage (s, total);
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.h 2005-10-10 01:54:23 UTC (rev 4100)
@@ -0,0 +1,33 @@
+/* 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.
+ */
+
+/* ---------------------------------------------------------------- */
+/* Object hash consing */
+/* ---------------------------------------------------------------- */
+
+typedef uint32_t GC_hash;
+
+typedef struct GC_objectHashElement {
+ GC_hash hash;
+ pointer object;
+} *GC_objectHashElement;
+
+typedef struct GC_objectHashTable {
+ struct GC_objectHashElement *elements;
+ bool elementsIsInHeap;
+ size_t elementsSize;
+ int log2ElementsSize;
+ bool mayInsert;
+ int32_t numElements;
+} *GC_ObjectHashTable;
+
+pointer hashCons (GC_state s, pointer object,
+ bool countBytesHashConsed);
+void maybeShareObjptr (GC_state s,
+ objptr *opp,
+ bool shouldHashCons);
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-09 19:59:19 UTC (rev 4099)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-10 01:54:23 UTC (rev 4100)
@@ -5,91 +5,134 @@
* See the file MLton-LICENSE for details.
*/
-static inline bool pointerIsInHeap (GC_state s, pointer p) {
- return (not (isPointer (p))
- or (s->heap.start <= p
- and p < s->frontier));
+void displayHeap (__attribute__ ((unused)) GC_state s,
+ GC_heap heap,
+ FILE *stream) {
+ fprintf(stream,
+ "\t\tnursery ="FMTPTR"\n"
+ "\t\toldGenSize = %zu\n"
+ "\t\tstart = "FMTPTR"\n"
+ "\t\tsize = %zu\n",
+ (uintptr_t)heap->nursery,
+ heap->oldGenSize,
+ (uintptr_t)heap->start,
+ heap->size);
}
-static inline bool objptrIsInHeap (GC_state s, objptr op) {
- pointer p;
- if (not (isObjptr(op)))
- return TRUE;
- p = objptrToPointer (op, s->heap.start);
- return pointerIsInHeap (s, p);
-}
-static inline bool pointerIsInOldGen (GC_state s, pointer p) {
- return (not (isPointer (p))
- or (s->heap.start <= p
- and p < s->heap.start + s->heap.oldGenSize));
+static inline void heapInit (GC_heap h) {
+ h->start = NULL;
+ h->size = 0;
+ h->oldGenSize = 0;
+ h->nursery = NULL;
}
-static inline bool objptrIsInOldGen (GC_state s, objptr op) {
- pointer p;
- if (not (isObjptr(op)))
- return TRUE;
- p = objptrToPointer (op, s->heap.start);
- return pointerIsInOldGen (s, p);
+static void heapRelease (GC_state s, GC_heap h) {
+ if (NULL == h->start)
+ return;
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr, "Releasing heap at "FMTPTR" of size %zu.\n",
+ (uintptr_t)h->start,
+ /*uintToCommaString*/(h->size));
+ GC_release (h->start, h->size);
+ heapInit (h);
}
-static inline bool pointerIsInNursery (GC_state s, pointer p) {
- return (not (isPointer (p))
- or (s->heap.nursery <= p and p < s->frontier));
+static void heapShrink (GC_state s, GC_heap h, size_t keep) {
+ assert (keep <= h->size);
+ if (0 == keep) {
+ heapRelease (s, h);
+ return;
+ }
+ keep = align (keep, s->sysvals.pageSize);
+ if (keep < h->size) {
+ if (DEBUG or s->controls.messages)
+ fprintf (stderr,
+ "Shrinking heap at "FMTPTR" of size %zu to %zu bytes.\n",
+ (uintptr_t)h->start,
+ /*uintToCommaString*/(h->size),
+ /*uintToCommaString*/(keep));
+ GC_decommit (h->start + keep, h->size - keep);
+ h->size = keep;
+ }
}
-static inline bool objptrIsInNursery (GC_state s, objptr op) {
- pointer p;
- if (not (isObjptr(op)))
- return TRUE;
- p = objptrToPointer (op, s->heap.start);
- return pointerIsInNursery (s, p);
-}
+/* heapCreate (s, h, desiredSize, minSize)
+ *
+ * allocates a heap of the size necessary to work with desiredSize
+ * live data, and ensures that at least minSize is available. It
+ * returns TRUE if it is able to allocate the space, and returns FALSE
+ * if it is unable. If a reaso...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2005-10-09 12:59:29
|
Some heap management
----------------------------------------------------------------------
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.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c
A 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/current.c
A 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/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/heap.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c
A 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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-09 19:59:19 UTC (rev 4099)
@@ -73,22 +73,28 @@
## Order matters, as these are concatenated together to form "gc.c".
CFILES = \
gc_prefix.c \
+ util.c \
debug.c \
align.c \
+ virtual-memory.c \
pointer.c \
model.c \
object.c \
array.c \
+ object_size.c \
frame.c \
stack.c \
thread.c \
generational.c \
heap.c \
+ gc_state.c \
+ new_object.c \
ratios.c \
- gc_state.c \
current.c \
foreach.c \
+ atomic.c \
invariant.c \
+ enter_leave.c \
cheney-copy.c \
assumptions.c \
gc_suffix.c
@@ -106,14 +112,15 @@
stack.h \
thread.h \
weak.h \
+ heap.h \
major.h \
generational.h \
statistics.h \
- heap.h \
control.h \
sysvals.h \
ratios.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/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -17,30 +17,17 @@
return a;
}
-/*
-static inline W64 w64align (W64 a, uint b) {
- W64 res;
-
- assert (a >= 0);
- assert (b >= 1);
- res = a + b - 1;
- res = res - res % b;
- if (FALSE)
- fprintf (stderr, "%llu = w64Align (%llu, %u)\n", res, a, b);
- return res;
-}
-*/
-
static inline bool isAligned (size_t a, size_t b) {
return 0 == a % b;
}
#if ASSERT
static inline bool isAlignedFrontier (GC_state s, pointer p) {
- return isAligned ((uintptr_t)p + GC_NORMAL_HEADER_SIZE, s->alignment);
+ return isAligned ((uintptr_t)p + GC_NORMAL_HEADER_SIZE,
+ s->alignment);
}
-static bool isAlignedReserved (GC_state s, size_t reserved) {
+static inline bool isAlignedReserved (GC_state s, size_t reserved) {
return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved,
s->alignment);
}
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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -52,32 +52,3 @@
result = OBJPTR_SIZE;
return pad (s, result, GC_ARRAY_HEADER_SIZE);
}
-
-static inline size_t objectSize (GC_state s, pointer p) {
- size_t headerBytes, objectBytes;
- GC_header header;
- GC_objectTypeTag tag;
- uint16_t numNonObjptrs, numObjptrs;
-
- header = getHeader (p);
- splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
- if (NORMAL_TAG == tag) { /* Fixed size object. */
- headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes =
- numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
- + (numObjptrs * OBJPTR_SIZE);
- } else if (ARRAY_TAG == tag) {
- headerBytes = GC_ARRAY_HEADER_SIZE;
- objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
- } else if (WEAK_TAG == tag) {
- headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes =
- numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
- + (numObjptrs * OBJPTR_SIZE);
- } else { /* Stack. */
- assert (STACK_TAG == tag);
- headerBytes = GC_STACK_HEADER_SIZE;
- objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
- }
- return headerBytes + objectBytes;
-}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c (from rev 4098, mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array_defs.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -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.
+ */
+
+#if ASSERT
+static inline pointer arrayIndexAtPointer (GC_state s,
+ pointer a,
+ uint32_t arrayIndex,
+ uint32_t pointerIndex) {
+ GC_header header;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
+ GC_objectTypeTag tag;
+
+ header = getHeader (a);
+ splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ assert (tag == ARRAY_TAG);
+
+ size_t nonObjptrBytesPerElement =
+ numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG);
+ size_t bytesPerElement =
+ nonObjptrBytesPerElement
+ + (numObjptrs * OBJPTR_SIZE);
+
+ return a
+ + arrayIndex * bytesPerElement
+ + nonObjptrBytesPerElement
+ + pointerIndex * OBJPTR_SIZE;
+}
+#endif
+
+/* The number of bytes in an array, not including the header. */
+static inline size_t arrayNumBytes (GC_state s,
+ pointer p,
+ uint16_t numNonObjptrs,
+ uint16_t numObjptrs) {
+ size_t bytesPerElement;
+ GC_arrayLength numElements;
+ size_t result;
+
+ numElements = getArrayLength (p);
+ bytesPerElement =
+ numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ result = numElements * bytesPerElement;
+ /* Empty arrays have OBJPTR_SIZE bytes for the forwarding pointer. */
+ if (0 == result)
+ result = OBJPTR_SIZE;
+ return pad (s, result, GC_ARRAY_HEADER_SIZE);
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/atomic.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -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.
+ */
+
+static inline void atomicBegin (GC_state s) {
+ s->atomicState++;
+ if (0 == s->limit)
+ s->limit = s->limitPlusSlop - LIMIT_SLOP;
+}
+
+static inline void atomicEnd (GC_state s) {
+ s->atomicState--;
+ if (0 == s->atomicState and s->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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -169,7 +169,7 @@
} else {
if (DEBUG_WEAK)
fprintf (stderr, "cleared\n");
- *(getHeaderp(p)) = WEAK_GONE_HEADER;
+ *(getHeaderp(p)) = GC_WEAK_GONE_HEADER;
w->objptr = BOGUS_OBJPTR;
}
}
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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -28,3 +28,16 @@
static inline size_t currentStackUsed (GC_state s) {
return s->stackTop - s->stackBottom;
}
+
+static void setCurrentStack (GC_state s) {
+ GC_thread thread;
+ GC_stack stack;
+
+ thread = currentThread (s);
+ s->exnStack = thread->exnStack;
+ stack = currentThreadStack (s);
+ s->stackBottom = stackBottom (s, stack);
+ s->stackTop = stackTop (s, stack);
+ s->stackLimit = stackLimit (s, stack);
+ markCard (s, (pointer)stack);
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,39 @@
+/* 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.
+ */
+
+/* enter and leave should be called at the start and end of every GC
+ * function that is exported to the outside world. They make sure
+ * that the function is run in a critical section and check the GC
+ * invariant.
+ */
+static 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;
+ if (DEBUG)
+ displayGCState (s, stderr);
+ atomicBegin (s);
+ assert (invariant (s));
+ if (DEBUG)
+ fprintf (stderr, "enter ok\n");
+}
+
+static void leave (GC_state s) {
+ if (DEBUG)
+ fprintf (stderr, "leave\n");
+ /* The mutator frontier invariant may not hold
+ * for functions that don't ensureBytesFree.
+ */
+ assert (mutatorInvariant (s, FALSE, TRUE));
+ atomicEnd (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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -59,7 +59,7 @@
" tag = %s"
" numNonObjptrs = %d"
" numObjptrs = %d\n",
- (uintptr_t)p, header, tagToString (tag),
+ (uintptr_t)p, header, objectTypeTagToString (tag),
numNonObjptrs, numObjptrs);
if (NORMAL_TAG == tag) {
p += numNonObjptrsToBytes(numNonObjptrs, NORMAL_TAG);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c 2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_prefix.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -3,3 +3,8 @@
static inline size_t maxZ (size_t x, size_t y) {
return ((x < y) ? x : y);
}
+
+static inline size_t meg (size_t n) {
+ return n / (1024ul * 1024ul);
+}
+
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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-09 19:59:19 UTC (rev 4099)
@@ -3,11 +3,13 @@
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. */
struct GC_control control;
struct GC_cumulativeStatistics cumulativeStatistics;
objptr currentThread; /* Currently executing thread (in heap). */
+ uint32_t exnStack;
GC_frameLayout *frameLayouts; /* Array of frame layouts. */
uint32_t frameLayoutsLength; /* Cardinality of frameLayouts array. */
pointer frontier; /* heap.start <= frontier < limit */
@@ -31,6 +33,7 @@
*/
struct GC_heap secondaryHeap; /* Used for major copying collection. */
objptr signalHandlerThread; /* Handler for signals (in heap). */
+ /*Bool*/bool signalIsPending;
pointer stackBottom; /* Bottom of stack in current thread. */
pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
pointer stackTop; /* Top of stack in current thread. */
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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -55,7 +55,7 @@
}
#if ASSERT
-static bool hasBytesFree (GC_state s, size_t oldGen, size_t nursery) {
+static bool heapHasBytesFree (GC_state s, size_t oldGen, size_t nursery) {
size_t total;
bool res;
@@ -67,7 +67,7 @@
and (nursery <= (size_t)(s->limitPlusSlop - s->frontier));
if (DEBUG_DETAILED)
fprintf (stderr, "%s = hasBytesFree (%zd, %zd)\n",
- res ? "true" : "false",
+ boolToString (res),
/*uintToCommaString*/(oldGen),
/*uintToCommaString*/(nursery));
return res;
@@ -268,5 +268,69 @@
s->frontier = s->heap.nursery;
assert (nurseryBytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
assert (isAlignedFrontier (s, s->heap.nursery));
- assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+ assert (heapHasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
}
+
+/* heapCreate (s, h, desiredSize, minSize)
+ *
+ * allocates a heap of the size necessary to work with desiredSize
+ * live data, and ensures that at least minSize is available. It
+ * returns TRUE if it is able to allocate the space, and returns FALSE
+ * if it is unable. If a reasonable size to space is already there,
+ * then heapCreate leaves it.
+ */
+static bool heapCreate (GC_state s, GC_heap h,
+ size_t desiredSize,
+ size_t minSize) {
+ size_t backoff;
+
+ if (DEBUG_MEM)
+ fprintf (stderr, "heapCreate desired size = %zd min size = %zd\n",
+ /*uintToCommaString*/(desiredSize),
+ /*uintToCommaString*/(minSize));
+ assert (heapIsInit (h));
+ if (desiredSize < minSize)
+ desiredSize = minSize;
+ desiredSize = align (desiredSize, s->sysvals.pageSize);
+ assert (0 == h->size and NULL == h->start);
+ backoff = (desiredSize - minSize) / 20;
+ if (0 == backoff)
+ backoff = 1; /* enough to terminate the loop below */
+ backoff = align (backoff, s->sysvals.pageSize);
+ /* mmap toggling back and forth between high and low addresses to
+ * decrease the chance of virtual memory fragmentation causing an mmap
+ * to fail. This is important for large heaps.
+ */
+ for (h->size = desiredSize; h->size >= minSize; h->size -= backoff) {
+ static bool direction = TRUE;
+ unsigned int i;
+
+ assert (isAligned (h->size, s->sysvals.pageSize));
+ for (i = 0; i < 32; i++) {
+ size_t address;
+
+ address = i * 0x08000000ul;
+ if (direction)
+ address = 0xf8000000ul - address;
+ h->start = GC_mmap ((void*)address, h->size);
+ if ((void*)-1 == h->start)
+ h->start = (void*)NULL;
+ unless ((void*)NULL == h->start) {
+ direction = not direction;
+ if (h->size > s->cumulativeStatistics.maxHeapSizeSeen)
+ s->cumulativeStatistics.maxHeapSizeSeen = h->size;
+ if (DEBUG or s->messages)
+ fprintf (stderr, "Created heap of size %zd at "FMTPTR".\n",
+ /*uintToCommaString*/(h->size),
+ (uintptr_t)h->start);
+ assert (h->size >= minSize);
+ return TRUE;
+ }
+ }
+ if (s->messages)
+ fprintf(stderr, "[Requested %zuM cannot be satisfied, backing off by %zuM (min size = %zuM).\n",
+ meg (h->size), meg (backoff), meg (minSize));
+ }
+ h->size = 0;
+ return FALSE;
+}
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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -52,7 +52,7 @@
assert (s->heap.nursery <= s->frontier);
assert (s->frontier <= s->limitPlusSlop);
assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
- assert (hasBytesFree (s, 0, 0));
+ assert (heapHasBytesFree (s, 0, 0));
}
assert (s->secondaryHeap.start == NULL
or s->heap.size == s->secondaryHeap.size);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/new_object.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,67 @@
+/* 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.
+ */
+
+/* newObject (s, header, bytesRequested, allocInOldGen)
+ *
+ * Allocate a new object in the heap.
+ * bytesRequested includes the size of the header.
+ */
+static pointer newObject (GC_state s,
+ GC_header header,
+ size_t bytesRequested,
+ bool allocInOldGen) {
+ pointer frontier;
+ pointer result;
+
+ assert (isAligned (bytesRequested, s->alignment));
+ assert (allocInOldGen
+ ? heapHasBytesFree (s, bytesRequested, 0)
+ : heapHasBytesFree (s, 0, bytesRequested));
+ if (allocInOldGen) {
+ frontier = s->heap.start + s->heap.oldGenSize;
+ s->heap.oldGenSize += bytesRequested;
+ s->cumulativeStatistics.bytesAllocated += bytesRequested;
+ } else {
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "frontier changed from "FMTPTR" to "FMTPTR"\n",
+ (uintptr_t)s->frontier,
+ (uintptr_t)(s->frontier + bytesRequested));
+ frontier = s->frontier;
+ s->frontier += bytesRequested;
+ }
+ GC_profileAllocInc (s, bytesRequested);
+ *(GC_header*)(frontier) = header;
+ result = frontier + GC_NORMAL_HEADER_SIZE;
+ if (DEBUG)
+ fprintf (stderr, FMTPTR " = newObject ("FMTHDR", %zd, %s)\n",
+ (uintptr_t)result,
+ header,
+ bytesRequested,
+ boolToString (allocInOldGen));
+ return result;
+}
+
+static GC_stack newStack (GC_state s,
+ size_t reserved,
+ bool allocInOldGen) {
+ GC_stack stack;
+
+ reserved = stackReserved (s, reserved);
+ if (reserved > s->cumulativeStatistics.maxStackSizeSeen)
+ s->cumulativeStatistics.maxStackSizeSeen = reserved;
+ stack = (GC_stack) newObject (s, GC_STACK_HEADER,
+ stackNumBytes (s, reserved),
+ allocInOldGen);
+ stack->reserved = reserved;
+ stack->used = 0;
+ if (DEBUG_STACKS)
+ fprintf (stderr, FMTPTR " = newStack (%zd)\n",
+ (uintptr_t)stack,
+ reserved);
+ return stack;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -6,21 +6,8 @@
* See the file MLton-LICENSE for details.
*/
-/*
- * Build the header for an object, given the index to its type info.
- */
-static inline GC_header GC_objectHeader (uint32_t t) {
- assert (t < TWOPOWER (TYPE_INDEX_BITS));
- return 1 | (t << 1);
-}
-#define STACK_HEADER GC_objectHeader (STACK_TYPE_INDEX)
-#define STRING_HEADER GC_objectHeader (STRING_TYPE_INDEX)
-#define THREAD_HEADER GC_objectHeader (THREAD_TYPE_INDEX)
-#define WEAK_GONE_HEADER GC_objectHeader (WEAK_GONE_TYPE_INDEX)
-#define WORD8_VECTOR_HEADER GC_objectHeader (WORD8_TYPE_INDEX)
-
-static char* tagToString (GC_objectTypeTag tag) {
+static char* objectTypeTagToString (GC_objectTypeTag tag) {
switch (tag) {
case ARRAY_TAG:
return "ARRAY";
@@ -35,6 +22,20 @@
}
}
+/*
+ * Build the header for an object, given the index to its type info.
+ */
+static inline GC_header GC_objectHeader (uint32_t t) {
+ assert (t < TWOPOWER (TYPE_INDEX_BITS));
+ return 1 | (t << 1);
+}
+
+#define GC_STACK_HEADER GC_objectHeader (STACK_TYPE_INDEX)
+#define GC_STRING_HEADER GC_objectHeader (STRING_TYPE_INDEX)
+#define GC_THREAD_HEADER GC_objectHeader (THREAD_TYPE_INDEX)
+#define GC_WEAK_GONE_HEADER GC_objectHeader (WEAK_GONE_TYPE_INDEX)
+#define GC_WORD8_VECTOR_HEADER GC_objectHeader (WORD8_TYPE_INDEX)
+
static inline void splitHeader(GC_state s, GC_header header,
GC_objectTypeTag *tagRet, bool *hasIdentityRet,
uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet) {
@@ -61,7 +62,7 @@
" numNonObjptrs = %"PRIu16
" numObjptrs = %"PRIu16"\n",
header,
- tagToString(tag), hasIdentity, numNonObjptrs, numObjptrs);
+ objectTypeTagToString(tag), hasIdentity, numNonObjptrs, numObjptrs);
if (tagRet != NULL)
*tagRet = tag;
@@ -73,6 +74,20 @@
*numObjptrsRet = numObjptrs;
}
+static inline size_t numNonObjptrsToBytes (uint16_t numNonObjptrs,
+ GC_objectTypeTag tag) {
+ switch (tag) {
+ case ARRAY_TAG:
+ return (size_t)(numNonObjptrs);
+ case NORMAL_TAG:
+ return (size_t)(numNonObjptrs) * 4;
+ case WEAK_TAG:
+ return (size_t)(numNonObjptrs) * 4;
+ default:
+ die ("bad tag %u", tag);
+ }
+}
+
/* objectData (s, p)
*
* If p points at the beginning of an object, then objectData returns
@@ -93,17 +108,3 @@
assert (isAligned ((uintptr_t)res, s->alignment));
return res;
}
-
-static inline size_t numNonObjptrsToBytes (uint16_t numNonObjptrs,
- GC_objectTypeTag tag) {
- switch (tag) {
- case ARRAY_TAG:
- return (size_t)(numNonObjptrs);
- case NORMAL_TAG:
- return (size_t)(numNonObjptrs) * 4;
- case WEAK_TAG:
- return (size_t)(numNonObjptrs) * 4;
- default:
- die ("bad tag %u", tag);
- }
-}
Added: 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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_size.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,36 @@
+/* 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 inline size_t objectSize (GC_state s, pointer p) {
+ size_t headerBytes, objectBytes;
+ GC_header header;
+ GC_objectTypeTag tag;
+ uint16_t numNonObjptrs, numObjptrs;
+
+ header = getHeader (p);
+ splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ if (NORMAL_TAG == tag) { /* Fixed size object. */
+ headerBytes = GC_NORMAL_HEADER_SIZE;
+ objectBytes =
+ numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ } else if (ARRAY_TAG == tag) {
+ headerBytes = GC_ARRAY_HEADER_SIZE;
+ objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
+ } else if (WEAK_TAG == tag) {
+ headerBytes = GC_NORMAL_HEADER_SIZE;
+ objectBytes =
+ numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ } else { /* Stack. */
+ assert (STACK_TAG == tag);
+ headerBytes = GC_STACK_HEADER_SIZE;
+ objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+ }
+ return headerBytes + objectBytes;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c 2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -11,16 +11,3 @@
uintptr_t mask = ~((~((uintptr_t)0)) << GC_MODEL_MINALIGN_SHIFT);
return (0 == ((uintptr_t)p & mask));
}
-
-static inline void GC_memcpy (pointer src, pointer dst, size_t size) {
- if (DEBUG_DETAILED)
- fprintf (stderr, "GC_memcpy ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)src, (uintptr_t)dst, size);
- assert (isAligned ((uintptr_t)src, sizeof(unsigned int)));
- assert (isAligned ((uintptr_t)dst, sizeof(unsigned int)));
- assert (isAligned (size, sizeof(unsigned int)));
- assert (dst <= src or src + size <= dst);
- if (src == dst)
- return;
- memcpy (dst, src, size);
-}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profile.h 2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,23 @@
+/* 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_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/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-10-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -93,6 +93,21 @@
return stack->used + stackSlop (s) - topFrameSize(s, stack);
}
+static inline void stackCopy (GC_state s, GC_stack from, GC_stack to) {
+ pointer fromBottom, toBottom;
+
+ fromBottom = stackBottom (s, from);
+ toBottom = stackBottom (s, to);
+ assert (from->used <= to->reserved);
+ to->used = from->used;
+ if (DEBUG_STACKS)
+ fprintf (stderr, "stackCopy from "FMTPTR" to "FMTPTR" of length %zd\n",
+ (uintptr_t) fromBottom,
+ (uintptr_t) toBottom,
+ from->used);
+ memcpy (fromBottom, toBottom, from->used);
+}
+
void displayStack (__attribute__ ((unused)) GC_state s,
GC_stack stack,
FILE *stream) {
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/platform.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,10 @@
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+char* boolToString (bool b) {
+ return b ? "TRUE" : "FALSE";
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.c 2005-10-09 19:59:19 UTC (rev 4099)
@@ -0,0 +1,20 @@
+/* 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 inline void GC_memcpy (pointer src, pointer dst, size_t size) {
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "GC_memcpy ("FMTPTR", "FMTPTR", %zu)\n",
+ (uintptr_t)src, (uintptr_t)dst, size);
+ assert (isAligned ((uintptr_t)src, sizeof(unsigned int)));
+ assert (isAligned ((uintptr_t)dst, sizeof(unsigned int)));
+ assert (isAligned (size, sizeof(unsigned int)));
+ assert (dst <= src or src + size <= dst);
+ if (src == dst)
+ return;
+ memcpy (dst, src, size);
+}
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-08 20:36:15 UTC (rev 4098)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-10-09 19:59:19 UTC (rev 4099)
@@ -8,6 +8,6 @@
void *GC_mmapAnon (size_t length);
void *GC_mmap (void *start, size_t length);
-void *GC_munmap (void *base, size_t length);
+void GC_munmap (void *start, size_t length);
void GC_release (void *base, size_t length);
void GC_decommit (void *base, size_t length);
|
|
From: Matthew F. <fl...@ml...> - 2005-10-08 13:36:28
|
More invariant and heap functions
----------------------------------------------------------------------
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/align.c
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/cheney-copy.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
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/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/generational.c
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/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.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/object.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/sysvals.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.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.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-10-08 20:36:15 UTC (rev 4098)
@@ -49,14 +49,24 @@
endif
CC = gcc -std=gnu99
-CWFLAGS = -Wall -pedantic -Wextra -Wshadow -Wpointer-arith -Wcast-qual -Wcast-align -Wconversion -Wsign-compare -Wstrict-prototypes -Wredundant-decls -Winline
-CWFLAGS = -pedantic -Wall -Wextra -Wno-unused \
-## -Wshadow \
+CWFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter \
+ -Wformat-nonliteral \
+ -Wuninitialized -Winit-self \
+ -Wstrict-aliasing=2 \
+ -Wfloat-equal \
+ -Wpointer-arith \
+ -Wbad-function-cast -Wcast-qual -Wcast-align \
+ -Waggregate-return \
+ -Wstrict-prototypes \
+ -Wmissing-noreturn -Wmissing-format-attribute \
+ -Wpacked \
-Wredundant-decls \
- -Wpointer-arith -Wcast-qual -Wcast-align \
-## -Wconversion \
- -Wstrict-prototypes \
- -Winline
+ -Wnested-externs
+## -Wshadow
+## -Wconversion
+## -Wmissing-prototypes
+## -Wmissing-declarations
+## -Winline -Wdisabled-optimization
CFLAGS = -O2 $(CWFLAGS) -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
DEBUGFLAGS = $(CFLAGS) -Wunused -gstabs+ -g2
@@ -74,9 +84,11 @@
thread.c \
generational.c \
heap.c \
+ ratios.c \
gc_state.c \
+ current.c \
+ foreach.c \
invariant.c \
- foreach.c \
cheney-copy.c \
assumptions.c \
gc_suffix.c
@@ -98,6 +110,9 @@
generational.h \
statistics.h \
heap.h \
+ control.h \
+ sysvals.h \
+ ratios.h \
gc_state.h \
gc_suffix.h
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-10-08 20:36:15 UTC (rev 4098)
@@ -15,3 +15,5 @@
codegen in thread.h is still true; it used to be the case when
GC_switchToThread was implemented in codegens. Now it should
be implemented in Backend.
+* the "skipObjects" loop in forwardInterGenerationalObjptrs appears to
+ be unnecessary.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -6,6 +6,10 @@
* See the file MLton-LICENSE for details.
*/
+static inline size_t roundDown (size_t a, size_t b) {
+ return a - (a % b);
+}
+
static inline size_t align (size_t a, size_t b) {
assert (b >= 1);
a += b - 1;
@@ -36,12 +40,10 @@
return isAligned ((uintptr_t)p + GC_NORMAL_HEADER_SIZE, s->alignment);
}
-/*
-static bool isAlignedReserved (GC_state s, uint r) {
- return isAligned (STACK_HEADER_SIZE + sizeof (struct GC_stack) + r,
+static bool isAlignedReserved (GC_state s, size_t reserved) {
+ return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved,
s->alignment);
}
-*/
#endif
static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
@@ -49,7 +51,11 @@
}
static inline pointer alignFrontier (GC_state s, pointer p) {
- return (pointer) pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
+ size_t bytes, res;
+
+ bytes = (size_t) p;
+ res = pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
+ return (pointer)res;
}
pointer GC_alignFrontier (GC_state s, pointer p) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -42,7 +42,7 @@
GC_arrayLength numElements;
size_t result;
- numElements = arrayNumElements (p);
+ numElements = getArrayLength (p);
bytesPerElement =
numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
+ (numObjptrs * OBJPTR_SIZE);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -23,10 +23,18 @@
#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)
-static inline GC_arrayLength* arrayNumElementsp (pointer a) {
+/* getArrayNumElementsp (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);
}
-static inline GC_arrayLength arrayNumElements (pointer a) {
- return *(arrayNumElementsp (a));
+/* getArrayNumElements (p)
+ *
+ * Returns the length for the array pointed to by p.
+ */
+static inline GC_arrayLength getArrayLength (pointer a) {
+ return *(getArrayLengthp (a));
}
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-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -24,14 +24,6 @@
};
static struct forwardState forwardState;
-static inline bool pointerIsInFromSpace (GC_state s, pointer p) {
- return (pointerIsInOldGen (s, p) or pointerIsInNursery (s, p));
-}
-
-static inline bool objptrIsInFromSpace (GC_state s, objptr op) {
- return (objptrIsInOldGen (s, op) or objptrIsInNursery (s, op));
-}
-
static inline bool pointerIsInToSpace (pointer p) {
return (not (isPointer (p))
or (forwardState.toStart <= p and p < forwardState.toLimit));
@@ -87,7 +79,7 @@
headerBytes = GC_STACK_HEADER_SIZE;
stack = (GC_stack)p;
- if (currentThreadStack(s) == op) {
+ if (currentThreadStackObjptr(s) == op) {
/* Shrink stacks that don't use a lot of their reserved space;
* but don't violate the stack invariant.
*/
@@ -111,7 +103,7 @@
} else {
/* Shrink heap stacks. */
stack->reserved =
- stackReserved (s, maxZ((size_t)(s->threadShrinkRatio * stack->reserved),
+ stackReserved (s, maxZ((size_t)(s->ratios.threadShrink * stack->reserved),
stack->used));
if (DEBUG_STACKS)
fprintf (stderr, "Shrinking stack to size %zd.\n",
@@ -204,7 +196,7 @@
assert (s->secondaryHeap.size >= s->heap.oldGenSize);
/* if (detailedGCTime (s)) */
/* startTiming (&ru_start); */
- s->cumulative.numCopyingGCs++;
+ s->cumulativeStatistics.numCopyingGCs++;
forwardState.toStart = s->secondaryHeap.start;
forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.size;
if (DEBUG or s->messages) {
@@ -229,13 +221,13 @@
foreachObjptrInRange (s, toStart, &forwardState.back, TRUE, forward);
updateWeaks (s);
s->secondaryHeap.oldGenSize = forwardState.back - s->secondaryHeap.start;
- s->cumulative.bytesCopied += s->secondaryHeap.oldGenSize;
+ s->cumulativeStatistics.bytesCopied += s->secondaryHeap.oldGenSize;
if (DEBUG)
fprintf (stderr, "%zd bytes live.\n",
/*uintToCommaString*/(s->secondaryHeap.oldGenSize));
swapHeaps (s);
clearCrossMap (s);
- s->lastMajor.kind = GC_COPYING;
+ s->lastMajorStatistics.kind = GC_COPYING;
/* if (detailedGCTime (s)) */
/* stopTiming (&ru_start, &s->ru_gcCopy); */
if (DEBUG or s->messages)
@@ -276,8 +268,8 @@
fprintf (stderr, "Forwarding inter-generational pointers.\n");
updateCrossMap (s);
/* Constants. */
- cardMap = s->generational.cardMap;
- crossMap = s->generational.crossMap;
+ cardMap = s->generationalMaps.cardMap;
+ crossMap = s->generationalMaps.crossMap;
maxCardIndex = sizeToCardIndex (align (s->heap.oldGenSize, CARD_SIZE));
oldGenStart = s->heap.start;
oldGenEnd = oldGenStart + s->heap.oldGenSize;
@@ -299,7 +291,7 @@
pointer lastObject;
size_t size;
- s->cumulative.markedCards++;
+ s->cumulativeStatistics.markedCards++;
if (DEBUG_GENERATIONAL)
fprintf (stderr, "card %zu is marked objectStart = "FMTPTR"\n",
cardIndex, (uintptr_t)objectStart);
@@ -311,7 +303,7 @@
objectStart += size;
goto skipObjects;
}
- s->cumulative.minorBytesSkipped += objectStart - lastObject;
+ s->cumulativeStatistics.minorBytesSkipped += objectStart - lastObject;
cardEnd = cardStart + CARD_SIZE;
if (oldGenEnd < cardEnd)
cardEnd = oldGenEnd;
@@ -325,7 +317,7 @@
*/
objectStart = foreachObjptrInRange (s, objectStart, &cardEnd,
FALSE, forwardIfInNursery);
- s->cumulative.minorBytesScanned += objectStart - lastObject;
+ s->cumulativeStatistics.minorBytesScanned += objectStart - lastObject;
if (objectStart == oldGenEnd)
goto done;
cardIndex = sizeToCardIndex (objectStart - oldGenStart);
@@ -363,7 +355,7 @@
bytesAllocated = s->frontier - s->heap.nursery;
if (bytesAllocated == 0)
return;
- s->cumulative.bytesAllocated += bytesAllocated;
+ s->cumulativeStatistics.bytesAllocated += bytesAllocated;
if (not s->canMinor) {
s->heap.oldGenSize += bytesAllocated;
bytesCopied = 0;
@@ -379,8 +371,8 @@
assert (isAlignedFrontier (s, forwardState.toStart));
forwardState.toLimit = forwardState.toStart + bytesAllocated;
assert (invariant (s));
- s->cumulative.numMinorGCs++;
- s->lastMajor.numMinorsGCs++;
+ s->cumulativeStatistics.numMinorGCs++;
+ s->lastMajorStatistics.numMinorsGCs++;
forwardState.back = forwardState.toStart;
/* Forward all globals. Would like to avoid doing this once all
* the globals have been assigned.
@@ -391,7 +383,7 @@
TRUE, forwardIfInNursery);
updateWeaks (s);
bytesCopied = forwardState.back - forwardState.toStart;
- s->cumulative.bytesCopiedMinor += bytesCopied;
+ s->cumulativeStatistics.bytesCopiedMinor += bytesCopied;
s->heap.oldGenSize += bytesCopied;
s->amInMinorGC = FALSE;
/* if (detailedGCTime (s)) */
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/control.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -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.
+ */
+
+struct GC_control {
+ size_t fixedHeap; /* If 0, then no fixed heap. */
+ size_t maxHeap; /* if zero, then unlimited, else limit total heap */
+};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/current.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -0,0 +1,30 @@
+/* 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 inline objptr currentThreadObjptr (GC_state s) {
+ return s->currentThread;
+}
+
+static inline GC_thread currentThread (GC_state s) {
+ pointer p = objptrToPointer(currentThreadObjptr(s), s->heap.start);
+ return (GC_thread)p;
+}
+
+static inline objptr currentThreadStackObjptr (GC_state s) {
+ GC_thread ct = currentThread (s);
+ return ct->stack;
+}
+
+static inline GC_stack currentThreadStack (GC_state s) {
+ pointer p = objptrToPointer(currentThreadStackObjptr(s), s->heap.start);
+ return (GC_stack)p;
+}
+
+static inline size_t currentStackUsed (GC_state s) {
+ return s->stackTop - s->stackBottom;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -11,20 +11,22 @@
#endif
enum {
- DEBUG_ARRAY = FALSE,
- DEBUG_CALL_STACK = FALSE,
- DEBUG_CARD_MARKING = FALSE,
- DEBUG_DETAILED = FALSE,
- DEBUG_ENTER_LEAVE = FALSE,
- DEBUG_GENERATIONAL = FALSE,
- DEBUG_MARK_COMPACT = FALSE,
- DEBUG_MEM = FALSE,
- DEBUG_PROFILE = FALSE,
- DEBUG_RESIZING = FALSE,
- DEBUG_SHARE = FALSE,
- DEBUG_SIZE = FALSE,
- DEBUG_STACKS = FALSE,
- DEBUG_THREADS = FALSE,
- DEBUG_WEAK = FALSE,
- DEBUG_WORLD = FALSE,
+ DEBUG_ARRAY = FALSE,
+ DEBUG_CALL_STACK = FALSE,
+ DEBUG_CARD_MARKING = FALSE,
+ DEBUG_DETAILED = FALSE,
+ DEBUG_ENTER_LEAVE = FALSE,
+ DEBUG_GENERATIONAL = FALSE,
+ DEBUG_MARK_COMPACT = FALSE,
+ DEBUG_MEM = FALSE,
+ DEBUG_PROFILE = FALSE,
+ DEBUG_RESIZING = FALSE,
+ DEBUG_SHARE = FALSE,
+ DEBUG_SIZE = FALSE,
+ DEBUG_STACKS = FALSE,
+ DEBUG_THREADS = FALSE,
+ DEBUG_WEAK = FALSE,
+ DEBUG_WORLD = FALSE,
+ FORCE_GENERATIONAL = FALSE,
+ FORCE_MARK_COMPACT = FALSE,
};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -27,10 +27,10 @@
}
if (DEBUG_DETAILED)
fprintf (stderr, "foreachGlobal threads\n");
- maybeCall (f, s, &s->callFromCHandler);
+ maybeCall (f, s, &s->callFromCHandlerThread);
maybeCall (f, s, &s->currentThread);
maybeCall (f, s, &s->savedThread);
- maybeCall (f, s, &s->signalHandler);
+ maybeCall (f, s, &s->signalHandlerThread);
}
@@ -84,7 +84,7 @@
pointer max;
GC_arrayLength numElements;
- numElements = arrayNumElements (p);
+ numElements = getArrayLength (p);
bytesPerElement =
numNonObjptrsToBytes(numNonObjptrs, ARRAY_TAG)
+ (numObjptrs * OBJPTR_SIZE);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -12,7 +12,7 @@
res = s->returnAddressToFrameIndex (ra);
if (DEBUG_DETAILED)
- fprintf (stderr, "%"PRIu32" = getFrameIndex ("FMTRA")\n",
+ fprintf (stderr, "%"PRIu32" = getFrameIndexFromReturnAddress ("FMTRA")\n",
res, ra);
return res;
}
@@ -23,7 +23,7 @@
if (DEBUG_DETAILED)
fprintf (stderr,
- "index = %"PRIx32
+ "index = %"PRIu32
" frameLayoutsLength = %"PRIu32"\n",
index, s->frameLayoutsLength);
assert (index < s->frameLayoutsLength);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -16,10 +16,10 @@
*
* The frameLayouts pointer is initialized to point to a static array
* of frame layouts that is emitted for each compiled program. The
- * isC field identified whether or not the frame is for a C
- * call. (Note: The ML stack is distinct from the system stack. A C
- * call executes on the system stack. The frame left on the ML stack
- * is just a marker.) The size field indicates the size of the frame,
+ * kind field identifies whether or not the frame is for a C call.
+ * (Note: The ML stack is distinct from the system stack. A C call
+ * executes on the system stack. The frame left on the ML stack is
+ * just a marker.) The size field indicates the size of the frame,
* including space for the return address. The offsets field points
* to an array (the zeroeth element recording the size of the array)
* whose elements record byte offsets from the bottom of the frame at
@@ -27,8 +27,13 @@
*/
typedef uint16_t *GC_frameOffsets;
+typedef enum {
+ C_FRAME,
+ ML_FRAME
+} GC_frameKind;
+
typedef struct GC_frameLayout {
- bool isC;
+ GC_frameKind kind;
uint16_t size;
GC_frameOffsets offsets;
} GC_frameLayout;
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-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -13,7 +13,7 @@
displayThread (s, (GC_thread)(objptrToPointer (s->currentThread, s->heap.start)),
stream);
fprintf (stream, "\tgenerational\n");
- displayGenerationalMaps (s, &s->generational,
+ displayGenerationalMaps (s, &s->generationalMaps,
stream);
fprintf (stream, "\theap\n");
displayHeap (s, &s->heap,
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-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -3,35 +3,38 @@
size_t alignment; /* */
bool amInGC;
bool amInMinorGC;
- objptr callFromCHandler; /* Handler for exported C calls (in heap). */
+ objptr callFromCHandlerThread; /* Handler for exported C calls (in heap). */
bool canMinor; /* TRUE iff there is space for a minor gc. */
- struct GC_cumulativeStatistics cumulative;
+ struct GC_control control;
+ struct GC_cumulativeStatistics cumulativeStatistics;
objptr currentThread; /* Currently executing thread (in heap). */
GC_frameLayout *frameLayouts; /* Array of frame layouts. */
uint32_t frameLayoutsLength; /* Cardinality of frameLayouts array. */
pointer frontier; /* heap.start <= frontier < limit */
- struct GC_generationalMaps generational;
+ struct GC_generationalMaps generationalMaps;
objptr *globals;
uint32_t globalsLength;
struct GC_heap heap;
- struct GC_lastMajorStatistics lastMajor;
+ struct GC_lastMajorStatistics lastMajorStatistics;
pointer limit; /* limit = heap.start + heap.totalBytes */
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
uint32_t maxFrameSize;
+ /*Bool*/bool messages; /* Print a message at the start and end of each gc. */
/*Bool*/bool mutatorMarksCards;
GC_objectType *objectTypes; /* Array of object types. */
uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
size_t pageSize;
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
+ struct GC_ratios ratios;
objptr savedThread; /* Result of GC_copyCurrentThread.
* Thread interrupted by arrival of signal.
*/
struct GC_heap secondaryHeap; /* Used for major copying collection. */
- objptr signalHandler; /* Handler for signals (in heap). */
+ objptr signalHandlerThread; /* Handler for signals (in heap). */
pointer stackBottom; /* Bottom of stack in current thread. */
+ pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
pointer stackTop; /* Top of stack in current thread. */
/*Bool*/bool summary; /* Print a summary of gc info when program exits. */
- /*Bool*/bool messages; /* Print a message at the start and end of each gc. */
- float threadShrinkRatio;
+ 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/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -21,7 +21,7 @@
static inline pointer pointerToCardMapAddr (GC_state s, pointer p) {
pointer res;
- res = &s->generational.cardMapAbsolute [pointerToCardIndex (p)];
+ res = &s->generationalMaps.cardMapAbsolute [pointerToCardIndex (p)];
if (DEBUG_CARD_MARKING)
fprintf (stderr, "pointerToCardMapAddr ("FMTPTR") = "FMTPTR"\n",
(uintptr_t)p, (uintptr_t)res);
@@ -42,16 +42,16 @@
static inline void clearCardMap (GC_state s) {
if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
fprintf (stderr, "clearCardMap ()\n");
- memset (s->generational.cardMap, 0,
- s->generational.cardMapLength * CARD_MAP_ELEM_SIZE);
+ memset (s->generationalMaps.cardMap, 0,
+ s->generationalMaps.cardMapLength * CARD_MAP_ELEM_SIZE);
}
static inline void clearCrossMap (GC_state s) {
if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
fprintf (stderr, "clearCrossMap ()\n");
- s->generational.crossMapValidSize = 0;
- memset (s->generational.crossMap, CROSS_MAP_EMPTY,
- s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE);
+ s->generationalMaps.crossMapValidSize = 0;
+ memset (s->generationalMaps.crossMap, CROSS_MAP_EMPTY,
+ s->generationalMaps.crossMapLength * CROSS_MAP_ELEM_SIZE);
}
static inline void setCardMapAbsolute (GC_state s) {
@@ -61,20 +61,20 @@
* subsequent additions to mark the cards will overflow and put us
* in the right place.
*/
- s->generational.cardMapAbsolute =
+ s->generationalMaps.cardMapAbsolute =
pointerToCardMapAddr (s, s->heap.start);
if (DEBUG_CARD_MARKING)
fprintf (stderr, "cardMapAbsolute = "FMTPTR"\n",
- (uintptr_t)s->generational.cardMapAbsolute);
+ (uintptr_t)s->generationalMaps.cardMapAbsolute);
}
static inline void createCardMapAndCrossMap (GC_state s) {
unless (s->mutatorMarksCards) {
- s->generational.cardMapLength = 0;
- s->generational.cardMap = NULL;
- s->generational.cardMapAbsolute = NULL;
- s->generational.crossMapLength = 0;
- s->generational.crossMap = NULL;
+ s->generationalMaps.cardMapLength = 0;
+ s->generationalMaps.cardMap = NULL;
+ s->generationalMaps.cardMapAbsolute = NULL;
+ s->generationalMaps.crossMapLength = 0;
+ s->generationalMaps.crossMap = NULL;
return;
}
assert (isAligned (s->heap.size, CARD_SIZE));
@@ -86,25 +86,25 @@
cardMapLength = sizeToCardIndex (s->heap.size);
cardMapSize = align (cardMapLength * CARD_MAP_ELEM_SIZE, s->pageSize);
cardMapLength = cardMapSize / CARD_MAP_ELEM_SIZE;
- s->generational.cardMapLength = cardMapLength;
+ s->generationalMaps.cardMapLength = cardMapLength;
crossMapLength = sizeToCardIndex (s->heap.size);
crossMapSize = align (crossMapLength * CROSS_MAP_ELEM_SIZE, s->pageSize);
crossMapLength = crossMapSize / CROSS_MAP_ELEM_SIZE;
- s->generational.crossMapLength = crossMapLength;
+ s->generationalMaps.crossMapLength = crossMapLength;
totalMapSize = cardMapSize + crossMapSize;
if (DEBUG_MEM)
fprintf (stderr, "Creating card/cross map of size %zd\n",
/*uintToCommaString*/(totalMapSize));
- s->generational.cardMap =
+ s->generationalMaps.cardMap =
GC_mmapAnon (totalMapSize);
- s->generational.crossMap =
- (GC_crossMapElem*)((pointer)s->generational.cardMap + cardMapSize);
+ s->generationalMaps.crossMap =
+ (GC_crossMapElem*)((pointer)s->generationalMaps.cardMap + cardMapSize);
if (DEBUG_CARD_MARKING)
fprintf (stderr, "cardMap = "FMTPTR" crossMap = "FMTPTR"\n",
- (uintptr_t)s->generational.cardMap,
- (uintptr_t)s->generational.crossMap);
+ (uintptr_t)s->generationalMaps.cardMap,
+ (uintptr_t)s->generationalMaps.crossMap);
setCardMapAbsolute (s);
clearCardMap (s);
clearCrossMap (s);
@@ -139,7 +139,7 @@
if (DEBUG)
fprintf (stderr, "crossMapIsOK ()\n");
- mapSize = s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE;
+ mapSize = s->generationalMaps.crossMapLength * CROSS_MAP_ELEM_SIZE;
map = GC_mmapAnon (mapSize);
memset (map, CROSS_MAP_EMPTY, mapSize);
back = s->heap.start + s->heap.oldGenSize;
@@ -155,7 +155,7 @@
goto loopObjects;
}
for (size_t i = 0; i < cardIndex; ++i)
- assert (map[i] == s->generational.crossMap[i]);
+ assert (map[i] == s->generationalMaps.crossMap[i]);
GC_munmap (map, mapSize);
return TRUE;
}
@@ -169,10 +169,10 @@
pointer nextObject, objectStart;
pointer oldGenEnd;
- if (s->generational.crossMapValidSize == s->heap.oldGenSize)
+ if (s->generationalMaps.crossMapValidSize == s->heap.oldGenSize)
goto done;
oldGenEnd = s->heap.start + s->heap.oldGenSize;
- objectStart = s->heap.start + s->generational.crossMapValidSize;
+ objectStart = s->heap.start + s->generationalMaps.crossMapValidSize;
if (objectStart == s->heap.start) {
cardIndex = 0;
objectStart = alignFrontier (s, objectStart);
@@ -197,7 +197,7 @@
if (DEBUG_GENERATIONAL)
fprintf (stderr, "crossMap[%zu] = %zu\n",
cardIndex, offset);
- s->generational.crossMap[cardIndex] = (GC_crossMapElem)offset;
+ s->generationalMaps.crossMap[cardIndex] = (GC_crossMapElem)offset;
cardIndex = sizeToCardIndex (nextObject - 1 - s->heap.start);
cardStart = s->heap.start + cardIndexToSize (cardIndex);
cardEnd = cardStart + CARD_SIZE;
@@ -206,29 +206,29 @@
if (objectStart < oldGenEnd)
goto loopObjects;
assert (objectStart == oldGenEnd);
- s->generational.crossMap[cardIndex] = (GC_crossMapElem)(oldGenEnd - cardStart);
- s->generational.crossMapValidSize = s->heap.oldGenSize;
+ s->generationalMaps.crossMap[cardIndex] = (GC_crossMapElem)(oldGenEnd - cardStart);
+ s->generationalMaps.crossMapValidSize = s->heap.oldGenSize;
done:
- assert (s->generational.crossMapValidSize == s->heap.oldGenSize);
+ assert (s->generationalMaps.crossMapValidSize == s->heap.oldGenSize);
assert (crossMapIsOK (s));
}
static inline void resizeCardMapAndCrossMap (GC_state s) {
if (s->mutatorMarksCards
- and (s->generational.cardMapLength * CARD_MAP_ELEM_SIZE)
+ and (s->generationalMaps.cardMapLength * CARD_MAP_ELEM_SIZE)
!= align (sizeToCardIndex (s->heap.size), s->pageSize)) {
GC_cardMapElem *oldCardMap;
size_t oldCardMapSize;
GC_crossMapElem *oldCrossMap;
size_t oldCrossMapSize;
- oldCardMap = s->generational.cardMap;
- oldCardMapSize = s->generational.cardMapLength * CARD_MAP_ELEM_SIZE;
- oldCrossMap = s->generational.crossMap;
- oldCrossMapSize = s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE;
+ oldCardMap = s->generationalMaps.cardMap;
+ oldCardMapSize = s->generationalMaps.cardMapLength * CARD_MAP_ELEM_SIZE;
+ oldCrossMap = s->generationalMaps.crossMap;
+ oldCrossMapSize = s->generationalMaps.crossMapLength * CROSS_MAP_ELEM_SIZE;
createCardMapAndCrossMap (s);
- GC_memcpy ((pointer)oldCrossMap, (pointer)s->generational.crossMap,
- min (s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE,
+ GC_memcpy ((pointer)oldCrossMap, (pointer)s->generationalMaps.crossMap,
+ min (s->generationalMaps.crossMapLength * CROSS_MAP_ELEM_SIZE,
oldCrossMapSize));
if (DEBUG_MEM)
fprintf (stderr, "Releasing card/cross map.\n");
@@ -236,7 +236,7 @@
}
}
-void displayGenerationalMaps (GC_state s,
+void displayGenerationalMaps (__attribute__ ((unused)) GC_state s,
struct GC_generationalMaps *generational,
FILE *stream) {
fprintf(stream,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -46,7 +46,35 @@
return pointerIsInNursery (s, p);
}
-void displayHeap (GC_state s,
+static inline bool pointerIsInFromSpace (GC_state s, pointer p) {
+ return (pointerIsInOldGen (s, p) or pointerIsInNursery (s, p));
+}
+
+static inline bool objptrIsInFromSpace (GC_state s, objptr op) {
+ return (objptrIsInOldGen (s, op) or objptrIsInNursery (s, op));
+}
+
+#if ASSERT
+static bool hasBytesFree (GC_state s, size_t oldGen, size_t nursery) {
+ size_t total;
+ bool res;
+
+ total =
+ s->heap.oldGenSize + oldGen
+ + (s->canMinor ? 2 : 1) * (s->limitPlusSlop - s->heap.nursery);
+ res =
+ (total <= s->heap.size)
+ and (nursery <= (size_t)(s->limitPlusSlop - s->frontier));
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "%s = hasBytesFree (%zd, %zd)\n",
+ res ? "true" : "false",
+ /*uintToCommaString*/(oldGen),
+ /*uintToCommaString*/(nursery));
+ return res;
+}
+#endif
+
+void displayHeap (__attribute__ ((unused)) GC_state s,
GC_heap heap,
FILE *stream) {
fprintf(stream,
@@ -59,3 +87,186 @@
(uintptr_t)heap->start,
heap->size);
}
+
+/* heapDesiredSize (s, l, c) returns the desired heap size for a heap
+ * with l bytes live, given that the current heap size is c.
+ */
+static size_t heapDesiredSize (GC_state s, size_t live, size_t currentSize) {
+ size_t res;
+ float ratio;
+
+ ratio = (float)s->sysvals.ram / (float)live;
+ if (ratio >= s->ratios.live + s->ratios.grow) {
+ /* Cheney copying fits in RAM with desired ratios.live. */
+ res = live * s->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 >= s->ratios.copy
+ and ratio >= 2 * s->ratios.copy) {
+ /* Split RAM in half. Round down by pageSize so that the total
+ * amount of space taken isn't greater than RAM once rounding
+ * happens. This is so resizeHeap2 doesn't get confused and free
+ * a semispace in a misguided attempt to avoid paging.
+ */
+ res = roundDown (s->sysvals.ram / 2, s->sysvals.pageSize);
+ } else if (ratio >= s->ratios.copy + s->ratios.grow) {
+ /* Cheney copying fits in RAM. */
+ res = s->sysvals.ram - s->ratios.grow * live;
+ /* If the heap isn't too much smaller than what we want, leave it
+ * alone. On the other hand, if it is bigger we want to leave res
+ * as is so that the heap is shrunk, to try to avoid paging.
+ */
+ if (currentSize <= res
+ and res <= 1.1 * currentSize)
+ res = currentSize;
+ } else if (ratio >= s->ratios.markCompact) {
+ /* Mark compact fits in RAM. It doesn't matter what the current
+ * size is. If the heap is currently smaller, we are using
+ * copying and should switch to mark-compact. If the heap is
+ * currently bigger, we want to shrink back to RAM to avoid
+ * paging.
+ */
+ res = s->sysvals.ram;
+ } else { /* Required live ratio. */
+ res = live * s->ratios.markCompact;
+ /* If the current heap is bigger than res, the shrinking always
+ * sounds like a good idea. However, depending on what pages the
+ * VM keeps around, growing could be very expensive, if it
+ * involves paging the entire heap. Hopefully the copy loop in
+ * growFromSpace will make the right thing happen.
+ */
+ }
+ if (s->control.fixedHeap > 0) {
+ if (res > s->control.fixedHeap / 2)
+ res = s->control.fixedHeap;
+ else
+ res = s->control.fixedHeap / 2;
+ if (res < live)
+ die ("Out of memory with fixed heap size %zd.",
+ /*uintToCommaString*/(s->control.fixedHeap));
+ } else if (s->control.maxHeap > 0) {
+ if (res > s->control.maxHeap)
+ res = s->control.maxHeap;
+ if (res < live)
+ die ("Out of memory with max heap size %zd.",
+ /*uintToCommaString*/(s->control.maxHeap));
+ }
+ if (DEBUG_RESIZING)
+ fprintf (stderr, "%zd = heapDesiredSize (%zd, %zd)\n",
+ /*uintToCommaString*/(res),
+ /*uintToCommaString*/(live),
+ /*uintToCommaString*/(currentSize));
+ assert (res >= live);
+ return res;
+}
+
+static inline void heapInit (GC_heap h) {
+ h->start = NULL;
+ h->size = 0;
+ h->oldGenSize = 0;
+ h->nursery = NULL;
+}
+
+static inline bool heapIsInit (GC_heap h) {
+ return 0 == h->size;
+}
+
+static void heapRelease (GC_state s, GC_heap h) {
+ if (NULL == h->start)
+ return;
+ if (DEBUG or s->messages)
+ fprintf (stderr, "Releasing heap at "FMTPTR" of size %zd.\n",
+ (uintptr_t)h->start,
+ /*uintToCommaString*/(h->size));
+ GC_release (h->start, h->size);
+ heapInit (h);
+}
+
+static void heapShrink (GC_state s, GC_heap h, size_t keep) {
+ assert (keep <= h->size);
+ if (0 == keep) {
+ heapRelease (s, h);
+ return;
+ }
+ keep = align (keep, s->pageSize);
+ if (keep < h->size) {
+ if (DEBUG or s->messages)
+ fprintf (stderr,
+ "Shrinking heap at "FMTPTR" of size %zd to %zd bytes.\n",
+ (uintptr_t)h->start,
+ /*uintToCommaString*/(h->size),
+ /*uintToCommaString*/(keep));
+ GC_decommit (h->start + keep, h->size - keep);
+ h->size = keep;
+ }
+}
+
+static void heapSetNursery (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested) {
+ GC_heap h;
+ size_t nurserySize;
+
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "setNursery(%zd, %zd)\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 - LIMIT_SLOP;
+ assert (isAligned (nurserySize, WORD_SIZE)); // FIXME
+ 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->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->ratios.copyGenerational
+ : s->ratios.markCompactGenerational))
+ )) {
+ s->canMinor = TRUE;
+ nurserySize /= 2;
+ while (not (isAligned (nurserySize, WORD_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 (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -18,10 +18,10 @@
*/
typedef struct GC_heap {
- pointer nursery; /* start of nursery */
- size_t oldGenSize; /* size of old generation */
pointer start; /* start of heap (and old generation) */
size_t size; /* size of heap */
+ size_t oldGenSize; /* size of old generation */
+ pointer nursery; /* start of nursery */
} *GC_heap;
#define LIMIT_SLOP 512
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -8,10 +8,18 @@
#if ASSERT
+static inline void assertObjptrIsInFromSpace (GC_state s, objptr *opp) {
+ unless (objptrIsInFromSpace (s, *opp))
+ die ("gc.c: assertObjptrIsInFromSpace "
+ "opp = "FMTPTR" "
+ "*opp = "FMTOBJPTR"\n",
+ (uintptr_t)opp, *opp);
+}
+
static bool invariant (GC_state s) {
if (DEBUG)
fprintf (stderr, "invariant\n");
- // assert (ratiosOk (s));
+ assert (ratiosOk (s->ratios));
/* Frame layouts */
for (unsigned int i = 0; i < s->frameLayoutsLength; ++i) {
GC_frameLayout *layout;
@@ -22,22 +30,17 @@
assert (layout->size <= s->maxFrameSize);
offsets = layout->offsets;
- /* No longer correct, since handler frames have a "size"
- * (i.e. return address) pointing into the middle of the frame.
- */
-/* for (unsigned int j = 0; j < offsets[0]; ++j) */
-/* assert (offsets[j + 1] < layout->numBytes); */
}
}
/* Generational */
if (s->mutatorMarksCards) {
- assert (s->generational.cardMap ==
- &(s->generational.cardMapAbsolute
+ assert (s->generationalMaps.cardMap ==
+ &(s->generationalMaps.cardMapAbsolute
[pointerToCardIndex(s->heap.start)]));
- assert (&(s->generational.cardMapAbsolute
+ assert (&(s->generationalMaps.cardMapAbsolute
[pointerToCardIndex(s->heap.start + s->heap.size - 1)])
- < (s->generational.cardMap
- + (s->generational.cardMapLength * CARD_MAP_ELEM_SIZE)));
+ < (s->generationalMaps.cardMap
+ + (s->generationalMaps.cardMapLength * CARD_MAP_ELEM_SIZE)));
}
assert (isAligned (s->heap.size, s->pageSize));
assert (isAligned ((size_t)s->heap.start, CARD_SIZE));
@@ -49,43 +52,52 @@
assert (s->heap.nursery <= s->frontier);
assert (s->frontier <= s->limitPlusSlop);
assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
-/* assert (hasBytesFree (s, 0, 0)); */
+ assert (hasBytesFree (s, 0, 0));
}
- assert (s->secondaryHeap.start == NULL or s->heap.size == s->secondaryHeap.size);
-/* /\* Check that all pointers are into from space. *\/ */
-/* foreachGlobal (s, assertIsInFromSpace); */
-/* back = s->heap.start + s->oldGenSize; */
-/* if (DEBUG_DETAILED) */
-/* fprintf (stderr, "Checking old generation.\n"); */
-/* foreachPointerInRange (s, alignFrontier (s, s->heap.start), &back, FALSE, */
-/* assertIsInFromSpace); */
-/* if (DEBUG_DETAILED) */
-/* fprintf (stderr, "Checking nursery.\n"); */
-/* foreachPointerInRange (s, s->nursery, &s->frontier, FALSE, */
-/* assertIsInFromSpace); */
-/* /\* Current thread. *\/ */
-/* stack = s->currentThread->stack; */
-/* assert (isAlignedReserved (s, stack->reserved)); */
-/* assert (s->stackBottom == stackBottom (s, stack)); */
-/* assert (s->stackTop == stackTop (s, stack)); */
-/* assert (s->stackLimit == stackLimit (s, stack)); */
-/* assert (stack->used == currentStackUsed (s)); */
-/* assert (stack->used <= stack->reserved); */
-/* assert (s->stackBottom <= s->stackTop); */
+ assert (s->secondaryHeap.start == NULL
+ or s->heap.size == s->secondaryHeap.size);
+ /* Check that all pointers are into from space. */
+ foreachGlobalObjptr (s, assertObjptrIsInFromSpace);
+ pointer back = s->heap.start + s->heap.oldGenSize;
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "Checking old generation.\n");
+ foreachObjptrInRange (s, alignFrontier (s, s->heap.start), &back,
+ FALSE, assertObjptrIsInFromSpace);
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "Checking nursery.\n");
+ foreachObjptrInRange (s, s->heap.nursery, &s->frontier,
+ FALSE, assertObjptrIsInFromSpace);
+ /* Current thread. */
+ GC_stack stack = currentThreadStack(s);
+ assert (isAlignedReserved (s, stack->reserved));
+ assert (s->stackBottom == stackBottom (s, stack));
+ assert (s->stackTop == stackTop (s, stack));
+ assert (s->stackLimit == stackLimit (s, stack));
+ assert (s->stackBottom <= s->stackTop);
+ assert (stack->used == currentStackUsed (s));
+ assert (stack->used <= stack->reserved);
if (DEBUG)
fprintf (stderr, "invariant passed\n");
return TRUE;
}
+static bool mutatorFrontierInvariant (GC_state s) {
+ GC_thread ct = currentThread(s);
+ return (ct->bytesNeeded <= s->limitPlusSlop - s->frontier);
+}
+
+static bool mutatorStackInvariant (GC_state s) {
+ GC_stack sk = currentThreadStack(s);
+ return (stackTop (s, sk) <= stackLimit (s, sk) + topFrameSize (s, sk));
+}
+
static bool mutatorInvariant (GC_state s, bool frontier, bool stack) {
-#if FALSE
if (DEBUG)
- GC_display (s, stderr);
+ displayGCState (s, stderr);
if (frontier)
assert (mutatorFrontierInvariant(s));
if (stack)
assert (mutatorStackInvariant(s));
-#endif
assert (invariant (s));
return TRUE;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/major.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -9,4 +9,4 @@
typedef enum {
GC_COPYING,
GC_MARK_COMPACT,
-} GC_MajorKind;
+} GC_majorKind;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -49,7 +49,7 @@
/* isObjptr returns true if p looks like an object pointer. */
static inline bool isObjptr (objptr p) {
- if GC_MODEL_NONPTR {
+ if GC_MODEL_NONOBJPTR {
unsigned int shift = GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT;
objptr mask = ~((~((objptr)0)) << shift);
return (0 == (p & mask));
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -203,7 +203,7 @@
#else
#error gc model unknown
#endif
-#define GC_MODEL_NONPTR ((GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT) > 0)
+#define GC_MODEL_NONOBJPTR ((GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT) > 0)
#define GC_MODEL_MINALIGN TWOPOWER(GC_MODEL_MINALIGN_SHIFT)
#define OBJPTR_TYPE__(z) uint ## z ## _t
@@ -216,7 +216,7 @@
#define PRIxOBJPTR PRIxOBJPTR_(GC_MODEL_BITSIZE)
#define FMTOBJPTR "0x%016"PRIxOBJPTR
-#if GC_MODEL_NONPTR
+#if GC_MODEL_NONOBJPTR
#define BOGUS_OBJPTR (objptr)0x1
#else
#error gc model does not admit bogus object pointer
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -11,10 +11,10 @@
* array, normal (fixed size), stack, and weak.
*/
typedef enum {
- ARRAY_TAG,
- NORMAL_TAG,
- STACK_TAG,
- WEAK_TAG,
+ ARRAY_TAG,
+ NORMAL_TAG,
+ STACK_TAG,
+ WEAK_TAG,
} GC_objectTypeTag;
/*
@@ -40,7 +40,7 @@
#define COUNTER_SHIFT 20
#define MARK_BITS 1
#define MARK_MASK 0x80000000
-#define MARK_SHIFT 3
+#define MARK_SHIFT 31
/* getHeaderp (p)
*
@@ -103,11 +103,11 @@
* object (and, hence, must be (2,1) or (3,0)).
*/
typedef struct {
- /* Keep tag first, at zero offset, since it is referenced most often. */
- GC_objectTypeTag tag;
- bool hasIdentity;
- uint16_t numNonObjptrs;
- uint16_t numObjptrs;
+ /* Keep tag first, at zero offset, since it is referenced most often. */
+ GC_objectTypeTag tag;
+ bool hasIdentity;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
} GC_objectType;
enum {
/* The type indices here must agree with those in backend/rep-type.fun. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -7,6 +7,8 @@
*/
typedef unsigned char* pointer;
-#define POINTER_SIZE sizeof(pointer);
+#define POINTER_SIZE sizeof(pointer)
#define FMTPTR "0x%016"PRIxPTR
#define BOGUS_POINTER (pointer)0x1
+
+#define WORD_SIZE POINTER_SIZE
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.c (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -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.
+ */
+
+static bool ratiosOk (struct GC_ratios ratios) {
+ return 1.0 < ratios.grow
+ and 1.0 < ratios.nursery
+ and 1.0 < ratios.markCompact
+ and ratios.markCompact <= ratios.copy
+ and ratios.copy <= ratios.live;
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -0,0 +1,31 @@
+/* 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_ratios {
+ /* 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;
+ /* Desired ratio of heap size to live data. */
+ float live;
+ /* Minimum live ratio to us mark-compact GC. */
+ float markCompact;
+ /* Only use generational GC with mark-compact collection if the
+ * ratio of heap size to live data size is below
+ * markCompactGenerational.
+ */
+ float markCompactGenerational;
+ /* As long as the ratio of bytes live to nursery size is greater
+ * than nurseryRatio, use minor GCs.
+ */
+ float nursery;
+ float threadShrink;
+};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -7,7 +7,7 @@
*/
static inline bool stackIsEmpty (GC_stack stack) {
- return 0 == stack->used;
+ return 0 == stack->used;
}
/* stackSlop returns the amount of "slop" space needed between the top
@@ -21,32 +21,42 @@
return stackSlop (s);
}
-static inline size_t stackBytes (GC_state s, size_t size) {
+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 = stackBytes (%zu)\n", res, size);
+ fprintf (stderr, "%zu = stackNumBytes (%zu)\n", res, size);
return res;
}
static inline pointer stackBottom (GC_state s, GC_stack stack) {
- pointer res;
-
- res = ((pointer)stack) + sizeof (struct GC_stack);
- assert (isAligned ((uintptr_t)res, s->alignment));
- return res;
+ pointer res;
+
+ res = ((pointer)stack) + sizeof (struct GC_stack);
+ assert (isAligned ((uintptr_t)res, s->alignment));
+ return res;
}
/* Pointer to the topmost word in use on the stack. */
static inline pointer stackTop (GC_state s, GC_stack stack) {
- return stackBottom (s, stack) + stack->used;
+ return stackBottom (s, stack) + stack->used;
}
+/* Pointer to the end of stack. */
+static inline pointer stackLimitPlusSlop (GC_state s, GC_stack stack) {
+ return stackBottom (s, stack) + stack->reserved;
+}
+
+/* The maximum value stackTop may take on. */
+static inline pointer stackLimit (GC_state s, GC_stack stack) {
+ return stackLimitPlusSlop (s, stack) - stackSlop (s);
+}
+
static inline uint32_t topFrameIndex (GC_state s, GC_stack stack) {
uint32_t res;
-
+
res =
getFrameIndexFromReturnAddress
(s, *(GC_returnAddress*)(stackTop (s, stack) - GC_RETURNADDRESS_SIZE));
@@ -72,7 +82,7 @@
static inline size_t stackReserved (GC_state s, size_t r) {
size_t res;
-
+
res = pad (s, r, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
if (DEBUG_STACKS)
fprintf (stderr, "%zu = stackReserved (%zu)\n", res, r);
@@ -83,7 +93,7 @@
return stack->used + stackSlop (s) - topFrameSize(s, stack);
}
-void displayStack (GC_state s,
+void displayStack (__attribute__ ((unused)) GC_state s,
GC_stack stack,
FILE *stream) {
fprintf(stream,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -24,10 +24,10 @@
uintmax_t numLimitChecks;
- unsigned int numCopyingGCs;
- unsigned int numHashConsGCs;
- unsigned int numMarkCompactGCs;
- unsigned int numMinorGCs;
+ uintmax_t numCopyingGCs;
+ uintmax_t numHashConsGCs;
+ uintmax_t numMarkCompactGCs;
+ uintmax_t numMinorGCs;
/* struct rusage ru_gc; /\* total resource usage spent in gc *\/ */
/* struct rusage ru_gcCopy; /\* resource usage in major copying gcs. *\/ */
@@ -37,6 +37,6 @@
struct GC_lastMajorStatistics {
size_t bytesLive; /* Number of bytes live at most recent major GC. */
- GC_MajorKind kind;
- unsigned int numMinorsGCs;
+ GC_majorKind kind;
+ uintmax_t numMinorsGCs;
};
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/sysvals.h (from rev 4097, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/sysvals.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -0,0 +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.
+ */
+
+struct GC_sysvals {
+ size_t ram;
+ size_t availRam;
+ size_t totalRam;
+ size_t pageSize;
+};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-10-08 20:36:15 UTC (rev 4098)
@@ -6,16 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-static inline GC_thread currentThread (GC_state s) {
- pointer p = objptrToPointer(s->currentThread, s->heap.start);
- return (GC_thread)p;
-}
-
-static inline objptr currentThreadStack (GC_state s) {
- GC_thread ct = currentThread (s);
- return ct->stack;
-}
-
void displayThread (GC_state s,
GC_thread thread,
FILE *stream) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -19,11 +19,11 @@
#include <stddef.h>
#include <stdbool.h>
#include <iso646.h>
-#include <stdio.h>
#include <stdint.h>
#include <inttypes.h>
+#include <limits.h>
#include <stdlib.h>
-#include <limits.h>
+#include <stdio.h>
#include <string.h>
#include "../assert.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-09-22 22:02:42 UTC (rev 4097)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-10-08 20:36:15 UTC (rev 4098)
@@ -6,6 +6,8 @@
* See the file MLton-LICENSE for details.
*/
+void *GC_mmapAnon (size_t length);
void *GC_mmap (void *start, size_t length);
-void *GC_mmapAnon (size_t length);
void *GC_munmap (void *base, size_t length);
+void GC_release (void *base, size_t length);
+void GC_decommit (void *base, size_t length);
|
|
From: Stephen W. <sw...@ml...> - 2005-09-22 15:02:43
|
Fixed minor Debian problem. ---------------------------------------------------------------------- U mlton/trunk/package/debian/mlton.doc-base ---------------------------------------------------------------------- Modified: mlton/trunk/package/debian/mlton.doc-base =================================================================== --- mlton/trunk/package/debian/mlton.doc-base 2005-09-17 17:38:07 UTC (rev 4096) +++ mlton/trunk/package/debian/mlton.doc-base 2005-09-22 22:02:42 UTC (rev 4097) @@ -6,5 +6,5 @@ Section: Apps/Programming Format: HTML -Index: /usr/share/doc/mlton/user-guide/Home -Files: /usr/share/doc/mlton/user-guide/*.html +Index: /usr/share/doc/mlton/guide/Home +Files: /usr/share/doc/mlton/guide/*.html |
|
From: Matthew F. <fl...@ml...> - 2005-09-17 10:38:08
|
Formatting
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-09-16 02:27:15 UTC (rev 4095)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-09-17 17:38:07 UTC (rev 4096)
@@ -12,6 +12,8 @@
typedef uint8_t GC_cardMapElem;
typedef uint8_t GC_crossMapElem;
+#define CARD_MAP_ELEM_SIZE sizeof(GC_cardMapElem)
+#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)
struct GC_generationalMaps {
/* cardMap is an array with cardinality equal to the size of the
@@ -37,6 +39,3 @@
*/
size_t crossMapValidSize;
};
-
-#define CARD_MAP_ELEM_SIZE sizeof(GC_cardMapElem)
-#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)
|
|
From: Matthew F. <fl...@ml...> - 2005-09-15 19:27:21
|
Display functions
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
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/thread.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-09-16 02:27:15 UTC (rev 4095)
@@ -74,6 +74,7 @@
thread.c \
generational.c \
heap.c \
+ gc_state.c \
invariant.c \
foreach.c \
cheney-copy.c \
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c (from rev 4094, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c 2005-09-16 02:27:15 UTC (rev 4095)
@@ -0,0 +1,28 @@
+/* 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 displayGCState (GC_state s, FILE *stream) {
+ fprintf (stream,
+ "GC state\n");
+ fprintf (stream, "\tcurrentThread"FMTOBJPTR"\n", s->currentThread);
+ displayThread (s, (GC_thread)(objptrToPointer (s->currentThread, s->heap.start)),
+ stream);
+ fprintf (stream, "\tgenerational\n");
+ displayGenerationalMaps (s, &s->generational,
+ stream);
+ fprintf (stream, "\theap\n");
+ displayHeap (s, &s->heap,
+ stream);
+ fprintf (stream,
+ "\tlimit = "FMTPTR"\n"
+ "\tstackBottom = "FMTPTR"\n"
+ "\tstackTop = "FMTPTR"\n",
+ (uintptr_t)s->limit,
+ (uintptr_t)s->stackBottom,
+ (uintptr_t)s->stackTop);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-09-16 02:27:15 UTC (rev 4095)
@@ -235,3 +235,30 @@
GC_munmap (oldCardMap, oldCardMapSize + oldCrossMapSize);
}
}
+
+void displayGenerationalMaps (GC_state s,
+ struct GC_generationalMaps *generational,
+ FILE *stream) {
+ fprintf(stream,
+ "\t\tcardMap ="FMTPTR"\n"
+ "\t\tcardMapAbsolute = "FMTPTR"\n"
+ "\t\tcardMapLength = %zu\n"
+ "\t\tcrossMap = "FMTPTR"\n"
+ "\t\tcrossMapLength = %zu\n"
+ "\t\tcrossMapValidSize = %zu\n",
+ (uintptr_t)generational->cardMap,
+ (uintptr_t)generational->cardMapAbsolute,
+ generational->cardMapLength,
+ (uintptr_t)generational->crossMap,
+ generational->crossMapLength,
+ generational->crossMapValidSize);
+ if (DEBUG_GENERATIONAL and DEBUG_DETAILED) {
+ unsigned int i;
+
+ fprintf (stderr, "crossMap trues\n");
+ for (i = 0; i < generational->crossMapLength; ++i)
+ unless (CROSS_MAP_EMPTY == generational->crossMap[i])
+ fprintf (stderr, "\t%u\n", i);
+ fprintf (stderr, "\n");
+ }
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-09-16 02:27:15 UTC (rev 4095)
@@ -45,3 +45,17 @@
p = objptrToPointer (op, s->heap.start);
return pointerIsInNursery (s, p);
}
+
+void displayHeap (GC_state s,
+ GC_heap heap,
+ FILE *stream) {
+ fprintf(stream,
+ "\t\tnursery ="FMTPTR"\n"
+ "\t\toldGenSize = %zu\n"
+ "\t\tstart = "FMTPTR"\n"
+ "\t\tsize = %zu\n",
+ (uintptr_t)heap->nursery,
+ heap->oldGenSize,
+ (uintptr_t)heap->start,
+ heap->size);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-09-16 02:27:15 UTC (rev 4095)
@@ -82,3 +82,13 @@
static inline size_t stackNeedsReserved (GC_state s, GC_stack stack) {
return stack->used + stackSlop (s) - topFrameSize(s, stack);
}
+
+void displayStack (GC_state s,
+ GC_stack stack,
+ FILE *stream) {
+ fprintf(stream,
+ "\t\treserved = %zu\n"
+ "\t\tused = %zu\n",
+ stack->reserved,
+ stack->used);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h 2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h 2005-09-16 02:27:15 UTC (rev 4095)
@@ -46,5 +46,6 @@
* reserved bytes hold space for the stack.
*/
} *GC_stack;
+
#define GC_STACK_HEADER_SIZE GC_HEADER_SIZE
#define GC_STACK_SIZE sizeof(struct GC_stack);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-09-14 02:50:33 UTC (rev 4094)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-09-16 02:27:15 UTC (rev 4095)
@@ -15,3 +15,17 @@
GC_thread ct = currentThread (s);
return ct->stack;
}
+
+void displayThread (GC_state s,
+ GC_thread thread,
+ FILE *stream) {
+ fprintf(stream,
+ "\t\texnStack = %"PRIu32"\n"
+ "\t\tbytesNeeded = %"PRIu32"\n"
+ "\t\tstack = "FMTOBJPTR"\n",
+ thread->exnStack,
+ thread->bytesNeeded,
+ thread->stack);
+ displayStack (s, (GC_stack)(objptrToPointer (thread->stack, s->heap.start)),
+ stream);
+}
|
|
From: Matthew F. <fl...@ml...> - 2005-09-13 19:50:37
|
Adopting the convention that the cardinality of an array is denoted by
a variable with name "zzzLength", while variables with name "zzzSize"
denote the size of the object in bytes.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
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/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-09-14 02:50:33 UTC (rev 4094)
@@ -20,7 +20,7 @@
*/
static inline void foreachGlobalObjptr (GC_state s,
GC_foreachObjptrFun f) {
- for (unsigned int i = 0; i < s->globalsSize; ++i) {
+ for (unsigned int i = 0; i < s->globalsLength; ++i) {
if (DEBUG_DETAILED)
fprintf (stderr, "foreachGlobal %u\n", i);
maybeCall (f, s, &s->globals [i]);
@@ -154,7 +154,7 @@
}
frameLayout = getFrameLayoutFromReturnAddress (s, returnAddress);
frameOffsets = frameLayout->offsets;
- top -= frameLayout->numBytes;
+ top -= frameLayout->size;
for (i = 0 ; i < frameOffsets[0] ; ++i) {
if (DEBUG)
fprintf(stderr, " offset %"PRIx16" address "FMTOBJPTR"\n",
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c 2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.c 2005-09-14 02:50:33 UTC (rev 4094)
@@ -24,11 +24,11 @@
if (DEBUG_DETAILED)
fprintf (stderr,
"index = %"PRIx32
- " frameLayoutsSize = %"PRIu16"\n",
- index, s->frameLayoutsSize);
- assert (index < s->frameLayoutsSize);
+ " frameLayoutsLength = %"PRIu32"\n",
+ index, s->frameLayoutsLength);
+ assert (index < s->frameLayoutsLength);
layout = &(s->frameLayouts[index]);
- assert (layout->numBytes > 0);
+ assert (layout->size > 0);
return layout;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h 2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/frame.h 2005-09-14 02:50:33 UTC (rev 4094)
@@ -19,17 +19,17 @@
* isC field identified whether or not the frame is for a C
* call. (Note: The ML stack is distinct from the system stack. A C
* call executes on the system stack. The frame left on the ML stack
- * is just a marker.) The numBytes field indicates the size of the
- * frame, including space for the return address. The offsets field
- * points to an array (the zeroeth element recording the size of the
- * array) whose elements record byte offsets from the bottom of the
- * frame at which live heap pointers are located.
+ * is just a marker.) The size field indicates the size of the frame,
+ * including space for the return address. The offsets field points
+ * to an array (the zeroeth element recording the size of the array)
+ * whose elements record byte offsets from the bottom of the frame at
+ * which live heap pointers are located.
*/
typedef uint16_t *GC_frameOffsets;
typedef struct GC_frameLayout {
bool isC;
- uint16_t numBytes;
+ uint16_t size;
GC_frameOffsets offsets;
} GC_frameLayout;
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-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-09-14 02:50:33 UTC (rev 4094)
@@ -8,11 +8,11 @@
struct GC_cumulativeStatistics cumulative;
objptr currentThread; /* Currently executing thread (in heap). */
GC_frameLayout *frameLayouts; /* Array of frame layouts. */
- uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
+ uint32_t frameLayoutsLength; /* Cardinality of frameLayouts array. */
pointer frontier; /* heap.start <= frontier < limit */
struct GC_generationalMaps generational;
objptr *globals;
- uint32_t globalsSize;
+ uint32_t globalsLength;
struct GC_heap heap;
struct GC_lastMajorStatistics lastMajor;
pointer limit; /* limit = heap.start + heap.totalBytes */
@@ -20,7 +20,7 @@
uint32_t maxFrameSize;
/*Bool*/bool mutatorMarksCards;
GC_objectType *objectTypes; /* Array of object types. */
- uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
+ uint32_t objectTypesLength; /* Cardinality of objectTypes array. */
size_t pageSize;
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
objptr savedThread; /* Result of GC_copyCurrentThread.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-09-14 02:50:33 UTC (rev 4094)
@@ -13,14 +13,14 @@
fprintf (stderr, "invariant\n");
// assert (ratiosOk (s));
/* Frame layouts */
- for (unsigned int i = 0; i < s->frameLayoutsSize; ++i) {
+ for (unsigned int i = 0; i < s->frameLayoutsLength; ++i) {
GC_frameLayout *layout;
layout = &(s->frameLayouts[i]);
- if (layout->numBytes > 0) {
+ if (layout->size > 0) {
GC_frameOffsets offsets;
- assert (layout->numBytes <= s->maxFrameSize);
+ assert (layout->size <= s->maxFrameSize);
offsets = layout->offsets;
/* No longer correct, since handler frames have a "size"
* (i.e. return address) pointing into the middle of the frame.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-09-14 02:50:33 UTC (rev 4094)
@@ -46,7 +46,7 @@
assert (1 == (header & GC_VALID_HEADER_MASK));
objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT;
- assert (objectTypeIndex < s->objectTypesSize);
+ assert (objectTypeIndex < s->objectTypesLength);
objectType = &s->objectTypes [objectTypeIndex];
tag = objectType->tag;
hasIdentity = objectType->hasIdentity;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-09-14 02:43:18 UTC (rev 4093)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-09-14 02:50:33 UTC (rev 4094)
@@ -67,7 +67,7 @@
assert (not (stackIsEmpty (stack)));
layout = topFrameLayout (s, stack);
- return layout->numBytes;
+ return layout->size;
}
static inline size_t stackReserved (GC_state s, size_t r) {
|
|
From: Matthew F. <fl...@ml...> - 2005-09-13 19:43:21
|
Changed meaning of crossMap to be a byte-offset from card start.
Record the cardinality of the maps, rather than their size.
----------------------------------------------------------------------
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/generational.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-09-14 02:43:18 UTC (rev 4093)
@@ -15,5 +15,3 @@
codegen in thread.h is still true; it used to be the case when
GC_switchToThread was implemented in codegens. Now it should
be implemented in Backend.
-* change the meaning of crossMap to indicate offset in bytes rather
- than offset in 32-bit words.
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-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-09-14 02:43:18 UTC (rev 4093)
@@ -264,12 +264,11 @@
/* Walk through all the cards and forward all intergenerational pointers. */
static void forwardInterGenerationalObjptrs (GC_state s) {
- uint8_t *cardMap;
- uint8_t *crossMap;
- size_t numCards;
+ GC_cardMapElem *cardMap;
+ GC_crossMapElem *crossMap;
pointer oldGenStart, oldGenEnd;
- size_t cardIndex;
+ size_t cardIndex, maxCardIndex;
pointer cardStart, cardEnd;
pointer objectStart;
@@ -279,7 +278,7 @@
/* Constants. */
cardMap = s->generational.cardMap;
crossMap = s->generational.crossMap;
- numCards = sizeToCardIndex (align (s->heap.oldGenSize, s->generational.cardSize));
+ maxCardIndex = sizeToCardIndex (align (s->heap.oldGenSize, CARD_SIZE));
oldGenStart = s->heap.start;
oldGenEnd = oldGenStart + s->heap.oldGenSize;
/* Loop variables*/
@@ -287,9 +286,9 @@
cardIndex = 0;
cardStart = oldGenStart;
checkAll:
- assert (cardIndex <= numCards);
+ assert (cardIndex <= maxCardIndex);
assert (isAlignedFrontier (s, objectStart));
- if (cardIndex == numCards)
+ if (cardIndex == maxCardIndex)
goto done;
checkCard:
if (DEBUG_GENERATIONAL)
@@ -313,7 +312,7 @@
goto skipObjects;
}
s->cumulative.minorBytesSkipped += objectStart - lastObject;
- cardEnd = cardStart + s->generational.cardSize;
+ cardEnd = cardStart + CARD_SIZE;
if (oldGenEnd < cardEnd)
cardEnd = oldGenEnd;
assert (objectStart < cardEnd);
@@ -334,16 +333,16 @@
goto checkCard;
} else {
unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
- objectStart = cardStart + (crossMap[cardIndex] >> CROSS_MAP_SCALE);
+ objectStart = cardStart + (size_t)(crossMap[cardIndex]);
if (DEBUG_GENERATIONAL)
fprintf (stderr,
"card %zu is not marked"
- " crossMap[%zu] == %"PRIu8
+ " crossMap[%zu] == %zu"
" objectStart = "FMTPTR"\n",
cardIndex, cardIndex,
- crossMap[cardIndex], (uintptr_t)objectStart);
+ (size_t)(crossMap[cardIndex]), (uintptr_t)objectStart);
cardIndex++;
- cardStart += s->generational.cardSize;
+ cardStart += CARD_SIZE;
goto checkAll;
}
assert (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-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-09-14 02:43:18 UTC (rev 4093)
@@ -10,7 +10,7 @@
GC_frameLayout *frameLayouts; /* Array of frame layouts. */
uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
pointer frontier; /* heap.start <= frontier < limit */
- struct GC_generationalInfo generational;
+ struct GC_generationalMaps generational;
objptr *globals;
uint32_t globalsSize;
struct GC_heap heap;
@@ -18,6 +18,7 @@
pointer limit; /* limit = heap.start + heap.totalBytes */
pointer limitPlusSlop; /* limit + LIMIT_SLOP */
uint32_t maxFrameSize;
+ /*Bool*/bool mutatorMarksCards;
GC_objectType *objectTypes; /* Array of object types. */
uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
size_t pageSize;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-09-14 02:43:18 UTC (rev 4093)
@@ -6,11 +6,7 @@
* See the file MLton-LICENSE for details.
*/
-/* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
-#define CARD_SIZE_LOG2 8
-#define CARD_SIZE TWOPOWER(CARD_SIZE_LOG2)
-#define CROSS_MAP_EMPTY 255
-#define CROSS_MAP_SCALE 2
+#define CROSS_MAP_EMPTY ((GC_crossMapElem)255)
static inline uintptr_t pointerToCardIndex (pointer p) {
return (uintptr_t)p >> CARD_SIZE_LOG2;
@@ -33,64 +29,78 @@
}
static inline bool cardIsMarked (GC_state s, pointer p) {
- return (*pointerToCardMapAddr (s, p) != 0);
+ return (*pointerToCardMapAddr (s, p) != 0x0);
}
static inline void markCard (GC_state s, pointer p) {
if (DEBUG_CARD_MARKING)
fprintf (stderr, "markCard ("FMTPTR")\n", (uintptr_t)p);
- if (s->generational.mutatorMarksCards)
+ if (s->mutatorMarksCards)
*pointerToCardMapAddr (s, p) = 0x1;
}
static inline void clearCardMap (GC_state s) {
if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
fprintf (stderr, "clearCardMap ()\n");
- memset (s->generational.cardMap, 0, s->generational.cardMapSize);
+ memset (s->generational.cardMap, 0,
+ s->generational.cardMapLength * CARD_MAP_ELEM_SIZE);
}
static inline void clearCrossMap (GC_state s) {
if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
fprintf (stderr, "clearCrossMap ()\n");
s->generational.crossMapValidSize = 0;
- memset (s->generational.crossMap, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+ memset (s->generational.crossMap, CROSS_MAP_EMPTY,
+ s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE);
}
static inline void setCardMapAbsolute (GC_state s) {
- unless (s->generational.mutatorMarksCards)
+ unless (s->mutatorMarksCards)
return;
/* It's OK if the subtraction below underflows because all the
* subsequent additions to mark the cards will overflow and put us
* in the right place.
*/
s->generational.cardMapAbsolute =
- s->generational.cardMap - pointerToCardIndex ( s->heap.start);
+ pointerToCardMapAddr (s, s->heap.start);
if (DEBUG_CARD_MARKING)
fprintf (stderr, "cardMapAbsolute = "FMTPTR"\n",
(uintptr_t)s->generational.cardMapAbsolute);
}
static inline void createCardMapAndCrossMap (GC_state s) {
- unless (s->generational.mutatorMarksCards) {
- s->generational.cardMapSize = 0;
+ unless (s->mutatorMarksCards) {
+ s->generational.cardMapLength = 0;
s->generational.cardMap = NULL;
s->generational.cardMapAbsolute = NULL;
- s->generational.crossMapSize = 0;
+ s->generational.crossMapLength = 0;
s->generational.crossMap = NULL;
return;
}
- assert (isAligned (s->heap.size, s->generational.cardSize));
- s->generational.cardMapSize =
- align (sizeToCardIndex (s->heap.size), s->pageSize);
- s->generational.crossMapSize = s->generational.cardMapSize;
+ assert (isAligned (s->heap.size, CARD_SIZE));
+
+ size_t cardMapLength, cardMapSize;
+ size_t crossMapLength, crossMapSize;
+ size_t totalMapSize;
+
+ cardMapLength = sizeToCardIndex (s->heap.size);
+ cardMapSize = align (cardMapLength * CARD_MAP_ELEM_SIZE, s->pageSize);
+ cardMapLength = cardMapSize / CARD_MAP_ELEM_SIZE;
+ s->generational.cardMapLength = cardMapLength;
+
+ crossMapLength = sizeToCardIndex (s->heap.size);
+ crossMapSize = align (crossMapLength * CROSS_MAP_ELEM_SIZE, s->pageSize);
+ crossMapLength = crossMapSize / CROSS_MAP_ELEM_SIZE;
+ s->generational.crossMapLength = crossMapLength;
+
+ totalMapSize = cardMapSize + crossMapSize;
if (DEBUG_MEM)
fprintf (stderr, "Creating card/cross map of size %zd\n",
- /*uintToCommaString*/
- (s->generational.cardMapSize + s->generational.crossMapSize));
+ /*uintToCommaString*/(totalMapSize));
s->generational.cardMap =
- GC_mmapAnon (s->generational.cardMapSize + s->generational.crossMapSize);
+ GC_mmapAnon (totalMapSize);
s->generational.crossMap =
- s->generational.cardMap + s->generational.cardMapSize;
+ (GC_crossMapElem*)((pointer)s->generational.cardMap + cardMapSize);
if (DEBUG_CARD_MARKING)
fprintf (stderr, "cardMap = "FMTPTR" crossMap = "FMTPTR"\n",
(uintptr_t)s->generational.cardMap,
@@ -108,7 +118,7 @@
*/
return (p == s->heap.start)
? s->heap.start
- : (p - 1) - ((uintptr_t)(p - 1) % s->generational.cardSize);
+ : (p - 1) - ((uintptr_t)(p - 1) % CARD_SIZE);
}
/* crossMapIsOK is a slower, but easier to understand, way of
@@ -120,7 +130,8 @@
*/
static inline bool crossMapIsOK (GC_state s) {
- static uint8_t *map;
+ static GC_crossMapElem *map;
+ size_t mapSize;
pointer front, back;
size_t cardIndex;
@@ -128,8 +139,9 @@
if (DEBUG)
fprintf (stderr, "crossMapIsOK ()\n");
- map = GC_mmapAnon (s->generational.crossMapSize);
- memset (map, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+ mapSize = s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE;
+ map = GC_mmapAnon (mapSize);
+ memset (map, CROSS_MAP_EMPTY, mapSize);
back = s->heap.start + s->heap.oldGenSize;
cardIndex = 0;
front = alignFrontier (s, s->heap.start);
@@ -137,14 +149,14 @@
assert (front <= back);
cardStart = crossMapCardStart (s, front);
cardIndex = sizeToCardIndex (cardStart - s->heap.start);
- map[cardIndex] = (front - cardStart) >> CROSS_MAP_SCALE;
+ map[cardIndex] = (front - cardStart);
if (front < back) {
front += objectSize (s, objectData (s, front));
goto loopObjects;
}
for (size_t i = 0; i < cardIndex; ++i)
assert (map[i] == s->generational.crossMap[i]);
- GC_munmap (map, s->generational.crossMapSize);
+ GC_munmap (map, mapSize);
return TRUE;
}
@@ -167,7 +179,7 @@
} else
cardIndex = sizeToCardIndex (objectStart - 1 - s->heap.start);
cardStart = s->heap.start + cardIndexToSize (cardIndex);
- cardEnd = cardStart + s->generational.cardSize;
+ cardEnd = cardStart + CARD_SIZE;
loopObjects:
assert (objectStart < oldGenEnd);
assert ((objectStart == s->heap.start or cardStart < objectStart)
@@ -180,21 +192,21 @@
*/
size_t offset;
- offset = (objectStart - cardStart) >> CROSS_MAP_SCALE;
+ offset = (objectStart - cardStart);
assert (offset < CROSS_MAP_EMPTY);
if (DEBUG_GENERATIONAL)
fprintf (stderr, "crossMap[%zu] = %zu\n",
cardIndex, offset);
- s->generational.crossMap[cardIndex] = (uint8_t)offset;
+ s->generational.crossMap[cardIndex] = (GC_crossMapElem)offset;
cardIndex = sizeToCardIndex (nextObject - 1 - s->heap.start);
cardStart = s->heap.start + cardIndexToSize (cardIndex);
- cardEnd = cardStart + s->generational.cardSize;
+ cardEnd = cardStart + CARD_SIZE;
}
objectStart = nextObject;
if (objectStart < oldGenEnd)
goto loopObjects;
assert (objectStart == oldGenEnd);
- s->generational.crossMap[cardIndex] = (oldGenEnd - cardStart) >> CROSS_MAP_SCALE;
+ s->generational.crossMap[cardIndex] = (GC_crossMapElem)(oldGenEnd - cardStart);
s->generational.crossMapValidSize = s->heap.oldGenSize;
done:
assert (s->generational.crossMapValidSize == s->heap.oldGenSize);
@@ -202,21 +214,22 @@
}
static inline void resizeCardMapAndCrossMap (GC_state s) {
- if (s->generational.mutatorMarksCards
- and s->generational.cardMapSize
+ if (s->mutatorMarksCards
+ and (s->generational.cardMapLength * CARD_MAP_ELEM_SIZE)
!= align (sizeToCardIndex (s->heap.size), s->pageSize)) {
- uint8_t *oldCardMap;
+ GC_cardMapElem *oldCardMap;
size_t oldCardMapSize;
- uint8_t *oldCrossMap;
+ GC_crossMapElem *oldCrossMap;
size_t oldCrossMapSize;
oldCardMap = s->generational.cardMap;
- oldCardMapSize = s->generational.cardMapSize;
+ oldCardMapSize = s->generational.cardMapLength * CARD_MAP_ELEM_SIZE;
oldCrossMap = s->generational.crossMap;
- oldCrossMapSize = s->generational.crossMapSize;
+ oldCrossMapSize = s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE;
createCardMapAndCrossMap (s);
GC_memcpy ((pointer)oldCrossMap, (pointer)s->generational.crossMap,
- min (s->generational.crossMapSize, oldCrossMapSize));
+ min (s->generational.crossMapLength * CROSS_MAP_ELEM_SIZE,
+ oldCrossMapSize));
if (DEBUG_MEM)
fprintf (stderr, "Releasing card/cross map.\n");
GC_munmap (oldCardMap, oldCardMapSize + oldCrossMapSize);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-09-14 02:43:18 UTC (rev 4093)
@@ -6,16 +6,37 @@
* See the file MLton-LICENSE for details.
*/
-struct GC_generationalInfo {
- uint8_t *cardMap;
- uint8_t *cardMapAbsolute;
- size_t cardMapSize;
- size_t cardSize;
- uint8_t *crossMap;
- size_t crossMapSize;
- /* crossMapValidEnd is the size of the prefix of the old generation
+/* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
+#define CARD_SIZE_LOG2 8
+#define CARD_SIZE TWOPOWER(CARD_SIZE_LOG2)
+
+typedef uint8_t GC_cardMapElem;
+typedef uint8_t GC_crossMapElem;
+
+struct GC_generationalMaps {
+ /* cardMap is an array with cardinality equal to the size of the
+ * heap divided by card size. Each element in the array is
+ * interpreted as a boolean; true indicates that some mutable field
+ * of some object in the corresponding card in the heap has been
+ * written since the last minor GC; hence, the corresponding card
+ * must be traced at the next minor GC.
+ */
+ GC_cardMapElem *cardMap;
+ GC_cardMapElem *cardMapAbsolute;
+ size_t cardMapLength;
+ /* crossMap is an array with cardinality equal to the size of the
+ * heap divided by card size. Each element in the array is
+ * interpreted as a byte offset; the offset indicates the start of
+ * the last object in the corresponding card from the start of the
+ * card.
+ */
+ GC_crossMapElem *crossMap;
+ size_t crossMapLength;
+ /* crossMapValidSize the size of the prefix of the old generation
* for which the crossMap is valid.
*/
size_t crossMapValidSize;
- /*Bool*/bool mutatorMarksCards;
};
+
+#define CARD_MAP_ELEM_SIZE sizeof(GC_cardMapElem)
+#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-09-12 13:50:36 UTC (rev 4092)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-09-14 02:43:18 UTC (rev 4093)
@@ -30,16 +30,17 @@
}
}
/* Generational */
- if (s->generational.mutatorMarksCards) {
+ if (s->mutatorMarksCards) {
assert (s->generational.cardMap ==
- &s->generational.cardMapAbsolute
- [pointerToCardIndex(s->heap.start)]);
- assert (&s->generational.cardMapAbsolute
- [pointerToCardIndex(s->heap.start + s->heap.size - 1)]
- < s->generational.cardMap + s->generational.cardMapSize);
+ &(s->generational.cardMapAbsolute
+ [pointerToCardIndex(s->heap.start)]));
+ assert (&(s->generational.cardMapAbsolute
+ [pointerToCardIndex(s->heap.start + s->heap.size - 1)])
+ < (s->generational.cardMap
+ + (s->generational.cardMapLength * CARD_MAP_ELEM_SIZE)));
}
assert (isAligned (s->heap.size, s->pageSize));
- assert (isAligned ((size_t)s->heap.start, s->generational.cardSize));
+ assert (isAligned ((size_t)s->heap.start, CARD_SIZE));
assert (isAlignedFrontier (s, s->heap.start + s->heap.oldGenSize));
assert (isAlignedFrontier (s, s->heap.nursery));
assert (isAlignedFrontier (s, s->frontier));
|
|
From: Matthew F. <fl...@ml...> - 2005-09-12 06:50:37
|
crossMap todo item
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-09-12 02:23:11 UTC (rev 4091)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-09-12 13:50:36 UTC (rev 4092)
@@ -15,3 +15,5 @@
codegen in thread.h is still true; it used to be the case when
GC_switchToThread was implemented in codegens. Now it should
be implemented in Backend.
+* change the meaning of crossMap to indicate offset in bytes rather
+ than offset in 32-bit words.
|
|
From: Matthew F. <fl...@ml...> - 2005-09-11 19:23:18
|
Working on generational GC.
----------------------------------------------------------------------
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.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
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.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
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
A 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-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-09-12 02:23:11 UTC (rev 4091)
@@ -51,7 +51,8 @@
CC = gcc -std=gnu99
CWFLAGS = -Wall -pedantic -Wextra -Wshadow -Wpointer-arith -Wcast-qual -Wcast-align -Wconversion -Wsign-compare -Wstrict-prototypes -Wredundant-decls -Winline
CWFLAGS = -pedantic -Wall -Wextra -Wno-unused \
- -Wshadow -Wredundant-decls \
+## -Wshadow \
+ -Wredundant-decls \
-Wpointer-arith -Wcast-qual -Wcast-align \
## -Wconversion \
-Wstrict-prototypes \
@@ -71,7 +72,9 @@
frame.c \
stack.c \
thread.c \
+ generational.c \
heap.c \
+ invariant.c \
foreach.c \
cheney-copy.c \
assumptions.c \
@@ -81,6 +84,7 @@
HFILES = \
gc_prefix.h \
util.h \
+ virtual-memory.h \
pointer.h \
model.h \
object.h \
@@ -90,6 +94,7 @@
thread.h \
weak.h \
major.h \
+ generational.h \
statistics.h \
heap.h \
gc_state.h \
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -27,7 +27,7 @@
}
*/
-static inline bool isAligned (uintptr_t a, size_t b) {
+static inline bool isAligned (size_t a, size_t b) {
return 0 == a % b;
}
@@ -55,16 +55,3 @@
pointer GC_alignFrontier (GC_state s, pointer p) {
return alignFrontier (s, p);
}
-
-/*
-static inline uint stackReserved (GC_state s, uint r) {
- uint res;
-
- res = pad (s, r, STACK_HEADER_SIZE + sizeof (struct GC_stack));
- if (DEBUG_STACKS)
- fprintf (stderr, "%s = stackReserved (%s)\n",
- uintToCommaString (res),
- uintToCommaString (r));
- return res;
-}
-*/
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -11,14 +11,13 @@
pointer a,
uint32_t arrayIndex,
uint32_t pointerIndex) {
- bool hasIdentity;
GC_header header;
uint16_t numNonObjptrs;
uint16_t numObjptrs;
GC_objectTypeTag tag;
header = getHeader (a);
- SPLIT_HEADER();
+ splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
assert (tag == ARRAY_TAG);
size_t nonObjptrBytesPerElement =
@@ -37,8 +36,8 @@
/* The number of bytes in an array, not including the header. */
static inline size_t arrayNumBytes (GC_state s,
pointer p,
- uint16_t numObjptrs,
- uint16_t numNonObjptrs) {
+ uint16_t numNonObjptrs,
+ uint16_t numObjptrs) {
size_t bytesPerElement;
GC_arrayLength numElements;
size_t result;
@@ -53,3 +52,32 @@
result = OBJPTR_SIZE;
return pad (s, result, GC_ARRAY_HEADER_SIZE);
}
+
+static inline size_t objectSize (GC_state s, pointer p) {
+ size_t headerBytes, objectBytes;
+ GC_header header;
+ GC_objectTypeTag tag;
+ uint16_t numNonObjptrs, numObjptrs;
+
+ header = getHeader (p);
+ splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ if (NORMAL_TAG == tag) { /* Fixed size object. */
+ headerBytes = GC_NORMAL_HEADER_SIZE;
+ objectBytes =
+ numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ } else if (ARRAY_TAG == tag) {
+ headerBytes = GC_ARRAY_HEADER_SIZE;
+ objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
+ } else if (WEAK_TAG == tag) {
+ headerBytes = GC_NORMAL_HEADER_SIZE;
+ objectBytes =
+ numNonObjptrsToBytes (numNonObjptrs, NORMAL_TAG)
+ + (numObjptrs * OBJPTR_SIZE);
+ } else { /* Stack. */
+ assert (STACK_TAG == tag);
+ headerBytes = GC_STACK_HEADER_SIZE;
+ objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+ }
+ return headerBytes + objectBytes;
+}
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-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -46,11 +46,10 @@
return pointerIsInToSpace (p);
}
-static inline void forward (GC_state s, objptr *opp) {
+static void forward (GC_state s, objptr *opp) {
objptr op;
pointer p;
GC_header header;
- GC_objectTypeTag tag;
op = *opp;
p = objptrToPointer (op, s->heap.start);
@@ -63,12 +62,14 @@
if (DEBUG_DETAILED and header == GC_FORWARDED)
fprintf (stderr, " already FORWARDED\n");
if (header != GC_FORWARDED) { /* forward the object */
- bool hasIdentity;
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. */
- SPLIT_HEADER();
if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) { /* Fixed size object. */
headerBytes = GC_NORMAL_HEADER_SIZE;
objectBytes =
@@ -77,7 +78,7 @@
skip = 0;
} else if (ARRAY_TAG == tag) {
headerBytes = GC_ARRAY_HEADER_SIZE;
- objectBytes = arrayNumBytes (s, p, numObjptrs, numNonObjptrs);
+ objectBytes = arrayNumBytes (s, p, numNonObjptrs, numObjptrs);
skip = 0;
} else { /* Stack. */
GC_stack stack;
@@ -122,7 +123,7 @@
size = headerBytes + objectBytes;
assert (forwardState.back + size + skip <= forwardState.toLimit);
/* Copy the object. */
- copy (p - headerBytes, forwardState.back, size);
+ 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.
*/
@@ -189,7 +190,7 @@
tempHeap = s->secondaryHeap;
s->secondaryHeap = s->heap;
s->heap = tempHeap;
- // setCardMapForMutator (s);
+ setCardMapAbsolute (s);
}
/* static inline bool detailedGCTime (GC_state s) { */
@@ -200,43 +201,204 @@
// struct rusage ru_start;
pointer toStart;
- assert (s->secondaryHeap.totalBytes >= s->heap.oldGenBytes);
+ assert (s->secondaryHeap.size >= s->heap.oldGenSize);
/* if (detailedGCTime (s)) */
/* startTiming (&ru_start); */
s->cumulative.numCopyingGCs++;
forwardState.toStart = s->secondaryHeap.start;
- forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.totalBytes;
+ forwardState.toLimit = s->secondaryHeap.start + s->secondaryHeap.size;
if (DEBUG or s->messages) {
fprintf (stderr, "Major copying GC.\n");
fprintf (stderr, "fromSpace = "FMTPTR" of size %zd\n",
(uintptr_t) s->heap.start,
- /*uintToCommaString*/(s->heap.totalBytes));
+ /*uintToCommaString*/(s->heap.size));
fprintf (stderr, "toSpace = "FMTPTR" of size %zd\n",
(uintptr_t) s->secondaryHeap.start,
- /*uintToCommaString*/(s->secondaryHeap.totalBytes));
+ /*uintToCommaString*/(s->secondaryHeap.size));
}
assert (s->secondaryHeap.start != (pointer)NULL);
/* The next assert ensures there is enough space for the copy to
* succeed. It does not assert
- * (s->secondaryHeap.totalBytes >= s->heap.totalByes)
+ * (s->secondaryHeap.size >= s->heap.size)
* because that is too strong.
*/
- assert (s->secondaryHeap.totalBytes >= s->heap.oldGenBytes);
+ assert (s->secondaryHeap.size >= s->heap.oldGenSize);
toStart = alignFrontier (s, s->secondaryHeap.start);
forwardState.back = toStart;
foreachGlobalObjptr (s, forward);
foreachObjptrInRange (s, toStart, &forwardState.back, TRUE, forward);
updateWeaks (s);
- s->secondaryHeap.oldGenBytes = forwardState.back - s->secondaryHeap.start;
- s->cumulative.bytesCopied += s->secondaryHeap.oldGenBytes;
+ s->secondaryHeap.oldGenSize = forwardState.back - s->secondaryHeap.start;
+ s->cumulative.bytesCopied += s->secondaryHeap.oldGenSize;
if (DEBUG)
fprintf (stderr, "%zd bytes live.\n",
- /*uintToCommaString*/(s->secondaryHeap.oldGenBytes));
+ /*uintToCommaString*/(s->secondaryHeap.oldGenSize));
swapHeaps (s);
- // clearCrossMap (s);
+ clearCrossMap (s);
s->lastMajor.kind = GC_COPYING;
/* if (detailedGCTime (s)) */
/* stopTiming (&ru_start, &s->ru_gcCopy); */
if (DEBUG or s->messages)
fprintf (stderr, "Major copying GC done.\n");
}
+
+/* ---------------------------------------------------------------- */
+/* Minor Cheney Copying Collection */
+/* ---------------------------------------------------------------- */
+
+static inline void forwardIfInNursery (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,
+ "forwardIfInNursery opp = "FMTPTR" op = "FMTOBJPTR" p = "FMTPTR"\n",
+ (uintptr_t)opp, op, (uintptr_t)p);
+ assert (s->heap.nursery <= p and p < s->limitPlusSlop);
+ forward (s, opp);
+}
+
+/* Walk through all the cards and forward all intergenerational pointers. */
+static void forwardInterGenerationalObjptrs (GC_state s) {
+ uint8_t *cardMap;
+ uint8_t *crossMap;
+ size_t numCards;
+ pointer oldGenStart, oldGenEnd;
+
+ size_t cardIndex;
+ pointer cardStart, cardEnd;
+ pointer objectStart;
+
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "Forwarding inter-generational pointers.\n");
+ updateCrossMap (s);
+ /* Constants. */
+ cardMap = s->generational.cardMap;
+ crossMap = s->generational.crossMap;
+ numCards = sizeToCardIndex (align (s->heap.oldGenSize, s->generational.cardSize));
+ oldGenStart = s->heap.start;
+ oldGenEnd = oldGenStart + s->heap.oldGenSize;
+ /* Loop variables*/
+ objectStart = alignFrontier (s, s->heap.start);
+ cardIndex = 0;
+ cardStart = oldGenStart;
+checkAll:
+ assert (cardIndex <= numCards);
+ assert (isAlignedFrontier (s, objectStart));
+ if (cardIndex == numCards)
+ goto done;
+checkCard:
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "checking card %zu objectStart = "FMTPTR"\n",
+ cardIndex, (uintptr_t)objectStart);
+ assert (objectStart < oldGenStart + cardIndexToSize (cardIndex + 1));
+ if (cardMap[cardIndex]) {
+ pointer lastObject;
+ size_t size;
+
+ s->cumulative.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 = objectSize (s, objectData (s, objectStart));
+ if (objectStart + size < cardStart) {
+ objectStart += size;
+ goto skipObjects;
+ }
+ s->cumulative.minorBytesSkipped += objectStart - lastObject;
+ cardEnd = cardStart + s->generational.cardSize;
+ 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, forwardIfInNursery);
+ s->cumulative.minorBytesScanned += objectStart - lastObject;
+ if (objectStart == oldGenEnd)
+ goto done;
+ cardIndex = sizeToCardIndex (objectStart - oldGenStart);
+ cardStart = oldGenStart + cardIndexToSize (cardIndex);
+ goto checkCard;
+ } else {
+ unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
+ objectStart = cardStart + (crossMap[cardIndex] >> CROSS_MAP_SCALE);
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr,
+ "card %zu is not marked"
+ " crossMap[%zu] == %"PRIu8
+ " objectStart = "FMTPTR"\n",
+ cardIndex, cardIndex,
+ crossMap[cardIndex], (uintptr_t)objectStart);
+ cardIndex++;
+ cardStart += s->generational.cardSize;
+ goto checkAll;
+ }
+ assert (FALSE);
+done:
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "Forwarding inter-generational pointers done.\n");
+}
+
+static void minorGC (GC_state s) {
+ size_t bytesAllocated;
+ size_t bytesCopied;
+ // struct rusage ru_start;
+
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "minorGC nursery = "FMTPTR" frontier = "FMTPTR"\n",
+ (uintptr_t)s->heap.nursery, (uintptr_t)s->frontier);
+ assert (invariant (s));
+ bytesAllocated = s->frontier - s->heap.nursery;
+ if (bytesAllocated == 0)
+ return;
+ s->cumulative.bytesAllocated += bytesAllocated;
+ if (not s->canMinor) {
+ s->heap.oldGenSize += bytesAllocated;
+ bytesCopied = 0;
+ } else {
+ if (DEBUG_GENERATIONAL or s->messages)
+ fprintf (stderr, "Minor GC.\n");
+/* if (detailedGCTime (s)) */
+/* startTiming (&ru_start); */
+ s->amInMinorGC = TRUE;
+ 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;
+ assert (invariant (s));
+ s->cumulative.numMinorGCs++;
+ s->lastMajor.numMinorsGCs++;
+ forwardState.back = forwardState.toStart;
+ /* Forward all globals. Would like to avoid doing this once all
+ * the globals have been assigned.
+ */
+ foreachGlobalObjptr (s, forwardIfInNursery);
+ forwardInterGenerationalObjptrs (s);
+ foreachObjptrInRange (s, forwardState.toStart, &forwardState.back,
+ TRUE, forwardIfInNursery);
+ updateWeaks (s);
+ bytesCopied = forwardState.back - forwardState.toStart;
+ s->cumulative.bytesCopiedMinor += bytesCopied;
+ s->heap.oldGenSize += bytesCopied;
+ s->amInMinorGC = FALSE;
+/* if (detailedGCTime (s)) */
+/* stopTiming (&ru_start, &s->ru_gcMinor); */
+ if (DEBUG_GENERATIONAL or s->messages)
+ fprintf (stderr, "Minor GC done. %zd bytes copied.\n",
+ /*uintToCommaString*/(bytesCopied));
+ }
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -18,6 +18,7 @@
DEBUG_ENTER_LEAVE = FALSE,
DEBUG_GENERATIONAL = FALSE,
DEBUG_MARK_COMPACT = FALSE,
+ DEBUG_MEM = FALSE,
DEBUG_PROFILE = FALSE,
DEBUG_RESIZING = FALSE,
DEBUG_SHARE = FALSE,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -45,14 +45,13 @@
pointer p,
bool skipWeaks,
GC_foreachObjptrFun f) {
- bool hasIdentity;
GC_header header;
uint16_t numNonObjptrs;
uint16_t numObjptrs;
GC_objectTypeTag tag;
header = getHeader (p);
- SPLIT_HEADER();
+ splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
if (DEBUG_DETAILED)
fprintf (stderr,
"foreachObjptrInObject ("FMTPTR")"
@@ -202,7 +201,7 @@
fprintf (stderr,
" front = "FMTPTR" *back = "FMTPTR"\n",
(uintptr_t)front, (uintptr_t)(*back));
- front = foreachObjptrInObject (s, toData (s, front), skipWeaks, f);
+ front = foreachObjptrInObject (s, objectData (s, front), skipWeaks, f);
}
b = *back;
}
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-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-09-12 02:23:11 UTC (rev 4091)
@@ -4,19 +4,23 @@
bool amInGC;
bool amInMinorGC;
objptr callFromCHandler; /* Handler for exported C calls (in heap). */
+ bool canMinor; /* TRUE iff there is space for a minor gc. */
struct GC_cumulativeStatistics cumulative;
objptr currentThread; /* Currently executing thread (in heap). */
GC_frameLayout *frameLayouts; /* Array of frame layouts. */
uint32_t frameLayoutsSize; /* Cardinality of frameLayouts array. */
pointer frontier; /* heap.start <= frontier < limit */
+ struct GC_generationalInfo generational;
objptr *globals;
uint32_t globalsSize;
struct GC_heap heap;
struct GC_lastMajorStatistics lastMajor;
pointer limit; /* limit = heap.start + heap.totalBytes */
+ pointer limitPlusSlop; /* limit + LIMIT_SLOP */
uint32_t maxFrameSize;
GC_objectType *objectTypes; /* Array of object types. */
uint32_t objectTypesSize; /* Cardinality of objectTypes array. */
+ size_t pageSize;
uint32_t (*returnAddressToFrameIndex) (GC_returnAddress ra);
objptr savedThread; /* Result of GC_copyCurrentThread.
* Thread interrupted by arrival of signal.
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -0,0 +1,224 @@
+/* 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.
+ */
+
+/* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
+#define CARD_SIZE_LOG2 8
+#define CARD_SIZE TWOPOWER(CARD_SIZE_LOG2)
+#define CROSS_MAP_EMPTY 255
+#define CROSS_MAP_SCALE 2
+
+static inline uintptr_t pointerToCardIndex (pointer p) {
+ return (uintptr_t)p >> CARD_SIZE_LOG2;
+}
+static inline size_t sizeToCardIndex (size_t n) {
+ return n >> CARD_SIZE_LOG2;
+}
+static inline size_t cardIndexToSize (size_t n) {
+ return n << CARD_SIZE_LOG2;
+}
+
+static inline pointer pointerToCardMapAddr (GC_state s, pointer p) {
+ pointer res;
+
+ res = &s->generational.cardMapAbsolute [pointerToCardIndex (p)];
+ if (DEBUG_CARD_MARKING)
+ fprintf (stderr, "pointerToCardMapAddr ("FMTPTR") = "FMTPTR"\n",
+ (uintptr_t)p, (uintptr_t)res);
+ return res;
+}
+
+static inline bool cardIsMarked (GC_state s, pointer p) {
+ return (*pointerToCardMapAddr (s, p) != 0);
+}
+
+static inline void markCard (GC_state s, pointer p) {
+ if (DEBUG_CARD_MARKING)
+ fprintf (stderr, "markCard ("FMTPTR")\n", (uintptr_t)p);
+ if (s->generational.mutatorMarksCards)
+ *pointerToCardMapAddr (s, p) = 0x1;
+}
+
+static inline void clearCardMap (GC_state s) {
+ if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
+ fprintf (stderr, "clearCardMap ()\n");
+ memset (s->generational.cardMap, 0, s->generational.cardMapSize);
+}
+
+static inline void clearCrossMap (GC_state s) {
+ if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
+ fprintf (stderr, "clearCrossMap ()\n");
+ s->generational.crossMapValidSize = 0;
+ memset (s->generational.crossMap, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+}
+
+static inline void setCardMapAbsolute (GC_state s) {
+ unless (s->generational.mutatorMarksCards)
+ return;
+ /* It's OK if the subtraction below underflows because all the
+ * subsequent additions to mark the cards will overflow and put us
+ * in the right place.
+ */
+ s->generational.cardMapAbsolute =
+ s->generational.cardMap - pointerToCardIndex ( s->heap.start);
+ if (DEBUG_CARD_MARKING)
+ fprintf (stderr, "cardMapAbsolute = "FMTPTR"\n",
+ (uintptr_t)s->generational.cardMapAbsolute);
+}
+
+static inline void createCardMapAndCrossMap (GC_state s) {
+ unless (s->generational.mutatorMarksCards) {
+ s->generational.cardMapSize = 0;
+ s->generational.cardMap = NULL;
+ s->generational.cardMapAbsolute = NULL;
+ s->generational.crossMapSize = 0;
+ s->generational.crossMap = NULL;
+ return;
+ }
+ assert (isAligned (s->heap.size, s->generational.cardSize));
+ s->generational.cardMapSize =
+ align (sizeToCardIndex (s->heap.size), s->pageSize);
+ s->generational.crossMapSize = s->generational.cardMapSize;
+ if (DEBUG_MEM)
+ fprintf (stderr, "Creating card/cross map of size %zd\n",
+ /*uintToCommaString*/
+ (s->generational.cardMapSize + s->generational.crossMapSize));
+ s->generational.cardMap =
+ GC_mmapAnon (s->generational.cardMapSize + s->generational.crossMapSize);
+ s->generational.crossMap =
+ s->generational.cardMap + s->generational.cardMapSize;
+ if (DEBUG_CARD_MARKING)
+ fprintf (stderr, "cardMap = "FMTPTR" crossMap = "FMTPTR"\n",
+ (uintptr_t)s->generational.cardMap,
+ (uintptr_t)s->generational.crossMap);
+ setCardMapAbsolute (s);
+ clearCardMap (s);
+ clearCrossMap (s);
+}
+
+#if ASSERT
+
+static inline pointer crossMapCardStart (GC_state s, pointer p) {
+ /* The p - 1 is so that a pointer to the beginning of a card falls
+ * into the index for the previous crossMap entry.
+ */
+ return (p == s->heap.start)
+ ? s->heap.start
+ : (p - 1) - ((uintptr_t)(p - 1) % s->generational.cardSize);
+}
+
+/* crossMapIsOK is a slower, but easier to understand, way of
+ * computing the crossMap. updateCrossMap (below) incrementally
+ * updates the crossMap, checking only the part of the old generation
+ * that it hasn't seen before. crossMapIsOK simply walks through the
+ * entire old generation. It is useful to check that the incremental
+ * update is working correctly.
+ */
+
+static inline bool crossMapIsOK (GC_state s) {
+ static uint8_t *map;
+
+ pointer front, back;
+ size_t cardIndex;
+ pointer cardStart;
+
+ if (DEBUG)
+ fprintf (stderr, "crossMapIsOK ()\n");
+ map = GC_mmapAnon (s->generational.crossMapSize);
+ memset (map, CROSS_MAP_EMPTY, s->generational.crossMapSize);
+ back = s->heap.start + s->heap.oldGenSize;
+ cardIndex = 0;
+ front = alignFrontier (s, s->heap.start);
+loopObjects:
+ assert (front <= back);
+ cardStart = crossMapCardStart (s, front);
+ cardIndex = sizeToCardIndex (cardStart - s->heap.start);
+ map[cardIndex] = (front - cardStart) >> CROSS_MAP_SCALE;
+ if (front < back) {
+ front += objectSize (s, objectData (s, front));
+ goto loopObjects;
+ }
+ for (size_t i = 0; i < cardIndex; ++i)
+ assert (map[i] == s->generational.crossMap[i]);
+ GC_munmap (map, s->generational.crossMapSize);
+ return TRUE;
+}
+
+#endif /* ASSERT */
+
+static inline void updateCrossMap (GC_state s) {
+ size_t cardIndex;
+ pointer cardStart, cardEnd;
+
+ pointer nextObject, objectStart;
+ pointer oldGenEnd;
+
+ if (s->generational.crossMapValidSize == s->heap.oldGenSize)
+ goto done;
+ oldGenEnd = s->heap.start + s->heap.oldGenSize;
+ objectStart = s->heap.start + s->generational.crossMapValidSize;
+ if (objectStart == s->heap.start) {
+ cardIndex = 0;
+ objectStart = alignFrontier (s, objectStart);
+ } else
+ cardIndex = sizeToCardIndex (objectStart - 1 - s->heap.start);
+ cardStart = s->heap.start + cardIndexToSize (cardIndex);
+ cardEnd = cardStart + s->generational.cardSize;
+loopObjects:
+ assert (objectStart < oldGenEnd);
+ assert ((objectStart == s->heap.start or cardStart < objectStart)
+ and objectStart <= cardEnd);
+ nextObject = objectStart + objectSize (s, objectData (s, objectStart));
+ if (nextObject > cardEnd) {
+ /* We're about to move to a new card, so we are looking at the
+ * last object boundary in the current card.
+ * Store it in the crossMap.
+ */
+ size_t offset;
+
+ offset = (objectStart - cardStart) >> CROSS_MAP_SCALE;
+ assert (offset < CROSS_MAP_EMPTY);
+ if (DEBUG_GENERATIONAL)
+ fprintf (stderr, "crossMap[%zu] = %zu\n",
+ cardIndex, offset);
+ s->generational.crossMap[cardIndex] = (uint8_t)offset;
+ cardIndex = sizeToCardIndex (nextObject - 1 - s->heap.start);
+ cardStart = s->heap.start + cardIndexToSize (cardIndex);
+ cardEnd = cardStart + s->generational.cardSize;
+ }
+ objectStart = nextObject;
+ if (objectStart < oldGenEnd)
+ goto loopObjects;
+ assert (objectStart == oldGenEnd);
+ s->generational.crossMap[cardIndex] = (oldGenEnd - cardStart) >> CROSS_MAP_SCALE;
+ s->generational.crossMapValidSize = s->heap.oldGenSize;
+done:
+ assert (s->generational.crossMapValidSize == s->heap.oldGenSize);
+ assert (crossMapIsOK (s));
+}
+
+static inline void resizeCardMapAndCrossMap (GC_state s) {
+ if (s->generational.mutatorMarksCards
+ and s->generational.cardMapSize
+ != align (sizeToCardIndex (s->heap.size), s->pageSize)) {
+ uint8_t *oldCardMap;
+ size_t oldCardMapSize;
+ uint8_t *oldCrossMap;
+ size_t oldCrossMapSize;
+
+ oldCardMap = s->generational.cardMap;
+ oldCardMapSize = s->generational.cardMapSize;
+ oldCrossMap = s->generational.crossMap;
+ oldCrossMapSize = s->generational.crossMapSize;
+ createCardMapAndCrossMap (s);
+ GC_memcpy ((pointer)oldCrossMap, (pointer)s->generational.crossMap,
+ min (s->generational.crossMapSize, oldCrossMapSize));
+ if (DEBUG_MEM)
+ fprintf (stderr, "Releasing card/cross map.\n");
+ GC_munmap (oldCardMap, oldCardMapSize + oldCrossMapSize);
+ }
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h (from rev 4078, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-09-07 00:47:05 UTC (rev 4078)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-09-12 02:23:11 UTC (rev 4091)
@@ -0,0 +1,21 @@
+/* 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_generationalInfo {
+ uint8_t *cardMap;
+ uint8_t *cardMapAbsolute;
+ size_t cardMapSize;
+ size_t cardSize;
+ uint8_t *crossMap;
+ size_t crossMapSize;
+ /* crossMapValidEnd is the size of the prefix of the old generation
+ * for which the crossMap is valid.
+ */
+ size_t crossMapValidSize;
+ /*Bool*/bool mutatorMarksCards;
+};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -22,7 +22,7 @@
static inline bool pointerIsInOldGen (GC_state s, pointer p) {
return (not (isPointer (p))
or (s->heap.start <= p
- and p < s->heap.start + s->heap.oldGenBytes));
+ and p < s->heap.start + s->heap.oldGenSize));
}
static inline bool objptrIsInOldGen (GC_state s, objptr op) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/heap.h 2005-09-12 02:23:11 UTC (rev 4091)
@@ -19,7 +19,9 @@
typedef struct GC_heap {
pointer nursery; /* start of nursery */
- size_t oldGenBytes; /* size of old generation */
+ size_t oldGenSize; /* size of old generation */
pointer start; /* start of heap (and old generation) */
- size_t totalBytes; /* size of heap */
+ size_t size; /* size of heap */
} *GC_heap;
+
+#define LIMIT_SLOP 512
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c (from rev 4089, mlton/branches/on-20050822-x86_64-branch/runtime/gc.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -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.
+ */
+
+#if ASSERT
+
+static bool invariant (GC_state s) {
+ if (DEBUG)
+ fprintf (stderr, "invariant\n");
+ // assert (ratiosOk (s));
+ /* Frame layouts */
+ for (unsigned int i = 0; i < s->frameLayoutsSize; ++i) {
+ GC_frameLayout *layout;
+
+ layout = &(s->frameLayouts[i]);
+ if (layout->numBytes > 0) {
+ GC_frameOffsets offsets;
+
+ assert (layout->numBytes <= s->maxFrameSize);
+ offsets = layout->offsets;
+ /* No longer correct, since handler frames have a "size"
+ * (i.e. return address) pointing into the middle of the frame.
+ */
+/* for (unsigned int j = 0; j < offsets[0]; ++j) */
+/* assert (offsets[j + 1] < layout->numBytes); */
+ }
+ }
+ /* Generational */
+ if (s->generational.mutatorMarksCards) {
+ assert (s->generational.cardMap ==
+ &s->generational.cardMapAbsolute
+ [pointerToCardIndex(s->heap.start)]);
+ assert (&s->generational.cardMapAbsolute
+ [pointerToCardIndex(s->heap.start + s->heap.size - 1)]
+ < s->generational.cardMap + s->generational.cardMapSize);
+ }
+ assert (isAligned (s->heap.size, s->pageSize));
+ assert (isAligned ((size_t)s->heap.start, s->generational.cardSize));
+ assert (isAlignedFrontier (s, s->heap.start + s->heap.oldGenSize));
+ assert (isAlignedFrontier (s, s->heap.nursery));
+ assert (isAlignedFrontier (s, s->frontier));
+ assert (s->heap.nursery <= s->frontier);
+ unless (0 == s->heap.size) {
+ assert (s->heap.nursery <= s->frontier);
+ assert (s->frontier <= s->limitPlusSlop);
+ assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
+/* assert (hasBytesFree (s, 0, 0)); */
+ }
+ assert (s->secondaryHeap.start == NULL or s->heap.size == s->secondaryHeap.size);
+/* /\* Check that all pointers are into from space. *\/ */
+/* foreachGlobal (s, assertIsInFromSpace); */
+/* back = s->heap.start + s->oldGenSize; */
+/* if (DEBUG_DETAILED) */
+/* fprintf (stderr, "Checking old generation.\n"); */
+/* foreachPointerInRange (s, alignFrontier (s, s->heap.start), &back, FALSE, */
+/* assertIsInFromSpace); */
+/* if (DEBUG_DETAILED) */
+/* fprintf (stderr, "Checking nursery.\n"); */
+/* foreachPointerInRange (s, s->nursery, &s->frontier, FALSE, */
+/* assertIsInFromSpace); */
+/* /\* Current thread. *\/ */
+/* stack = s->currentThread->stack; */
+/* assert (isAlignedReserved (s, stack->reserved)); */
+/* assert (s->stackBottom == stackBottom (s, stack)); */
+/* assert (s->stackTop == stackTop (s, stack)); */
+/* assert (s->stackLimit == stackLimit (s, stack)); */
+/* assert (stack->used == currentStackUsed (s)); */
+/* assert (stack->used <= stack->reserved); */
+/* assert (s->stackBottom <= s->stackTop); */
+ if (DEBUG)
+ fprintf (stderr, "invariant passed\n");
+ return TRUE;
+}
+
+static bool mutatorInvariant (GC_state s, bool frontier, bool stack) {
+#if FALSE
+ if (DEBUG)
+ GC_display (s, stderr);
+ if (frontier)
+ assert (mutatorFrontierInvariant(s));
+ if (stack)
+ assert (mutatorStackInvariant(s));
+#endif
+ assert (invariant (s));
+ return TRUE;
+}
+
+#endif /* #if ASSERT */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -20,30 +20,6 @@
#define WEAK_GONE_HEADER GC_objectHeader (WEAK_GONE_TYPE_INDEX)
#define WORD8_VECTOR_HEADER GC_objectHeader (WORD8_TYPE_INDEX)
-#define SPLIT_HEADER() \
- do { \
- unsigned int objectTypeIndex; \
- GC_objectType *t; \
- \
- assert (1 == (header & GC_VALID_HEADER_MASK)); \
- objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT; \
- assert (objectTypeIndex < s->objectTypesSize); \
- t = &s->objectTypes [objectTypeIndex]; \
- tag = t->tag; \
- hasIdentity = t->hasIdentity; \
- numNonObjptrs = t->numNonObjptrs; \
- numObjptrs = t->numObjptrs; \
- if (DEBUG_DETAILED) \
- fprintf (stderr, \
- "SPLIT_HEADER ("FMTHDR")" \
- " tag = %s" \
- " hasIdentity = %u" \
- " numNonObjptrs = %"PRIu16 \
- " numObjptrs = %"PRIu16"\n", \
- header, \
- tagToString(tag), hasIdentity, numNonObjptrs, numObjptrs); \
- } while (0)
-
static char* tagToString (GC_objectTypeTag tag) {
switch (tag) {
case ARRAY_TAG:
@@ -59,10 +35,50 @@
}
}
-/* If p points at the beginning of an object, then toData p returns a
- * pointer to the start of the object data.
+static inline void splitHeader(GC_state s, GC_header header,
+ GC_objectTypeTag *tagRet, bool *hasIdentityRet,
+ uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet) {
+ unsigned int objectTypeIndex;
+ GC_objectType *objectType;
+ GC_objectTypeTag tag;
+ bool hasIdentity;
+ uint16_t numNonObjptrs, numObjptrs;
+
+ assert (1 == (header & GC_VALID_HEADER_MASK));
+ objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT;
+ assert (objectTypeIndex < s->objectTypesSize);
+ objectType = &s->objectTypes [objectTypeIndex];
+ tag = objectType->tag;
+ hasIdentity = objectType->hasIdentity;
+ numNonObjptrs = objectType->numNonObjptrs;
+ numObjptrs = objectType->numObjptrs;
+
+ if (DEBUG_DETAILED)
+ fprintf (stderr,
+ "splitHeader ("FMTHDR")"
+ " tag = %s"
+ " hasIdentity = %u"
+ " numNonObjptrs = %"PRIu16
+ " numObjptrs = %"PRIu16"\n",
+ header,
+ tagToString(tag), hasIdentity, numNonObjptrs, numObjptrs);
+
+ if (tagRet != NULL)
+ *tagRet = tag;
+ if (hasIdentityRet != NULL)
+ *hasIdentityRet = hasIdentity;
+ if (numNonObjptrsRet != NULL)
+ *numNonObjptrsRet = numNonObjptrs;
+ if (numObjptrsRet != NULL)
+ *numObjptrsRet = numObjptrs;
+}
+
+/* objectData (s, p)
+ *
+ * If p points at the beginning of an object, then objectData returns
+ * a pointer to the start of the object data.
*/
-static inline pointer toData (GC_state s, pointer p) {
+static inline pointer objectData (GC_state s, pointer p) {
GC_header header;
pointer res;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/pointer.c 2005-09-12 02:23:11 UTC (rev 4091)
@@ -12,11 +12,9 @@
return (0 == ((uintptr_t)p & mask));
}
-static inline void copy (pointer src, pointer dst, size_t size) {
- unsigned int *to, *from, *limit;
-
+static inline void GC_memcpy (pointer src, pointer dst, size_t size) {
if (DEBUG_DETAILED)
- fprintf (stderr, "copy ("FMTPTR", "FMTPTR", %zu)\n",
+ fprintf (stderr, "GC_memcpy ("FMTPTR", "FMTPTR", %zu)\n",
(uintptr_t)src, (uintptr_t)dst, size);
assert (isAligned ((uintptr_t)src, sizeof(unsigned int)));
assert (isAligned ((uintptr_t)dst, sizeof(unsigned int)));
@@ -24,9 +22,5 @@
assert (dst <= src or src + size <= dst);
if (src == dst)
return;
- from = (unsigned int*)src;
- to = (unsigned int*)dst;
- limit = (unsigned int*)(src + size);
- until (from == limit)
- *to++ = *from++;
+ memcpy (dst, src, size);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-09-12 02:23:11 UTC (rev 4091)
@@ -13,6 +13,8 @@
uintmax_t bytesHashConsed;
uintmax_t bytesMarkCompacted;
+ uintmax_t markedCards; /* Number of marked cards seen during minor GCs. */
+
size_t maxBytesLive;
size_t maxHeapSizeSeen;
size_t maxStackSizeSeen;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-09-11 23:26:29 UTC (rev 4090)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/util.h 2005-09-12 02:23:11 UTC (rev 4091)
@@ -24,6 +24,7 @@
#include <inttypes.h>
#include <stdlib.h>
#include <limits.h>
+#include <string.h>
#include "../assert.h"
@@ -38,6 +39,14 @@
#define unless(p) if (not (p))
#define until(p) while (not (p))
+#ifndef max
+#define max(a, b) ((a)>(b)?(a):(b))
+#endif
+
+#ifndef min
+#define min(a, b) ((a)<(b)?(a):(b))
+#endif
+
/* issue error message and exit */
extern void die (char *fmt, ...)
__attribute__ ((format(printf, 1, 2)))
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h (from rev 4089, mlton/branches/on-20050822-x86_64-branch/runtime/gc.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/virtual-memory.h 2005-09-12 02:23:11 UTC (rev 4091)
@@ -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.
+ */
+
+void *GC_mmap (void *start, size_t length);
+void *GC_mmapAnon (size_t length);
+void *GC_munmap (void *base, size_t length);
|
|
From: Stephen W. <sw...@ml...> - 2005-09-11 16:26:33
|
Fixed bug in display of types with large numbers of type variables,
which could cause unhandled exception Chr.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/mlton/elaborate/type-env.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/trunk/doc/changelog 2005-09-11 23:26:29 UTC (rev 4090)
@@ -1,5 +1,9 @@
Here are the changes since version 20041109.
+* 2005-09-11
+ - Fixed bug in display of types with large numbers of type
+ variables, which could cause unhandled exception Chr.
+
* 2005-09-08
- Fixed bug in type inference of flexible records that would show up
as "Type error: variable applied to wrong number of type args"
Modified: mlton/trunk/mlton/elaborate/type-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.fun 2005-09-11 16:58:45 UTC (rev 4089)
+++ mlton/trunk/mlton/elaborate/type-env.fun 2005-09-11 23:26:29 UTC (rev 4090)
@@ -644,7 +644,13 @@
val n = !r
val l =
simple
- (str (concat ["'", Char.toString (Char.fromInt n)]))
+ (str (concat
+ ["'",
+ if n > Char.toInt #"z" then
+ concat ["a",
+ Int.toString (n - Char.toInt #"z")]
+ else
+ Char.toString (Char.fromInt n )]))
val _ = r := 1 + n
in
l
|
|
From: Stephen W. <sw...@ml...> - 2005-09-11 09:58:46
|
Enabled GC rusage measurement when verbosity isn't silent.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-09-11 16:58:07 UTC (rev 4088)
+++ mlton/trunk/mlton/main/main.fun 2005-09-11 16:58:45 UTC (rev 4089)
@@ -478,7 +478,7 @@
"0" => Silent
| "1" => Top
| "2" => Pass
- | "3" => Detail
+ | "3" => Detail
| _ => usage (concat ["invalid -verbose arg: ", s])))),
(Expert, "warn-ann", " {true|false}",
"unrecognized annotation warnings",
@@ -517,6 +517,7 @@
| _ => Error.bug "incorrect args from shell script"
val _ = setTargetType ("self", usage)
val result = parse args
+ val () = MLton.GC.setRusage (!verbosity <> Silent)
val () =
if !showAnns then
(Layout.outputl (Control.Elaborate.document {expert = !expert},
|
|
From: Stephen W. <sw...@ml...> - 2005-09-11 09:58:08
|
Exported Socket. ---------------------------------------------------------------------- U mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm ---------------------------------------------------------------------- Modified: mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm =================================================================== --- mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm 2005-09-11 16:27:05 UTC (rev 4087) +++ mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm 2005-09-11 16:58:07 UTC (rev 4088) @@ -53,6 +53,7 @@ structure RealVector structure SML90 structure SMLofNJ +structure Socket structure String structure StringCvt structure Substring |
|
From: Stephen W. <sw...@ml...> - 2005-09-11 09:27:08
|
Caught up with changes to MLton structure.
----------------------------------------------------------------------
U mlton/trunk/lib/mlton-stubs/gc.sig
U mlton/trunk/lib/mlton-stubs/itimer.sig
U mlton/trunk/lib/mlton-stubs/mlton.sml
U mlton/trunk/lib/mlton-stubs/random.sig
U mlton/trunk/lib/mlton-stubs/rlimit.sig
U mlton/trunk/lib/mlton-stubs/rusage.sig
U mlton/trunk/lib/mlton-stubs/signal.sig
U mlton/trunk/lib/mlton-stubs/socket.sig
U mlton/trunk/lib/mlton-stubs/syslog.sig
U mlton/trunk/lib/mlton-stubs/word.sig
----------------------------------------------------------------------
Modified: mlton/trunk/lib/mlton-stubs/gc.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/gc.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/gc.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
@@ -10,6 +11,7 @@
val collect: unit -> unit
val pack: unit -> unit
val setMessages: bool -> unit
+ val setRusage: bool -> unit
val setSummary: bool -> unit
val unpack: unit -> unit
end
Modified: mlton/trunk/lib/mlton-stubs/itimer.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/itimer.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/itimer.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/trunk/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs/mlton.sml 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/mlton.sml 2005-09-11 16:27:05 UTC (rev 4087)
@@ -132,6 +132,7 @@
fun collect _ = ()
val pack = MLton.GC.pack
fun setMessages _ = ()
+ fun setRusage _ = ()
fun setSummary _ = ()
fun time _ = Time.zeroTime
fun unpack _ = ()
@@ -478,6 +479,11 @@
type t = word
end
+ structure Ctl =
+ struct
+ fun getERROR _ = NONE
+ end
+
structure Host =
struct
type t = {name: string}
@@ -495,6 +501,7 @@
fun accept _ = raise Fail "Socket.accept"
fun connect _ = raise Fail "Socket.connect"
+ fun fdToSock _ = raise Fail "Socket.fdToSock"
fun listen _ = raise Fail "Socket.listen"
fun listenAt _ = raise Fail "Socket.listenAt"
fun shutdownRead _ = raise Fail "Socket.shutdownWrite"
Modified: mlton/trunk/lib/mlton-stubs/random.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/random.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/random.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/trunk/lib/mlton-stubs/rlimit.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/rlimit.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/rlimit.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/trunk/lib/mlton-stubs/rusage.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/rusage.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/rusage.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/trunk/lib/mlton-stubs/signal.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/signal.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/signal.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/trunk/lib/mlton-stubs/socket.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/socket.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/socket.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
@@ -15,6 +16,13 @@
type t = word
end
+ structure Ctl:
+ sig
+ val getERROR:
+ ('af, 'sock_type) Socket.sock
+ -> (string * Posix.Error.syserror option) option
+ end
+
structure Host:
sig
type t = {name: string}
@@ -36,4 +44,6 @@
val listenAt: Port.t -> t
val shutdownRead: TextIO.instream -> unit
val shutdownWrite: TextIO.outstream -> unit
+
+ val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) Socket.sock
end
Modified: mlton/trunk/lib/mlton-stubs/syslog.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/syslog.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/syslog.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/trunk/lib/mlton-stubs/word.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/word.sig 2005-09-11 16:18:55 UTC (rev 4086)
+++ mlton/trunk/lib/mlton-stubs/word.sig 2005-09-11 16:27:05 UTC (rev 4087)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
|
|
From: Stephen W. <sw...@ml...> - 2005-09-11 09:18:57
|
Fixed Subscript bug in signature matching.
The bug was tickled by the following program, which caused an
unhandled exception to be raised.
signature X =
sig
type x = unit
end
structure X :> X =
struct
type 'a x = unit
end
The problem was in the isPlausible function, introduced back in
revision 3744. It was checking schemes too early, under the
assumption that the type arities were equal, rather than waiting until
after the check that verified that they were (which in the above case
would fail). The fix was to delay the checkSchemes call until after
isPlausible succeeds.
----------------------------------------------------------------------
U mlton/trunk/mlton/elaborate/elaborate-env.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.fun 2005-09-09 23:29:50 UTC (rev 4085)
+++ mlton/trunk/mlton/elaborate/elaborate-env.fun 2005-09-11 16:18:55 UTC (rev 4086)
@@ -2673,18 +2673,26 @@
Datatype {cons = sigCons, ...} =>
(case TypeStr.node structStr of
Datatype {cons = structCons, ...} =>
- (checkCons (structCons, sigCons, strids, name)
- ; (structStr, false))
- | _ => (sigStr, true))
- | Scheme s => (checkScheme s; (sigStr, false))
- | Tycon c => (checkScheme (tyconScheme c); (sigStr, false))
+ (fn () =>
+ (checkCons (structCons, sigCons, strids,
+ name)
+ ; structStr),
+ false)
+ | _ => (fn () => sigStr, true))
+ | Scheme s =>
+ (fn () => (checkScheme s; sigStr),
+ false)
+ | Tycon c =>
+ (fn () => (checkScheme (tyconScheme c); sigStr),
+ false)
in
- if not (isPlausible (structStr, strids, name,
- TypeStr.admitsEquality sigStr,
- TypeStr.kind sigStr,
- consMismatch))
- then sigStr
- else return
+ if isPlausible (structStr, strids, name,
+ TypeStr.admitsEquality sigStr,
+ TypeStr.kind sigStr,
+ consMismatch) then
+ return ()
+ else
+ sigStr
end
fun map (structInfo: ('a, 'b) Info.t,
sigArray: ('a * 'c) array,
|
