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-11-12 12:11:19
|
Comments ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h 2005-11-12 19:55:50 UTC (rev 4209) +++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h 2005-11-12 20:11:17 UTC (rev 4210) @@ -15,8 +15,8 @@ * object-pointer * * The object type indexed by the header determines whether the weak - * is valid or not. If the type has numPointers == 1, then the weak - * pointer is valid. Otherwise, the type has numPointers == 0 and the + * is valid or not. If the type has numObjptrs == 1, then the weak + * pointer is valid. Otherwise, the type has numObjptrs == 0 and the * weak pointer is not valid. * * There may be zero or more bytes of padding for alignment purposes. @@ -36,4 +36,3 @@ uint32_t GC_weakCanGet (GC_state s, pointer p); pointer GC_weakGet (GC_state s, pointer p); pointer GC_weakNew (GC_state s, GC_header header, pointer p); - |
|
From: Matthew F. <fl...@ml...> - 2005-11-12 11:56:00
|
Changed the semantics of numNonObjptrs for normal objects to mean
bytes of non-objptr data, rather than number of 32-bit words of
non-objptr data. Renamed the field to bytesNonObjptrs.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
U 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/forward.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun 2005-11-12 19:55:50 UTC (rev 4209)
@@ -415,16 +415,16 @@
val (b, p) = Type.bytesAndPointers elt
in
R.Array {hasIdentity = hasIdentity,
- nonPointer = b,
- pointers = p}
+ bytesNonPointers = b,
+ numPointers = p}
end
| Normal {hasIdentity, ty} =>
let
val (b, p) = Type.bytesAndPointers ty
in
R.Normal {hasIdentity = hasIdentity,
- nonPointer = Bytes.toWords b,
- pointers = p}
+ bytesNonPointers = b,
+ numPointers = p}
end
| Stack => R.Stack
| Weak _ => R.Weak
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun 2005-11-12 19:55:50 UTC (rev 4209)
@@ -107,11 +107,11 @@
struct
datatype t =
Array of {hasIdentity: bool,
- nonPointer: Bytes.t,
- pointers: int}
+ bytesNonPointers: Bytes.t,
+ numPointers: int}
| Normal of {hasIdentity: bool,
- nonPointer: Words.t,
- pointers: int}
+ bytesNonPointers: Bytes.t,
+ numPointers: int}
| Stack
| Weak
| WeakGone
@@ -121,16 +121,16 @@
open Layout
in
case t of
- Array {hasIdentity, nonPointer = np, pointers = p} =>
+ Array {hasIdentity, bytesNonPointers = np, numPointers = p} =>
seq [str "Array ",
record [("hasIdentity", Bool.layout hasIdentity),
- ("nonPointer", Bytes.layout np),
- ("pointers", Int.layout p)]]
- | Normal {hasIdentity, nonPointer = np, pointers = p} =>
+ ("bytesNonPointers", Bytes.layout np),
+ ("numPointers", Int.layout p)]]
+ | Normal {hasIdentity, bytesNonPointers = np, numPointers = p} =>
seq [str "Normal ",
record [("hasIdentity", Bool.layout hasIdentity),
- ("nonPointer", Words.layout np),
- ("pointers", Int.layout p)]]
+ ("bytesNonPointers", Bytes.layout np),
+ ("numPointers", Int.layout p)]]
| Stack => str "Stack"
| Weak => str "Weak"
| WeakGone => str "WeakGone"
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig 2005-11-12 19:55:50 UTC (rev 4209)
@@ -54,11 +54,11 @@
sig
datatype t =
Array of {hasIdentity: bool,
- nonPointer: Bytes.t,
- pointers: int}
+ bytesNonPointers: Bytes.t,
+ numPointers: int}
| Normal of {hasIdentity: bool,
- nonPointer: Words.t,
- pointers: int}
+ bytesNonPointers: Bytes.t,
+ numPointers: int}
| Stack
| Weak
| WeakGone
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2005-11-12 19:55:50 UTC (rev 4209)
@@ -324,27 +324,37 @@
fn (_, ty) =>
let
datatype z = datatype Runtime.RObjectType.t
- val (tag, hasIdentity, nonPointers, pointers) =
+ val (tag, hasIdentity, bytesNonPointers, numPointers) =
case ObjectType.toRuntime ty of
- Array {hasIdentity, nonPointer, pointers} =>
- (0, hasIdentity, Bytes.toInt nonPointer, pointers)
- | Normal {hasIdentity, nonPointer, pointers} =>
- (1, hasIdentity, Words.toInt nonPointer, pointers)
+ Array {hasIdentity, bytesNonPointers, numPointers} =>
+ (0, hasIdentity,
+ Bytes.toInt bytesNonPointers, numPointers)
+ | Normal {hasIdentity, bytesNonPointers, numPointers} =>
+ (1, hasIdentity,
+ Bytes.toInt bytesNonPointers, numPointers)
| Stack =>
(2, false, 0, 0)
| Weak =>
(case !Control.align of
- Control.Align4 => (3, false, 1, 1)
- | Control.Align8 => (3, false, 2, 1))
+ Control.Align4 =>
+ (3, false,
+ Bytes.toInt (Words.toBytes (Words.fromInt 1)), 1)
+ | Control.Align8 =>
+ (3, false,
+ Bytes.toInt (Words.toBytes (Words.fromInt 2)), 1))
| WeakGone =>
(case !Control.align of
- Control.Align4 => (3, false, 2, 0)
- | Control.Align8 => (3, false, 3, 0))
+ Control.Align4 =>
+ (3, false,
+ Bytes.toInt (Words.toBytes (Words.fromInt 2)), 0)
+ | Control.Align8 =>
+ (3, false,
+ Bytes.toInt (Words.toBytes (Words.fromInt 3)), 0))
in
concat ["{ ", C.int tag, ", ",
C.bool hasIdentity, ", ",
- C.int nonPointers, ", ",
- C.int pointers, " }"]
+ C.int bytesNonPointers, ", ",
+ C.int numPointers, " }"]
end)
fun declareMain () =
let
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -6,7 +6,7 @@
* See the file MLton-LICENSE for details.
*/
-static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
+static inline size_t alignWithExtra (GC_state s, size_t bytes, size_t extra) {
return align (bytes + extra, s->alignment) - extra;
}
@@ -21,7 +21,7 @@
pointer alignFrontier (GC_state s, pointer p) {
size_t res;
- res = pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
+ res = alignWithExtra (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
assert (isFrontierAligned (s, (pointer)res));
return (pointer)res;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -13,19 +13,17 @@
uintmax_t arraySizeMax;
size_t arraySize;
size_t bytesPerElement;
- uint16_t numNonObjptrs;
+ uint16_t bytesNonObjptrs;
uint16_t numObjptrs;
pointer frontier;
pointer last;
pointer res;
- splitHeader(s, header, NULL, NULL, &numNonObjptrs, &numObjptrs);
+ splitHeader(s, header, NULL, NULL, &bytesNonObjptrs, &numObjptrs);
if (DEBUG)
fprintf (stderr, "GC_arrayAllocate (%zu, "FMTARRLEN", "FMTHDR")\n",
ensureBytesFree, numElements, header);
- bytesPerElement =
- sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs)
- + (numObjptrs * OBJPTR_SIZE);
+ bytesPerElement = bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE);
arraySizeMax =
alignMax ((uintmax_t)bytesPerElement * (uintmax_t)numElements + GC_ARRAY_HEADER_SIZE,
s->alignment);
@@ -76,22 +74,20 @@
if (1 <= numObjptrs and 0 < numElements) {
pointer p;
- if (0 == numNonObjptrs)
+ if (0 == bytesNonObjptrs)
for (p = frontier; p < last; p += OBJPTR_SIZE)
*((objptr*)p) = BOGUS_OBJPTR;
else {
/* Array with a mix of pointers and non-pointers. */
- size_t nonObjptrBytes;
- size_t objptrBytes;
-
- nonObjptrBytes = sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
- objptrBytes = numObjptrs * OBJPTR_SIZE;
+ size_t bytesObjptrs;
+ bytesObjptrs = numObjptrs * OBJPTR_SIZE;
+
for (p = frontier; p < last; ) {
pointer next;
- p += nonObjptrBytes;
- next = p + objptrBytes;
+ p += bytesNonObjptrs;
+ next = p + bytesObjptrs;
assert (next <= last);
for ( ; p < next; p += OBJPTR_SIZE)
*((objptr*)p) = BOGUS_OBJPTR;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -47,24 +47,18 @@
GC_arrayCounter arrayIndex,
uint32_t pointerIndex) {
GC_header header;
- uint16_t numNonObjptrs;
+ uint16_t bytesNonObjptrs;
uint16_t numObjptrs;
GC_objectTypeTag tag;
header = getHeader (a);
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ splitHeader(s, header, &tag, NULL, &bytesNonObjptrs, &numObjptrs);
assert (tag == ARRAY_TAG);
- size_t nonObjptrBytesPerElement =
- sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
- size_t bytesPerElement =
- nonObjptrBytesPerElement
- + (numObjptrs * OBJPTR_SIZE);
-
return a
- + arrayIndex * bytesPerElement
- + nonObjptrBytesPerElement
- + pointerIndex * OBJPTR_SIZE;
+ + (arrayIndex * (bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE)))
+ + bytesNonObjptrs
+ + (pointerIndex * OBJPTR_SIZE);
}
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-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -46,7 +46,7 @@
pointer todo; /* A pointer to the pointer in cur to next. */
GC_header header;
GC_header* headerp;
- uint16_t numNonObjptrs;
+ uint16_t bytesNonObjptrs;
uint16_t numObjptrs;
GC_objectTypeTag tag;
uint32_t index; /* The i'th pointer in the object (element) being marked. */
@@ -114,11 +114,11 @@
* would see the object as unmarked and traverse it again.
*/
*headerp = header;
- splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ splitHeader (s, header, &tag, NULL, &bytesNonObjptrs, &numObjptrs);
if (NORMAL_TAG == tag) {
size +=
GC_NORMAL_HEADER_SIZE
- + sizeofNumNonObjptrs (tag, numNonObjptrs)
+ + bytesNonObjptrs
+ (numObjptrs * OBJPTR_SIZE);
if (0 == numObjptrs) {
/* There is nothing to mark. */
@@ -127,7 +127,7 @@
cur = hashConsPointer (s, cur, TRUE);
goto ret;
}
- todo = cur + sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
+ todo = cur + bytesNonObjptrs;
index = 0;
markInNormal:
if (DEBUG_DFS_MARK)
@@ -169,7 +169,7 @@
*/
size +=
GC_ARRAY_HEADER_SIZE
- + sizeofArrayNoHeader (s, getArrayLength (cur), numNonObjptrs, numObjptrs);
+ + sizeofArrayNoHeader (s, getArrayLength (cur), bytesNonObjptrs, numObjptrs);
if (0 == numObjptrs or 0 == getArrayLength (cur)) {
/* There is nothing to mark. */
arrayDone:
@@ -184,7 +184,7 @@
assert (arrayIndex < getArrayLength (cur));
index = 0;
/* Skip to the first pointer. */
- todo += sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
+ todo += bytesNonObjptrs;
markInArray:
if (DEBUG_DFS_MARK)
fprintf (stderr, "markInArray arrayIndex = %"PRIu32" index = %"PRIu32"\n",
@@ -288,13 +288,13 @@
cur = prev;
headerp = getHeaderp (cur);
header = *headerp;
- splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ splitHeader (s, header, &tag, NULL, &bytesNonObjptrs, &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 + sizeofNumNonObjptrs (tag, numNonObjptrs);
+ todo = cur + bytesNonObjptrs;
index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
todo += index * OBJPTR_SIZE;
// prev = *(pointer*)todo;
@@ -304,10 +304,9 @@
goto markNextInNormal;
} else if (ARRAY_TAG == tag) {
arrayIndex = getArrayCounter (cur);
- todo = cur + arrayIndex * (sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs)
- + (numObjptrs * OBJPTR_SIZE));
+ todo = cur + arrayIndex * (bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE));
index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
- todo += sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs) + index * OBJPTR_SIZE;
+ todo += bytesNonObjptrs + index * OBJPTR_SIZE;
// prev = *(pointer*)todo;
prev = fetchObjptrToPointer (todo, s->heap.start);
// *(pointer*)todo = next;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -40,23 +40,23 @@
pointer foreachObjptrInObject (GC_state s, pointer p,
GC_foreachObjptrFun f, bool skipWeaks) {
GC_header header;
- uint16_t numNonObjptrs;
+ uint16_t bytesNonObjptrs;
uint16_t numObjptrs;
GC_objectTypeTag tag;
header = getHeader (p);
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ splitHeader(s, header, &tag, NULL, &bytesNonObjptrs, &numObjptrs);
if (DEBUG_DETAILED)
fprintf (stderr,
"foreachObjptrInObject ("FMTPTR")"
" header = "FMTHDR
" tag = %s"
- " numNonObjptrs = %d"
+ " bytesNonObjptrs = %d"
" numObjptrs = %d\n",
(uintptr_t)p, header, objectTypeTagToString (tag),
- numNonObjptrs, numObjptrs);
+ bytesNonObjptrs, numObjptrs);
if (NORMAL_TAG == tag) {
- p += sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
+ p += bytesNonObjptrs;
pointer max = p + (numObjptrs * OBJPTR_SIZE);
/* Apply f to all internal pointers. */
for ( ; p < max; p += OBJPTR_SIZE) {
@@ -67,23 +67,19 @@
callIfIsObjptr (s, f, (objptr*)p);
}
} else if (WEAK_TAG == tag) {
- p += sizeofNumNonObjptrs (WEAK_TAG, numNonObjptrs);
+ p += bytesNonObjptrs;
if (1 == numObjptrs) {
if (not skipWeaks)
callIfIsObjptr (s, f, (objptr*)p);
p += OBJPTR_SIZE;
}
} else if (ARRAY_TAG == tag) {
- size_t bytesPerElement;
size_t dataBytes;
pointer last;
GC_arrayLength numElements;
numElements = getArrayLength (p);
- bytesPerElement =
- sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs)
- + (numObjptrs * OBJPTR_SIZE);
- dataBytes = numElements * bytesPerElement;
+ dataBytes = numElements * (bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE));
/* Must check 0 == dataBytes before 0 == numPointers to correctly
* handle arrays when both are true.
*/
@@ -95,25 +91,23 @@
;
else {
last = p + dataBytes;
- if (0 == numNonObjptrs)
+ if (0 == bytesNonObjptrs)
/* Array with only pointers. */
for ( ; p < last; p += OBJPTR_SIZE)
callIfIsObjptr (s, f, (objptr*)p);
else {
/* Array with a mix of pointers and non-pointers. */
- size_t nonObjptrBytes;
- size_t objptrBytes;
+ size_t bytesObjptrs;
- nonObjptrBytes = sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
- objptrBytes = numObjptrs * OBJPTR_SIZE;
+ bytesObjptrs = numObjptrs * OBJPTR_SIZE;
/* For each array element. */
for ( ; p < last; ) {
pointer next;
/* Skip the non-pointers. */
- p += nonObjptrBytes;
- next = p + objptrBytes;
+ p += bytesNonObjptrs;
+ next = p + bytesObjptrs;
/* For each internal pointer. */
for ( ; p < next; p += OBJPTR_SIZE)
callIfIsObjptr (s, f, (objptr*)p);
@@ -122,7 +116,7 @@
assert (p == last);
p -= dataBytes;
}
- p += pad (s, dataBytes, GC_ARRAY_HEADER_SIZE);
+ p += alignWithExtra (s, dataBytes, GC_ARRAY_HEADER_SIZE);
} else { /* stack */
GC_stack stack;
pointer top, bottom;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -41,22 +41,22 @@
if (DEBUG_DETAILED and header == GC_FORWARDED)
fprintf (stderr, " already FORWARDED\n");
if (header != GC_FORWARDED) { /* forward the object */
- uint16_t numNonObjptrs, numObjptrs;
+ uint16_t bytesNonObjptrs, numObjptrs;
GC_objectTypeTag tag;
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ splitHeader(s, header, &tag, NULL, &bytesNonObjptrs, &numObjptrs);
size_t headerBytes, objectBytes, size, skip;
/* Compute the space taken by the header and object body. */
if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) { /* Fixed size object. */
headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes = sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs);
+ objectBytes = bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE);
skip = 0;
} else if (ARRAY_TAG == tag) {
headerBytes = GC_ARRAY_HEADER_SIZE;
objectBytes = sizeofArrayNoHeader (s, getArrayLength (p),
- numNonObjptrs, numObjptrs);
+ bytesNonObjptrs, numObjptrs);
skip = 0;
} else { /* Stack. */
GC_stack stack;
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-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/hash-cons.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -226,7 +226,7 @@
pointer hashConsPointer (GC_state s, pointer object, bool countBytesHashConsed) {
GC_objectHashTable t;
GC_header header;
- uint16_t numNonObjptrs;
+ uint16_t bytesNonObjptrs;
uint16_t numObjptrs;
bool hasIdentity;
GC_objectTypeTag tag;
@@ -239,19 +239,19 @@
fprintf (stderr, "hashCons ("FMTPTR")\n", (uintptr_t)object);
t = s->objectHashTable;
header = getHeader (object);
- splitHeader(s, header, &tag, &hasIdentity, &numNonObjptrs, &numObjptrs);
+ splitHeader(s, header, &tag, &hasIdentity, &bytesNonObjptrs, &numObjptrs);
if (hasIdentity) {
/* Don't hash cons. */
res = object;
goto done;
}
- assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
+ assert ((ARRAY_TAG == tag) or (NORMAL_TAG == tag));
max =
object
+ (ARRAY_TAG == tag
? (sizeofArrayNoHeader (s, getArrayLength (object),
- numNonObjptrs, numObjptrs))
- : (sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs)));
+ bytesNonObjptrs, numObjptrs))
+ : (bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE)));
// Compute the hash.
hash = (GC_hash)header;
for (p = (GC_hash*)object; p < (GC_hash*)max; ++p)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -218,7 +218,7 @@
assert (isAligned (sizeof (struct GC_stack), s->alignment));
assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
s->alignment));
- // While the following assert is manifestly true,
+ // While the following asserts is manifestly true,
// it checks the asserts in sizeofWeak.
assert (sizeofWeak (s) == sizeofWeak (s));
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-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -64,12 +64,12 @@
void clearIfWeakAndUnmarkedForMarkCompact (GC_state s, pointer p) {
GC_header header;
GC_header *headerp;
- uint16_t numNonObjptrs, numObjptrs;
+ uint16_t bytesNonObjptrs, numObjptrs;
GC_objectTypeTag tag;
headerp = getHeaderp (p);
header = *headerp;
- splitHeader(s, *headerp, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ splitHeader(s, *headerp, &tag, NULL, &bytesNonObjptrs, &numObjptrs);
if (WEAK_TAG == tag and 1 == numObjptrs) {
GC_header objptrHeader;
GC_weak w;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -6,57 +6,18 @@
* See the file MLton-LICENSE for details.
*/
-size_t sizeofNumNonObjptrs (GC_objectTypeTag tag, uint16_t numNonObjptrs) {
- 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 GC_objectTypeTag %u", tag);
- }
-}
-
-size_t sizeofNormalNoHeader (__attribute__ ((unused)) GC_state s,
- uint16_t numNonObjptrs,
- uint16_t numObjptrs) {
- size_t result;
-
- result =
- sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs)
- + (numObjptrs * OBJPTR_SIZE);
- return result;
-}
-
size_t sizeofArrayNoHeader (GC_state s,
GC_arrayLength numElements,
- uint16_t numNonObjptrs, uint16_t numObjptrs) {
- size_t bytesPerElement;
+ uint16_t bytesNonObjptrs, uint16_t numObjptrs) {
size_t result;
- bytesPerElement =
- sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs)
- + (numObjptrs * OBJPTR_SIZE);
- result = numElements * bytesPerElement;
+ result = numElements * (bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE));
/* Empty arrays have OBJPTR_SIZE bytes for the forwarding pointer. */
if (0 == result)
result = OBJPTR_SIZE;
- return pad (s, result, GC_ARRAY_HEADER_SIZE);
+ return alignWithExtra (s, result, GC_ARRAY_HEADER_SIZE);
}
-size_t sizeofWeakNoHeader (__attribute__ ((unused)) GC_state s,
- uint16_t numNonObjptrs,
- uint16_t numObjptrs) {
- size_t result;
-
- result =
- sizeofNumNonObjptrs (WEAK_TAG, numNonObjptrs)
- + (numObjptrs * OBJPTR_SIZE);
- return result;
-}
-
size_t sizeofStackNoHeader (__attribute__ ((unused)) GC_state s,
GC_stack stack) {
size_t result;
@@ -69,20 +30,17 @@
size_t headerBytes, objectBytes;
GC_header header;
GC_objectTypeTag tag;
- uint16_t numNonObjptrs, numObjptrs;
+ uint16_t bytesNonObjptrs, numObjptrs;
header = getHeader (p);
- splitHeader (s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
- if (NORMAL_TAG == tag) {
+ splitHeader (s, header, &tag, NULL, &bytesNonObjptrs, &numObjptrs);
+ if ((NORMAL_TAG == tag) or (WEAK_TAG == tag)) {
headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes = sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs);
+ objectBytes = bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE);
} else if (ARRAY_TAG == tag) {
headerBytes = GC_ARRAY_HEADER_SIZE;
objectBytes = sizeofArrayNoHeader (s, getArrayLength (p),
- numNonObjptrs, numObjptrs);
- } else if (WEAK_TAG == tag) {
- headerBytes = GC_NORMAL_HEADER_SIZE;
- objectBytes = sizeofWeakNoHeader (s, numNonObjptrs, numObjptrs);
+ bytesNonObjptrs, numObjptrs);
} else { /* Stack. */
assert (STACK_TAG == tag);
headerBytes = GC_STACK_HEADER_SIZE;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h 2005-11-12 19:55:50 UTC (rev 4209)
@@ -6,14 +6,8 @@
* See the file MLton-LICENSE for details.
*/
-size_t sizeofNumNonObjptrs (GC_objectTypeTag tag,
- uint16_t numNonObjptrs);
-size_t sizeofNormalNoHeader (GC_state s,
- uint16_t numNonObjptrs, uint16_t numObjptrs);
size_t sizeofArrayNoHeader (GC_state s, GC_arrayLength numElements,
uint16_t numNonObjptrs, uint16_t numObjptrs);
-size_t sizeofWeakNoHeader (GC_state s,
- uint16_t numNonObjptrs, uint16_t numObjptrs);
size_t sizeofStackNoHeader (GC_state s, GC_stack stack);
size_t sizeofObject (GC_state s, pointer p);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -48,12 +48,12 @@
void splitHeader(GC_state s, GC_header header,
GC_objectTypeTag *tagRet, bool *hasIdentityRet,
- uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet) {
+ uint16_t *bytesNonObjptrsRet, uint16_t *numObjptrsRet) {
unsigned int objectTypeIndex;
GC_objectType objectType;
GC_objectTypeTag tag;
bool hasIdentity;
- uint16_t numNonObjptrs, numObjptrs;
+ uint16_t bytesNonObjptrs, numObjptrs;
assert (1 == (header & GC_VALID_HEADER_MASK));
objectTypeIndex = (header & TYPE_INDEX_MASK) >> TYPE_INDEX_SHIFT;
@@ -61,7 +61,7 @@
objectType = &(s->objectTypes[objectTypeIndex]);
tag = objectType->tag;
hasIdentity = objectType->hasIdentity;
- numNonObjptrs = objectType->numNonObjptrs;
+ bytesNonObjptrs = objectType->bytesNonObjptrs;
numObjptrs = objectType->numObjptrs;
if (DEBUG_DETAILED)
@@ -70,20 +70,20 @@
" objectTypeIndex = %u"
" tag = %s"
" hasIdentity = %s"
- " numNonObjptrs = %"PRIu16
+ " bytesNonObjptrs = %"PRIu16
" numObjptrs = %"PRIu16"\n",
header,
objectTypeIndex,
objectTypeTagToString(tag),
boolToString(hasIdentity),
- numNonObjptrs, numObjptrs);
+ bytesNonObjptrs, numObjptrs);
if (tagRet != NULL)
*tagRet = tag;
if (hasIdentityRet != NULL)
*hasIdentityRet = hasIdentity;
- if (numNonObjptrsRet != NULL)
- *numNonObjptrsRet = numNonObjptrs;
+ if (bytesNonObjptrsRet != NULL)
+ *bytesNonObjptrsRet = bytesNonObjptrs;
if (numObjptrsRet != NULL)
*numObjptrsRet = numObjptrs;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-11-12 19:55:50 UTC (rev 4209)
@@ -82,21 +82,21 @@
* of object types that is emitted for each compiled program. The
* hasIdentity field indicates whether or not the object has mutable
* fields, in which case it may not be hash-cons-ed. In a normal
- * object, the numNonObjptrs field indicates the number of 32-bit
- * words of non heap-pointer data, while the numObjptrs field
- * indicates the number of heap pointers. In an array object, the
- * numNonObjptrs field indicates the number of bytes of non
- * heap-pointer data, while the numObjptrs field indicates the number
- * of heap pointers. In a stack object, the numNonObjptrs and
- * numObjptrs fields are irrelevant. In a weak object, the
- * numNonObjptrs and numObjptrs fields are interpreted as in a normal
- * object (and, hence, must be (2,1) or (3,0)).
+ * object, the bytesNonObjptrs field indicates the number of bytes of
+ * non heap-pointer data, while the numObjptrs field indicates the
+ * number of heap pointers. In an array object, the bytesNonObjptrs
+ * field indicates the number of bytes of non heap-pointer data in a
+ * single array element, while the numObjptrs field indicates the
+ * number of heap pointers in a single array element. In a stack
+ * object, the bytesNonObjptrs and numObjptrs fields are irrelevant.
+ * In a weak object, the bytesNonObjptrs and numObjptrs fields are
+ * interpreted as in a normal object.
*/
typedef struct GC_objectType {
/* Keep tag first, at zero offset, since it is referenced most often. */
GC_objectTypeTag tag;
bool hasIdentity;
- uint16_t numNonObjptrs;
+ uint16_t bytesNonObjptrs;
uint16_t numObjptrs;
} *GC_objectType;
enum {
@@ -118,7 +118,7 @@
void splitHeader (GC_state s, GC_header header,
GC_objectTypeTag *tagRet, bool *hasIdentityRet,
- uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet);
+ uint16_t *bytesNonObjptrsRet, uint16_t *numObjptrsRet);
pointer advanceToObjectData (GC_state s, pointer p);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -101,7 +101,7 @@
size_t alignStackReserved (GC_state s, size_t reserved) {
size_t res;
- res = pad (s, reserved, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
+ res = alignWithExtra (s, reserved, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
if (DEBUG_STACKS)
fprintf (stderr, "%zu = alignStackReserved (%zu)\n", res, reserved);
assert (isStackReservedAligned (s, res));
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -26,10 +26,10 @@
res = GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread);
if (DEBUG) {
size_t check;
- uint16_t numNonObjptrs, numObjptrs;
+ uint16_t bytesNonObjptrs, numObjptrs;
- splitHeader (s, GC_THREAD_HEADER, NULL, NULL, &numNonObjptrs, &numObjptrs);
- check = GC_NORMAL_HEADER_SIZE + sizeofNormalNoHeader (s, numNonObjptrs, numObjptrs);
+ splitHeader (s, GC_THREAD_HEADER, NULL, NULL, &bytesNonObjptrs, &numObjptrs);
+ check = GC_NORMAL_HEADER_SIZE + (bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE));
if (DEBUG_DETAILED)
fprintf (stderr,
"sizeofThread: res = %zu check = %zu\n",
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-11-12 17:29:46 UTC (rev 4208)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-11-12 19:55:50 UTC (rev 4209)
@@ -13,10 +13,10 @@
res = align (res, s->alignment);
if (DEBUG) {
size_t check;
- uint16_t numNonObjptrs, numObjptrs;
+ uint16_t bytesNonObjptrs, numObjptrs;
- splitHeader (s, GC_WEAK_GONE_HEADER, NULL, NULL, &numNonObjptrs, &numObjptrs);
- check = GC_NORMAL_HEADER_SIZE + sizeofWeakNoHeader (s, numNonObjptrs, numObjptrs);
+ splitHeader (s, GC_WEAK_GONE_HEADER, NULL, NULL, &bytesNonObjptrs, &numObjptrs);
+ check = GC_NORMAL_HEADER_SIZE + (bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE));
assert (check == res);
}
assert (isAligned (res, s->alignment));
|
|
From: Matthew F. <fl...@ml...> - 2005-11-12 09:29:50
|
Fixed some warnings with -m64 compilations.
Exclude -fomit-frame-pointer from debug libs; the debugger is almost
useless without the frame pointer.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/write.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Date.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Ptrace.c
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/mmap.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-12 17:29:46 UTC (rev 4208)
@@ -14,7 +14,8 @@
GCC_VERSION = \
$(shell gcc -v 2>&1 | grep 'gcc version' | sed 's/.*gcc version \(.\).*/\1/')
-FLAGS = -fomit-frame-pointer
+FLAGS =
+OPTFLAGS = -fomit-frame-pointer
ifeq ($(TARGET_ARCH), x86)
ifneq ($(findstring $(GCC_VERSION), 3 4),)
@@ -25,15 +26,15 @@
endif
ifeq ($(TARGET_ARCH), amd64)
-FLAGS += -mtune=opteron -m32
+FLAGS += -m32 -mtune=opteron
endif
ifeq ($(TARGET_ARCH), sparc)
-FLAGS += -mcpu=v8 -m32
+FLAGS += -m32 -mcpu=v8
endif
ifeq ($(TARGET_OS), solaris)
-FLAGS += -Wa,-xarch=v8plusa -funroll-all-loops -mcpu=ultrasparc
+FLAGS += -Wa,-xarch=v8plusa -mcpu=ultrasparc -funroll-all-loops
endif
ifeq ($(TARGET), self)
@@ -46,8 +47,9 @@
endif
CC = gcc -std=gnu99
-CFLAGS = -O2 -Wall -I. -Iplatform -D_FILE_OFFSET_BITS=64 $(FLAGS)
-DEBUGFLAGS = $(CFLAGS) -gstabs+ -g2
+CFLAGS = -Wall -I. -Iplatform -D_FILE_OFFSET_BITS=64 $(FLAGS)
+OPTCFLAGS = $(CFLAGS) -O2 $(OPTFLAGS)
+DEBUGCFLAGS = $(CFLAGS) -gstabs+ -g2 -O1 -DASSERT=1
WARNFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter -Wno-unused-function \
-Wformat-nonliteral \
-Wuninitialized -Winit-self \
@@ -65,7 +67,8 @@
# -Wshadow \
# -Wmissing-prototypes \
# -Wmissing-declarations
-DEBUGWARNFLAGS = $(DEBUGFLAGS) $(WARNFLAGS) -Wunused
+OPTWARNFLAGS = $(WARNFLAGS)
+DEBUGWARNFLAGS = $(WARNFLAGS) -Wunused
UTILCFILES = \
$(shell find util -type f | grep '\.c$$')
@@ -124,7 +127,7 @@
libgdtoa.a: gdtoa/arith.h
cd gdtoa && \
- $(CC) $(CFLAGS) $(WARNFLAGS) \
+ $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) \
-Dstrtod=gdtoa_strtod \
-Dstrtof=gdtoa_strtof \
-w -O1 -c -DINFNAN_CHECK \
@@ -150,27 +153,28 @@
$(AR) libmlton-gdb.a $(DEBUG_OBJS)
$(RANLIB) libmlton-gdb.a
+
runtime.c: $(CFILES)
cat $(CFILES) >runtime.c
util/%-gdb.o: util/%.c util.h $(UTILHFILES)
- $(CC) $(DEBUGFLAGS) $(DEBUGWARNFLAGS) -O1 -DASSERT=1 -c -o $@ $<
+ $(CC) $(DEBUGCFLAGS) $(DEBUGWARNFLAGS) -c -o $@ $<
util/%.o: util/%.c util.h $(UTILHFILES)
- $(CC) $(CFLAGS) $(WARNFLAGS) -c -o $@ $<
+ $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) -c -o $@ $<
types.h: gen/gen-types.c util.h $(UTILOFILES)
rm -f types.h
- $(CC) $(CFLAGS) $(WARNFLAGS) -o gen-types gen/gen-types.c $(UTILOFILES)
+ $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) -o gen-types gen/gen-types.c $(UTILOFILES)
./gen-types
rm -f gen-types
gc-gdb.o: gc.c $(GCCFILES) $(HFILES)
- $(CC) $(DEBUGFLAGS) $(DEBUGWARNFLAGS) -O1 -DASSERT=1 -c -o $@ $<
+ $(CC) $(DEBUGCFLAGS) $(DEBUGWARNFLAGS) -c -o $@ $<
gc.o: gc.c $(GCCFILES) $(HFILES)
- $(CC) $(CFLAGS) $(WARNFLAGS) -c -o $@ $<
+ $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) -c -o $@ $<
# It looks like we don't follow the C spec w.r.t. aliasing. And gcc
# -O2 catches us on the code in Real/*.c where we treat a double as a
@@ -179,21 +183,21 @@
# with -fno-strict-aliasing to prevent gcc from taking advantage of
# this aspect of the C spec.
basis/Real/%-gdb.o: basis/Real/%.c gdtoa/arith.h
- $(CC) $(DEBUGFLAGS) $(WARNFLAGS) -O1 -DASSERT=1 -c -o $@ $<
+ $(CC) $(DEBUGCFLAGS) $(DEBUGWARNFLAGS) -c -o $@ $<
basis/Real/%.o: basis/Real/%.c gdtoa/arith.h
- $(CC) $(CFLAGS) $(DEBUGWARNFLAGS) -O1 -fno-strict-aliasing -c -o $@ $<
+ $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) -O1 -fno-strict-aliasing -c -o $@ $<
%-gdb.o: %.c $(HFILES)
- $(CC) $(DEBUGFLAGS) -O1 -DASSERT=1 -c -o $@ $<
+ $(CC) $(DEBUGCFLAGS) -c -o $@ $<
%.o: %.c $(HFILES)
- $(CC) $(CFLAGS) -c -o $@ $<
+ $(CC) $(OPTCFLAGS) -c -o $@ $<
%-gdb.o: %.S
- $(CC) $(DEBUGFLAGS) -c -o $@ $<
+ $(CC) $(DEBUGCFLAGS) -c -o $@ $<
%.o: %.S
- $(CC) $(CFLAGS) -c -o $@ $<
+ $(CC) $(OPTCFLAGS) -c -o $@ $<
.PHONY: clean
clean:
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/write.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/write.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/write.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -9,7 +9,7 @@
res = (Ssize)(write (fd, (void *) ((char *) b + i), s));
if (DEBUG_WRITE)
- fprintf (stderr, "%d = Posix_IO_write (%d, 0x%08x, %d, %d)\n",
- (int)res, (int)fd, (uint)b, (int)i, (int)s);
+ fprintf (stderr, "%d = Posix_IO_write (%d, "FMTPTR", %d, %d)\n",
+ (int)res, (int)fd, (uintptr_t)b, (int)i, (int)s);
return res;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Date.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Date.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Date.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -95,8 +95,8 @@
void Date_localTime(Pointer p) {
tmp = localtime((time_t*)p);
if (DEBUG)
- fprintf (stderr, "0x%08x = Date_localTime (0x%08x)\n",
- (unsigned int)tmp, (unsigned int)p);
+ fprintf (stderr, FMTPTR" = Date_localTime ("FMTPTR")\n",
+ (uintptr_t)tmp, (uintptr_t)p);
}
Int Date_mkTime() {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -28,7 +28,7 @@
#define DEBUG FALSE
#endif
-#if ! (defined (__hppa__) || defined (__i386__) || defined (__ppc__) || defined (__powerpc__) || defined (__sparc__))
+#if ! (defined (__amd64__) || defined (__hppa__) || defined (__i386__) || defined (__ppc__) || defined (__powerpc__) || defined (__sparc__))
#error check that C {/,%} correctly implement {quot,rem} from the basis library
#endif
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -20,16 +20,16 @@
/*
* Test if a intInf is a fixnum.
*/
-static inline uint isSmall (pointer arg) {
- return ((uint)arg & 1);
+static inline bool isSmall (pointer arg) {
+ return ((uintptr_t)arg & 1);
}
-static inline uint eitherIsSmall (pointer arg1, pointer arg2) {
- return (1 & ((uint)arg1 | (uint)arg2));
+static inline bool eitherIsSmall (pointer arg1, pointer arg2) {
+ return (((uintptr_t)arg1 | (uintptr_t)arg2) & 1);
}
-static inline uint areSmall (pointer arg1, pointer arg2) {
- return ((uint)arg1 & (uint)arg2 & 1);
+static inline bool areSmall (pointer arg1, pointer arg2) {
+ return ((uintptr_t)arg1 & (uintptr_t)arg2 & 1);
}
/*
@@ -39,7 +39,7 @@
GC_intInf bp;
assert(not isSmall(arg));
- bp = (GC_intInf)((uint)arg - offsetof(struct GC_intInf, isneg));
+ bp = (GC_intInf)(arg - offsetof(struct GC_intInf, isneg));
if (DEBUG_INT_INF)
fprintf (stderr, "bp->header = 0x%08x\n", bp->header);
assert (bp->header == GC_INTINF_HEADER);
@@ -54,8 +54,8 @@
GC_intInf bp;
if (DEBUG_INT_INF)
- fprintf (stderr, "fill (0x%08x, 0x%08x, 0x%08x)\n",
- (uint)arg, (uint)res, (uint)space);
+ fprintf (stderr, "fill ("FMTPTR", "FMTPTR", "FMTPTR")\n",
+ (uintptr_t)arg, (uintptr_t)res, (uintptr_t)space);
if (isSmall(arg)) {
res->_mp_alloc = 2;
res->_mp_d = space;
@@ -185,50 +185,50 @@
pointer IntInf_add (pointer lhs, pointer rhs, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_add (0x%08x, 0x%08x, %u)\n",
- (uint)lhs, (uint)rhs, bytes);
+ fprintf (stderr, "IntInf_add ("FMTPTR", "FMTPTR", %u)\n",
+ (uintptr_t)lhs, (uintptr_t)rhs, bytes);
return binary (lhs, rhs, bytes, &mpz_add);
}
pointer IntInf_gcd (pointer lhs, pointer rhs, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_gcd (0x%08x, 0x%08x, %u)\n",
- (uint)lhs, (uint)rhs, bytes);
+ fprintf (stderr, "IntInf_gcd ("FMTPTR", "FMTPTR", %u)\n",
+ (uintptr_t)lhs, (uintptr_t)rhs, bytes);
return binary (lhs, rhs, bytes, &mpz_gcd);
}
pointer IntInf_mul (pointer lhs, pointer rhs, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_mul (0x%08x, 0x%08x, %u)\n",
- (uint)lhs, (uint)rhs, bytes);
+ fprintf (stderr, "IntInf_mul ("FMTPTR", "FMTPTR", %u)\n",
+ (uintptr_t)lhs, (uintptr_t)rhs, bytes);
return binary (lhs, rhs, bytes, &mpz_mul);
}
pointer IntInf_sub (pointer lhs, pointer rhs, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_sub (0x%08x, 0x%08x, %u)\n",
- (uint)lhs, (uint)rhs, bytes);
+ fprintf (stderr, "IntInf_sub ("FMTPTR", "FMTPTR", %u)\n",
+ (uintptr_t)lhs, (uintptr_t)rhs, bytes);
return binary (lhs, rhs, bytes, &mpz_sub);
}
pointer IntInf_andb(pointer lhs, pointer rhs, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_andb (0x%08x, 0x%08x, %u)\n",
- (uint)lhs, (uint)rhs, bytes);
+ fprintf (stderr, "IntInf_andb ("FMTPTR", "FMTPTR", %u)\n",
+ (uintptr_t)lhs, (uintptr_t)rhs, bytes);
return binary(lhs, rhs, bytes, &mpz_and);
}
pointer IntInf_orb(pointer lhs, pointer rhs, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_orb (0x%08x, 0x%08x, %u)\n",
- (uint)lhs, (uint)rhs, bytes);
+ fprintf (stderr, "IntInf_orb ("FMTPTR", "FMTPTR", %u)\n",
+ (uintptr_t)lhs, (uintptr_t)rhs, bytes);
return binary(lhs, rhs, bytes, &mpz_ior);
}
pointer IntInf_xorb(pointer lhs, pointer rhs, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_xorb (0x%08x, 0x%08x, %u)\n",
- (uint)lhs, (uint)rhs, bytes);
+ fprintf (stderr, "IntInf_xorb ("FMTPTR", "FMTPTR", %u)\n",
+ (uintptr_t)lhs, (uintptr_t)rhs, bytes);
return binary(lhs, rhs, bytes, &mpz_xor);
}
@@ -249,15 +249,15 @@
pointer IntInf_neg(pointer arg, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_neg (0x%08x, %u)\n",
- (uint)arg, bytes);
+ fprintf (stderr, "IntInf_neg ("FMTPTR", %u)\n",
+ (uintptr_t)arg, bytes);
return unary(arg, bytes, &mpz_neg);
}
pointer IntInf_notb(pointer arg, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_notb (0x%08x, %u)\n",
- (uint)arg, bytes);
+ fprintf (stderr, "IntInf_notb ("FMTPTR", %u)\n",
+ (uintptr_t)arg, bytes);
return unary(arg, bytes, &mpz_com);
}
@@ -279,15 +279,15 @@
pointer IntInf_arshift(pointer arg, uint shift, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_arshift (0x%08x, %u, %u)\n",
- (uint)arg, shift, bytes);
+ fprintf (stderr, "IntInf_arshift ("FMTPTR", %u, %u)\n",
+ (uintptr_t)arg, shift, bytes);
return shary(arg, shift, bytes, &mpz_fdiv_q_2exp);
}
pointer IntInf_lshift(pointer arg, uint shift, uint bytes) {
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_lshift (0x%08x, %u, %u)\n",
- (uint)arg, shift, bytes);
+ fprintf (stderr, "IntInf_lshift ("FMTPTR", %u, %u)\n",
+ (uintptr_t)arg, shift, bytes);
return shary(arg, shift, bytes, &mpz_mul_2exp);
}
@@ -312,8 +312,8 @@
rhsspace[2];
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_compare (0x%08x, 0x%08x)\n",
- (uint)lhs, (uint)rhs);
+ fprintf (stderr, "IntInf_compare ("FMTPTR", "FMTPTR")\n",
+ (uintptr_t)lhs, (uintptr_t)rhs);
fill (lhs, &lhsmpz, lhsspace);
fill (rhs, &rhsmpz, rhsspace);
return mpz_cmp (&lhsmpz, &rhsmpz);
@@ -346,8 +346,8 @@
char c;
if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_toString (0x%08x, %d, %u)\n",
- (uint)arg, base, bytes);
+ fprintf (stderr, "IntInf_toString ("FMTPTR", %d, %u)\n",
+ (uintptr_t)arg, base, bytes);
assert (base == 2 || base == 8 || base == 10 || base == 16);
fill (arg, &argmpz, argspace);
sp = (GC_string)gcState.frontier;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/profile.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -7,35 +7,37 @@
extern struct GC_state gcState;
void MLton_Profile_Data_free (Pointer p) {
- GC_profileFree (&gcState, (GC_profileData)p);
+ GC_profileFree (&gcState, (GC_profileData)p);
}
Pointer MLton_Profile_Data_malloc (void) {
- return (Pointer)GC_profileNew (&gcState);
+ return (Pointer)GC_profileNew (&gcState);
}
void MLton_Profile_Data_write (Pointer p, Word fd) {
- if (DEBUG_PROFILE)
- fprintf (stderr, "MLton_Profile_Data_write (0x%08x)\n", (uint)p);
- GC_profileWrite (&gcState, (GC_profileData)p, (int)fd);
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "MLton_Profile_Data_write ("FMTPTR")\n",
+ (uintptr_t)p);
+ GC_profileWrite (&gcState, (GC_profileData)p, (int)fd);
}
Pointer MLton_Profile_current (void) {
- Pointer res;
-
- res = (Pointer)(GC_getProfileCurrent (&gcState));
- if (DEBUG_PROFILE)
- fprintf (stderr, "0x%08x = MLton_Profile_current ()\n",
- (uint)res);
- return res;
+ Pointer res;
+
+ res = (Pointer)(GC_getProfileCurrent (&gcState));
+ if (DEBUG_PROFILE)
+ fprintf (stderr, FMTPTR" = MLton_Profile_current ()\n",
+ (uintptr_t)res);
+ return res;
}
void MLton_Profile_setCurrent (Pointer d) {
- if (DEBUG_PROFILE)
- fprintf (stderr, "MLton_Profile_setCurrent (0x%08x)\n", (uint)d);
- GC_setProfileCurrent (&gcState, (GC_profileData)d);
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "MLton_Profile_setCurrent ("FMTPTR")\n",
+ (uintptr_t)d);
+ GC_setProfileCurrent (&gcState, (GC_profileData)d);
}
void MLton_Profile_done () {
- GC_profileDone (&gcState);
+ GC_profileDone (&gcState);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/thread.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -3,52 +3,55 @@
extern struct GC_state gcState;
enum {
- DEBUG_THREAD = FALSE,
+ DEBUG_THREAD = FALSE,
};
Pointer Thread_current () {
- Pointer t;
-
- t = (Pointer)(GC_getCurrentThread (&gcState));
- if (DEBUG_THREAD)
- fprintf (stderr, "0x%08x = Thread_current ()\n", (uint)t);
- return t;
+ Pointer t;
+
+ t = (Pointer)(GC_getCurrentThread (&gcState));
+ if (DEBUG_THREAD)
+ fprintf (stderr, FMTPTR" = Thread_current ()\n",
+ (uintptr_t)t);
+ return t;
}
void Thread_finishSignalHandler () {
- GC_finishSignalHandler (&gcState);
+ GC_finishSignalHandler (&gcState);
}
Pointer Thread_saved () {
- Pointer t;
-
- t = (Pointer)(GC_getSavedThread (&gcState));
- if (DEBUG_THREAD)
- fprintf (stderr, "0x%08x = Thread_saved ()\n", (uint)t);
- return t;
+ Pointer t;
+
+ t = (Pointer)(GC_getSavedThread (&gcState));
+ if (DEBUG_THREAD)
+ fprintf (stderr, FMTPTR" = Thread_saved ()\n",
+ (uintptr_t)t);
+ return t;
}
void Thread_setCallFromCHandler (Pointer t) {
- GC_setCallFromCHandlerThread (&gcState, (GC_thread)t);
+ GC_setCallFromCHandlerThread (&gcState, (GC_thread)t);
}
void Thread_setSaved (Pointer t) {
- if (DEBUG_THREAD)
- fprintf (stderr, "Thread_setSaved (0x%08x)\n", (uint)t);
- GC_setSavedThread (&gcState, (GC_thread)t);
+ if (DEBUG_THREAD)
+ fprintf (stderr, "Thread_setSaved ("FMTPTR")\n",
+ (uintptr_t)t);
+ GC_setSavedThread (&gcState, (GC_thread)t);
}
void Thread_setSignalHandler (Pointer t) {
- GC_setSignalHandlerThread (&gcState, (GC_thread)t);
+ GC_setSignalHandlerThread (&gcState, (GC_thread)t);
}
void Thread_startSignalHandler () {
- GC_startSignalHandler (&gcState);
+ GC_startSignalHandler (&gcState);
}
void Thread_switchTo (Pointer t, Word ensureBytesFree) {
- if (DEBUG_THREAD)
- fprintf (stderr, "Thread_switchTo (0x%08x, %u)\n",
- (uint)t, (uint)ensureBytesFree);
- GC_switchToThread (&gcState, (GC_thread)t, ensureBytesFree);
+ if (DEBUG_THREAD)
+ fprintf (stderr, "Thread_switchTo ("FMTPTR", %u)\n",
+ (uintptr_t)t, (uint)ensureBytesFree);
+ GC_switchToThread (&gcState, (GC_thread)t, ensureBytesFree);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Ptrace.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Ptrace.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Ptrace.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -3,11 +3,11 @@
#if HAS_PTRACE
Int Ptrace_ptrace2 (Int request, Int pid) {
- return ptrace (request, pid, 0, 0);
+ return ptrace (request, pid, NULL, NULL);
}
Int Ptrace_ptrace4 (Int request, Int pid, Word addr, Pointer data) {
- return ptrace (request, pid, (int) addr, (int) data);
+ return ptrace (request, pid, (void *) addr, (void *) data);
}
#endif
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/mmap.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/mmap.c 2005-11-12 16:25:21 UTC (rev 4207)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/mmap.c 2005-11-12 17:29:46 UTC (rev 4208)
@@ -5,8 +5,8 @@
static void munmap_safe (void *base, size_t length) {
if (DEBUG_MEM)
- fprintf (stderr, "munmap_safe (0x%08x, %s)\n",
- (uint)base,
+ fprintf (stderr, "munmap_safe ("FMTPTR", %s)\n",
+ (uintptr_t)base,
uintmaxToCommaString (length));
assert (base != NULL);
if (0 == length)
|
|
From: Matthew F. <fl...@ml...> - 2005-11-12 08:25:24
|
Fixing asserts and comments
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-12 04:22:23 UTC (rev 4206)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-12 16:25:21 UTC (rev 4207)
@@ -3,6 +3,4 @@
non-pointer data. Rename to sizeNonPointers.
* what type should be used for the size field in GC_heap? I'm using
size_t currently, since that is the type needed by malloc.
-* the "skipObjects" loop in forwardInterGenerationalObjptrs appears to
- be unnecessary.
* Why does hash-table use malloc/free while generational maps use mmap/munmap?
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 04:22:23 UTC (rev 4206)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 16:25:21 UTC (rev 4207)
@@ -218,6 +218,9 @@
assert (isAligned (sizeof (struct GC_stack), s->alignment));
assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
s->alignment));
+ // While the following assert is manifestly true,
+ // it checks the asserts in sizeofWeak.
+ assert (sizeofWeak (s) == sizeofWeak (s));
s->amInGC = TRUE;
s->amOriginal = TRUE;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h 2005-11-12 04:22:23 UTC (rev 4206)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h 2005-11-12 16:25:21 UTC (rev 4207)
@@ -24,7 +24,7 @@
* The link native-pointer is used to chain the live weaks together
* during a copying gc and is otherwise unused.
*
- * The third word is the weak object-pointer.
+ * The final component is the weak object-pointer.
*/
typedef struct GC_weak {
struct GC_weak *link;
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 20:22:28
|
gcc warnings
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Error.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/allocTooLarge.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetProtDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetServDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-12 04:22:23 UTC (rev 4206)
@@ -14,7 +14,7 @@
GCC_VERSION = \
$(shell gcc -v 2>&1 | grep 'gcc version' | sed 's/.*gcc version \(.\).*/\1/')
-## FLAGS = -fomit-frame-pointer
+FLAGS = -fomit-frame-pointer
ifeq ($(TARGET_ARCH), x86)
ifneq ($(findstring $(GCC_VERSION), 3 4),)
@@ -61,11 +61,10 @@
-Wpacked \
-Wredundant-decls \
-Wnested-externs
+# -Winline -Wdisabled-optimization
# -Wshadow \
-# -Wconversion \
# -Wmissing-prototypes \
-# -Wmissing-declarations \
-# -Winline -Wdisabled-optimization
+# -Wmissing-declarations
DEBUGWARNFLAGS = $(DEBUGFLAGS) $(WARNFLAGS) -Wunused
UTILCFILES = \
@@ -125,7 +124,7 @@
libgdtoa.a: gdtoa/arith.h
cd gdtoa && \
- $(CC) $(CFLAGS) \
+ $(CC) $(CFLAGS) $(WARNFLAGS) \
-Dstrtod=gdtoa_strtod \
-Dstrtof=gdtoa_strtof \
-w -O1 -c -DINFNAN_CHECK \
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Error.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Error.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Error.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -1,10 +1,10 @@
#include "platform.h"
-void Posix_Error_clearErrno () {
+void Posix_Error_clearErrno (void) {
errno = 0;
}
-int Posix_Error_getErrno () {
+int Posix_Error_getErrno (void) {
return errno;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -24,7 +24,7 @@
return sigaction (signum, &sa, NULL);
}
-bool Posix_Signal_isGCPending () {
+bool Posix_Signal_isGCPending (void) {
Bool res;
res = GC_getGCSignalPending (&gcState);
@@ -52,7 +52,7 @@
return sigaction (signum, &sa, NULL);
}
-void Posix_Signal_handleGC () {
+void Posix_Signal_handleGC (void) {
GC_setGCSignalHandled (&gcState, TRUE);
}
@@ -76,7 +76,7 @@
return res;
}
-void Posix_Signal_resetPending () {
+void Posix_Signal_resetPending (void) {
if (DEBUG_SIGNALS)
fprintf (stderr, "Posix_Signal_resetPending ()\n");
sigemptyset (GC_getSignalsPendingAddr (&gcState));
@@ -93,11 +93,11 @@
return sigdelset (&set, signum);
}
-Int Posix_Signal_sigemptyset () {
+Int Posix_Signal_sigemptyset (void) {
return sigemptyset (&set);
}
-Int Posix_Signal_sigfillset () {
+Int Posix_Signal_sigfillset (void) {
return sigfillset (&set);
}
@@ -109,7 +109,7 @@
return sigprocmask (how, &set, &set);
}
-void Posix_Signal_suspend () {
+void Posix_Signal_suspend (void) {
int res;
res = sigsuspend (&set);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -342,7 +342,7 @@
mp_limb_t argspace[2];
char *str;
uint size;
- int i;
+ uint i;
char c;
if (DEBUG_INT_INF)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/allocTooLarge.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/allocTooLarge.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/allocTooLarge.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -1,6 +1,6 @@
#include "platform.h"
-void MLton_allocTooLarge () {
+void MLton_allocTooLarge (void) {
fprintf (stderr, "Out of memory: attempt to allocate more than %d bytes.\n", 0x7FFFFFFF);
exit (2);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/gc.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -20,10 +20,10 @@
GC_setRusageMeasureGC (&gcState, b);
}
-void MLton_GC_pack () {
+void MLton_GC_pack (void) {
GC_pack (&gcState);
}
-void MLton_GC_unpack () {
+void MLton_GC_unpack (void) {
GC_unpack (&gcState);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/rusage.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -6,55 +6,55 @@
static struct rusage children;
static struct rusage gc;
-Int MLton_Rusage_self_utime_sec () {
+Int MLton_Rusage_self_utime_sec (void) {
return self.ru_utime.tv_sec;
}
-Int MLton_Rusage_self_utime_usec () {
+Int MLton_Rusage_self_utime_usec (void) {
return self.ru_utime.tv_usec;
}
-Int MLton_Rusage_self_stime_sec () {
+Int MLton_Rusage_self_stime_sec (void) {
return self.ru_stime.tv_sec;
}
-Int MLton_Rusage_self_stime_usec () {
+Int MLton_Rusage_self_stime_usec (void) {
return self.ru_stime.tv_usec;
}
-Int MLton_Rusage_children_utime_sec () {
+Int MLton_Rusage_children_utime_sec (void) {
return children.ru_utime.tv_sec;
}
-Int MLton_Rusage_children_utime_usec () {
+Int MLton_Rusage_children_utime_usec (void) {
return children.ru_utime.tv_usec;
}
-Int MLton_Rusage_children_stime_sec () {
+Int MLton_Rusage_children_stime_sec (void) {
return children.ru_stime.tv_sec;
}
-Int MLton_Rusage_children_stime_usec () {
+Int MLton_Rusage_children_stime_usec (void) {
return children.ru_stime.tv_usec;
}
-Int MLton_Rusage_gc_utime_sec () {
+Int MLton_Rusage_gc_utime_sec (void) {
return gc.ru_utime.tv_sec;
}
-Int MLton_Rusage_gc_utime_usec () {
+Int MLton_Rusage_gc_utime_usec (void) {
return gc.ru_utime.tv_usec;
}
-Int MLton_Rusage_gc_stime_sec () {
+Int MLton_Rusage_gc_stime_sec (void) {
return gc.ru_stime.tv_sec;
}
-Int MLton_Rusage_gc_stime_usec () {
+Int MLton_Rusage_gc_stime_usec (void) {
return gc.ru_stime.tv_usec;
}
-void MLton_Rusage_ru () {
+void MLton_Rusage_ru (void) {
gc = *(GC_getRusageGCAddr (&gcState));
getrusage (RUSAGE_SELF, &self);
getrusage (RUSAGE_CHILDREN, &children);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/world.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -2,10 +2,10 @@
extern struct GC_state gcState;
-Bool World_isOriginal() {
+Bool World_isOriginal(void) {
return (Bool)(GC_getAmOriginal (&gcState));
}
-void World_makeOriginal() {
+void World_makeOriginal(void) {
GC_setAmOriginal (&gcState, TRUE);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -2,11 +2,11 @@
static struct hostent *hostent;
-Cstring NetHostDB_Entry_name() {
+Cstring NetHostDB_Entry_name(void) {
return (Cstring)hostent->h_name;
}
-Int NetHostDB_Entry_numAliases() {
+Int NetHostDB_Entry_numAliases(void) {
int num = 0;
while (hostent->h_aliases[num] != NULL) num++;
return num;
@@ -16,15 +16,15 @@
return (Cstring)hostent->h_aliases[n];
}
-Int NetHostDB_Entry_addrType() {
+Int NetHostDB_Entry_addrType(void) {
return hostent->h_addrtype;
}
-Int NetHostDB_Entry_length() {
+Int NetHostDB_Entry_length(void) {
return hostent->h_length;
}
-Int NetHostDB_Entry_numAddrs() {
+Int NetHostDB_Entry_numAddrs(void) {
int num = 0;
while (hostent->h_addr_list[num] != NULL) num++;
return num;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetProtDB.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetProtDB.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetProtDB.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -2,11 +2,11 @@
static struct protoent *protoent;
-Cstring NetProtDB_Entry_name() {
+Cstring NetProtDB_Entry_name(void) {
return (Cstring)protoent->p_name;
}
-Int NetProtDB_Entry_numAliases() {
+Int NetProtDB_Entry_numAliases(void) {
int num = 0;
while (protoent->p_aliases[num] != NULL) num++;
return num;
@@ -16,7 +16,7 @@
return (Cstring)protoent->p_aliases[n];
}
-Int NetProtDB_Entry_protocol() {
+Int NetProtDB_Entry_protocol(void) {
return protoent->p_proto;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetServDB.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetServDB.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetServDB.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -5,11 +5,11 @@
static struct servent *servent;
-Cstring NetServDB_Entry_name() {
+Cstring NetServDB_Entry_name(void) {
return (Cstring)servent->s_name;
}
-Int NetServDB_Entry_numAliases() {
+Int NetServDB_Entry_numAliases(void) {
int num = 0;
while (servent->s_aliases[num] != NULL) num++;
return num;
@@ -19,11 +19,11 @@
return (Cstring)servent->s_aliases[n];
}
-Int NetServDB_Entry_port() {
+Int NetServDB_Entry_port(void) {
return servent->s_port;
}
-Cstring NetServDB_Entry_protocol() {
+Cstring NetServDB_Entry_protocol(void) {
return (Cstring)servent->s_proto;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -20,7 +20,7 @@
in_addr = sa->sin_addr;
}
-Int INetSock_getPort () {
+Int INetSock_getPort (void) {
return port;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.h 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.h 2005-11-12 04:22:23 UTC (rev 4206)
@@ -16,7 +16,7 @@
#define GC_FORWARDED ~((GC_header)0)
bool isPointerInToSpace (GC_state s, pointer p);
-bool isObjptrsInToSpace (GC_state s, objptr op);
+bool isObjptrInToSpace (GC_state s, objptr op);
void forwardObjptr (GC_state s, objptr *opp);
void forwardObjptrIfInNursery (GC_state s, objptr *opp);
void forwardInterGenerationalObjptrs (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h 2005-11-12 04:22:23 UTC (rev 4206)
@@ -14,7 +14,7 @@
GC_arrayLength length;
GC_header header;
uint32_t isneg;
- uint32_t limbs[0];
+ uint32_t limbs[1];
} *GC_intInf;
#define GC_INTINF_HEADER GC_WORD32_VECTOR_HEADER
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.h 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.h 2005-11-12 04:22:23 UTC (rev 4206)
@@ -10,5 +10,5 @@
void threadInternalObjptr (GC_state s, objptr *opp);
void clearIfWeakAndUnmarkedForMarkCompact (GC_state s, pointer p);
void updateForwardPointersForMarkCompact (GC_state s);
-void updateBackwardPointersAndSlideForMarkComact (GC_state s);
+void updateBackwardPointersAndSlideForMarkCompact (GC_state s);
void majorMarkCompactGC (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h 2005-11-12 04:22:23 UTC (rev 4206)
@@ -13,7 +13,7 @@
GC_arrayCounter counter;
GC_arrayLength length;
GC_header header;
- char chars[0];
+ char chars[1];
} *GC_string;
#define GC_STRING_HEADER GC_WORD8_VECTOR_HEADER
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-11-12 03:11:49 UTC (rev 4205)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-11-12 04:22:23 UTC (rev 4206)
@@ -27,7 +27,7 @@
return (sizeofWeak (s)) - (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak));
}
-uint32_t GC_weakCanGet (GC_state s, pointer p) {
+uint32_t GC_weakCanGet (__attribute__ ((unused)) GC_state s, pointer p) {
uint32_t res;
res = GC_WEAK_GONE_HEADER != getHeader (p);
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 19:11:52
|
Eliminate skipObjects loop in forwardInterGenerationalObjptrs
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c 2005-11-12 02:53:20 UTC (rev 4204)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c 2005-11-12 03:11:49 UTC (rev 4205)
@@ -84,8 +84,6 @@
uintmaxToCommaString (s->cumulativeStatistics.markedCards));
fprintf (out, "minor scanned: %s bytes\n",
uintmaxToCommaString (s->cumulativeStatistics.minorBytesScanned));
- fprintf (out, "minor skipped: %s bytes\n",
- uintmaxToCommaString (s->cumulativeStatistics.minorBytesSkipped));
}
releaseHeap (s, &s->heap);
releaseHeap (s, &s->secondaryHeap);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-12 02:53:20 UTC (rev 4204)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-12 03:11:49 UTC (rev 4205)
@@ -194,21 +194,12 @@
assert (objectStart < oldGenStart + cardMapIndexToSize (cardIndex + 1));
if (cardMap[cardIndex]) {
pointer lastObject;
- size_t size;
s->cumulativeStatistics.markedCards++;
if (DEBUG_GENERATIONAL)
fprintf (stderr, "card %zu is marked objectStart = "FMTPTR"\n",
cardIndex, (uintptr_t)objectStart);
- lastObject = objectStart;
-skipObjects:
assert (isFrontierAligned (s, objectStart));
- size = sizeofObject (s, advanceToObjectData (s, objectStart));
- if (objectStart + size < cardStart) {
- objectStart += size;
- goto skipObjects;
- }
- s->cumulativeStatistics.minorBytesSkipped += objectStart - lastObject;
cardEnd = cardStart + CARD_SIZE;
if (oldGenEnd < cardEnd)
cardEnd = oldGenEnd;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 02:53:20 UTC (rev 4204)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 03:11:49 UTC (rev 4205)
@@ -249,7 +249,6 @@
s->cumulativeStatistics.maxHeapSizeSeen = 0;
s->cumulativeStatistics.maxStackSizeSeen = 0;
s->cumulativeStatistics.minorBytesScanned = 0;
- s->cumulativeStatistics.minorBytesSkipped = 0;
s->cumulativeStatistics.numLimitChecks = 0;
s->cumulativeStatistics.numCopyingGCs = 0;
s->cumulativeStatistics.numHashConsGCs = 0;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-11-12 02:53:20 UTC (rev 4204)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/statistics.h 2005-11-12 03:11:49 UTC (rev 4205)
@@ -19,7 +19,6 @@
size_t maxStackSizeSeen;
uintmax_t minorBytesScanned;
- uintmax_t minorBytesSkipped;
uintmax_t numLimitChecks;
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 18:53:26
|
Eliminated the "unused" field of GC_weak.
Instead, the representation for weaks is chosen by the backend to
respect the alignment (and, in the future, the objptr model). Uses of
GC_weak in the runtime are handled by computing an offset from the
start of the object, again, respecting the alignment.
The upshot is that weak pointers require 4bytes less space with
-align 4.
We could, and probably should, do something similar with GC_thread.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2005-11-12 02:53:20 UTC (rev 4204)
@@ -333,9 +333,13 @@
| Stack =>
(2, false, 0, 0)
| Weak =>
- (3, false, 2, 1)
+ (case !Control.align of
+ Control.Align4 => (3, false, 1, 1)
+ | Control.Align8 => (3, false, 2, 1))
| WeakGone =>
- (3, false, 3, 0)
+ (case !Control.align of
+ Control.Align4 => (3, false, 2, 0)
+ | Control.Align8 => (3, false, 3, 0))
in
concat ["{ ", C.int tag, ", ",
C.bool hasIdentity, ", ",
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-12 02:53:20 UTC (rev 4204)
@@ -14,7 +14,7 @@
GCC_VERSION = \
$(shell gcc -v 2>&1 | grep 'gcc version' | sed 's/.*gcc version \(.\).*/\1/')
-FLAGS = -fomit-frame-pointer
+## FLAGS = -fomit-frame-pointer
ifeq ($(TARGET_ARCH), x86)
ifneq ($(findstring $(GCC_VERSION), 3 4),)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-12 02:53:20 UTC (rev 4204)
@@ -1,18 +1,8 @@
* fix semantics of numNonPointers for normal objects to mean bytes of
non-pointer data, rather than number of 32-bit words of
non-pointer data. Rename to sizeNonPointers.
-* the unused field in GC_weak appears to be for alignment; is there a
- way to have it work well with 64-bits? Yes -- it requires
- choosing the representation for Weaks based on the model and
- the alignment; also, the GC will need to bump the pointer to
- the word after the header to get GC_weak to overlay properly.
* what type should be used for the size field in GC_heap? I'm using
size_t currently, since that is the type needed by malloc.
-* I don't believe the comment concerning exnStack and the native
- 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.
-* Why do {load,save}Globals differ in the representation of the file?
* Why does hash-table use malloc/free while generational maps use mmap/munmap?
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-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-12 02:53:20 UTC (rev 4204)
@@ -29,7 +29,7 @@
} else {
if (DEBUG_WEAK)
fprintf (stderr, "cleared\n");
- *(getHeaderp((pointer)w)) = GC_WEAK_GONE_HEADER;
+ *(getHeaderp((pointer)w - (offsetofWeak(s)))) = GC_WEAK_GONE_HEADER;
w->objptr = BOGUS_OBJPTR;
}
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-11-12 02:53:20 UTC (rev 4204)
@@ -67,7 +67,7 @@
callIfIsObjptr (s, f, (objptr*)p);
}
} else if (WEAK_TAG == tag) {
- p += sizeofNumNonObjptrs (NORMAL_TAG, numNonObjptrs);
+ p += sizeofNumNonObjptrs (WEAK_TAG, numNonObjptrs);
if (1 == numObjptrs) {
if (not skipWeaks)
callIfIsObjptr (s, f, (objptr*)p);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-12 02:53:20 UTC (rev 4204)
@@ -110,7 +110,7 @@
if ((WEAK_TAG == tag) and (numObjptrs == 1)) {
GC_weak w;
- w = (GC_weak)(s->forwardState.back + GC_NORMAL_HEADER_SIZE);
+ w = (GC_weak)(s->forwardState.back + GC_NORMAL_HEADER_SIZE + (offsetofWeak (s)));
if (DEBUG_WEAK)
fprintf (stderr, "forwarding weak "FMTPTR" ",
(uintptr_t)w);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-12 02:53:20 UTC (rev 4204)
@@ -218,8 +218,6 @@
assert (isAligned (sizeof (struct GC_stack), s->alignment));
assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
s->alignment));
- assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
- s->alignment));
s->amInGC = TRUE;
s->amOriginal = TRUE;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-12 02:53:20 UTC (rev 4204)
@@ -7,6 +7,7 @@
*/
void assertIsObjptrInFromSpace (GC_state s, objptr *opp) {
+ assert (isObjptrInFromSpace (s, *opp));
unless (isObjptrInFromSpace (s, *opp))
die ("gc.c: assertIsObjptrInFromSpace "
"opp = "FMTPTR" "
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-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-11-12 02:53:20 UTC (rev 4204)
@@ -72,15 +72,17 @@
splitHeader(s, *headerp, &tag, NULL, &numNonObjptrs, &numObjptrs);
if (WEAK_TAG == tag and 1 == numObjptrs) {
GC_header objptrHeader;
+ GC_weak w;
if (DEBUG_MARK_COMPACT or DEBUG_WEAK)
fprintf (stderr, "clearIfWeakAndUnmarkedForMarkCompact ("FMTPTR") header = "FMTHDR"\n",
(uintptr_t)p, header);
- objptrHeader = getHeader (objptrToPointer(((GC_weak)p)->objptr, s->heap.start));
+ w = (GC_weak)(p + (offsetofWeak(s)));
+ objptrHeader = getHeader (objptrToPointer(w->objptr, s->heap.start));
/* If it's not threaded and unmarked, clear the weak pointer. */
if ((GC_VALID_HEADER_MASK & objptrHeader)
and not (MARK_MASK & objptrHeader)) {
- ((GC_weak)p)->objptr = BOGUS_OBJPTR;
+ w->objptr = BOGUS_OBJPTR;
header = GC_WEAK_GONE_HEADER | MARK_MASK;
if (DEBUG_WEAK)
fprintf (stderr, "cleared. new header = "FMTHDR"\n",
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h 2005-11-12 02:53:20 UTC (rev 4204)
@@ -9,25 +9,25 @@
/*
* Stack objects have the following layout:
*
- * header word ::
- * markTop pointer ::
- * markIndex word ::
- * reserved word ::
- * used word ::
+ * header word32 ::
+ * markTop native-pointer ::
+ * markIndex word32 ::
+ * reserved ::
+ * used ::
* ... reserved bytes ...
*
- * The markTop pointer and markIndex word are used by mark compact GC.
- * The reserved word gives the number of bytes for the stack (before
- * the next ML object). The used word gives the number of bytes
- * currently used by the stack. The sequence of reserved bytes
- * correspond to ML stack frames, which will be discussed in more
- * detail in "frame.h".
+ * The markTop native-pointer and markIndex word32 are used by mark
+ * compact GC. The reserved size gives the number of bytes for the
+ * stack (before the next ML object). The used size gives the number
+ * of bytes currently used by the stack. The sequence of reserved
+ * bytes correspond to ML stack frames, which will be discussed in
+ * more detail in "frame.h".
*/
typedef struct GC_stack {
/* markTop and markIndex are only used during marking. They record
* the current pointer in the stack that is being followed. markTop
* points to the top of the stack frame containing the pointer and
- * markIndex is the index in that frames frameOffsets of the pointer
+ * markIndex is the index in that frame's frameOffsets of the pointer
* slot. So, when the GC pointer reversal gets back to the stack,
* it can continue with the next pointer (either in the current
* frame or the next frame).
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c 2005-11-12 02:53:20 UTC (rev 4204)
@@ -10,6 +10,7 @@
size_t res;
res = GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak);
+ res = align (res, s->alignment);
if (DEBUG) {
size_t check;
uint16_t numNonObjptrs, numObjptrs;
@@ -18,16 +19,14 @@
check = GC_NORMAL_HEADER_SIZE + sizeofWeakNoHeader (s, numNonObjptrs, numObjptrs);
assert (check == res);
}
- /* The following assert depends on struct GC_weak being the right
- * size. Right now, it happens that res = 16, which is aligned mod
- * 4 and mod 8, which is all that we need. If the struct ever
- * changes (possible) or we need more alignment (doubtful), we may
- * need to put some padding at the beginning.
- */
assert (isAligned (res, s->alignment));
return res;
}
+size_t offsetofWeak (GC_state s) {
+ return (sizeofWeak (s)) - (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak));
+}
+
uint32_t GC_weakCanGet (GC_state s, pointer p) {
uint32_t res;
@@ -39,9 +38,11 @@
}
pointer GC_weakGet (GC_state s, pointer p) {
+ GC_weak weak;
pointer res;
- res = objptrToPointer(((GC_weak)p)->objptr, s->heap.start);
+ weak = (GC_weak)(p + (offsetofWeak (s)));
+ res = objptrToPointer(weak->objptr, s->heap.start);
if (DEBUG_WEAK)
fprintf (stderr, FMTPTR" = GC_weakGet ("FMTPTR")\n",
(uintptr_t)res, (uintptr_t)p);
@@ -49,12 +50,14 @@
}
pointer GC_weakNew (GC_state s, GC_header header, pointer p) {
- GC_weak res;
+ GC_weak weak;
+ pointer res;
- res = (GC_weak)(newObject (s, header,
- sizeofWeak (s),
- FALSE));
- res->objptr = pointerToObjptr(p, s->heap.start);
+ res = newObject (s, header,
+ sizeofWeak (s),
+ FALSE);
+ weak = (GC_weak)(res + (offsetofWeak (s)));
+ weak->objptr = pointerToObjptr(p, s->heap.start);
if (DEBUG_WEAK)
fprintf (stderr, FMTPTR" = GC_weakNew ("FMTHDR", "FMTPTR")\n",
(uintptr_t)res, header, (uintptr_t)p);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h 2005-11-12 01:22:59 UTC (rev 4203)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h 2005-11-12 02:53:20 UTC (rev 4204)
@@ -9,30 +9,30 @@
/*
* Weak objects have the following layout:
*
- * header word ::
- * unused word ::
- * link word ::
- * heap-pointer
+ * header word32 ::
+ * padding ::
+ * link native-pointer ::
+ * object-pointer
*
* The object type indexed by the header determines whether the weak
* is valid or not. If the type has numPointers == 1, then the weak
* pointer is valid. Otherwise, the type has numPointers == 0 and the
* weak pointer is not valid.
*
- * The first word is unused; present for alignment purposes
+ * There may be zero or more bytes of padding for alignment purposes.
*
- * The second word is used to chain the live weaks together during a copying gc
- * and is otherwise unused.
+ * The link native-pointer is used to chain the live weaks together
+ * during a copying gc and is otherwise unused.
*
- * The third word is the weak pointer.
+ * The third word is the weak object-pointer.
*/
typedef struct GC_weak {
- uint32_t unused;
struct GC_weak *link;
objptr objptr;
} *GC_weak;
size_t sizeofWeak (GC_state s);
+size_t offsetofWeak (GC_state s);
uint32_t GC_weakCanGet (GC_state s, pointer p);
pointer GC_weakGet (GC_state s, pointer p);
pointer GC_weakNew (GC_state s, GC_header header, pointer p);
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 17:23:03
|
Reordered TYPE_INDEX constants
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun 2005-11-12 00:24:53 UTC (rev 4202)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun 2005-11-12 01:22:59 UTC (rev 4203)
@@ -379,10 +379,11 @@
(* Order in the following vector matters. The basic pointer tycons must
* correspond to the constants in gc.h.
* STACK_TYPE_INDEX,
- * STRING_TYPE_INDEX,
* THREAD_TYPE_INDEX,
* WEAK_GONE_TYPE_INDEX,
- * WORD_VECTOR_TYPE_INDEX.
+ * WORD8_VECTOR_TYPE_INDEX,
+ * WORD16_VECTOR_TYPE_INDEX,
+ * WORD32_VECTOR_TYPE_INDEX.
*)
val basic =
let
@@ -397,9 +398,9 @@
in
Vector.fromList
[(PointerTycon.stack, stack),
- wordVec 8,
(PointerTycon.thread, thread),
(PointerTycon.weakGone, WeakGone),
+ wordVec 8,
wordVec 32,
wordVec 16]
end
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-12 00:24:53 UTC (rev 4202)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-12 01:22:59 UTC (rev 4203)
@@ -1,6 +1,3 @@
-
-* reorder ZZZ_TYPE_INDEX
-* eliminate STRING_TYPE_INDEX, STRING_TYPE_HEADER in favor of WORD8.
* fix semantics of numNonPointers for normal objects to mean bytes of
non-pointer data, rather than number of 32-bit words of
non-pointer data. Rename to sizeNonPointers.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-11-12 00:24:53 UTC (rev 4202)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-11-12 01:22:59 UTC (rev 4203)
@@ -102,10 +102,9 @@
enum {
/* The type indices here must agree with those in backend/rep-type.fun. */
STACK_TYPE_INDEX = 0,
- STRING_TYPE_INDEX = 1,
- THREAD_TYPE_INDEX = 2,
- WEAK_GONE_TYPE_INDEX = 3,
- WORD8_VECTOR_TYPE_INDEX = STRING_TYPE_INDEX,
+ THREAD_TYPE_INDEX = 1,
+ WEAK_GONE_TYPE_INDEX = 2,
+ WORD8_VECTOR_TYPE_INDEX = 3,
WORD32_VECTOR_TYPE_INDEX = 4,
WORD16_VECTOR_TYPE_INDEX = 5,
};
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 16:24:57
|
Eliminated out of date comment; reordered fields
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h 2005-11-12 00:24:09 UTC (rev 4201)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.h 2005-11-12 00:24:53 UTC (rev 4202)
@@ -10,15 +10,13 @@
/* The order of these fields is important. The nonpointer fields
* must be first, because this object must appear to be a normal
* heap object.
- * Furthermore, the exnStack field must be first, because the native
- * codegen depends on this (which is bad and should be fixed).
*/
- uint32_t exnStack; /* An offset added to stackBottom that specifies
- * where the top of the exnStack is.
- */
size_t bytesNeeded; /* The number of bytes needed when returning
* to this thread.
*/
+ uint32_t exnStack; /* An offset added to stackBottom that specifies
+ * where the top of the exnStack is.
+ */
objptr stack; /* The stack for this thread. */
} *GC_thread;
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 16:24:11
|
Added -skip-to option to regression script to skip to a particular regression; useful for testing subsets without editting the script
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/bin/regression
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/bin/regression
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-11 23:29:14 UTC (rev 4200)
+++ mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-12 00:24:09 UTC (rev 4201)
@@ -3,12 +3,12 @@
# This script runs the regression tests in src/regression.
# It also compiles the tests in benchmark/tests
-set -e
+# set -e
name=`basename $0`
usage () {
- echo >&2 "usage: $name [-cross target] [-run-only target] [-short] [mlton flags ...]"
+ echo >&2 "usage: $name [-cross target] [-run-only target] [-short] [-skip-to reg] [mlton flags ...]"
exit 1
}
@@ -16,6 +16,7 @@
fail='false'
runOnly='false'
short='false'
+skipTo=''
while [ "$#" -gt 0 ]; do
case "$1" in
-cross)
@@ -44,6 +45,14 @@
short='true'
shift
;;
+ -skip-to)
+ shift
+ if [ "$#" = 0 ]; then
+ usage
+ fi
+ skipTo="$1"
+ shift
+ ;;
*)
flags="$@"
break
@@ -102,6 +111,14 @@
for f in `ls *.sml`; do
f=`basename $f .sml`
+ if [ "$skipTo" != "" ]; then
+ if [ "$skipTo" != "$f" ]; then
+ echo "skipping $f"
+ continue
+ else
+ skipTo=''
+ fi
+ fi
case `host-os` in
cygwin|mingw)
case "$f" in
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 15:29:17
|
Formatting
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-11 21:58:14 UTC (rev 4199)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-11 23:29:14 UTC (rev 4200)
@@ -1,7 +1,6 @@
* reorder ZZZ_TYPE_INDEX
* eliminate STRING_TYPE_INDEX, STRING_TYPE_HEADER in favor of WORD8.
-* reorder SOURCE_SEQ_UNKNOWN
* fix semantics of numNonPointers for normal objects to mean bytes of
non-pointer data, rather than number of 32-bit words of
non-pointer data. Rename to sizeNonPointers.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.h 2005-11-11 21:58:14 UTC (rev 4199)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.h 2005-11-11 23:29:14 UTC (rev 4200)
@@ -25,8 +25,8 @@
#define PRISSI PRIu32
#define FMTSSI "%"PRISSI
+#define SOURCE_SEQ_UNKNOWN 0
#define SOURCE_SEQ_GC 1
-#define SOURCE_SEQ_UNKNOWN 0
typedef struct GC_source {
GC_sourceNameIndex sourceNameIndex;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-11-11 21:58:14 UTC (rev 4199)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-11-11 23:29:14 UTC (rev 4200)
@@ -12,9 +12,13 @@
#include "cenv.h"
#include "util.h"
+
+#include "gc/debug.h"
+
struct GC_state;
typedef struct GC_state *GC_state;
+
#if (defined (MLTON_GC_INTERNAL))
#define GC_MODEL_NATIVE32
@@ -31,6 +35,7 @@
#include "gc/weak.h"
#include "gc/int-inf.h"
#include "gc/string.h"
+
#include "gc/object-size.h"
#include "gc/generational.h"
#include "gc/heap.h"
@@ -73,7 +78,6 @@
#endif /* (defined (MLTON_GC_INTERNAL)) */
-#include "gc/debug.h"
#include "gc/platform.h"
#include "gc/gc_state_exports.h"
#include "gc/exports.h"
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 13:58:16
|
Added flag -debug-runtime {false|true} for linking with libmlton-gdb.a
without adding debug info to the generated .o files.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2005-11-11 21:42:01 UTC (rev 4198)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2005-11-11 21:58:14 UTC (rev 4199)
@@ -51,6 +51,7 @@
val buildConstants: bool ref = ref false
val ccOpts: {opt: string, pred: OptPred.t} list ref = ref []
val coalesce: int option ref = ref NONE
+val debugRuntime: bool ref = ref false
val expert: bool ref = ref false
val explicitAlign: Control.align option ref = ref NONE
val explicitCodegen: Control.codegen option ref = ref NONE
@@ -178,7 +179,10 @@
"contify functions into main",
boolRef contifyIntoMain),
(Expert, "debug", " {false|true}", "produce executable with debug info",
- boolRef debug),
+ Bool (fn b => (debug := b
+ ; debugRuntime := b))),
+ (Expert, "debug-runtime", " {false|true}", "produce executable with debug info",
+ boolRef debugRuntime),
let
val flag = "default-ann"
in
@@ -578,7 +582,7 @@
val ccOpts = addTargetOpts ccOpts
val linkOpts =
List.concat [[concat ["-L", !libTargetDir],
- if !debug then "-lmlton-gdb" else "-lmlton"],
+ if !debugRuntime then "-lmlton-gdb" else "-lmlton"],
addTargetOpts linkOpts]
(* With gcc 3.4, the '-b <arch>' must be the first argument. *)
val targetOpts =
|
|
From: Matthew F. <fl...@ml...> - 2005-11-11 13:42:13
|
Merge trunk revisions 4165:4197 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
U mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
A mlton/branches/on-20050822-x86_64-branch/bin/patch-mingw
U mlton/branches/on-20050822-x86_64-branch/bin/regression
U mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis
U mlton/branches/on-20050822-x86_64-branch/doc/changelog
U mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile
A mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/platform/memory.x86-mingw.mlb
U mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun
U mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
U mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat
A mlton/branches/on-20050822-x86_64-branch/regression/time4.ok
A mlton/branches/on-20050822-x86_64-branch/regression/time4.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2005-11-11 21:42:01 UTC (rev 4198)
@@ -353,6 +353,9 @@
ifeq ($(TARGET_OS), darwin)
PREFIX = /usr/local
endif
+ifeq ($(TARGET_OS), mingw)
+PREFIX = /mingw
+endif
ifeq ($(TARGET_OS), solaris)
PREFIX = /usr/local
endif
@@ -391,7 +394,8 @@
sed "/^lib=/s;.*;lib='$(prefix)/$(ULIB)';" \
<$(SRC)/bin/mlton-script >$(TBIN)/mlton
chmod a+x $(TBIN)/mlton
- cd $(BIN) && $(CP) $(LEX) $(NLFFIGEN) $(PROF) $(YACC) $(TBIN)/
+ cd $(BIN) && $(CP) $(LEX)$(EXE) $(NLFFIGEN)$(EXE) \
+ $(PROF)$(EXE) $(YACC)$(EXE) $(TBIN)/
( cd $(SRC)/man && tar cf - $(MAN_PAGES)) | \
( cd $(TMAN)/ && tar xf - )
if $(GZIP_MAN); then \
@@ -401,9 +405,9 @@
cygwin|darwin|solaris) \
;; \
*) \
- for f in $(TLIB)/$(AOUT) $(TBIN)/$(LEX) \
- $(TBIN)/$(NLFFIGEN) $(TBIN)/$(PROF) \
- $(TBIN)/$(YACC); do \
+ for f in $(TLIB)/$(AOUT)$(EXE) $(TBIN)/$(LEX)$(EXE) \
+ $(TBIN)/$(NLFFIGEN)$(EXE) $(TBIN)/$(PROF)$(EXE) \
+ $(TBIN)/$(YACC)$(EXE); do \
strip --remove-section=.comment \
--remove-section=.note $$f; \
done \
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun 2005-11-11 21:42:01 UTC (rev 4198)
@@ -77,19 +77,37 @@
(* outstream *)
(* ------------------------------------------------- *)
-datatype outstream = Out of SIO.outstream ref
+(* The following :> hides the fact that Outstream.t is an eqtype. Doing it
+ * here is much easier than putting :> on the functor result.
+ *)
+structure Outstream:>
+ sig
+ type t
-fun output (Out os, v) = SIO.output (!os, v)
-fun output1 (Out os, v) = SIO.output1 (!os, v)
-fun outputSlice (Out os, v) = SIO.outputSlice (!os, v)
-fun flushOut (Out os) = SIO.flushOut (!os)
-fun closeOut (Out os) = SIO.closeOut (!os)
-fun mkOutstream os = Out (ref os)
-fun getOutstream (Out os) = !os
-fun setOutstream (Out os, os') = os := os'
-fun getPosOut (Out os) = SIO.getPosOut (!os)
-fun setPosOut (Out os, outPos) = os := SIO.setPosOut outPos
+ val get: t -> SIO.outstream
+ val make: SIO.outstream -> t
+ val set: t * SIO.outstream -> unit
+ end =
+ struct
+ datatype t = T of SIO.outstream ref
+ fun get (T r) = !r
+ fun set (T r, s) = r := s
+ fun make s = T (ref s)
+ end
+
+type outstream = Outstream.t
+fun output (os, v) = SIO.output (Outstream.get os, v)
+fun output1 (os, v) = SIO.output1 (Outstream.get os, v)
+fun outputSlice (os, v) = SIO.outputSlice (Outstream.get os, v)
+fun flushOut os = SIO.flushOut (Outstream.get os)
+fun closeOut os = SIO.closeOut (Outstream.get os)
+val mkOutstream = Outstream.make
+val getOutstream = Outstream.get
+val setOutstream = Outstream.set
+val getPosOut = SIO.getPosOut o Outstream.get
+fun setPosOut (os, outPos) = Outstream.set (os, SIO.setPosOut outPos)
+
fun newOut {appendMode, bufferMode, closeAtExit, fd, name} =
let
val writer = mkWriter {appendMode = appendMode,
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig 2005-11-11 21:42:01 UTC (rev 4198)
@@ -622,6 +622,10 @@
sharing type Word64VectorSlice.vector = Word64Vector.vector
sharing type Word64Array2.elem = Word64.word
sharing type Word64Array2.vector = Word64Vector.vector
+ sharing type MLton.BinIO.instream = BinIO.instream
+ sharing type MLton.BinIO.outstream = BinIO.outstream
+ sharing type MLton.TextIO.instream = TextIO.instream
+ sharing type MLton.TextIO.outstream = TextIO.outstream
end
(* bool is already defined as bool and so cannot be shared.
* So, we where these to get the needed sharing.
@@ -696,6 +700,9 @@
where type Word8ArraySlice.vector_slice = Word8ArraySlice.vector_slice
where type Word8Vector.vector = Word8Vector.vector
+ where type 'a MLton.Thread.t = 'a MLton.Thread.t
+ where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
+
(* Types that must be exposed because constants denote them. *)
where type Int1.int = Int1.int
where type Int2.int = Int2.int
@@ -765,6 +772,3 @@
where type Word31.word = Word31.word
where type Word32.word = Word32.word
where type Word64.word = Word64.word
-
- where type 'a MLton.Thread.t = 'a MLton.Thread.t
- where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig 2005-11-11 21:42:01 UTC (rev 4198)
@@ -5,7 +5,5 @@
* See the file MLton-LICENSE for details.
*)
-signature MLTON_BIN_IO =
- MLTON_IO
- where type instream = BinIO.instream
- where type outstream = BinIO.outstream
+signature MLTON_BIN_IO = MLTON_IO
+
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig 2005-11-11 21:42:01 UTC (rev 4198)
@@ -6,7 +6,4 @@
* See the file MLton-LICENSE for details.
*)
-signature MLTON_TEXT_IO =
- MLTON_IO
- where type instream = TextIO.instream
- where type outstream = TextIO.outstream
+signature MLTON_TEXT_IO = MLTON_IO
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2005-11-11 21:42:01 UTC (rev 4198)
@@ -92,6 +92,7 @@
val toString = fmt 3
(* Adapted from the ML Kit 4.1.4; basislib/Time.sml
+ * by mf...@ac... on 2005-11-10 based on
* by mf...@ac... on 2005-8-10 based on
* adaptations from the ML Kit 3 Version; basislib/Time.sml
* by sw...@re... on 1999-1-3.
@@ -103,10 +104,14 @@
| pow10 n = 10 * pow10 (n-1)
fun mkTime sign intv fracv decs =
let
- val nsec = (pow10 (10-decs) * fracv + 5) div 10
+ val nsec =
+ LargeInt.div (LargeInt.+ (LargeInt.* (Int.toLarge (pow10 (10 - decs)),
+ Int.toLarge fracv),
+ 5),
+ 10)
val t =
LargeInt.+ (LargeInt.* (Int.toLarge intv, ticksPerSecond),
- Int.toLarge nsec)
+ nsec)
val t = if sign then t else LargeInt.~ t
in
T t
@@ -139,6 +144,7 @@
fun int sign src =
case getc src of
NONE => NONE
+ | SOME (#".", rest) => frac sign 0 rest
| SOME (c, rest) =>
(case charToDigit c of
NONE => NONE
Modified: mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/mlton-script 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/bin/mlton-script 2005-11-11 21:42:01 UTC (rev 4198)
@@ -6,11 +6,19 @@
dir=`dirname $0`
lib=`cd $dir/../lib && pwd`
+eval `$lib/platform`
gcc='gcc'
-mlton="$lib/mlton-compile"
+case "$HOST_OS" in
+mingw)
+ exe='.exe'
+;;
+*)
+ exe=''
+;;
+esac
+mlton="$lib/mlton-compile$exe"
world="$lib/world.mlton"
nj='sml'
-eval `$lib/platform`
# Try to use the SML/NJ .arch-n-opsys
if .arch-n-opsys >/dev/null 2>&1; then
eval `.arch-n-opsys`
Copied: mlton/branches/on-20050822-x86_64-branch/bin/patch-mingw (from rev 4197, mlton/trunk/bin/patch-mingw)
Modified: mlton/branches/on-20050822-x86_64-branch/bin/regression
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-11 21:42:01 UTC (rev 4198)
@@ -12,14 +12,14 @@
exit 1
}
-cross='no'
-fail='no'
-runOnly='no'
-short='no'
+cross='false'
+fail='false'
+runOnly='false'
+short='false'
while [ "$#" -gt 0 ]; do
case "$1" in
-cross)
- cross='yes'
+ cross='true'
shift
if [ "$#" = 0 ]; then
usage
@@ -28,11 +28,11 @@
shift
;;
-fail)
- fail='yes'
+ fail='true'
shift
;;
-run-only)
- runOnly='yes'
+ runOnly='true'
shift
if [ "$#" = 0 ]; then
usage
@@ -41,7 +41,7 @@
shift
;;
-short)
- short='yes'
+ short='true'
shift
;;
*)
@@ -57,7 +57,7 @@
lib="$src/build/lib"
mlton="$bin/mlton"
flags="-type-check true $flags"
-if [ $cross = 'yes' ]; then
+if $cross; then
flags="$flags -target $crossTarget -stop g"
fi
cont='callcc.sml callcc2.sml callcc3.sml once.sml'
@@ -80,7 +80,7 @@
cd $src/regression
-if [ "$fail" = 'yes' ]; then
+if $fail; then
for f in `ls fail/*.sml`; do
echo "testing $f"
( $mlton $flags -stop tc $f >/dev/null 2>&1 &&
@@ -90,6 +90,16 @@
exit 0
fi
+forMinGW='false'
+if [ `host-os` = mingw ]; then
+ forMinGW='true'
+fi
+case $crossTarget in
+*mingw)
+ forMinGW='true'
+;;
+esac
+
for f in `ls *.sml`; do
f=`basename $f .sml`
case `host-os` in
@@ -123,8 +133,7 @@
extraFlags=""
;;
esac
- case "$runOnly" in
- no)
+ if (! $runOnly); then
mlb="$f.mlb"
echo "\$(SML_LIB)/basis/basis.mlb
\$(SML_LIB)/basis/mlton.mlb
@@ -139,12 +148,10 @@
cmd="$mlton $flags $extraFlags -output $f $mlb"
eval $cmd
rm $mlb
- if [ "$?" -ne '0' ] ||
- [ "$cross" = 'no' -a ! -x "$f" ]; then
+ if [ "$?" -ne '0' ] || ((! $cross) && [ ! -x "$f" ]); then
compFail $f
fi
- ;;
- yes)
+ else
case $crossTarget in
*mingw)
libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
@@ -170,34 +177,29 @@
-L/usr/pkg/lib \
-L/usr/local/lib \
$files $libs
- ;;
- esac
- if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
+ fi
+ if [ ! -r $f.nonterm -a $cross = 'false' -a -x $f ]; then
nonZeroMsg='Nonzero exit status.'
- case $crossTarget in
- *mingw)
- nonZeroMsg="$nonZeroMsg"'\r'
- ;;
- esac
+ if $forMinGW; then
+ nonZeroMsg="$nonZeroMsg"'\r'
+ fi
( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1
if [ -r $f.ok ]; then
compare="$f.$HOST_ARCH-$HOST_OS.ok"
if [ ! -r $compare ]; then
compare="$f.ok"
fi
- case $crossTarget in
- *mingw)
+ if $forMinGW; then
compare="$f.sed.ok"
- sed 's/$/\r/' <"$f.ok" >"$compare"
- ;;
- esac
+ /c/cygwin/bin/sed 's/$/\r/' <"$f.ok" >"$compare"
+ fi
if ! diff $compare $tmp; then
echo "difference with $flags"
fi
fi
fi
done
-if [ "$cross" = 'yes' -o "$runOnly" = 'yes' -o "$short" = 'yes' ]; then
+if $cross || $runOnly || $short; then
exit 0
fi
mmake clean >/dev/null
Modified: mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis 2005-11-11 21:42:01 UTC (rev 4198)
@@ -11,12 +11,14 @@
name=`basename $0`
usage () {
- die "usage: $name <PATH>"
+ die "usage: $name <PATH> <ARCH> <OS>"
}
case "$#" in
-1)
+3)
PATH="$1"
+ ARCH="$2"
+ OS="$3"
;;
*)
usage
@@ -94,7 +96,7 @@
structure LargeWord = Word'
eval `$bin/platform`
-case $HOST_ARCH in
+case "$ARCH" in
alpha)
arch='Alpha'
;;
@@ -132,7 +134,7 @@
die "strange HOST_ARCH: $HOST_ARCH"
esac
-case $HOST_OS in
+case "$OS" in
cygwin)
os='Cygwin'
;;
Modified: mlton/branches/on-20050822-x86_64-branch/doc/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/changelog 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/doc/changelog 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1,5 +1,11 @@
Here are the changes since version 20041109.
+* 2005-11-10
+ - Fixed two bugs in Time.scan. One would raise Time on a string with a
+ large fractional component. Thanks to Carsten Varming for the bug
+ report. The other failed to scan strings with an explicit sign
+ followed by a decimal point.
+
* 2005-11-03
- Removed MLton.GC.setRusage.
- Added MLton.Rusage.measureGC.
Modified: mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile 2005-11-11 21:42:01 UTC (rev 4198)
@@ -8,7 +8,7 @@
PATH = ../../../build/bin:$(shell echo $$PATH)
-mlton = mlton -default-ann 'allowFFI true' -codegen c
+mlton = mlton -default-ann 'allowFFI true'
.PHONY: all
all: import import2 export iimport test_quot
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/platform/memory.x86-mingw.mlb (from rev 4197, mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-mingw.mlb)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/Makefile 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/Makefile 2005-11-11 21:42:01 UTC (rev 4198)
@@ -9,6 +9,7 @@
SRC = $(shell cd .. && pwd)
BUILD = $(SRC)/build
BIN = $(BUILD)/bin
+HOST_ARCH = $(shell $(SRC)/bin/host-arch)
HOST_OS = $(shell $(SRC)/bin/host-os)
LIB = $(BUILD)/lib
MLTON = mlton
@@ -85,7 +86,7 @@
#! Pass $(PATH) to upgrade-basis because it is run via #!/usr/bin/env
# bash, which resets the path.
$(UP):
- $(SRC)/bin/upgrade-basis "$(PATH)" >$(UP)
+ $(SRC)/bin/upgrade-basis "$(PATH)" "$(HOST_ARCH)" "$(HOST_OS)" >$(UP)
mlton.sml: $(SOURCES)
rm -f mlton.sml && mlton -stop sml mlton.cm && chmod -w mlton.sml
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2005-11-11 21:42:01 UTC (rev 4198)
@@ -901,6 +901,13 @@
(MLton.GC.pack ()
; compileCSO (List.concat [!outputs, csoFiles]))
end
+ fun showFiles (fs: File.t vector) =
+ Vector.foreach
+ (fs, fn f =>
+ print (concat [String.translate
+ (f, fn #"\\" => "/"
+ | c => str c),
+ "\n"]))
fun compileCM input =
let
val files = CM.cm {cmfile = input}
@@ -916,8 +923,7 @@
in
case stop of
Place.Files =>
- List.foreach
- (files, fn f => print (concat [f, "\n"]))
+ showFiles (Vector.fromList files)
| Place.SML => saveSML (maybeOut ".sml")
| _ =>
(if !keepSML
@@ -970,9 +976,8 @@
val _ =
case stop of
Place.Files =>
- Vector.foreach
- (Compile.sourceFilesMLB {input = file}, fn f =>
- print (concat [f, "\n"]))
+ showFiles
+ (Compile.sourceFilesMLB {input = file})
| Place.SML => saveSML (maybeOut ".sml")
| Place.TypeCheck =>
trace (Top, "Type Check SML")
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1202,12 +1202,19 @@
| Object {args, con} =>
let
val args = varInfos args
+ val isMutable =
+ case Type.dest ty of
+ Type.Object {args, ...} => Prod.isMutable args
+ | _ => Error.bug "strange Object type"
in
- if isSome con
- then
- construct (Value.Object {args = args, con = con},
- fn () => Object {args = uses args,
- con = con})
+ (* It would be nice to improve this code to do
+ * reconstruction when isSome con, not just for
+ * tuples.
+ *)
+ if isMutable orelse isSome con then
+ construct (Value.Object {args = args, con = con},
+ fn () => Object {args = uses args,
+ con = con})
else tuple args
end
| PrimApp {args, prim} =>
Modified: mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/debian/changelog 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/package/debian/changelog 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1,3 +1,9 @@
+mlton (20051109-1) unstable; urgency=low
+
+ * new upstream version
+
+ -- Stephen Weeks <sw...@sw...> Wed, 09 Nov 2005 18:47:04 -0800
+
mlton (20051102-1) unstable; urgency=low
* new upstream version
Modified: mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1,13 +1,46 @@
-@echo off
-set lib=c:\MLton\lib
-set cc=c:\MinGW\bin\gcc.exe
-
-set world=%lib%\world.mlton
-set mlton=%lib%\mlton-compile.exe
-
-set ccopts=-I%lib%\include -O1 -fno-strict-aliasing -fomit-frame-pointer -w
-set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2
-set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2 -mtune=pentium4
-set linkopts=-L%lib%\lib -lgdtoa -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32
-
-%mlton% @MLton load-world %world% -- %lib% -cc %cc% -cc-opt "%ccopts%" -link-opt "%linkopts%" %1 %2 %3 %4 %5 %6 %7 %8 %9
+@echo off
+if "%CMDEXTVERSION%"=="" goto :downlevel
+
+rem %0 contains the name of this batch file, before the path was searched
+rem But we can use the %~dp0 call-parameter syntax to find out what drive and directory it lives on
+setlocal
+call :setdir %~dp0 "%*"
+
+if not exist %dir% (
+ echo MLton directory %dir% does not exist
+ goto :end
+)
+
+set lib=%dir%\lib\MLton
+if not exist %lib% (
+ echo MLton library directory %lib% does not exist
+ goto :end
+)
+
+set cc=%dir%\bin\gcc.exe
+if not exist %cc% (
+ echo GCC compiler %cc% does not exist
+ goto :end
+)
+
+set world=%lib%\world.mlton
+set mlton=%lib%\mlton-compile.exe
+
+set ccopts=-I%lib%\include -O1 -fno-strict-aliasing -fomit-frame-pointer -w
+set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2
+set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2
+set linkopts=-lgdtoa -lm
+set linkopts=%linkopts% -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32
+
+%mlton% @MLton load-world %world% ram-slop 0.5 -- %lib% -cc %cc% -cc-opt "%ccopts%" -mlb-path-map %lib%\mlb-path-map -link-opt "%linkopts%" %*
+goto :eof
+
+:setdir
+set dir=%1%..\
+GOTO :eof
+
+:downlevel
+echo Batch file execution of MLton not supported without command extensions
+goto :end
+
+:end
Copied: mlton/branches/on-20050822-x86_64-branch/regression/time4.ok (from rev 4197, mlton/trunk/regression/time4.ok)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/time4.sml (from rev 4197, mlton/trunk/regression/time4.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c 2005-11-11 21:42:01 UTC (rev 4198)
@@ -110,7 +110,10 @@
static inline void *Windows_mmapAnon (void *start, size_t length) {
void *res;
- res = VirtualAlloc ((LPVOID)start, length, MEM_COMMIT, PAGE_READWRITE);
+ /* Use "0" instead of "start" as the first argument to VirtualAlloc
+ * because it is more stable on MinGW (at least).
+ */
+ res = VirtualAlloc ((LPVOID)0/*start*/, length, MEM_COMMIT, PAGE_READWRITE);
if (NULL == res)
res = (void*)-1;
return res;
|
|
From: Stephen W. <sw...@ml...> - 2005-11-11 12:28:51
|
Andrew Kennedy's bat file. ---------------------------------------------------------------------- U mlton/trunk/package/mingw/mlton.bat ---------------------------------------------------------------------- Modified: mlton/trunk/package/mingw/mlton.bat =================================================================== --- mlton/trunk/package/mingw/mlton.bat 2005-11-11 04:10:53 UTC (rev 4196) +++ mlton/trunk/package/mingw/mlton.bat 2005-11-11 20:28:50 UTC (rev 4197) @@ -1,13 +1,46 @@ -@echo off -set lib=c:\MLton\lib -set cc=c:\MinGW\bin\gcc.exe - -set world=%lib%\world.mlton -set mlton=%lib%\mlton-compile.exe - -set ccopts=-I%lib%\include -O1 -fno-strict-aliasing -fomit-frame-pointer -w -set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2 -set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2 -mtune=pentium4 -set linkopts=-L%lib%\lib -lgdtoa -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32 - -%mlton% @MLton load-world %world% -- %lib% -cc %cc% -cc-opt "%ccopts%" -link-opt "%linkopts%" %1 %2 %3 %4 %5 %6 %7 %8 %9 +@echo off +if "%CMDEXTVERSION%"=="" goto :downlevel + +rem %0 contains the name of this batch file, before the path was searched +rem But we can use the %~dp0 call-parameter syntax to find out what drive and directory it lives on +setlocal +call :setdir %~dp0 "%*" + +if not exist %dir% ( + echo MLton directory %dir% does not exist + goto :end +) + +set lib=%dir%\lib\MLton +if not exist %lib% ( + echo MLton library directory %lib% does not exist + goto :end +) + +set cc=%dir%\bin\gcc.exe +if not exist %cc% ( + echo GCC compiler %cc% does not exist + goto :end +) + +set world=%lib%\world.mlton +set mlton=%lib%\mlton-compile.exe + +set ccopts=-I%lib%\include -O1 -fno-strict-aliasing -fomit-frame-pointer -w +set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2 +set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2 +set linkopts=-lgdtoa -lm +set linkopts=%linkopts% -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32 + +%mlton% @MLton load-world %world% ram-slop 0.5 -- %lib% -cc %cc% -cc-opt "%ccopts%" -mlb-path-map %lib%\mlb-path-map -link-opt "%linkopts%" %* +goto :eof + +:setdir +set dir=%1%..\ +GOTO :eof + +:downlevel +echo Batch file execution of MLton not supported without command extensions +goto :end + +:end |
|
From: Matthew F. <fl...@ml...> - 2005-11-10 20:10:56
|
Scale crossMap offsets
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.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/model.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-11 00:14:33 UTC (rev 4195)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-11 04:10:53 UTC (rev 4196)
@@ -230,14 +230,15 @@
goto checkCard;
} else {
unless (CROSS_MAP_EMPTY == crossMap[cardIndex])
- objectStart = cardStart + (size_t)(crossMap[cardIndex]);
+ objectStart = cardStart + (size_t)(crossMap[cardIndex] * CROSS_MAP_OFFSET_SCALE);
if (DEBUG_GENERATIONAL)
fprintf (stderr,
"card %zu is not marked"
" crossMap[%zu] == %zu"
" objectStart = "FMTPTR"\n",
cardIndex, cardIndex,
- (size_t)(crossMap[cardIndex]), (uintptr_t)objectStart);
+ (size_t)(crossMap[cardIndex] * CROSS_MAP_OFFSET_SCALE),
+ (uintptr_t)objectStart);
cardIndex++;
cardStart += CARD_SIZE;
goto checkAll;
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-11-11 00:14:33 UTC (rev 4195)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-11-11 04:10:53 UTC (rev 4196)
@@ -6,7 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-#ifdef MLTON_GC_INTERNAL
struct GC_state {
size_t alignment; /* */
bool amInGC;
@@ -61,7 +60,6 @@
uint32_t vectorInitsLength;
GC_weak weaks; /* Linked list of (live) weak pointers */
};
-#endif
void displayGCState (GC_state s, FILE *stream);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-11-11 00:14:33 UTC (rev 4195)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-11-11 04:10:53 UTC (rev 4196)
@@ -28,8 +28,9 @@
fprintf (stderr, "crossMap trues\n");
for (i = 0; i < generational->crossMapLength; i++)
unless (CROSS_MAP_EMPTY == generational->crossMap[i])
- fprintf (stderr, "\t"FMTCMI" "FMTCME"\n",
- i, generational->crossMap[i]);
+ fprintf (stderr, "\t"FMTCMI" "FMTCME" "FMTCME"\n",
+ i, generational->crossMap[i],
+ CROSS_MAP_OFFSET_SCALE * generational->crossMap[i]);
fprintf (stderr, "\n");
}
}
@@ -198,7 +199,7 @@
assert (front <= back);
cardStart = getCrossMapCardStart (s, front);
cardIndex = sizeToCardMapIndex (cardStart - s->heap.start);
- map[cardIndex] = (front - cardStart);
+ map[cardIndex] = (front - cardStart) / CROSS_MAP_OFFSET_SCALE;
if (front < back) {
front += sizeofObject (s, advanceToObjectData (s, front));
goto loopObjects;
@@ -220,6 +221,7 @@
fprintf (stderr, "updateCrossMap starting\n");
displayGenerationalMaps (s, &s->generationalMaps, stderr);
}
+ assert (isAligned (s->alignment, CROSS_MAP_OFFSET_SCALE));
if (s->generationalMaps.crossMapValidSize == s->heap.oldGenSize)
goto done;
oldGenEnd = s->heap.start + s->heap.oldGenSize;
@@ -254,7 +256,7 @@
*/
size_t offset;
- offset = (objectStart - cardStart);
+ offset = (objectStart - cardStart) / CROSS_MAP_OFFSET_SCALE;
assert (offset < CROSS_MAP_EMPTY);
if (DEBUG_GENERATIONAL)
fprintf (stderr, "crossMap[%zu] = %zu\n",
@@ -268,7 +270,8 @@
if (objectStart < oldGenEnd)
goto loopObjects;
assert (objectStart == oldGenEnd);
- s->generationalMaps.crossMap[cardIndex] = (GC_crossMapElem)(oldGenEnd - cardStart);
+ s->generationalMaps.crossMap[cardIndex] =
+ (GC_crossMapElem)(oldGenEnd - cardStart) / CROSS_MAP_OFFSET_SCALE;
s->generationalMaps.crossMapValidSize = s->heap.oldGenSize;
done:
assert (s->generationalMaps.crossMapValidSize == s->heap.oldGenSize);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-11-11 00:14:33 UTC (rev 4195)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-11-11 04:10:53 UTC (rev 4196)
@@ -17,6 +17,7 @@
#define CARD_MAP_ELEM_SIZE sizeof(GC_cardMapElem)
#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)
#define CROSS_MAP_EMPTY ((GC_crossMapElem)255)
+#define CROSS_MAP_OFFSET_SCALE 4
#define FMTCMI "%zu"
#define FMTCME "%"PRIu8
@@ -33,9 +34,9 @@
GC_cardMapIndex 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.
+ * interpreted as a byte offset (scaled by CARD_MAP_OFFSET_SCALE);
+ * the offset indicates the start of the last object in the
+ * corresponding card from the start of the card.
*/
GC_crossMapElem *crossMap;
GC_crossMapIndex crossMapLength;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h 2005-11-11 00:14:33 UTC (rev 4195)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/model.h 2005-11-11 04:10:53 UTC (rev 4196)
@@ -135,8 +135,6 @@
manageable set for users.
*/
-#if (defined (MLTON_GC_INTERNAL))
-
#if (defined (GC_MODEL_A) || defined (GC_MODEL_NATIVE32))
#define GC_MODEL_BITSIZE 32
#define GC_MODEL_SHIFT 0
@@ -207,5 +205,3 @@
#endif
#define GC_MODEL_NONOBJPTR ((GC_MODEL_MINALIGN_SHIFT - GC_MODEL_SHIFT) > 0)
#define GC_MODEL_MINALIGN TWOPOWER(GC_MODEL_MINALIGN_SHIFT)
-
-#endif /* (defined (MLTON_GC_INTERNAL)) */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h 2005-11-11 00:14:33 UTC (rev 4195)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/objptr.h 2005-11-11 04:10:53 UTC (rev 4196)
@@ -5,8 +5,6 @@
* See the file MLton-LICENSE for details.
*/
-#if (defined (MLTON_GC_INTERNAL))
-
#define OBJPTR_TYPE__(z) uint ## z ## _t
#define OBJPTR_TYPE_(z) OBJPTR_TYPE__(z)
#define OBJPTR_TYPE OBJPTR_TYPE_(GC_MODEL_BITSIZE)
@@ -28,5 +26,3 @@
objptr pointerToObjptr (pointer P, pointer B);
pointer fetchObjptrToPointer (pointer OP, pointer B);
void storeObjptrFromPointer (pointer OP, pointer P, pointer B);
-
-#endif /* (defined (MLTON_GC_INTERNAL)) */
|
|
From: Stephen W. <sw...@ml...> - 2005-11-10 16:14:38
|
Hid the mistakenly exposed fact that {Bin,Text}IO.outstream is an
equality type.
----------------------------------------------------------------------
U mlton/trunk/basis-library/io/imperative-io.fun
U mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
U mlton/trunk/basis-library/mlton/bin-io.sig
U mlton/trunk/basis-library/mlton/text-io.sig
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/io/imperative-io.fun
===================================================================
--- mlton/trunk/basis-library/io/imperative-io.fun 2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/io/imperative-io.fun 2005-11-11 00:14:33 UTC (rev 4195)
@@ -77,19 +77,37 @@
(* outstream *)
(* ------------------------------------------------- *)
-datatype outstream = Out of SIO.outstream ref
+(* The following :> hides the fact that Outstream.t is an eqtype. Doing it
+ * here is much easier than putting :> on the functor result.
+ *)
+structure Outstream:>
+ sig
+ type t
-fun output (Out os, v) = SIO.output (!os, v)
-fun output1 (Out os, v) = SIO.output1 (!os, v)
-fun outputSlice (Out os, v) = SIO.outputSlice (!os, v)
-fun flushOut (Out os) = SIO.flushOut (!os)
-fun closeOut (Out os) = SIO.closeOut (!os)
-fun mkOutstream os = Out (ref os)
-fun getOutstream (Out os) = !os
-fun setOutstream (Out os, os') = os := os'
-fun getPosOut (Out os) = SIO.getPosOut (!os)
-fun setPosOut (Out os, outPos) = os := SIO.setPosOut outPos
+ val get: t -> SIO.outstream
+ val make: SIO.outstream -> t
+ val set: t * SIO.outstream -> unit
+ end =
+ struct
+ datatype t = T of SIO.outstream ref
+ fun get (T r) = !r
+ fun set (T r, s) = r := s
+ fun make s = T (ref s)
+ end
+
+type outstream = Outstream.t
+fun output (os, v) = SIO.output (Outstream.get os, v)
+fun output1 (os, v) = SIO.output1 (Outstream.get os, v)
+fun outputSlice (os, v) = SIO.outputSlice (Outstream.get os, v)
+fun flushOut os = SIO.flushOut (Outstream.get os)
+fun closeOut os = SIO.closeOut (Outstream.get os)
+val mkOutstream = Outstream.make
+val getOutstream = Outstream.get
+val setOutstream = Outstream.set
+val getPosOut = SIO.getPosOut o Outstream.get
+fun setPosOut (os, outPos) = Outstream.set (os, SIO.setPosOut outPos)
+
fun newOut {appendMode, bufferMode, closeAtExit, fd, name} =
let
val writer = mkWriter {appendMode = appendMode,
Modified: mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2005-11-11 00:14:33 UTC (rev 4195)
@@ -622,6 +622,10 @@
sharing type Word64VectorSlice.vector = Word64Vector.vector
sharing type Word64Array2.elem = Word64.word
sharing type Word64Array2.vector = Word64Vector.vector
+ sharing type MLton.BinIO.instream = BinIO.instream
+ sharing type MLton.BinIO.outstream = BinIO.outstream
+ sharing type MLton.TextIO.instream = TextIO.instream
+ sharing type MLton.TextIO.outstream = TextIO.outstream
end
(* bool is already defined as bool and so cannot be shared.
* So, we where these to get the needed sharing.
@@ -696,6 +700,9 @@
where type Word8ArraySlice.vector_slice = Word8ArraySlice.vector_slice
where type Word8Vector.vector = Word8Vector.vector
+ where type 'a MLton.Thread.t = 'a MLton.Thread.t
+ where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
+
(* Types that must be exposed because constants denote them. *)
where type Int1.int = Int1.int
where type Int2.int = Int2.int
@@ -765,6 +772,3 @@
where type Word31.word = Word31.word
where type Word32.word = Word32.word
where type Word64.word = Word64.word
-
- where type 'a MLton.Thread.t = 'a MLton.Thread.t
- where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
Modified: mlton/trunk/basis-library/mlton/bin-io.sig
===================================================================
--- mlton/trunk/basis-library/mlton/bin-io.sig 2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/mlton/bin-io.sig 2005-11-11 00:14:33 UTC (rev 4195)
@@ -5,7 +5,5 @@
* See the file MLton-LICENSE for details.
*)
-signature MLTON_BIN_IO =
- MLTON_IO
- where type instream = BinIO.instream
- where type outstream = BinIO.outstream
+signature MLTON_BIN_IO = MLTON_IO
+
Modified: mlton/trunk/basis-library/mlton/text-io.sig
===================================================================
--- mlton/trunk/basis-library/mlton/text-io.sig 2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/mlton/text-io.sig 2005-11-11 00:14:33 UTC (rev 4195)
@@ -6,7 +6,4 @@
* See the file MLton-LICENSE for details.
*)
-signature MLTON_TEXT_IO =
- MLTON_IO
- where type instream = TextIO.instream
- where type outstream = TextIO.outstream
+signature MLTON_TEXT_IO = MLTON_IO
|
|
From: Stephen W. <sw...@ml...> - 2005-11-10 15:37:18
|
Fixed bug -- disabled tuple reconstruction if the reconstructed tuple
has mutable fields.
----------------------------------------------------------------------
U mlton/trunk/mlton/ssa/shrink2.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/ssa/shrink2.fun
===================================================================
--- mlton/trunk/mlton/ssa/shrink2.fun 2005-11-10 20:27:08 UTC (rev 4193)
+++ mlton/trunk/mlton/ssa/shrink2.fun 2005-11-10 23:37:14 UTC (rev 4194)
@@ -1202,12 +1202,19 @@
| Object {args, con} =>
let
val args = varInfos args
+ val isMutable =
+ case Type.dest ty of
+ Type.Object {args, ...} => Prod.isMutable args
+ | _ => Error.bug "strange Object type"
in
- if isSome con
- then
- construct (Value.Object {args = args, con = con},
- fn () => Object {args = uses args,
- con = con})
+ (* It would be nice to improve this code to do
+ * reconstruction when isSome con, not just for
+ * tuples.
+ *)
+ if isMutable orelse isSome con then
+ construct (Value.Object {args = args, con = con},
+ fn () => Object {args = uses args,
+ con = con})
else tuple args
end
| PrimApp {args, prim} =>
|
|
From: Matthew F. <fl...@ml...> - 2005-11-10 12:27:10
|
Record Time.scan bugfix in changelog ---------------------------------------------------------------------- U mlton/trunk/doc/changelog ---------------------------------------------------------------------- Modified: mlton/trunk/doc/changelog =================================================================== --- mlton/trunk/doc/changelog 2005-11-10 20:04:43 UTC (rev 4192) +++ mlton/trunk/doc/changelog 2005-11-10 20:27:08 UTC (rev 4193) @@ -1,5 +1,11 @@ Here are the changes since version 20041109. +* 2005-11-10 + - Fixed two bugs in Time.scan. One would raise Time on a string with a + large fractional component. Thanks to Carsten Varming for the bug + report. The other failed to scan strings with an explicit sign + followed by a decimal point. + * 2005-11-03 - Removed MLton.GC.setRusage. - Added MLton.Rusage.measureGC. |
|
From: Matthew F. <fl...@ml...> - 2005-11-10 12:04:46
|
Fixed two bugs in Time.scan.
* An Overflow exception (manifesting as a Time exception) in the
calculation of nanoseconds from fractional seconds. Reported by
va...@it....
* Noticed a latent bug whereby "~.417" was not scanned.
----------------------------------------------------------------------
U mlton/trunk/basis-library/system/time.sml
A mlton/trunk/regression/time4.ok
A mlton/trunk/regression/time4.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/system/time.sml
===================================================================
--- mlton/trunk/basis-library/system/time.sml 2005-11-10 17:53:04 UTC (rev 4191)
+++ mlton/trunk/basis-library/system/time.sml 2005-11-10 20:04:43 UTC (rev 4192)
@@ -92,6 +92,7 @@
val toString = fmt 3
(* Adapted from the ML Kit 4.1.4; basislib/Time.sml
+ * by mf...@ac... on 2005-11-10 based on
* by mf...@ac... on 2005-8-10 based on
* adaptations from the ML Kit 3 Version; basislib/Time.sml
* by sw...@re... on 1999-1-3.
@@ -103,10 +104,14 @@
| pow10 n = 10 * pow10 (n-1)
fun mkTime sign intv fracv decs =
let
- val nsec = (pow10 (10-decs) * fracv + 5) div 10
+ val nsec =
+ LargeInt.div (LargeInt.+ (LargeInt.* (Int.toLarge (pow10 (10 - decs)),
+ Int.toLarge fracv),
+ 5),
+ 10)
val t =
LargeInt.+ (LargeInt.* (Int.toLarge intv, ticksPerSecond),
- Int.toLarge nsec)
+ nsec)
val t = if sign then t else LargeInt.~ t
in
T t
@@ -139,6 +144,7 @@
fun int sign src =
case getc src of
NONE => NONE
+ | SOME (#".", rest) => frac sign 0 rest
| SOME (c, rest) =>
(case charToDigit c of
NONE => NONE
Added: mlton/trunk/regression/time4.ok
===================================================================
--- mlton/trunk/regression/time4.ok 2005-11-10 17:53:04 UTC (rev 4191)
+++ mlton/trunk/regression/time4.ok 2005-11-10 20:04:43 UTC (rev 4192)
@@ -0,0 +1,8 @@
+0.417
+0.999
+0.417
+0.999
+~0.417
+~0.999
+~0.417
+~0.999
Added: mlton/trunk/regression/time4.sml
===================================================================
--- mlton/trunk/regression/time4.sml 2005-11-10 17:53:04 UTC (rev 4191)
+++ mlton/trunk/regression/time4.sml 2005-11-10 20:04:43 UTC (rev 4192)
@@ -0,0 +1,24 @@
+
+val t = valOf (Time.fromString "0.417")
+val () = print (concat [Time.toString t, "\n"])
+
+val t = valOf (Time.fromString "0.999")
+val () = print (concat [Time.toString t, "\n"])
+
+val t = valOf (Time.fromString ".417")
+val () = print (concat [Time.toString t, "\n"])
+
+val t = valOf (Time.fromString ".999")
+val () = print (concat [Time.toString t, "\n"])
+
+val t = valOf (Time.fromString "~0.417")
+val () = print (concat [Time.toString t, "\n"])
+
+val t = valOf (Time.fromString "~0.999")
+val () = print (concat [Time.toString t, "\n"])
+
+val t = valOf (Time.fromString "~.417")
+val () = print (concat [Time.toString t, "\n"])
+
+val t = valOf (Time.fromString "~.999")
+val () = print (concat [Time.toString t, "\n"])
|
|
From: Stephen W. <sw...@ml...> - 2005-11-10 09:53:05
|
Took out unnecessary "-codegen c". ---------------------------------------------------------------------- U mlton/trunk/doc/examples/ffi/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/doc/examples/ffi/Makefile =================================================================== --- mlton/trunk/doc/examples/ffi/Makefile 2005-11-10 17:46:08 UTC (rev 4190) +++ mlton/trunk/doc/examples/ffi/Makefile 2005-11-10 17:53:04 UTC (rev 4191) @@ -8,7 +8,7 @@ PATH = ../../../build/bin:$(shell echo $$PATH) -mlton = mlton -default-ann 'allowFFI true' -codegen c +mlton = mlton -default-ann 'allowFFI true' .PHONY: all all: import import2 export iimport test_quot |
|
From: Stephen W. <sw...@ml...> - 2005-11-10 09:46:10
|
Tagged experimental release. ---------------------------------------------------------------------- A mlton/tags/on-20051109-release/ ---------------------------------------------------------------------- Copied: mlton/tags/on-20051109-release (from rev 4189, mlton/trunk) |
|
From: Stephen W. <sw...@ml...> - 2005-11-10 09:44:53
|
New debian package. ---------------------------------------------------------------------- U mlton/trunk/package/debian/changelog ---------------------------------------------------------------------- Modified: mlton/trunk/package/debian/changelog =================================================================== --- mlton/trunk/package/debian/changelog 2005-11-10 04:17:46 UTC (rev 4188) +++ mlton/trunk/package/debian/changelog 2005-11-10 17:44:52 UTC (rev 4189) @@ -1,3 +1,9 @@ +mlton (20051109-1) unstable; urgency=low + + * new upstream version + + -- Stephen Weeks <sw...@sw...> Wed, 09 Nov 2005 18:47:04 -0800 + mlton (20051102-1) unstable; urgency=low * new upstream version |
|
From: Matthew F. <fl...@ml...> - 2005-11-09 20:17:49
|
Discovered bug in the reinterpretation of crossMap as byte-offset
rather than word-offset. Since the crossMap entry at s->heap.start is
the only object allowed to have an offset of 0, every other crossMap
entry for which an object falls on the card boundary yields a
CARD_SIZE offset, which conflicts with CROSS_MAP_ENTRY.
Haven't fixed the bug; I guess I'll go back to scaling the offset by
4.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-11-10 03:39:08 UTC (rev 4187)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2005-11-10 04:17:46 UTC (rev 4188)
@@ -28,7 +28,8 @@
fprintf (stderr, "crossMap trues\n");
for (i = 0; i < generational->crossMapLength; i++)
unless (CROSS_MAP_EMPTY == generational->crossMap[i])
- fprintf (stderr, "\t"FMTCMI"\n", i);
+ fprintf (stderr, "\t"FMTCMI" "FMTCME"\n",
+ i, generational->crossMap[i]);
fprintf (stderr, "\n");
}
}
@@ -215,6 +216,10 @@
pointer nextObject, objectStart;
pointer oldGenEnd;
+ if (DEBUG_GENERATIONAL) {
+ fprintf (stderr, "updateCrossMap starting\n");
+ displayGenerationalMaps (s, &s->generationalMaps, stderr);
+ }
if (s->generationalMaps.crossMapValidSize == s->heap.oldGenSize)
goto done;
oldGenEnd = s->heap.start + s->heap.oldGenSize;
@@ -231,6 +236,17 @@
assert ((objectStart == s->heap.start or cardStart < objectStart)
and objectStart <= cardEnd);
nextObject = objectStart + sizeofObject (s, advanceToObjectData (s, objectStart));
+ if (DEBUG_GENERATIONAL) {
+ fprintf (stderr,
+ "\tloopObjects:\n"
+ "\t cardIndex = "FMTCMI"\n"
+ "\t cardStart = "FMTPTR"\n"
+ "\t cardEnd = "FMTPTR"\n"
+ "\tobjectStart = "FMTPTR"\n"
+ "\t nextObject = "FMTPTR"\n",
+ cardIndex, (uintptr_t)cardStart, (uintptr_t)cardEnd,
+ (uintptr_t)objectStart, (uintptr_t)nextObject);
+ }
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.
@@ -257,4 +273,8 @@
done:
assert (s->generationalMaps.crossMapValidSize == s->heap.oldGenSize);
assert (isCrossMapOk (s));
+ if (DEBUG_GENERATIONAL) {
+ fprintf (stderr, "updateCrossMap finished\n");
+ displayGenerationalMaps (s, &s->generationalMaps, stderr);
+ }
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-11-10 03:39:08 UTC (rev 4187)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2005-11-10 04:17:46 UTC (rev 4188)
@@ -18,6 +18,7 @@
#define CROSS_MAP_ELEM_SIZE sizeof(GC_crossMapElem)
#define CROSS_MAP_EMPTY ((GC_crossMapElem)255)
#define FMTCMI "%zu"
+#define FMTCME "%"PRIu8
struct GC_generationalMaps {
/* cardMap is an array with cardinality equal to the size of the
|
|
From: Matthew F. <fl...@ml...> - 2005-11-09 19:39:10
|
Fixed bug in mark-compact
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-11-09 20:11:26 UTC (rev 4186)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-11-10 03:39:08 UTC (rev 4187)
@@ -23,7 +23,7 @@
#define PRIxARRLEN PRIu32
#define FMTARRLEN "%"PRIxARRLEN
typedef GC_arrayLength GC_arrayCounter;
-#define GC_ARRAY_COUNTER_SIZE GC_ARRAY_LENGTH_SIZE
+#define GC_ARRAY_COUNTER_SIZE sizeof(GC_arrayCounter)
#define PRIxARRCTR PRIu32
#define FMTARRCTR "%"PRIxARRCTR
#define GC_ARRAY_HEADER_SIZE (GC_ARRAY_COUNTER_SIZE + GC_ARRAY_LENGTH_SIZE + GC_HEADER_SIZE)
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-11-09 20:11:26 UTC (rev 4186)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-11-10 03:39:08 UTC (rev 4187)
@@ -128,6 +128,7 @@
fprintf (stderr, "threading "FMTPTR" of size %zu\n",
(uintptr_t)p, size);
if ((size_t)(front - endOfLastMarked) >= GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE) {
+ pointer newArray = endOfLastMarked;
/* Compress all of the unmarked into one vector. We require
* (GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE) space to be available
* because that is the smallest possible array. You cannot
@@ -141,11 +142,12 @@
fprintf (stderr, "compressing from "FMTPTR" to "FMTPTR" (length = %zu)\n",
(uintptr_t)endOfLastMarked, (uintptr_t)front,
(size_t)(front - endOfLastMarked));
- *((GC_arrayCounter*)(endOfLastMarked)) = 0;
- endOfLastMarked = endOfLastMarked + GC_ARRAY_COUNTER_SIZE;
- *((GC_arrayLength*)(endOfLastMarked)) = ((size_t)(front - endOfLastMarked)) - GC_ARRAY_HEADER_SIZE;
- endOfLastMarked = endOfLastMarked + GC_ARRAY_LENGTH_SIZE;
- *((GC_header*)(endOfLastMarked)) = GC_WORD8_VECTOR_HEADER;
+ *((GC_arrayCounter*)(newArray)) = 0;
+ newArray += GC_ARRAY_COUNTER_SIZE;
+ *((GC_arrayLength*)(newArray)) =
+ ((size_t)(front - endOfLastMarked)) - GC_ARRAY_HEADER_SIZE;
+ newArray += GC_ARRAY_LENGTH_SIZE;
+ *((GC_header*)(newArray)) = GC_WORD8_VECTOR_HEADER;
}
front += size;
endOfLastMarked = front;
|
|
From: Stephen W. <sw...@ml...> - 2005-11-09 12:11:27
|
Added a script to replace calls to bash with calls to sh, for use on MinGW where there is no bash. ---------------------------------------------------------------------- A mlton/trunk/bin/patch-mingw ---------------------------------------------------------------------- Added: mlton/trunk/bin/patch-mingw =================================================================== --- mlton/trunk/bin/patch-mingw 2005-11-09 03:56:08 UTC (rev 4185) +++ mlton/trunk/bin/patch-mingw 2005-11-09 20:11:26 UTC (rev 4186) @@ -0,0 +1,13 @@ +#!/usr/bin/env sh + +set -e + +dir=`dirname $0` + +for f in `find "$dir" -type f | grep -v '\.svn' | grep -v '~'`; do + if head -n 1 "$f" | grep -q '#!/usr/bin/env bash'; then + echo "Processing $f" + sed 's;#!/usr/bin/env bash;#!/usr/bin/env sh;' <$f >.tmp; + mv .tmp $f; + fi +done Property changes on: mlton/trunk/bin/patch-mingw ___________________________________________________________________ Name: svn:executable + * |
