[MLton-devel] cvs commit: -runtime and PackReal*
Stephen Weeks
sweeks@users.sourceforge.net
Thu, 28 Aug 2003 17:25:21 -0700
sweeks 03/08/28 17:25:21
Modified: basis-library/integer pack-word.sig pack32.sml
basis-library/libs/basis-2002/top-level basis.sig basis.sml
basis-library/misc primitive.sml
basis-library/real pack-real.sml real.fun
doc changelog
doc/user-guide basis.tex man-page.tex
include c-main.h main.h x86-main.h
man mlton.1
mlton/codegen/c-codegen c-codegen.fun
mlton/control control.sig control.sml
mlton/main main.sml
regression pack-real.sml
runtime Makefile gc.c gc.h
runtime/basis/PackReal subVec.c update.c
Added: regression pack-real.ok
runtime/basis/Int Word8Array.c Word8Vector.c
Log:
Added PackReal{,64}Big, PackReal32{Big,Little}.
Fixed PackReal{,64}Little to work correctly on Sparc.
Added -runtime switch, which passes arguments to the runtime via
@MLton. These arguments are processed before command line switches.
Eliminated MLton switch -may-load-world. Can use -runtime combined
with new runtime switch -no-load-world to disable load world in an
executable.
Improved the implementation of Pack32{Big,Little} to avoid the
bit twiddling reversal when the machin endianness is different than
the pack endianness.
Added a new implementation of Real.toLargetInt that uses
Real.toDecimal followed by IntInf.fromString. It is much more
obviously correct, although possibly a bit slower. I plan to do
something similar for Real.fromLargeInt soon.
Cleaned up the runtime @MLton argument checking to be more robust in
the presence of errors.
Revision Changes Path
1.3 +2 -2 mlton/basis-library/integer/pack-word.sig
Index: pack-word.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/pack-word.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- pack-word.sig 10 Apr 2003 01:42:19 -0000 1.2
+++ pack-word.sig 29 Aug 2003 00:25:19 -0000 1.3
@@ -2,9 +2,9 @@
sig
val bytesPerElem: int
val isBigEndian: bool
- val subVec: Word8Vector.vector * int -> LargeWord.word
- val subVecX: Word8Vector.vector * int -> LargeWord.word
val subArr: Word8Array.array * int -> LargeWord.word
val subArrX: Word8Array.array * int -> LargeWord.word
+ val subVec: Word8Vector.vector * int -> LargeWord.word
+ val subVecX: Word8Vector.vector * int -> LargeWord.word
val update: Word8Array.array * int * LargeWord.word -> unit
end
1.9 +53 -50 mlton/basis-library/integer/pack32.sml
Index: pack32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/pack32.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- pack32.sml 26 Aug 2003 20:36:43 -0000 1.8
+++ pack32.sml 29 Aug 2003 00:25:19 -0000 1.9
@@ -6,58 +6,61 @@
* Please see the file MLton-LICENSE for license information.
*)
-functor Pack (val isBigEndian: bool): PACK_WORD =
- struct
- val bytesPerElem: int = 4
- val isBigEndian = isBigEndian
-
- fun revWord (w: word): word =
- let
- open Word
- in
- orb (orb (orb (andb (>> (w, 0w8), 0wxFF00),
- andb(<< (w, 0w8), 0wxFF0000)),
- >> (w, 0w24)),
- << (w, 0w24))
- end
-
- fun maybeRev w =
- if isBigEndian = Primitive.MLton.Platform.Arch.isBigEndian
- then w
- else revWord w
-
- fun start (i, n) =
- let
- val i = bytesPerElem * i
- val _ =
- if Primitive.safe andalso Int.geu (i + (bytesPerElem - 1), n)
- then raise Subscript
- else ()
- in
- i
- end handle Overflow => raise Subscript
-
- local
- fun make (sub, length) (av, i) =
- let
- val _ = start (i, length av)
- in
- maybeRev (sub (av, i))
- end
+functor Pack (S: sig
+ val isBigEndian: bool
+ end): PACK_WORD =
+struct
+
+open S
+
+val bytesPerElem: int = 4
+
+val isBigEndian = isBigEndian
+
+val (sub, up, subV) =
+ if isBigEndian = Primitive.MLton.Platform.Arch.isBigEndian
+ then (Primitive.Word8Array.subWord,
+ Primitive.Word8Array.updateWord,
+ Primitive.Word8Vector.subWord)
+ else (Primitive.Word8Array.subWordRev,
+ Primitive.Word8Array.updateWordRev,
+ Primitive.Word8Vector.subWordRev)
+
+fun start (i, n) =
+ let
+ val i = bytesPerElem * i
+ val _ =
+ if Primitive.safe andalso Int.geu (i + (bytesPerElem - 1), n)
+ then raise Subscript
+ else ()
+ in
+ i
+ end handle Overflow => raise Subscript
+
+local
+ fun make (sub, length) (av, i) =
+ let
+ val _ = start (i, length av)
in
- val subArr = make (Primitive.Word8Array.subWord, Word8Array.length)
- val subArrX = subArr
- val subVec = make (Primitive.Word8Vector.subWord, Word8Vector.length)
- val subVecX = subVec
+ sub (av, i)
end
+in
+ val subArr = make (sub, Word8Array.length)
+ val subArrX = subArr
+ val subVec = make (subV, Word8Vector.length)
+ val subVecX = subVec
+end
- fun update (a, i, w) =
- let
- val _ = start (i, Array.length a)
- in
- Primitive.Word8Array.updateWord (a, i, maybeRev w)
- end
+fun update (a, i, w) =
+ let
+ val _ = start (i, Array.length a)
+ in
+ up (a, i, w)
end
-structure Pack32Big = Pack (val isBigEndian = true)
-structure Pack32Little = Pack (val isBigEndian = false)
+end
+
+structure Pack32Big = Pack (val isBigEndian = true
+ open Primitive.Word8Array)
+structure Pack32Little = Pack (val isBigEndian = false
+ open Primitive.Word8Array)
1.13 +4 -6 mlton/basis-library/libs/basis-2002/top-level/basis.sig
Index: basis.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sig,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- basis.sig 25 Jul 2003 20:14:46 -0000 1.12
+++ basis.sig 29 Aug 2003 00:25:19 -0000 1.13
@@ -173,14 +173,12 @@
structure NetServDB : NET_SERV_DB
structure Pack32Big : PACK_WORD
structure Pack32Little : PACK_WORD
-(*
- structure PackRealBig : PACK_REAL
-*)
- structure PackRealLittle : PACK_REAL
-(*
+ structure PackReal32Big : PACK_REAL
+ structure PackReal32Little : PACK_REAL
structure PackReal64Big : PACK_REAL
-*)
structure PackReal64Little : PACK_REAL
+ structure PackRealBig : PACK_REAL
+ structure PackRealLittle : PACK_REAL
structure Posix : POSIX
structure RealArray : MONO_ARRAY
structure RealArraySlice : MONO_ARRAY_SLICE
1.11 +4 -6 mlton/basis-library/libs/basis-2002/top-level/basis.sml
Index: basis.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- basis.sml 26 Jun 2003 14:08:47 -0000 1.10
+++ basis.sml 29 Aug 2003 00:25:19 -0000 1.11
@@ -92,14 +92,12 @@
structure NetServDB = NetServDB
structure Pack32Big = Pack32Big
structure Pack32Little = Pack32Little
-(*
- structure PackRealBig = PackRealBig
-*)
- structure PackRealLittle = PackRealLittle
-(*
+ structure PackReal32Big = PackReal32Big
+ structure PackReal32Little = PackReal32Little
structure PackReal64Big = PackReal64Big
-*)
structure PackReal64Little = PackReal64Little
+ structure PackRealBig = PackRealBig
+ structure PackRealLittle = PackRealLittle
structure Posix = Posix
structure RealArray = Real64Array
structure RealArraySlice = Real64ArraySlice
1.73 +28 -3 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -r1.72 -r1.73
--- primitive.sml 26 Aug 2003 20:36:43 -0000 1.72
+++ primitive.sml 29 Aug 2003 00:25:20 -0000 1.73
@@ -699,11 +699,30 @@
end
end
- structure PackReal =
+ structure PackReal32 =
struct
- val subVec = _import "PackReal_subVec": word8 vector * int -> real;
+ type real = Real32.real
+
+ val subVec = _import "PackReal32_subVec": word8 vector * int -> real;
+ val subVecRev =
+ _import "PackReal32_subVecRev": word8 vector * int -> real;
+ val update =
+ _import "PackReal32_update": word8 array * int * real -> unit;
+ val updateRev =
+ _import "PackReal32_updateRev": word8 array * int * real -> unit;
+ end
+
+ structure PackReal64 =
+ struct
+ type real = Real64.real
+
+ val subVec = _import "PackReal64_subVec": word8 vector * int -> real;
+ val subVecRev =
+ _import "PackReal64_subVecRev": word8 vector * int -> real;
val update =
- _import "PackReal_update": word8 array * int * real -> unit;
+ _import "PackReal64_update": word8 array * int * real -> unit;
+ val updateRev =
+ _import "PackReal64_updateRev": word8 array * int * real -> unit;
end
structure Ptrace =
@@ -1153,14 +1172,20 @@
struct
val subWord =
_prim "Word8Array_subWord": word8 array * int -> word;
+ val subWordRev =
+ _import "Word8Array_subWord32Rev": word8 array * int -> word;
val updateWord =
_prim "Word8Array_updateWord": word8 array * int * word -> unit;
+ val updateWordRev =
+ _import "Word8Array_updateWord32Rev": word8 array * int * word -> unit;
end
structure Word8Vector =
struct
val subWord =
_prim "Word8Vector_subWord": word8 vector * int -> word;
+ val subWordRev =
+ _import "Word8Vector_subWord32Rev": word8 vector * int -> word;
end
structure Word16 =
1.5 +35 -9 mlton/basis-library/real/pack-real.sml
Index: pack-real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/pack-real.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- pack-real.sml 24 Nov 2002 01:19:39 -0000 1.4
+++ pack-real.sml 29 Aug 2003 00:25:20 -0000 1.5
@@ -1,28 +1,36 @@
-structure PackReal64Little: PACK_REAL =
+functor PackReal (S: sig
+ type real
+ val bytesPerElem: int
+ val isBigEndian: bool
+ val subVec: word8 vector * int -> real
+ val subVecRev: word8 vector * int -> real
+ val update: word8 array * int * real -> unit
+ val updateRev: word8 array * int * real -> unit
+ end): PACK_REAL =
struct
-structure Prim = Primitive.PackReal
+open S
-type real = real
-
-val bytesPerElem: int = 8
-val isBigEndian = false
+val (sub, up) =
+ if isBigEndian = Primitive.MLton.Platform.Arch.isBigEndian
+ then (subVec, update)
+ else (subVecRev, updateRev)
fun update (a, i, r) =
(Array.checkSlice (a, i, SOME bytesPerElem)
- ; Prim.update (a, i, r))
+ ; up (a, i, r))
local
val a = Word8Array.array (bytesPerElem, 0w0)
in
fun toBytes (r: real): Word8Vector.vector =
- (Prim.update (a, 0, r)
+ (up (a, 0, r)
; Byte.stringToBytes (Byte.unpackString (a, 0, NONE)))
end
fun subVec (v, i) =
(Vector.checkSlice (v, i, SOME bytesPerElem)
- ; Prim.subVec (v, i))
+ ; sub (v, i))
fun fromBytes v = subVec (v, 0)
@@ -30,4 +38,22 @@
end
+structure PackReal32Big: PACK_REAL =
+ PackReal (val bytesPerElem: int = 4
+ val isBigEndian = true
+ open Primitive.PackReal32)
+structure PackReal32Little: PACK_REAL =
+ PackReal (val bytesPerElem: int = 4
+ val isBigEndian = false
+ open Primitive.PackReal32)
+structure PackReal64Big: PACK_REAL =
+ PackReal (val bytesPerElem: int = 8
+ val isBigEndian = true
+ open Primitive.PackReal64)
+structure PackReal64Little: PACK_REAL =
+ PackReal (val bytesPerElem: int = 8
+ val isBigEndian = false
+ open Primitive.PackReal64)
+
+structure PackRealBig = PackReal64Big
structure PackRealLittle = PackReal64Little
1.5 +26 -2 mlton/basis-library/real/real.fun
Index: real.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- real.fun 26 Aug 2003 20:36:44 -0000 1.4
+++ real.fun 29 Aug 2003 00:25:20 -0000 1.5
@@ -602,7 +602,7 @@
| General.EQUAL => zero
| General.GREATER => pos (i, mode)
end
-
+
val toLargeInt: IEEEReal.rounding_mode -> real -> IntInf.int =
fn mode => fn x =>
(IntInf.fromInt (toInt mode x)
@@ -651,4 +651,28 @@
else IntInf.~ (pos (~ x, negateMode mode))
end)
end
- end
+
+ val toLargeInt: IEEEReal.rounding_mode -> real -> LargeInt.int =
+ fn mode => fn x =>
+ case class x of
+ INF => raise Overflow
+ | NAN => raise Domain
+ | ZERO => IntInf.fromInt 0
+ | _ =>
+ IntInf.fromInt (toInt mode x)
+ handle Overflow =>
+ let
+ val x =
+ IEEEReal.withRoundingMode (mode, fn () => Prim.round x)
+ val {digits, exp, sign, ...} = toDecimal x
+ val i =
+ valOf
+ (IntInf.fromString
+ (implode (List.map (fn d =>
+ Char.chr (Int.+ (d, Char.ord #"0")))
+ digits)))
+ val i = if sign then IntInf.~ i else i
+ in
+ IntInf.* (i, IntInf.pow (IntInf.fromInt 10, exp))
+ end
+ end
1.66 +10 -0 mlton/doc/changelog
Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- changelog 27 Aug 2003 21:13:31 -0000 1.65
+++ changelog 29 Aug 2003 00:25:20 -0000 1.66
@@ -1,5 +1,15 @@
Here are the changes since version 20030716.
+* 2003-08-28
+ - Fixed PackReal{,64}Little to work correctly on Sparc.
+ - Added PackReal{,64}Big, PackReal32{Big,Little}.
+ - Added -runtime switch, which passes arguments to the runtime via
+ @MLton. These arguments are processed before command line
+ switches.
+ - Eliminated MLton switch -may-load-world. Can use -runtime
+ combined with new runtime switch -no-load-world to disable load
+ world in an executable.
+
* 2003-08-26
- Changed -host to -target.
- Split MLton.Platform.{arch,os} into MLton.Platform.{Arch,OS}.t.
1.25 +5 -1 mlton/doc/user-guide/basis.tex
Index: basis.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/basis.tex,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- basis.tex 17 Aug 2003 00:28:29 -0000 1.24
+++ basis.tex 29 Aug 2003 00:25:20 -0000 1.25
@@ -249,8 +249,12 @@
\fullmodule{Option}{OPTION}
\fullmodule{Pack32Big}{PACK\_WORD}
\fullmodule{Pack32Little}{PACK\_WORD}
-\fullmodule{PackRealLittle}{PACK\_REAL}
+\fullmodule{PackReal32Big}{PACK\_REAL}
+\fullmodule{PackReal32Little}{PACK\_REAL}
+\fullmodule{PackReal64Big}{PACK\_REAL}
\fullmodule{PackReal64Little}{PACK\_REAL}
+\fullmodule{PackRealBig}{PACK\_REAL}
+\fullmodule{PackRealLittle}{PACK\_REAL}
\fullmodule{Position}{INTEGER}
\fullmodule{Posix}{POSIX}
\fullmodule{Real}{REAL}
1.39 +10 -0 mlton/doc/user-guide/man-page.tex
Index: man-page.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/man-page.tex,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- man-page.tex 27 Aug 2003 21:13:31 -0000 1.38
+++ man-page.tex 29 Aug 2003 00:25:20 -0000 1.39
@@ -133,6 +133,12 @@
If true, the profiler will count the time spent (or bytes allocated)
while a function is on the stack.
+\option{-runtime {\it arg}}
+Pass argument to the runtime via {\tt @MLton}. The argument will be
+processed before other {\tt @MLton} command line switches. Multiple
+uses of {\tt -runtime} are allowed, and will pass all the arguments in
+order.
+
\option{-safe \trueFalse}
This switch determines the value of the SML variable {\tt MLton.safe},
which controls whether the basis library performs array, string, and
@@ -224,6 +230,10 @@
Run the computation with an automatically resized heap that is never
larger than n. The meaning of [{\tt km}] is the same as with the
{\tt fixed-heap} option.
+
+\option{no-load-world}
+Disable {\tt load-world}. Can use this with the {\tt -runtime}
+compiler switch to prevent executables from loading a world.
\option{ram-slop {\mbox{\rm x}}}
Multiply {\tt x} by the amount of RAM on the machine to obtain what
1.7 +2 -2 mlton/include/c-main.h
Index: c-main.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-main.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- c-main.h 5 Jul 2003 23:30:25 -0000 1.6
+++ c-main.h 29 Aug 2003 00:25:20 -0000 1.7
@@ -4,7 +4,7 @@
#include "main.h"
#include "c-common.h"
-#define Main(al, cs, mg, mfs, mlw, mmc, ps, mc, ml) \
+#define Main(al, cs, mg, mfs, mmc, ps, mc, ml) \
/* Globals */ \
int nextFun; \
bool returnToC; \
@@ -34,7 +34,7 @@
int main (int argc, char **argv) { \
struct cont cont; \
gcState.native = FALSE; \
- Initialize (al, cs, mg, mfs, mlw, mmc, ps); \
+ Initialize (al, cs, mg, mfs, mmc, ps); \
if (gcState.isOriginal) { \
real_Init(); \
PrepFarJump(mc, ml); \
1.7 +3 -2 mlton/include/main.h
Index: main.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/main.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- main.h 16 Aug 2003 20:13:46 -0000 1.6
+++ main.h 29 Aug 2003 00:25:20 -0000 1.7
@@ -20,8 +20,10 @@
#define LoadArray(a, f) sfread (a, sizeof(*a), cardof(a), f)
#define SaveArray(a, fd) swrite (fd, a, sizeof(*a) * cardof(a))
-#define Initialize(al, cs, mg, mfs, mlw, mmc, ps) \
+#define Initialize(al, cs, mg, mfs, mmc, ps) \
gcState.alignment = al; \
+ gcState.atMLtons = atMLtons; \
+ gcState.atMLtonsSize = cardof(atMLtons); \
gcState.cardSizeLog2 = cs; \
gcState.frameLayouts = frameLayouts; \
gcState.frameLayoutsSize = cardof(frameLayouts); \
@@ -34,7 +36,6 @@
gcState.loadGlobals = loadGlobals; \
gcState.magic = mg; \
gcState.maxFrameSize = mfs; \
- gcState.mayLoadWorld = mlw; \
gcState.mutatorMarksCards = mmc; \
gcState.objectTypes = objectTypes; \
gcState.objectTypesSize = cardof(objectTypes); \
1.10 +2 -2 mlton/include/x86-main.h
Index: x86-main.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/x86-main.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- x86-main.h 22 Aug 2003 04:25:25 -0000 1.9
+++ x86-main.h 29 Aug 2003 00:25:20 -0000 1.10
@@ -43,7 +43,7 @@
#error ReturnToC not defined
#endif
-#define Main(al, cs, mg, mfs, mlw, mmc, ps, ml, reserveEsp) \
+#define Main(al, cs, mg, mfs, mmc, ps, ml, reserveEsp) \
void MLton_jumpToSML (pointer jump) { \
word lc_stackP; \
\
@@ -91,7 +91,7 @@
pointer jump; \
extern pointer ml; \
gcState.native = TRUE; \
- Initialize (al, cs, mg, mfs, mlw, mmc, ps); \
+ Initialize (al, cs, mg, mfs, mmc, ps); \
if (gcState.isOriginal) { \
real_Init(); \
jump = (pointer)&ml; \
1.35 +13 -6 mlton/man/mlton.1
Index: mlton.1
===================================================================
RCS file: /cvsroot/mlton/mlton/man/mlton.1,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- mlton.1 27 Aug 2003 21:13:31 -0000 1.34
+++ mlton.1 29 Aug 2003 00:25:20 -0000 1.35
@@ -109,11 +109,6 @@
syntax, e.g., \fB-link-opt '-Wl,--export-dynamic'\fP.
.TP
-\fB-may-load-world \fI{\fBtrue\fP|\fBfalse\fP}\fP
-Controls whether or not the generated executable supports the
-\fBload-world\fP runtime system option.
-
-.TP
\fB-native \fI{\fBtrue\fP|\fBfalse\fP}\fP
Controls whether or not to use native code generation as opposed to
generating C and using \fBgcc\fP. With native code generation,
@@ -139,6 +134,13 @@
while a function is on the stack.
.TP
+\fB-runtime \fIarg\fP\fP
+Pass argument to the runtime via \fB@MLton\fP. The argument will be
+processed before other \fB@MLton\fP command line switches. Multiple
+uses of \fB-runtime\fP are allowed, and will pass all the arguments in
+order.
+
+.TP
\fB-safe \fI{\fBtrue\fP|\fBfalse\fP}\fR
This switch determines the value of the SML variable \fBMLton.safe\fP, which
controls whether the basis library performs array, string, and vector bounds
@@ -218,7 +220,8 @@
Print a message at the start and end of every garbage collection.
.TP
\fBgc-summary\fP
-Print a summary of garbage collection statistics upon program termination.
+Print a summary of garbage collection statistics upon program
+termination.
.TP
\fBload-world \fIworld\fR
Restart the computation with the file \fIworld\fP.
@@ -230,6 +233,10 @@
than \fIn\fP.
The meaning of \fI[\fBkm\fI]\fR is the same as with the \fBfixed-heap\fP
option.
+.TP
+\fB-no-load-world\fP
+Disable \fBload-world\fP. Can use this with the \fB-runtime\fP
+compiler switch to prevent executables from loading a world.
.TP
\fBram-slop \fIx\fR
Multiply \fBx\fP by the amount of RAM on the machine to obtain what
1.67 +3 -1 mlton/mlton/codegen/c-codegen/c-codegen.fun
Index: c-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.fun,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -r1.66 -r1.67
--- c-codegen.fun 27 Aug 2003 21:13:32 -0000 1.66
+++ c-codegen.fun 29 Aug 2003 00:25:20 -0000 1.67
@@ -313,6 +313,8 @@
", ", C.int size,
", frameOffsets", C.int frameOffsetsIndex,
"}"])
+ fun declareAtMLtons () =
+ declareArray ("string", "atMLtons", !Control.atMLtons, C.string o #2)
fun declareObjectTypes () =
declareArray
("GC_ObjectType", "objectTypes", objectTypes,
@@ -351,7 +353,6 @@
C.int (!Control.cardSizeLog2),
magic,
C.int maxFrameSize,
- C.bool (!Control.mayLoadWorld),
C.bool (!Control.markCards),
C.bool (!Control.profileStack)]
@ additionalMainArgs,
@@ -403,6 +404,7 @@
; declareFrameLayouts ()
; declareObjectTypes ()
; declareProfileInfo ()
+ ; declareAtMLtons ()
; rest ()
; declareMain ()
end
1.80 +2 -0 mlton/mlton/control/control.sig
Index: control.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sig,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -r1.79 -r1.80
--- control.sig 27 Aug 2003 21:13:33 -0000 1.79
+++ control.sig 29 Aug 2003 00:25:20 -0000 1.80
@@ -20,6 +20,8 @@
datatype align = Align4 | Align8
val align: align ref
+
+ val atMLtons: string vector ref
val basisLibs: string list
val basisLibrary: string ref
1.97 +5 -0 mlton/mlton/control/control.sml
Index: control.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sml,v
retrieving revision 1.96
retrieving revision 1.97
diff -u -r1.96 -r1.97
--- control.sml 27 Aug 2003 21:13:33 -0000 1.96
+++ control.sml 29 Aug 2003 00:25:21 -0000 1.97
@@ -25,6 +25,11 @@
val align = control {name = "align",
default = Align4,
toString = Align.toString}
+
+val atMLtons = control {name = "atMLtons",
+ default = Vector.new0 (),
+ toString = fn v => Layout.toString (Vector.layout
+ String.layout v)}
val basisLibs = ["basis-2002", "basis-2002-strict", "basis-1997", "basis-none"]
1.156 +7 -3 mlton/mlton/main/main.sml
Index: main.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.sml,v
retrieving revision 1.155
retrieving revision 1.156
diff -u -r1.155 -r1.156
--- main.sml 27 Aug 2003 21:13:33 -0000 1.155
+++ main.sml 29 Aug 2003 00:25:21 -0000 1.156
@@ -53,6 +53,7 @@
val linkOpts: {opt: string, pred: OptPred.t} list ref = ref []
val output: string option ref = ref NONE
val profileSet: bool ref = ref false
+val runtimeArgs: string list ref = ref ["@MLton"]
val showBasis: bool ref = ref false
val stop = ref Place.OUT
@@ -241,9 +242,6 @@
else usage (concat ["invalid -loop-passes arg: ", Int.toString i]))),
(Expert, "mark-cards", " {true|false}", "mutator marks cards",
boolRef markCards),
- (Normal, "may-load-world", " {true|false}",
- "may @MLton load-world be used",
- boolRef mayLoadWorld),
(Normal, "native",
if !targetArch = Sparc then " {false}" else " {true|false}",
"use native code generator",
@@ -303,6 +301,8 @@
| _ => usage (concat ["invalid -profile-il arg: ", s]))),
(Normal, "profile-stack", " {false|true}", "profile the stack",
boolRef profileStack),
+ (Normal, "runtime", " <arg>", "pass arg to runtime via @MLton",
+ push runtimeArgs),
(Normal, "safe", " {true|false}", "bounds checking and other checks",
boolRef safe),
(Normal, "show-basis", " {false|true}", "display the basis library",
@@ -557,6 +557,10 @@
case !output of
NONE => suffix suf
| SOME f => f
+ val _ =
+ atMLtons :=
+ Vector.fromList
+ (maybeOut "" :: tokenize (rev ("--" :: (!runtimeArgs))))
datatype debugFormat =
Dwarf | DwarfPlus | Dwarf2 | Stabs | StabsPlus
(* The -Wa,--gstabs says to pass the --gstabs option to the
1.2 +29 -3 mlton/regression/pack-real.sml
Index: pack-real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/pack-real.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- pack-real.sml 18 Jul 2001 05:51:07 -0000 1.1
+++ pack-real.sml 29 Aug 2003 00:25:21 -0000 1.2
@@ -1,8 +1,34 @@
-open PackRealLittle
+functor Test (structure PackReal: PACK_REAL
+ structure Real: REAL
+ sharing type PackReal.real = Real.real) =
+struct
val _ =
- if List.all (fn r => Real.==(r, fromBytes(toBytes r)))
- [~100.0, ~1.1, ~0.12345, 0.0, 1.0, 123E6]
+ if List.all (fn r =>
+ let
+ val r = valOf (Real.fromString r)
+ val v = PackReal.toBytes r
+ val _ =
+ print (concat ["r = ", Real.fmt StringCvt.EXACT r, "\t"])
+ val _ =
+ Vector.app
+ (fn w => print (concat [" ", Word8.toString w]))
+ v
+ val _ = print "\n"
+ in
+ Real.== (r, PackReal.fromBytes v)
+ end)
+ ["~100.0", "~1.1", "~0.12345", "0.0", "1.0", "123E6"]
then ()
else raise Fail "failure"
+
+end
+structure Z = Test (structure PackReal = PackReal32Big
+ structure Real = Real32)
+structure Z = Test (structure PackReal = PackReal32Little
+ structure Real = Real32)
+structure Z = Test (structure PackReal = PackReal64Big
+ structure Real = Real64)
+structure Z = Test (structure PackReal = PackReal64Little
+ structure Real = Real64)
1.1 mlton/regression/pack-real.ok
Index: pack-real.ok
===================================================================
r = ~0.1E3 C2 C8 0 0
r = ~0.1100000023841858E1 BF 8C CC CD
r = ~0.12345000356435776 BD FC D3 5B
r = 0.0 0 0 0 0
r = 0.1E1 3F 80 0 0
r = 0.123E9 4C EA 9A 98
r = ~0.1E3 0 0 C8 C2
r = ~0.1100000023841858E1 CD CC 8C BF
r = ~0.12345000356435776 5B D3 FC BD
r = 0.0 0 0 0 0
r = 0.1E1 0 0 80 3F
r = 0.123E9 98 9A EA 4C
r = ~0.1E3 C0 59 0 0 0 0 0 0
r = ~0.11E1 BF F1 99 99 99 99 99 9A
r = ~0.12345 BF BF 9A 6B 50 B0 F2 7C
r = 0.0 0 0 0 0 0 0 0 0
r = 0.1E1 3F F0 0 0 0 0 0 0
r = 0.123E9 41 9D 53 53 0 0 0 0
r = ~0.1E3 0 0 0 0 0 0 59 C0
r = ~0.11E1 9A 99 99 99 99 99 F1 BF
r = ~0.12345 7C F2 B0 50 6B 9A BF BF
r = 0.0 0 0 0 0 0 0 0 0
r = 0.1E1 0 0 0 0 0 0 F0 3F
r = 0.123E9 0 0 0 0 53 53 9D 41
1.73 +4 -0 mlton/runtime/Makefile
Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -r1.72 -r1.73
--- Makefile 27 Aug 2003 21:13:34 -0000 1.72
+++ Makefile 29 Aug 2003 00:25:21 -0000 1.73
@@ -32,6 +32,8 @@
basis/IEEEReal.o \
basis/IntInf.o \
basis/Int/Int64.o \
+ basis/Int/Word8Array.o \
+ basis/Int/Word8Vector.o \
basis/Int/addOverflow.o \
basis/Int/mulOverflow.o \
basis/Int/negOverflow.o \
@@ -197,6 +199,8 @@
basis/IEEEReal-gdb.o \
basis/IntInf-gdb.o \
basis/Int/Int64-gdb.o \
+ basis/Int/Word8Array-gdb.o \
+ basis/Int/Word8Vector-gdb.o \
basis/Int/addOverflow-gdb.o \
basis/Int/mulOverflow-gdb.o \
basis/Int/negOverflow-gdb.o \
1.154 +117 -98 mlton/runtime/gc.c
Index: gc.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.c,v
retrieving revision 1.153
retrieving revision 1.154
diff -u -r1.153 -r1.154
--- gc.c 25 Aug 2003 19:57:00 -0000 1.153
+++ gc.c 29 Aug 2003 00:25:21 -0000 1.154
@@ -3983,47 +3983,55 @@
#endif /* definition of setMemInfo */
-static void usage (string s) {
- die ("Usage: %s [@MLton [fixed-heap n[{k|m}]] [gc-messages] [gc-summary] [load-world file] [ram-slop x] --] args",
- s);
+#if FALSE
+static bool stringToBool (string s) {
+ if (0 == strcmp (s, "false"))
+ return FALSE;
+ if (0 == strcmp (s, "true"))
+ return TRUE;
+ die ("Invalid @MLton bool: %s.", s);
}
+#endif
static float stringToFloat (string s) {
float f;
- sscanf (s, "%f", &f);
+ unless (1 == sscanf (s, "%f", &f))
+ die ("Invalid @MLton float: %s.", s);
return f;
}
static uint stringToBytes (string s) {
char c;
uint result;
- int i, m;
+ int i;
result = 0;
i = 0;
-
while ((c = s[i++]) != '\000') {
switch (c) {
case 'm':
if (s[i] == '\000')
- result = result * 1048576;
- else return 0;
+ return result * 1048576;
+ else
+ goto bad;
break;
case 'k':
if (s[i] == '\000')
- result = result * 1024;
- else return 0;
+ return result * 1024;
+ else
+ goto bad;
break;
default:
- m = (int)(c - '0');
- if (0 <= m and m <= 9)
- result = result * 10 + m;
- else return 0;
+ if ('0' <= c and c <= '9')
+ result = result * 10 + (c - '0');
+ else
+ goto bad;
}
}
-
- return result;
+ assert (FALSE);
+bad:
+ die ("Invalid @MLton memory amount: %s.", s);
}
static void setInitialBytesLive (GC_state s) {
@@ -4250,84 +4258,19 @@
/* GC_init */
/* ---------------------------------------------------------------- */
-int GC_init (GC_state s, int argc, char **argv) {
- char *worldFile;
+static int processAtMLton (GC_state s, int argc, char **argv,
+ string *worldFile) {
int i;
- assert (isAligned (sizeof (struct GC_stack), s->alignment));
- assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
- s->alignment));
- assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
- s->alignment));
- s->amInGC = TRUE;
- s->amInMinorGC = FALSE;
- s->bytesAllocated = 0;
- s->bytesCopied = 0;
- s->bytesCopiedMinor = 0;
- s->bytesMarkCompacted = 0;
- s->callFromCHandler = BOGUS_THREAD;
- s->canHandle = 0;
- s->cardSize = 0x1 << s->cardSizeLog2;
- s->copyRatio = 4.0;
- s->copyGenerationalRatio = 4.0;
- s->currentThread = BOGUS_THREAD;
- s->gcSignalIsPending = FALSE;
- s->growRatio = 8.0;
- s->handleGCSignal = FALSE;
- s->inSignalHandler = FALSE;
- s->isOriginal = TRUE;
- s->liveRatio = 8.0;
- s->markCompactRatio = 1.04;
- s->markCompactGenerationalRatio = 8.0;
- s->markedCards = 0;
- s->maxBytesLive = 0;
- s->maxHeap = 0;
- s->maxHeapSizeSeen = 0;
- s->maxPause = 0;
- s->maxStackSizeSeen = 0;
- s->messages = FALSE;
- s->minorBytesScanned = 0;
- s->minorBytesSkipped = 0;
- s->numCopyingGCs = 0;
- s->numLCs = 0;
- s->numMarkCompactGCs = 0;
- s->numMinorGCs = 0;
- s->numMinorsSinceLastMajor = 0;
- s->nurseryRatio = 10.0;
- s->oldGenArraySize = 0x100000;
- s->pageSize = getpagesize ();
- s->ramSlop = 0.80;
- s->savedThread = BOGUS_THREAD;
- s->signalHandler = BOGUS_THREAD;
- s->signalIsPending = FALSE;
- s->startTime = currentTime ();
- s->summary = FALSE;
- s->useFixedHeap = FALSE;
- s->weaks = NULL;
- heapInit (&s->heap);
- heapInit (&s->heap2);
- sigemptyset (&s->signalsHandled);
- initSignalStack (s);
- sigemptyset (&s->signalsPending);
- rusageZero (&s->ru_gc);
- rusageZero (&s->ru_gcCopy);
- rusageZero (&s->ru_gcMarkCompact);
- rusageZero (&s->ru_gcMinor);
- readProcessor ();
- worldFile = NULL;
- unless (isAligned (s->pageSize, s->cardSize))
- die ("page size must be a multiple of card size");
- /* Process command-line arguments. */
i = 1;
if (argc > 1 and (0 == strcmp (argv [1], "@MLton"))) {
bool done;
- /* process @MLton args */
i = 2;
done = FALSE;
while (!done) {
if (i == argc)
- usage(argv[0]);
+ die ("Missing -- at end of @MLton args.");
else {
string arg;
@@ -4335,13 +4278,13 @@
if (0 == strcmp (arg, "copy-ratio")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton copy-ratio missing argument.");
s->copyRatio =
stringToFloat (argv[i++]);
} else if (0 == strcmp(arg, "fixed-heap")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton fixed-heap missing argument.");
s->useFixedHeap = TRUE;
s->fixedHeapSize =
stringToBytes (argv[i++]);
@@ -4354,57 +4297,60 @@
} else if (0 == strcmp (arg, "copy-generational-ratio")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton copy-generational-ratio missing argument.");
s->copyGenerationalRatio =
stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "grow-ratio")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton grow-ratio missing argument.");
s->growRatio =
stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "live-ratio")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton live-ratio missing argument.");
s->liveRatio =
stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "load-world")) {
unless (s->mayLoadWorld)
- die ("may not load world");
+ die ("May not load world.");
++i;
s->isOriginal = FALSE;
if (i == argc)
- usage (argv[0]);
- worldFile = argv[i++];
+ die ("@MLton load-world missing argument.");
+ *worldFile = argv[i++];
} else if (0 == strcmp (arg, "max-heap")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton max-heap missing argument.");
s->useFixedHeap = FALSE;
s->maxHeap = stringToBytes (argv[i++]);
} else if (0 == strcmp (arg, "mark-compact-generational-ratio")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton mark-compact-generational-ratio missing argument.");
s->markCompactGenerationalRatio =
stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "mark-compact-ratio")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton mark-compact-ratio missing argument.");
s->markCompactRatio =
stringToFloat (argv[i++]);
+ } else if (0 == strcmp (arg, "no-load-world")) {
+ ++i;
+ s->mayLoadWorld = FALSE;
} else if (0 == strcmp (arg, "nursery-ratio")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton nursery-ratio missing argument.");
s->nurseryRatio =
stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "ram-slop")) {
++i;
if (i == argc)
- usage (argv[0]);
+ die ("@MLton ram-slop missing argument.");
s->ramSlop =
stringToFloat (argv[i++]);
} else if (0 == strcmp (arg, "show-prof")) {
@@ -4414,11 +4360,84 @@
++i;
done = TRUE;
} else if (i > 1)
- usage (argv[0]);
+ die ("Strange @MLton arg: %s", argv[i]);
else done = TRUE;
}
}
}
+ return i;
+}
+
+int GC_init (GC_state s, int argc, char **argv) {
+ char *worldFile;
+ int i;
+
+ assert (isAligned (sizeof (struct GC_stack), s->alignment));
+ assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
+ s->alignment));
+ assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
+ s->alignment));
+ s->amInGC = TRUE;
+ s->amInMinorGC = FALSE;
+ s->bytesAllocated = 0;
+ s->bytesCopied = 0;
+ s->bytesCopiedMinor = 0;
+ s->bytesMarkCompacted = 0;
+ s->callFromCHandler = BOGUS_THREAD;
+ s->canHandle = 0;
+ s->cardSize = 0x1 << s->cardSizeLog2;
+ s->copyRatio = 4.0;
+ s->copyGenerationalRatio = 4.0;
+ s->currentThread = BOGUS_THREAD;
+ s->gcSignalIsPending = FALSE;
+ s->growRatio = 8.0;
+ s->handleGCSignal = FALSE;
+ s->inSignalHandler = FALSE;
+ s->isOriginal = TRUE;
+ s->liveRatio = 8.0;
+ s->markCompactRatio = 1.04;
+ s->markCompactGenerationalRatio = 8.0;
+ s->markedCards = 0;
+ s->maxBytesLive = 0;
+ s->maxHeap = 0;
+ s->maxHeapSizeSeen = 0;
+ s->maxPause = 0;
+ s->maxStackSizeSeen = 0;
+ s->mayLoadWorld = TRUE;
+ s->messages = FALSE;
+ s->minorBytesScanned = 0;
+ s->minorBytesSkipped = 0;
+ s->numCopyingGCs = 0;
+ s->numLCs = 0;
+ s->numMarkCompactGCs = 0;
+ s->numMinorGCs = 0;
+ s->numMinorsSinceLastMajor = 0;
+ s->nurseryRatio = 10.0;
+ s->oldGenArraySize = 0x100000;
+ s->pageSize = getpagesize ();
+ s->ramSlop = 0.80;
+ s->savedThread = BOGUS_THREAD;
+ s->signalHandler = BOGUS_THREAD;
+ s->signalIsPending = FALSE;
+ s->startTime = currentTime ();
+ s->summary = FALSE;
+ s->useFixedHeap = FALSE;
+ s->weaks = NULL;
+ heapInit (&s->heap);
+ heapInit (&s->heap2);
+ sigemptyset (&s->signalsHandled);
+ initSignalStack (s);
+ sigemptyset (&s->signalsPending);
+ rusageZero (&s->ru_gc);
+ rusageZero (&s->ru_gcCopy);
+ rusageZero (&s->ru_gcMarkCompact);
+ rusageZero (&s->ru_gcMinor);
+ readProcessor ();
+ worldFile = NULL;
+ unless (isAligned (s->pageSize, s->cardSize))
+ die ("page size must be a multiple of card size");
+ processAtMLton (s, s->atMLtonsSize, s->atMLtons, &worldFile);
+ i = processAtMLton (s, argc, argv, &worldFile);
unless (ratiosOk (s))
die ("invalid ratios");
setMemInfo (s);
1.67 +4 -0 mlton/runtime/gc.h
Index: gc.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.h,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -r1.66 -r1.67
--- gc.h 22 Jul 2003 22:47:50 -0000 1.66
+++ gc.h 29 Aug 2003 00:25:21 -0000 1.67
@@ -322,6 +322,10 @@
uint alignment; /* Either WORD_SIZE or 2 * WORD_SIZE. */
bool amInGC;
bool amInMinorGC;
+ string *atMLtons; /* Initial @MLton args, processed before command
+ * line.
+ */
+ int atMLtonsSize;
pointer back; /* Points at next available word in toSpace. */
ullong bytesAllocated;
ullong bytesCopied;
1.1 mlton/runtime/basis/Int/Word8Array.c
Index: Word8Array.c
===================================================================
#include "mlton-basis.h"
Word32 Word8Array_subWord32Rev (Pointer v, Int offset) {
Word32 w;
char *p;
char *s;
int i;
p = (char*)&w;
s = v + (offset * 4);
for (i = 0; i < 4; ++i)
p[i] = s[3 - i];
return w;
}
void Word8Array_updateWord32Rev (Pointer a, Int offset, Word32 w) {
char *p;
char *s;
int i;
p = (char*)&w;
s = a + (offset * 4);
for (i = 0; i < 4; ++i) {
s[i] = p[3 - i];
}
}
1.1 mlton/runtime/basis/Int/Word8Vector.c
Index: Word8Vector.c
===================================================================
#include "mlton-basis.h"
Word32 Word8Vector_subWord32Rev (Pointer v, Int offset) {
Word32 w;
char *p;
char *s;
int i;
p = (char*)&w;
s = v + (offset * 4);
for (i = 0; i < 4; ++i)
p[i] = s[3 - i];
return w;
}
1.3 +35 -2 mlton/runtime/basis/PackReal/subVec.c
Index: subVec.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/PackReal/subVec.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- subVec.c 23 Jun 2003 04:59:01 -0000 1.2
+++ subVec.c 29 Aug 2003 00:25:21 -0000 1.3
@@ -1,12 +1,45 @@
#include "mlton-basis.h"
-Real64 PackReal_subVec (Pointer v, Int offset) {
- double r;
+Real32 PackReal32_subVec (Pointer v, Int offset) {
+ Real32 r;
+ char *p = (char*)&r;
+ char *s = v + offset;
+ int i;
+
+ for (i = 0; i < 4; ++i)
+ p[i] = s[i];
+ return r;
+}
+
+Real32 PackReal32_subVecRev (Pointer v, Int offset) {
+ Real32 r;
+ char *p = (char*)&r;
+ char *s = v + offset;
+ int i;
+
+ for (i = 0; i < 4; ++i)
+ p[i] = s[3 - i];
+ return r;
+}
+
+Real64 PackReal64_subVec (Pointer v, Int offset) {
+ Real64 r;
char *p = (char*)&r;
char *s = v + offset;
int i;
for (i = 0; i < 8; ++i)
p[i] = s[i];
+ return r;
+}
+
+Real64 PackReal64_subVecRev (Pointer v, Int offset) {
+ Real64 r;
+ char *p = (char*)&r;
+ char *s = v + offset;
+ int i;
+
+ for (i = 0; i < 8; ++i)
+ p[i] = s[7 - i];
return r;
}
1.3 +31 -1 mlton/runtime/basis/PackReal/update.c
Index: update.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/PackReal/update.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- update.c 23 Jun 2003 04:59:01 -0000 1.2
+++ update.c 29 Aug 2003 00:25:21 -0000 1.3
@@ -1,11 +1,41 @@
#include "mlton-basis.h"
-void PackReal_update (Pointer a, Int offset, Real r) {
+void PackReal32_update (Pointer a, Int offset, Real32 r) {
+ char *p = (char*)&r;
+ char *s = a + offset;
+ int i;
+
+ for (i = 0; i < 4; ++i) {
+ s[i] = p[i];
+ }
+}
+
+void PackReal32_updateRev (Pointer a, Int offset, Real32 r) {
+ char *p = (char*)&r;
+ char *s = a + offset;
+ int i;
+
+ for (i = 0; i < 4; ++i) {
+ s[i] = p[3 - i];
+ }
+}
+
+void PackReal64_update (Pointer a, Int offset, Real64 r) {
char *p = (char*)&r;
char *s = a + offset;
int i;
for (i = 0; i < 8; ++i) {
s[i] = p[i];
+ }
+}
+
+void PackReal64_updateRev (Pointer a, Int offset, Real64 r) {
+ char *p = (char*)&r;
+ char *s = a + offset;
+ int i;
+
+ for (i = 0; i < 8; ++i) {
+ s[i] = p[7 - i];
}
}
-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel