[MLton-commit] r4418
Matthew Fluet
MLton@mlton.org
Tue, 25 Apr 2006 13:10:39 -0700
Refactored PackWord.
Implemented PackWord structures using C-functions to sub and update.
This follows the implementation of PackReal. In the past, we've used
primitives for PackWord32. We will likely use primitives again in the
future, but its easier to get these architecture dependent primitives
out of the way for the time being.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word32.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-pack-word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/pack-real.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.c
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-25 20:10:36 UTC (rev 4418)
@@ -138,7 +138,7 @@
../integer/embed-int.sml
../integer/embed-word.sml
../integer/pack-word.sig
- (* ../integer/pack-word32.sml *)
+ ../integer/pack-word.sml
local
../config/bind/int-top.sml
../config/bind/pointer-prim.sml
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word.sml (from rev 4407, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word32.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word32.sml 2006-04-24 21:45:47 UTC (rev 4407)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word.sml 2006-04-25 20:10:36 UTC (rev 4418)
@@ -0,0 +1,341 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+functor PackWord (S: sig
+ type word
+ val wordSize: int
+ val isBigEndian: bool
+ val subArr: Word8.word array * C_Ptrdiff.t -> word
+ val subArrRev: Word8.word array * C_Ptrdiff.t -> word
+ val subVec: Word8.word vector * C_Ptrdiff.t -> word
+ val subVecRev: Word8.word vector * C_Ptrdiff.t -> word
+ val update: Word8.word array * C_Ptrdiff.t * word -> unit
+ val updateRev: Word8.word array * C_Ptrdiff.t * word -> unit
+ val toLarge: word -> LargeWord.word
+ val toLargeX: word -> LargeWord.word
+ val fromLarge: LargeWord.word -> word
+ end): PACK_WORD =
+struct
+
+open S
+
+val bytesPerElem = Int.div (wordSize, 8)
+
+val (subA, subV, updA) =
+ if isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ then (subArr, subVec, update)
+ else (subArrRev, subVecRev, updateRev)
+
+fun offset (i, n) =
+ let
+ val i = Int.* (bytesPerElem, i)
+ val () =
+ if Primitive.Controls.safe
+ andalso (Int.geu (Int.+ (i, Int.- (bytesPerElem, 1)), n))
+ then raise Subscript
+ else ()
+ in
+ C_Ptrdiff.fromInt i
+ end
+ handle Overflow => raise Subscript
+
+fun update (a, i, w) =
+ let
+ val i = offset (i, Word8Array.length a)
+ val a = Word8Array.toPoly a
+ in
+ updA (a, i, fromLarge w)
+ end
+
+local
+ fun make (sub, length, toPoly) (s, i) =
+ let
+ val i = offset (i, length s)
+ val s = toPoly s
+ in
+ sub (s, i)
+ end
+in
+ val subArr = make (subA, Word8Array.length, Word8Array.toPoly)
+ val subVec = make (subV, Word8Vector.length, Word8Vector.toPoly)
+end
+
+local
+ fun make (sub, length, toPoly) (av, i) =
+ let
+ val i = offset (i, length av)
+ in
+ sub (toPoly av, i)
+ end
+in
+ val subArr = toLarge o (make (subA, Word8Array.length, Word8Array.toPoly))
+ val subArrX = toLargeX o (make (subA, Word8Array.length, Word8Array.toPoly))
+ val subVec = toLarge o (make (subV, Word8Vector.length, Word8Vector.toPoly))
+ val subVecX = toLargeX o (make (subV, Word8Vector.length, Word8Vector.toPoly))
+end
+
+end
+
+structure PackWord8Big: PACK_WORD =
+ PackWord (val wordSize = Word8.wordSize
+ val isBigEndian = true
+ open PrimitiveFFI.PackWord8
+ open Word8)
+structure PackWord8Little: PACK_WORD =
+ PackWord (val wordSize = Word8.wordSize
+ val isBigEndian = false
+ open PrimitiveFFI.PackWord8
+ open Word8)
+structure PackWord8Host: PACK_WORD =
+ PackWord (val wordSize = Word8.wordSize
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ open PrimitiveFFI.PackWord8
+ open Word8)
+structure PackWord16Big: PACK_WORD =
+ PackWord (val wordSize = Word16.wordSize
+ val isBigEndian = true
+ open PrimitiveFFI.PackWord16
+ open Word16)
+structure PackWord16Little: PACK_WORD =
+ PackWord (val wordSize = Word16.wordSize
+ val isBigEndian = false
+ open PrimitiveFFI.PackWord16
+ open Word16)
+structure PackWord16Host: PACK_WORD =
+ PackWord (val wordSize = Word16.wordSize
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ open PrimitiveFFI.PackWord16
+ open Word16)
+structure PackWord32Big: PACK_WORD =
+ PackWord (val wordSize = Word32.wordSize
+ val isBigEndian = true
+ open PrimitiveFFI.PackWord32
+ open Word32)
+structure PackWord32Little: PACK_WORD =
+ PackWord (val wordSize = Word32.wordSize
+ val isBigEndian = false
+ open PrimitiveFFI.PackWord32
+ open Word32)
+structure PackWord32Host: PACK_WORD =
+ PackWord (val wordSize = Word32.wordSize
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ open PrimitiveFFI.PackWord32
+ open Word32)
+structure PackWord64Big: PACK_WORD =
+ PackWord (val wordSize = Word64.wordSize
+ val isBigEndian = true
+ open PrimitiveFFI.PackWord64
+ open Word64)
+structure PackWord64Little: PACK_WORD =
+ PackWord (val wordSize = Word64.wordSize
+ val isBigEndian = false
+ open PrimitiveFFI.PackWord64
+ open Word64)
+structure PackWord64Host: PACK_WORD =
+ PackWord (val wordSize = Word64.wordSize
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ open PrimitiveFFI.PackWord64
+ open Word64)
+local
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = int
+ val fWord8 = Word8.wordSize
+ val fWord16 = Word16.wordSize
+ val fWord32 = Word32.wordSize
+ val fWord64 = Word64.wordSize)
+ in
+ val wordSize = S.f
+ end
+ structure PackWord =
+ struct
+ type word = Word.word
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subArr
+ val fWord16 = PrimitiveFFI.PackWord16.subArr
+ val fWord32 = PrimitiveFFI.PackWord32.subArr
+ val fWord64 = PrimitiveFFI.PackWord64.subArr)
+ in
+ val subArr = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subArrRev
+ val fWord16 = PrimitiveFFI.PackWord16.subArrRev
+ val fWord32 = PrimitiveFFI.PackWord32.subArrRev
+ val fWord64 = PrimitiveFFI.PackWord64.subArrRev)
+ in
+ val subArrRev = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subVec
+ val fWord16 = PrimitiveFFI.PackWord16.subVec
+ val fWord32 = PrimitiveFFI.PackWord32.subVec
+ val fWord64 = PrimitiveFFI.PackWord64.subVec)
+ in
+ val subVec = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subVecRev
+ val fWord16 = PrimitiveFFI.PackWord16.subVecRev
+ val fWord32 = PrimitiveFFI.PackWord32.subVecRev
+ val fWord64 = PrimitiveFFI.PackWord64.subVecRev)
+ in
+ val subVecRev = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = PrimitiveFFI.PackWord8.update
+ val fWord16 = PrimitiveFFI.PackWord16.update
+ val fWord32 = PrimitiveFFI.PackWord32.update
+ val fWord64 = PrimitiveFFI.PackWord64.update)
+ in
+ val update = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = PrimitiveFFI.PackWord8.updateRev
+ val fWord16 = PrimitiveFFI.PackWord16.updateRev
+ val fWord32 = PrimitiveFFI.PackWord32.updateRev
+ val fWord64 = PrimitiveFFI.PackWord64.updateRev)
+ in
+ val updateRev = S.f
+ end
+ end
+in
+structure PackWordBig: PACK_WORD =
+ PackWord (val wordSize = Word.wordSize
+ val isBigEndian = true
+ open PackWord
+ open Word)
+structure PackWordLittle: PACK_WORD =
+ PackWord (val wordSize = Word.wordSize
+ val isBigEndian = false
+ open PackWord
+ open Word)
+structure PackWordHost: PACK_WORD =
+ PackWord (val wordSize = Word.wordSize
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ open PackWord
+ open Word)
+end
+local
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = int
+ val fWord8 = Word8.wordSize
+ val fWord16 = Word16.wordSize
+ val fWord32 = Word32.wordSize
+ val fWord64 = Word64.wordSize)
+ in
+ val wordSize = S.f
+ end
+ structure PackLargeWord =
+ struct
+ type word = Word.word
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subArr
+ val fWord16 = PrimitiveFFI.PackWord16.subArr
+ val fWord32 = PrimitiveFFI.PackWord32.subArr
+ val fWord64 = PrimitiveFFI.PackWord64.subArr)
+ in
+ val subArr = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subArrRev
+ val fWord16 = PrimitiveFFI.PackWord16.subArrRev
+ val fWord32 = PrimitiveFFI.PackWord32.subArrRev
+ val fWord64 = PrimitiveFFI.PackWord64.subArrRev)
+ in
+ val subArrRev = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subVec
+ val fWord16 = PrimitiveFFI.PackWord16.subVec
+ val fWord32 = PrimitiveFFI.PackWord32.subVec
+ val fWord64 = PrimitiveFFI.PackWord64.subVec)
+ in
+ val subVec = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fWord8 = PrimitiveFFI.PackWord8.subVecRev
+ val fWord16 = PrimitiveFFI.PackWord16.subVecRev
+ val fWord32 = PrimitiveFFI.PackWord32.subVecRev
+ val fWord64 = PrimitiveFFI.PackWord64.subVecRev)
+ in
+ val subVecRev = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = PrimitiveFFI.PackWord8.update
+ val fWord16 = PrimitiveFFI.PackWord16.update
+ val fWord32 = PrimitiveFFI.PackWord32.update
+ val fWord64 = PrimitiveFFI.PackWord64.update)
+ in
+ val update = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = PrimitiveFFI.PackWord8.updateRev
+ val fWord16 = PrimitiveFFI.PackWord16.updateRev
+ val fWord32 = PrimitiveFFI.PackWord32.updateRev
+ val fWord64 = PrimitiveFFI.PackWord64.updateRev)
+ in
+ val updateRev = S.f
+ end
+ end
+in
+structure PackLargeWordBig: PACK_WORD =
+ PackWord (val wordSize = LargeWord.wordSize
+ val isBigEndian = true
+ open PackLargeWord
+ open LargeWord)
+structure PackLargeWordLittle: PACK_WORD =
+ PackWord (val wordSize = LargeWord.wordSize
+ val isBigEndian = false
+ open PackLargeWord
+ open LargeWord)
+structure PackLargeWordHost: PACK_WORD =
+ PackWord (val wordSize = LargeWord.wordSize
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ open PackLargeWord
+ open LargeWord)
+end
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word32.sml 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/pack-word32.sml 2006-04-25 20:10:36 UTC (rev 4418)
@@ -1,64 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-functor PackWord32 (val isBigEndian: bool): PACK_WORD =
-struct
-
-val bytesPerElem: int = 4
-
-val isBigEndian = isBigEndian
-
-val (sub, up, subV) =
- if isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
- 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 = Int.* (bytesPerElem, i)
- val _ =
- if Primitive.safe
- andalso Primitive.Int.geu (Int.+ (i, Int.- (bytesPerElem, 1)), n)
- then raise Subscript
- else ()
- in
- i
- end handle Overflow => raise Subscript
-
-local
- fun make (sub, length, toPoly) (av, i) =
- let
- val _ = start (i, length av)
- in
- Word.toLarge (sub (toPoly av, i))
- end
-in
- val subArr = make (sub, Word8Array.length, Word8Array.toPoly)
- val subArrX = subArr
- val subVec = make (subV, Word8Vector.length, Word8Vector.toPoly)
- val subVecX = subVec
-end
-
-fun update (a, i, w) =
- let
- val a = Word8Array.toPoly a
- val _ = start (i, Array.length a)
- in
- up (a, i, Word.fromLarge w)
- end
-
-end
-
-structure PackWord32Big = PackWord32 (val isBigEndian = true)
-structure PackWord32Little = PackWord32 (val isBigEndian = false)
-structure PackWord32Host =
- PackWord32(val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-04-25 20:10:36 UTC (rev 4418)
@@ -222,6 +222,42 @@
val update = _import "PackReal64_update" : (Word8.t) array * C_Ptrdiff.t * Real64.t -> unit;
val updateRev = _import "PackReal64_updateRev" : (Word8.t) array * C_Ptrdiff.t * Real64.t -> unit;
end
+structure PackWord16 =
+struct
+val subArr = _import "PackWord16_subArr" : (Word8.t) array * C_Ptrdiff.t -> Word16.t;
+val subArrRev = _import "PackWord16_subArrRev" : (Word8.t) array * C_Ptrdiff.t -> Word16.t;
+val subVec = _import "PackWord16_subVec" : (Word8.t) vector * C_Ptrdiff.t -> Word16.t;
+val subVecRev = _import "PackWord16_subVecRev" : (Word8.t) vector * C_Ptrdiff.t -> Word16.t;
+val update = _import "PackWord16_update" : (Word8.t) array * C_Ptrdiff.t * Word16.t -> unit;
+val updateRev = _import "PackWord16_updateRev" : (Word8.t) array * C_Ptrdiff.t * Word16.t -> unit;
+end
+structure PackWord32 =
+struct
+val subArr = _import "PackWord32_subArr" : (Word8.t) array * C_Ptrdiff.t -> Word32.t;
+val subArrRev = _import "PackWord32_subArrRev" : (Word8.t) array * C_Ptrdiff.t -> Word32.t;
+val subVec = _import "PackWord32_subVec" : (Word8.t) vector * C_Ptrdiff.t -> Word32.t;
+val subVecRev = _import "PackWord32_subVecRev" : (Word8.t) vector * C_Ptrdiff.t -> Word32.t;
+val update = _import "PackWord32_update" : (Word8.t) array * C_Ptrdiff.t * Word32.t -> unit;
+val updateRev = _import "PackWord32_updateRev" : (Word8.t) array * C_Ptrdiff.t * Word32.t -> unit;
+end
+structure PackWord64 =
+struct
+val subArr = _import "PackWord64_subArr" : (Word8.t) array * C_Ptrdiff.t -> Word64.t;
+val subArrRev = _import "PackWord64_subArrRev" : (Word8.t) array * C_Ptrdiff.t -> Word64.t;
+val subVec = _import "PackWord64_subVec" : (Word8.t) vector * C_Ptrdiff.t -> Word64.t;
+val subVecRev = _import "PackWord64_subVecRev" : (Word8.t) vector * C_Ptrdiff.t -> Word64.t;
+val update = _import "PackWord64_update" : (Word8.t) array * C_Ptrdiff.t * Word64.t -> unit;
+val updateRev = _import "PackWord64_updateRev" : (Word8.t) array * C_Ptrdiff.t * Word64.t -> unit;
+end
+structure PackWord8 =
+struct
+val subArr = _import "PackWord8_subArr" : (Word8.t) array * C_Ptrdiff.t -> Word8.t;
+val subArrRev = _import "PackWord8_subArrRev" : (Word8.t) array * C_Ptrdiff.t -> Word8.t;
+val subVec = _import "PackWord8_subVec" : (Word8.t) vector * C_Ptrdiff.t -> Word8.t;
+val subVecRev = _import "PackWord8_subVecRev" : (Word8.t) vector * C_Ptrdiff.t -> Word8.t;
+val update = _import "PackWord8_update" : (Word8.t) array * C_Ptrdiff.t * Word8.t -> unit;
+val updateRev = _import "PackWord8_updateRev" : (Word8.t) array * C_Ptrdiff.t * Word8.t -> unit;
+end
structure Posix =
struct
structure Error =
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-pack-word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-pack-word.sml 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-pack-word.sml 2006-04-25 20:10:36 UTC (rev 4418)
@@ -0,0 +1,61 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+local
+ fun 'a check (x: 'a, y: 'a) : unit = ()
+
+ local
+ structure PW1 = Primitive.PackWord8
+ structure PW2 = PrimitiveFFI.PackWord8
+ in
+ val () = check (PW1.subArr, PW2.subArr)
+ val () = check (PW1.subArrRev, PW2.subArrRev)
+ val () = check (PW1.subVec, PW2.subVec)
+ val () = check (PW1.subVecRev, PW2.subVecRev)
+ val () = check (PW1.update, PW2.update)
+ val () = check (PW1.updateRev, PW2.updateRev)
+ end
+
+ local
+ structure PW1 = Primitive.PackWord16
+ structure PW2 = PrimitiveFFI.PackWord16
+ in
+ val () = check (PW1.subArr, PW2.subArr)
+ val () = check (PW1.subArrRev, PW2.subArrRev)
+ val () = check (PW1.subVec, PW2.subVec)
+ val () = check (PW1.subVecRev, PW2.subVecRev)
+ val () = check (PW1.update, PW2.update)
+ val () = check (PW1.updateRev, PW2.updateRev)
+ end
+
+ local
+ structure PW1 = Primitive.PackWord32
+ structure PW2 = PrimitiveFFI.PackWord32
+ in
+ val () = check (PW1.subArr, PW2.subArr)
+ val () = check (PW1.subArrRev, PW2.subArrRev)
+ val () = check (PW1.subVec, PW2.subVec)
+ val () = check (PW1.subVecRev, PW2.subVecRev)
+ val () = check (PW1.update, PW2.update)
+ val () = check (PW1.updateRev, PW2.updateRev)
+ end
+
+ local
+ structure PW1 = Primitive.PackWord64
+ structure PW2 = PrimitiveFFI.PackWord64
+ in
+ val () = check (PW1.subArr, PW2.subArr)
+ val () = check (PW1.subArrRev, PW2.subArrRev)
+ val () = check (PW1.subVec, PW2.subVec)
+ val () = check (PW1.subVecRev, PW2.subVecRev)
+ val () = check (PW1.update, PW2.update)
+ val () = check (PW1.updateRev, PW2.updateRev)
+ end
+in
+
+end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-word.sml 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-word.sml 2006-04-25 20:10:36 UTC (rev 4418)
@@ -0,0 +1,87 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+structure Primitive = struct
+
+open Primitive
+
+structure PackWord8 =
+ struct
+ type word = Word8.word
+
+ val subArr =
+ _import "PackWord8_subArr": Word8.word array * C_Ptrdiff.t -> word;
+ val subArrRev =
+ _import "PackWord8_subArrRev": Word8.word array * C_Ptrdiff.t -> word;
+ val subVec =
+ _import "PackWord8_subVec": Word8.word vector * C_Ptrdiff.t -> word;
+ val subVecRev =
+ _import "PackWord8_subVecRev": Word8.word vector * C_Ptrdiff.t -> word;
+ val update =
+ _import "PackWord8_update": Word8.word array * C_Ptrdiff.t * word -> unit;
+ val updateRev =
+ _import "PackWord8_updateRev": Word8.word array * C_Ptrdiff.t * word -> unit;
+ end
+
+structure PackWord16 =
+ struct
+ type word = Word16.word
+
+ val subArr =
+ _import "PackWord16_subArr": Word8.word array * C_Ptrdiff.t -> word;
+ val subArrRev =
+ _import "PackWord16_subArrRev": Word8.word array * C_Ptrdiff.t -> word;
+ val subVec =
+ _import "PackWord16_subVec": Word8.word vector * C_Ptrdiff.t -> word;
+ val subVecRev =
+ _import "PackWord16_subVecRev": Word8.word vector * C_Ptrdiff.t -> word;
+ val update =
+ _import "PackWord16_update": Word8.word array * C_Ptrdiff.t * word -> unit;
+ val updateRev =
+ _import "PackWord16_updateRev": Word8.word array * C_Ptrdiff.t * word -> unit;
+ end
+
+structure PackWord32 =
+ struct
+ type word = Word32.word
+
+ val subArr =
+ _import "PackWord32_subArr": Word8.word array * C_Ptrdiff.t -> word;
+ val subArrRev =
+ _import "PackWord32_subArrRev": Word8.word array * C_Ptrdiff.t -> word;
+ val subVec =
+ _import "PackWord32_subVec": Word8.word vector * C_Ptrdiff.t -> word;
+ val subVecRev =
+ _import "PackWord32_subVecRev": Word8.word vector * C_Ptrdiff.t -> word;
+ val update =
+ _import "PackWord32_update": Word8.word array * C_Ptrdiff.t * word -> unit;
+ val updateRev =
+ _import "PackWord32_updateRev": Word8.word array * C_Ptrdiff.t * word -> unit;
+ end
+
+structure PackWord64 =
+ struct
+ type word = Word64.word
+
+ val subArr =
+ _import "PackWord64_subArr": Word8.word array * C_Ptrdiff.t -> word;
+ val subArrRev =
+ _import "PackWord64_subArrRev": Word8.word array * C_Ptrdiff.t -> word;
+ val subVec =
+ _import "PackWord64_subVec": Word8.word vector * C_Ptrdiff.t -> word;
+ val subVecRev =
+ _import "PackWord64_subVecRev": Word8.word vector * C_Ptrdiff.t -> word;
+ val update =
+ _import "PackWord64_update": Word8.word array * C_Ptrdiff.t * word -> unit;
+ val updateRev =
+ _import "PackWord64_updateRev": Word8.word array * C_Ptrdiff.t * word -> unit;
+ end
+
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-04-25 20:10:36 UTC (rev 4418)
@@ -56,6 +56,8 @@
prim-string.sml
prim-real.sml
+
+ prim-pack-word.sml
prim-pack-real.sml
prim-mlton.sml
@@ -65,5 +67,6 @@
(* Check compatibility between primitives and runtime functions. *)
check-real.sml
+ check-pack-word.sml
check-pack-real.sml
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/pack-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/pack-real.sml 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/pack-real.sml 2006-04-25 20:10:36 UTC (rev 4418)
@@ -57,22 +57,19 @@
; Word8Vector.fromPoly (Vector.fromArray a))
end
-fun subArr (v, i) =
- let
- val i = offset (i, Word8Array.length v)
- val v = Word8Array.toPoly v
- in
- subA (v, i)
- end
+local
+ fun make (sub, length, toPoly) (s, i) =
+ let
+ val i = offset (i, length s)
+ val s = toPoly s
+ in
+ sub (s, i)
+ end
+in
+ val subArr = make (subA, Word8Array.length, Word8Array.toPoly)
+ val subVec = make (subV, Word8Vector.length, Word8Vector.toPoly)
+end
-fun subVec (v, i) =
- let
- val i = offset (i, Word8Vector.length v)
- val v = Word8Vector.toPoly v
- in
- subV (v, i)
- end
-
fun fromBytes v = subVec (v, 0)
end
@@ -103,7 +100,6 @@
in
val realSize = S.f
end
-
structure PackReal =
struct
type real = Real.real
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-04-25 20:10:36 UTC (rev 4418)
@@ -176,8 +176,9 @@
$(CC) $(OPTCFLAGS) $(WARNFLAGS) -o gen/gen-types gen/gen-types.c $(UTILOFILES)
cd gen && ./gen-types
cp gen/c-types.h c-types.h
+ cp gen/c-types.sml ../basis-library.refactor/config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
cp gen/ml-types.h ml-types.h
- rm -f gen/gen-types
+ rm -f gen/gen-types gen/c-types.h gen/c-types.sml gen/ml-types.h
basis-ffi.h: gen/gen-basis-ffi.sml gen/basis-ffi.def
rm -f basis-ffi.h
@@ -185,7 +186,7 @@
cd gen && ./gen-basis-ffi
cp gen/basis-ffi.h basis-ffi.h
cp gen/basis-ffi.sml ../basis-library.refactor/primitive/basis-ffi.sml
- rm -f gen/gen-basis-ffi
+ rm -f gen/gen-basis-ffi gen/basis-ffi.h gen/basis-ffi.sml
gc-gdb.o: gc.c $(GCCFILES) $(HFILES)
$(CC) $(DEBUGCFLAGS) $(DEBUGWARNFLAGS) -c -o $@ $<
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c 2006-04-25 20:10:36 UTC (rev 4418)
@@ -6,8 +6,8 @@
#define mkSubSeq(kind, Seq) \
Word##kind##_t PackWord##kind##_sub##Seq (Seq(Word8_t) seq, C_Ptrdiff_t offset) { \
Word##kind##_t w; \
- pointer p = (pointer)&w; \
- pointer s = (pointer)seq + ((kind / 8) * offset); \
+ Word8_t* p = (Word8_t*)&w; \
+ Word8_t* s = (Word8_t*)seq + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
@@ -17,8 +17,8 @@
#define mkSubSeqRev(kind, Seq) \
Word##kind##_t PackWord##kind##_sub##Seq##Rev (Seq(Word8_t) seq, C_Ptrdiff_t offset) { \
Word##kind##_t w; \
- pointer p = (pointer)&w; \
- pointer s = (pointer)seq + ((kind / 8) * offset); \
+ Word8_t* p = (Word8_t*)&w; \
+ Word8_t* s = (Word8_t*)seq + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
@@ -28,8 +28,8 @@
#define mkUpdate(kind) \
void PackWord##kind##_update (Arr(Word8_t) a, C_Ptrdiff_t offset, Word##kind##_t w) { \
- pointer p = (pointer)&w; \
- pointer s = (pointer)a + ((kind / 8) * offset); \
+ Word8_t* p = (Word8_t*)&w; \
+ Word8_t* s = (Word8_t*)a + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
@@ -37,8 +37,8 @@
}
#define mkUpdateRev(kind) \
void PackWord##kind##_updateRev (Arr(Word8_t) a, C_Ptrdiff_t offset, Word##kind##_t w) { \
- pointer p = (pointer)&w; \
- pointer s = (pointer)a + ((kind / 8) * offset); \
+ Word8_t* p = (Word8_t*)&w; \
+ Word8_t* s = (Word8_t*)a + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
@@ -53,6 +53,7 @@
mkUpdate(size) \
mkUpdateRev(size)
+all (8)
all (16)
all (32)
all (64)
@@ -64,13 +65,13 @@
Word32_t Word8Array_subWord32Rev (Array(Word8_t) a, C_Ptrdiff_t offset) {
- return PackWord32_subArrRev (a, offset);
+ return PackWord32_subArrRev (a, 4 * offset);
}
void Word8Array_updateWord32Rev (Array(Word32_t) a, C_Ptrdiff_t offset, Word32_t w) {
- PackWord32_updateRev (a, offset, w);
+ PackWord32_updateRev (a, 4 * offset, w);
}
Word32_t Word8Vector_subWord32Rev (Vector(Word8_t) v, C_Ptrdiff_t offset) {
- return PackWord32_subArrRev (v, offset);
+ return PackWord32_subArrRev (v, 4 * offset);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-04-25 20:10:36 UTC (rev 4418)
@@ -148,6 +148,30 @@
PackReal64.subVecRev = _import : Word8.t vector * C_Ptrdiff.t -> Real64.t
PackReal64.update = _import : Word8.t array * C_Ptrdiff.t * Real64.t -> unit
PackReal64.updateRev = _import : Word8.t array * C_Ptrdiff.t * Real64.t -> unit
+PackWord8.subArr = _import : Word8.t array * C_Ptrdiff.t -> Word8.t
+PackWord8.subArrRev = _import : Word8.t array * C_Ptrdiff.t -> Word8.t
+PackWord8.subVec = _import : Word8.t vector * C_Ptrdiff.t -> Word8.t
+PackWord8.subVecRev = _import : Word8.t vector * C_Ptrdiff.t -> Word8.t
+PackWord8.update = _import : Word8.t array * C_Ptrdiff.t * Word8.t -> unit
+PackWord8.updateRev = _import : Word8.t array * C_Ptrdiff.t * Word8.t -> unit
+PackWord16.subArr = _import : Word8.t array * C_Ptrdiff.t -> Word16.t
+PackWord16.subArrRev = _import : Word8.t array * C_Ptrdiff.t -> Word16.t
+PackWord16.subVec = _import : Word8.t vector * C_Ptrdiff.t -> Word16.t
+PackWord16.subVecRev = _import : Word8.t vector * C_Ptrdiff.t -> Word16.t
+PackWord16.update = _import : Word8.t array * C_Ptrdiff.t * Word16.t -> unit
+PackWord16.updateRev = _import : Word8.t array * C_Ptrdiff.t * Word16.t -> unit
+PackWord32.subArr = _import : Word8.t array * C_Ptrdiff.t -> Word32.t
+PackWord32.subArrRev = _import : Word8.t array * C_Ptrdiff.t -> Word32.t
+PackWord32.subVec = _import : Word8.t vector * C_Ptrdiff.t -> Word32.t
+PackWord32.subVecRev = _import : Word8.t vector * C_Ptrdiff.t -> Word32.t
+PackWord32.update = _import : Word8.t array * C_Ptrdiff.t * Word32.t -> unit
+PackWord32.updateRev = _import : Word8.t array * C_Ptrdiff.t * Word32.t -> unit
+PackWord64.subArr = _import : Word8.t array * C_Ptrdiff.t -> Word64.t
+PackWord64.subArrRev = _import : Word8.t array * C_Ptrdiff.t -> Word64.t
+PackWord64.subVec = _import : Word8.t vector * C_Ptrdiff.t -> Word64.t
+PackWord64.subVecRev = _import : Word8.t vector * C_Ptrdiff.t -> Word64.t
+PackWord64.update = _import : Word8.t array * C_Ptrdiff.t * Word64.t -> unit
+PackWord64.updateRev = _import : Word8.t array * C_Ptrdiff.t * Word64.t -> unit
Posix.Error.E2BIG = _const : C_Int.t
Posix.Error.EACCES = _const : C_Int.t
Posix.Error.EADDRINUSE = _const : C_Int.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-04-25 20:10:36 UTC (rev 4418)
@@ -127,14 +127,14 @@
"typedef Int32_t Bool;",
// "typedef Char8_t Char_t;",
// "typedef Char8_t Char;",
- "typedef Int32_t Int_t;",
- "typedef Int32_t Int;",
+ // "typedef Int32_t Int_t;",
+ // "typedef Int32_t Int;",
// "typedef Real64_t Real_t;",
// "typedef Real64_t Real;",
// "typedef String8_t String_t;",
// "typedef String8_t String;",
- "typedef Word32_t Word_t;",
- "typedef Word32_t Word;",
+ // "typedef Word32_t Word_t;",
+ // "typedef Word32_t Word;",
""
"typedef String8_t NullString8_t;",
"typedef String8_t NullString8;",
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.c 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.c 2006-04-25 20:10:36 UTC (rev 4418)
@@ -27,7 +27,7 @@
CommandLine_argv = (C_StringArray_t)(argv + start);
}
-void MLton_exit (GC_state s, Int status) {
+void MLton_exit (GC_state s, C_Int_t status) {
GC_done (s);
exit (status);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 18:56:21 UTC (rev 4417)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 20:10:36 UTC (rev 4418)
@@ -90,7 +90,7 @@
/* ---------------------------------------------------------------- */
void MLton_init (int argc, char **argv, GC_state s);
-void MLton_exit (GC_state s, Int status) __attribute__ ((noreturn));
+void MLton_exit (GC_state s, C_Int_t status) __attribute__ ((noreturn));
/* ---------------------------------------------------------------- */
/* Utility libraries */
@@ -188,28 +188,10 @@
/* PackWord */
/* ------------------------------------------------- */
-Word16_t PackWord16_subArr (Array(Word8_t) v, Int offset);
-Word16_t PackWord16_subArrRev (Array(Word8_t) v, Int offset);
-Word32_t PackWord32_subArr (Array(Word8_t) v, Int offset);
-Word32_t PackWord32_subArrRev (Array(Word8_t) v, Int offset);
-Word64_t PackWord64_subArr (Array(Word8_t) v, Int offset);
-Word64_t PackWord64_subArrRev (Array(Word8_t) v, Int offset);
-Word16_t PackWord16_subVec (Vector(Word8_t) v, Int offset);
-Word16_t PackWord16_subVecRev (Vector(Word8_t) v, Int offset);
-Word32_t PackWord32_subVec (Vector(Word8_t) v, Int offset);
-Word32_t PackWord32_subVecRev (Vector(Word8_t) v, Int offset);
-Word64_t PackWord64_subVec (Vector(Word8_t) v, Int offset);
-Word64_t PackWord64_subVecRev (Vector(Word8_t) v, Int offset);
-void PackWord16_update (Array(Word8_t) a, Int offset, Word16_t w);
-void PackWord16_updateRev (Array(Word8_t) a, Int offset, Word16_t w);
-void PackWord32_update (Array(Word8_t) a, Int offset, Word32_t w);
-void PackWord32_updateRev (Array(Word8_t) a, Int offset, Word32_t w);
-void PackWord64_update (Array(Word8_t) a, Int offset, Word64_t w);
-void PackWord64_updateRev (Array(Word8_t) a, Int offset, Word64_t w);
/* Compat */
-Word32 Word8Array_subWord32Rev (Pointer v, Int offset);
-void Word8Array_updateWord32Rev (Pointer a, Int offset, Word32 w);
-Word32 Word8Vector_subWord32Rev (Pointer v, Int offset);
+Word32_t Word8Array_subWord32Rev (Array(Word8_t) a, C_Ptrdiff_t offset);
+void Word8Array_updateWord32Rev (Array(Word8_t) a, C_Ptrdiff_t offset, Word32_t w);
+Word32_t Word8Vector_subWord32Rev (Vector(Word8_t) v, C_Ptrdiff_t offset);
/* ------------------------------------------------- */
/* Socket */