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...> - 2006-05-01 18:46:58
|
Refactored Socket
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
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-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-02 01:46:55 UTC (rev 4433)
@@ -304,13 +304,13 @@
../net/net-serv-db.sig
../net/net-serv-db.sml
../net/socket.sig
- (* ../net/socket.sml *)
- (* ../net/generic-sock.sig *)
- (* ../net/generic-sock.sml *)
- (* ../net/inet-sock.sig *)
- (* ../net/inet-sock.sml *)
- (* ../net/unix-sock.sig *)
- (* ../net/unix-sock.sml *)
+ ../net/socket.sml
+ ../net/generic-sock.sig
+ ../net/generic-sock.sml
+ ../net/inet-sock.sig
+ ../net/inet-sock.sml
+ ../net/unix-sock.sig
+ ../net/unix-sock.sml
../mlton/array.sig
../mlton/cont.sig
@@ -359,19 +359,4 @@
../sml-nj/sml-nj.sml
../sml-nj/unsafe.sig
../sml-nj/unsafe.sml
-
-(*
- top-level/basis.sig
- ann
- "allowRebindEquals true"
- in
- top-level/basis.sml
- end
- in
- structure BasisExtra
- top-level/basis-sigs.sml
- top-level/basis-funs.sml
- top-level/top-level.sml
- end
-*)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word32 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word32 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word64 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word16 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb 2006-05-02 01:46:55 UTC (rev 4433)
@@ -12,250 +12,8 @@
"warnUnused false" "forceUsed"
in
local
- ../../primitive/primitive.mlb
- (* Common basis implementation. *)
- ../../top-level/infixes.sml
- ../../misc/basic.sml
- ../../misc/dynamic-wind.sig
- ../../misc/dynamic-wind.sml
- ../../general/general.sig
- ../../general/general.sml
- ../../misc/util.sml
- ../../general/option.sig
- ../../general/option.sml
- ../../list/list.sig
- ../../list/list.sml
- ../../list/list-pair.sig
- ../../list/list-pair.sml
- ../../arrays-and-vectors/slice.sig
- ../../arrays-and-vectors/sequence.sig
- ../../arrays-and-vectors/sequence.fun
- ../../arrays-and-vectors/vector-slice.sig
- ../../arrays-and-vectors/vector.sig
- ../../arrays-and-vectors/vector.sml
- ../../arrays-and-vectors/array-slice.sig
- ../../arrays-and-vectors/array.sig
- ../../arrays-and-vectors/array.sml
- ../../arrays-and-vectors/array2.sig
- ../../arrays-and-vectors/array2.sml
- ../../arrays-and-vectors/mono-vector-slice.sig
- ../../arrays-and-vectors/mono-vector.sig
- ../../arrays-and-vectors/mono-vector.fun
- ../../arrays-and-vectors/mono-array-slice.sig
- ../../arrays-and-vectors/mono-array.sig
- ../../arrays-and-vectors/mono-array.fun
- ../../arrays-and-vectors/mono-array2.sig
- ../../arrays-and-vectors/mono-array2.fun
- ../../arrays-and-vectors/mono.sml
- ../../text/string0.sml
- ../../text/char0.sml
- ../../misc/reader.sig
- ../../misc/reader.sml
- ../../text/string-cvt.sig
- ../../text/string-cvt.sml
- ../../general/bool.sig
- ../../general/bool.sml
- ../../integer/integer.sig
- ../../integer/int.sml
- ../../text/char.sig
- ../../text/char.sml
- ../../text/substring.sig
- ../../text/substring.sml
- ../../text/string.sig
- ../../text/string.sml
- ../../misc/C.sig
- ../../misc/C.sml
- ../../integer/word.sig
- ../../integer/word.sml
- ../../integer/int-inf.sig
- ../../integer/int-inf.sml
- ../../real/IEEE-real.sig
- ../../real/IEEE-real.sml
- ../../real/math.sig
- ../../real/real.sig
- ../../real/real.fun
- ../../integer/pack-word.sig
- ../../integer/pack-word32.sml
- ../../text/byte.sig
- ../../text/byte.sml
- ../../text/text.sig
- ../../text/text.sml
- ../../real/pack-real.sig
- ../../real/pack-real.sml
- ../../real/real32.sml
- ../../real/real64.sml
- ../../integer/patch.sml
- ../../integer/embed-int.sml
- ../../integer/embed-word.sml
- ann "forceUsed" in
- ../../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
- end
+ ../../build/sources.mlb
- ../../top-level/arithmetic.sml
-
- (* misc/unique-id.sig *)
- (* misc/unique-id.fun *)
- ../../misc/cleaner.sig
- ../../misc/cleaner.sml
-
- ../../system/pre-os.sml
- ../../system/time.sig
- ../../system/time.sml
- ../../system/date.sig
- ../../system/date.sml
-
- ../../io/io.sig
- ../../io/io.sml
- ../../io/prim-io.sig
- ../../io/prim-io.fun
- ../../io/bin-prim-io.sml
- ../../io/text-prim-io.sml
-
- ../../posix/error.sig
- ../../posix/error.sml
- ../../posix/stub-mingw.sml
- ../../posix/flags.sig
- ../../posix/flags.sml
- ../../posix/signal.sig
- ../../posix/signal.sml
- ../../posix/proc-env.sig
- ../../posix/proc-env.sml
- ../../posix/file-sys.sig
- ../../posix/file-sys.sml
- ../../posix/io.sig
- ../../posix/io.sml
- ../../posix/process.sig
- ../../posix/process.sml
- ../../posix/sys-db.sig
- ../../posix/sys-db.sml
- ../../posix/tty.sig
- ../../posix/tty.sml
- ../../posix/posix.sig
- ../../posix/posix.sml
-
- ../../platform/cygwin.sml
-
- ../../io/stream-io.sig
- ../../io/stream-io.fun
- ../../io/imperative-io.sig
- ../../io/imperative-io.fun
- ../../io/bin-stream-io.sig
- ../../io/bin-io.sig
- ../../io/bin-io.sml
- ../../io/text-stream-io.sig
- ../../io/text-io.sig
- ../../io/text-io.sml
-
- ../../system/path.sig
- ../../system/path.sml
- ../../system/file-sys.sig
- ../../system/file-sys.sml
- ../../system/command-line.sig
- ../../system/command-line.sml
-
- ../../general/sml90.sig
- ../../general/sml90.sml
-
- ../../mlton/pointer.sig
- ../../mlton/pointer.sml
- ../../mlton/call-stack.sig
- ../../mlton/call-stack.sml
- ../../mlton/exit.sml
- ../../mlton/exn.sig
- ../../mlton/exn.sml
- ../../mlton/thread.sig
- ../../mlton/thread.sml
- ../../mlton/signal.sig
- ../../mlton/signal.sml
- ../../mlton/process.sig
- ../../mlton/process.sml
- ../../mlton/gc.sig
- ../../mlton/gc.sml
- ../../mlton/rusage.sig
- ../../mlton/rusage.sml
-
- ../../system/process.sig
- ../../system/process.sml
- ../../system/io.sig
- ../../system/io.sml
- ../../system/os.sig
- ../../system/os.sml
- ../../system/unix.sig
- ../../system/unix.sml
- ../../system/timer.sig
- ../../system/timer.sml
-
- ../../net/net.sig
- ../../net/net.sml
- ../../net/net-host-db.sig
- ../../net/net-host-db.sml
- ../../net/net-prot-db.sig
- ../../net/net-prot-db.sml
- ../../net/net-serv-db.sig
- ../../net/net-serv-db.sml
- ../../net/socket.sig
- ../../net/socket.sml
- ../../net/generic-sock.sig
- ../../net/generic-sock.sml
- ../../net/inet-sock.sig
- ../../net/inet-sock.sml
- ../../net/unix-sock.sig
- ../../net/unix-sock.sml
-
- ../../mlton/array.sig
- ../../mlton/cont.sig
- ../../mlton/cont.sml
- ../../mlton/random.sig
- ../../mlton/random.sml
- ../../mlton/io.sig
- ../../mlton/io.fun
- ../../mlton/text-io.sig
- ../../mlton/bin-io.sig
- ../../mlton/itimer.sig
- ../../mlton/itimer.sml
- ../../mlton/ffi.sig
- ann
- "ffiStr MLtonFFI"
- in
- ../../mlton/ffi.sml
- end
- ../../mlton/int-inf.sig
- ../../mlton/platform.sig
- ../../mlton/platform.sml
- ../../mlton/proc-env.sig
- ../../mlton/proc-env.sml
- ../../mlton/profile.sig
- ../../mlton/profile.sml
- (*
- # mlton/ptrace.sig
- # mlton/ptrace.sml
- *)
- ../../mlton/rlimit.sig
- ../../mlton/rlimit.sml
- ../../mlton/socket.sig
- ../../mlton/socket.sml
- ../../mlton/syslog.sig
- ann
- "allowFFI true"
- in
- ../../mlton/syslog.sml
- end
- ../../mlton/vector.sig
- ../../mlton/weak.sig
- ../../mlton/weak.sml
- ../../mlton/finalizable.sig
- ../../mlton/finalizable.sml
- ../../mlton/word.sig
- ../../mlton/world.sig
- ../../mlton/world.sml
- ../../mlton/mlton.sig
- ../../mlton/mlton.sml
-
- ../../sml-nj/sml-nj.sig
- ../../sml-nj/sml-nj.sml
- ../../sml-nj/unsafe.sig
- ../../sml-nj/unsafe.sml
-
top-level/basis.sig
ann
"allowRebindEquals true"
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -11,27 +11,19 @@
structure PE = Posix.Error
structure PESC = PE.SysCall
- fun intToSock i = Socket.wordToSock (SysWord.fromInt i)
-
fun socket' (af, st, p) =
- PESC.syscall
- (fn () =>
- let val n = Prim.socket (NetHostDB.addrFamilyToInt af, st, p)
- in (n, fn () => intToSock n)
- end)
+ PESC.simpleResult
+ (fn () => Prim.socket (af, st, C_Int.fromInt p))
fun socketPair' (af, st, p) =
let
val a = Array.array (2, 0)
in
PESC.syscall
- (fn () =>
- let val n = Prim.socketPair (NetHostDB.addrFamilyToInt af, st, p, a)
- in (n, fn () => (intToSock (Array.sub (a, 0)),
- intToSock (Array.sub (a, 1))))
- end)
+ (fn () => (Prim.socketPair (af, st, C_Int.fromInt p, a), fn _ =>
+ (Array.sub (a, 0), Array.sub (a, 1))))
end
-
+
fun socket (af, st) = socket' (af, st, 0)
fun socketPair (af, st) = socketPair' (af, st, 0)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -15,29 +15,26 @@
type dgram_sock = Socket.dgram sock
type sock_addr = inet Socket.sock_addr
- val inetAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.INET
+ val inetAF = PrimitiveFFI.Socket.AF.INET
fun toAddr (in_addr, port) =
- let val port = Net.htonl port
- in
if port < 0 orelse port >= 0x10000
then PosixError.raiseSys PosixError.inval
- else
- let
- val (sa, salen, finish) = Socket.new_sock_addr ()
- val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
- port, sa, salen)
- in
- finish ()
- end
- end
+ else let
+ val port = Net.C_Int.hton (C_Int.fromInt port)
+ val (sa, salen, finish) = Socket.new_sock_addr ()
+ val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
+ port, sa, salen)
+ in
+ finish ()
+ end
fun any port = toAddr (NetHostDB.any (), port)
fun fromAddr sa =
let
- val _ = Prim.fromAddr (Word8Vector.toPoly (Socket.unpackSockAddr sa))
- val port = Net.ntohl (Prim.getPort ())
+ val _ = Prim.fromAddr (Socket.unpackSockAddr sa)
+ val port = C_Int.toInt (Net.C_Int.ntoh (Prim.getPort ()))
val (ia, finish) = NetHostDB.new_in_addr ()
val _ = Prim.getInAddr (NetHostDB.preInAddrToWord8Array ia)
in
@@ -46,27 +43,23 @@
structure UDP =
struct
- fun socket' prot =
- GenericSock.socket' (inetAF, Socket.SOCK.dgram, prot)
-
+ fun socket' prot = GenericSock.socket' (inetAF, Socket.SOCK.dgram, prot)
fun socket () = socket' 0
end
structure TCP =
struct
structure Prim = Prim.Ctl
-
- fun socket' prot =
- GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
+ fun socket' prot = GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
fun socket () = socket' 0
-
+
fun getNODELAY sock =
- Socket.CtlExtra.getSockOptBool
- (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) sock
-
- fun setNODELAY (sock,optval) =
- Socket.CtlExtra.setSockOptBool
- (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) (sock,optval)
+ Socket.CtlExtra.getSockOptBool
+ (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) sock
+
+ fun setNODELAY (sock, optval) =
+ Socket.CtlExtra.setSockOptBool
+ (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) (sock,optval)
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-02 01:46:55 UTC (rev 4433)
@@ -22,18 +22,8 @@
include NET_HOST_DB
type pre_in_addr
- val addrFamilyToInt: addr_family -> int
-(*
val any: unit -> in_addr
-*)
val inAddrToWord8Vector: in_addr -> Word8.word vector
-(*
- val inAddrToWord: in_addr -> word
-*)
- val intToAddrFamily: int -> addr_family
val new_in_addr: unit -> pre_in_addr * (unit -> in_addr)
val preInAddrToWord8Array: pre_in_addr -> Word8.word array
-(*
- val wordToInAddr: word -> in_addr
-*)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -5,42 +5,45 @@
* See the file MLton-LICENSE for details.
*)
-structure NetHostDB:> NET_HOST_DB_EXTRA =
+structure NetHostDB: NET_HOST_DB_EXTRA =
struct
structure Prim = PrimitiveFFI.NetHostDB
- (* network byte order (MSB) *)
+ (* network byte order (big-endian) *)
type pre_in_addr = Word8.word array
type in_addr = Word8.word vector
val preInAddrToWord8Array = fn a => a
val inAddrToWord8Vector = fn v => v
- structure PW = PackWord32Big
+ val inAddrLen = C_Size.toInt Prim.inAddrSize
fun new_in_addr () =
let
- val inAddrLen = C_Size.toInt Prim.inAddrSize
val ia: pre_in_addr = Array.array (inAddrLen, 0wx0: Word8.word)
fun finish () = Array.vector ia
in
(ia, finish)
end
-(*
- fun inAddrToWord (ia: in_addr) =
- Word.fromLargeWord (PW.subVec (Word8Vector.fromPoly ia, 0))
- fun wordToInAddr w =
- let
- val (ia, finish) = new_in_addr ()
- val _ = PW.update (Word8Array.fromPoly ia, 0, Word.toLargeWord w)
- in
- finish ()
- end
- fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
-*)
+ fun any () =
+ let
+ val (wa, finish) = new_in_addr ()
+ fun loop (i, acc) =
+ if i >= inAddrLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, (inAddrLen - 1) - i, w)
+ in
+ loop (i + 1, C_Int.>> (acc, 0w4))
+ end
+ in
+ loop (0, Prim.INADDR_ANY)
+ ; finish ()
+ end
type addr_family = C_Int.t
- val intToAddrFamily = C_Int.fromInt
- val addrFamilyToInt = C_Int.toInt
datatype entry = T of {name: string,
aliases: string list,
@@ -80,10 +83,8 @@
if C_Int.< (n, numAddrs)
then let
val addr = Word8Array.array (C_Int.toInt length, 0wx0)
- val _ =
- Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
- val addr =
- Word8Vector.toPoly (Word8Array.vector addr)
+ val _ = Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
+ val addr = Word8Vector.toPoly (Word8Array.vector addr)
in
fill (C_Int.+ (n, 1), addr::addrs)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -30,8 +30,7 @@
fun fill (n, aliases) =
if C_Int.< (n, numAliases)
then let
- val alias =
- CUtil.C_String.toString (Prim.getEntryAliasesN n)
+ val alias = CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
fill (C_Int.+ (n, 1), alias::aliases)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -32,8 +32,7 @@
fun fill (n, aliases) =
if C_Int.< (n, numAliases)
then let
- val alias =
- CUtil.C_String.toString (Prim.getEntryAliasesN n)
+ val alias = CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
fill (C_Int.+ (n, 1), alias::aliases)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-02 01:46:55 UTC (rev 4433)
@@ -170,7 +170,7 @@
val sockToFD: ('af, 'sock_type) sock -> Posix.FileSys.file_desc
val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) sock
type pre_sock_addr
- val unpackSockAddr: 'af sock_addr -> Word8Vector.vector
+ val unpackSockAddr: 'af sock_addr -> Word8.word vector
val new_sock_addr: unit -> (pre_sock_addr * C_Socklen.t ref * (unit -> 'af sock_addr))
structure CtlExtra:
@@ -179,18 +179,14 @@
type optname = C_Int.int
type request = C_Int.int
- (* val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
- (* val setSockOptWord: level * optname -> ('af, 'sock_type) sock * word -> unit *)
val getERROR: ('af, 'sock_type) sock -> (string * Posix.Error.syserror option) option
- val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
- val setSockOptInt: level * optname -> ('af, 'sock_type) sock * int -> unit
+ val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> C_Int.int
+ val setSockOptInt: level * optname -> ('af, 'sock_type) sock * C_Int.int -> unit
val getSockOptBool: level * optname -> ('af, 'sock_type) sock -> bool
val setSockOptBool: level * optname -> ('af, 'sock_type) sock * bool -> unit
- (* val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
- (* val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
- val getIOCtlInt: request -> ('af, 'sock_type) sock -> int
- (* val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
+ val getIOCtlInt: request -> ('af, 'sock_type) sock -> C_Int.int
+ (* val setIOCtlInt: request -> ('af, 'sock_type) sock * C_Int.int -> unit *)
val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
(* val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -5,9 +5,7 @@
* See the file MLton-LICENSE for details.
*)
-structure Socket:> SOCKET_EXTRA
- where type SOCK.sock_type = C_Int.t
- where type pre_sock_addr = Word8.word array =
+structure Socket : SOCKET_EXTRA =
struct
structure Prim = PrimitiveFFI.Socket
@@ -16,22 +14,22 @@
structure FileSys = Posix.FileSys
type sock = C_Sock.t
-val sockToWord = SysWord.fromInt o C_Sock.toInt
-val wordToSock = C_Sock.fromInt o SysWord.toInt
-fun sockToFD sock = FileSys.wordToFD (sockToWord sock)
-fun fdToSock fd = wordToSock (FileSys.fdToWord fd)
+val sockToWord = C_Sock.toSysWord
+val wordToSock = C_Sock.fromSysWord
+val sockToFD = fn x => x
+val fdToSock = fn x => x
type pre_sock_addr = Word8.word array
datatype sock_addr = SA of Word8.word vector
-fun unpackSockAddr (SA sa) = Word8Vector.fromPoly sa
+fun unpackSockAddr (SA sa) = sa
fun new_sock_addr (): (pre_sock_addr * C_Socklen.t ref * (unit -> sock_addr)) =
let
val salen = C_Size.toInt Prim.sockAddrStorageLen
val sa = Array.array (salen, 0wx0)
val salenRef = ref (C_Socklen.fromInt salen)
- fun finish () =
- SA (ArraySlice.vector (ArraySlice.slice
- (sa, 0, SOME (C_Socklen.toInt (!salenRef)))))
+ fun finish () =
+ SA (ArraySlice.vector
+ (ArraySlice.slice (sa, 0, SOME (C_Socklen.toInt (!salenRef)))))
in
(sa, salenRef, finish)
end
@@ -43,12 +41,12 @@
structure AF =
struct
type addr_family = NetHostDB.addr_family
- val names = [
- ("UNIX", Prim.AF.UNIX),
- ("INET", Prim.AF.INET),
- ("INET6", Prim.AF.INET6),
- ("UNSPEC", Prim.AF.UNSPEC)
- ]
+ val names : (string * addr_family) list =
+ ("UNIX", Prim.AF.UNIX) ::
+ ("INET", Prim.AF.INET) ::
+ ("INET6", Prim.AF.INET6) ::
+ ("UNSPEC", Prim.AF.UNSPEC) ::
+ nil
fun list () = names
fun toString af' =
case List.find (fn (_, af) => af = af') names of
@@ -65,10 +63,10 @@
type sock_type = C_Int.t
val stream = Prim.SOCK.STREAM
val dgram = Prim.SOCK.DGRAM
- val names = [
- ("STREAM", stream),
- ("DGRAM", dgram)
- ]
+ val names : (string * sock_type) list =
+ ("STREAM", stream) ::
+ ("DGRAM", dgram) ::
+ nil
fun list () = names
fun toString st' =
case List.find (fn (_, st) => st = st') names of
@@ -85,99 +83,216 @@
type level = C_Int.t
type optname = C_Int.t
type request = C_Int.t
-
+
(* host byte order *)
- structure PW = PackWord32Host
+ type optvalVec = Word8.word vector
+ type optvalArr = Word8.word array
- val wordLen = PW.bytesPerElem
- fun unmarshalWord (wa, _, s): word =
- Word.fromLargeWord (PW.subArr (wa, s))
- val intLen: int = wordLen
- fun unmarshalInt (wa, l, s): int =
- Word.toIntX (unmarshalWord (wa, l, s))
- val boolLen: int = intLen
- fun unmarshalBool (wa, l, s): bool =
- if (unmarshalInt (wa, l, s)) = 0 then false else true
- val timeOptLen: int = boolLen + intLen
- fun unmarshalTimeOpt (wa, l, s): Time.time option =
- if unmarshalBool (wa, l, s)
- then SOME (Time.fromSeconds
- (LargeInt.fromInt
- (unmarshalInt (wa, l, s + 1))))
- else NONE
-
- fun marshalWord (w, wa, s) =
- PW.update (wa, s, Word.toLargeWord w)
-
- fun marshalInt (i, wa, s) =
- marshalWord (Word.fromInt i, wa, s)
-
- fun marshalBool (b, wa, s) =
- marshalInt (if b then 1 else 0, wa, s)
-
- fun marshalTimeOpt (t, wa, s) =
- case t of
- NONE => (marshalBool (false, wa, s)
- ; marshalInt (0, wa, s + 1))
- | SOME t =>
- (marshalBool (true, wa, s)
- ; marshalWord (Word.fromLargeInt (Time.toSeconds t)
- handle Overflow => Error.raiseSys Error.inval,
- wa, s + 1))
-
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ val intLen = Int.quot (C_Int.precision', 4)
+ fun unmarshalInt (wa: optvalArr) : C_Int.int =
+ let
+ fun loop (i, acc) =
+ if i >= intLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, if isBigEndian
+ then i
+ else (intLen - 1) - i)
+ val w = C_Int.fromSysWord (Word8.toSysWord w)
+ in
+ loop (i + 1, C_Int.andb (w, C_Int.<< (acc, 0w4)))
+ end
+ in
+ loop (0, 0)
+ end
+ fun marshalInt (i: C_Int.int) : optvalVec =
+ let
+ val wa = Array.array (intLen, 0wx0)
+ fun loop (i, acc) =
+ if i >= intLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, if isBigEndian
+ then (intLen - 1) - i
+ else i, w)
+ in
+ loop (i + 1, C_Int.>> (acc, 0w4))
+ end
+ in
+ loop (0, i)
+ ; Array.vector wa
+ end
+ val boolLen = intLen
+ fun unmarshalBool (wa: optvalArr) : bool =
+ if (unmarshalInt wa) = 0 then false else true
+ fun marshalBool (b: bool) : optvalVec =
+ marshalInt (if b then 1 else 0)
+ val sizeLen = Int.quot (C_Size.wordSize, 4)
+ fun unmarshalSize (wa: optvalArr) : int =
+ let
+ fun loop (i, acc) =
+ if i >= sizeLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, if isBigEndian
+ then i
+ else (sizeLen - 1) - i)
+ val w = C_Size.fromSysWord (Word8.toSysWord w)
+ in
+ loop (i + 1, C_Size.andb (w, C_Size.<< (acc, 0w4)))
+ end
+ in
+ C_Size.toInt (loop (0, 0wx0))
+ end
+ fun marshalSize (i: int) : optvalVec =
+ let
+ val wa = Array.array (sizeLen, 0wx0)
+ fun loop (i, acc) =
+ if i >= sizeLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Size.toSysWord acc)
+ val () =
+ Array.update
+ (wa, if isBigEndian
+ then (sizeLen - 1) - i
+ else i, w)
+ in
+ loop (i + 1, C_Size.>> (acc, 0w4))
+ end
+ in
+ loop (0, C_Size.fromInt i)
+ ; Array.vector wa
+ end
+ (* Assume 'struct linger' has no padding. *)
+ val optTimeLen: int = intLen + intLen
+ fun unmarshalOptTime (wa: optvalArr) : Time.time option =
+ let
+ fun loopBool (i, acc) =
+ if i >= intLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, if isBigEndian
+ then i
+ else (intLen - 1) - i)
+ val w = C_Int.fromSysWord (Word8.toSysWord w)
+ in
+ loopBool (i + 1, C_Int.andb (w, C_Int.<< (acc, 0w4)))
+ end
+ fun loopInt (i, acc) =
+ if i >= intLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, intLen + (if isBigEndian
+ then i
+ else (intLen - 1) - i))
+ val w = C_Int.fromSysWord (Word8.toSysWord w)
+ in
+ loopInt (i + 1, C_Int.andb (w, C_Int.<< (acc, 0w4)))
+ end
+ in
+ if loopBool (0, 0) = 0
+ then NONE
+ else SOME (Time.fromSeconds (C_Int.toLarge (loopInt (0, 0))))
+ end
+ fun marshalOptTime (to: Time.time option) : optvalVec =
+ let
+ val wa = Array.array (optTimeLen, 0wx0)
+ fun loopBool (i, acc) =
+ if i >= intLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, if isBigEndian
+ then (intLen - 1) - i
+ else i, w)
+ in
+ loopBool (i + 1, C_Int.>> (acc, 0w4))
+ end
+ fun loopInt (i, acc) =
+ if i >= intLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, intLen + (if isBigEndian
+ then (intLen - 1) - i
+ else i), w)
+ in
+ loopInt (i + 1, C_Int.>> (acc, 0w4))
+ end
+ in
+ case to of
+ NONE => (loopBool (0, 0); loopInt (0, 0))
+ | SOME t => (loopBool (0, 1); loopInt (0, C_Int.fromLarge (Time.toSeconds t)))
+ ; Array.vector wa
+ end
+
local
fun make (optlen: int,
- write: 'a * Word8Array.array * int -> unit,
- unmarshal: Word8Array.array * int * int -> 'a) =
+ marshal: 'a -> optvalVec,
+ unmarshal: optvalArr -> 'a) =
let
- fun marshal (x: 'a): Word8Vector.vector =
+ fun getSockOpt (level: level, optname: optname) s : 'a =
let
- val wa = Word8Array.array (optlen, 0wx0)
+ val optval = Array.array (optlen, 0wx0)
+ val optlen' = ref (C_Socklen.fromInt optlen)
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.getSockOpt (s, level, optname, optval, optlen'))
+ val () =
+ if C_Socklen.toInt (!optlen') <> optlen
+ then raise (Fail "Socket.Ctl.getSockOpt: optlen' <> optlen")
+ else ()
in
- write (x, wa, 0)
- ; Word8Array.vector wa
+ unmarshal optval
end
- fun getSockOpt (level: level, optname: optname) s =
+ fun setSockOpt (level: level, optname: optname) (s, optval: 'a) : unit =
let
- val optval = Word8Array.array (optlen, 0wx0)
- val optlen = ref (C_Socklen.fromInt optlen)
- in
- Syscall.simple
- (fn () =>
- Prim.Ctl.getSockOpt (s, level, optname,
- Word8Array.toPoly optval,
- optlen))
- ; unmarshal (optval, C_Socklen.toInt (!optlen), 0)
- end
- fun setSockOpt (level: level, optname: optname) (s, optval) =
- let
val optval = marshal optval
- val optlen = Word8Vector.length optval
+ val optlen' = C_Socklen.fromInt optlen
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.setSockOpt (s, level, optname, optval, optlen'))
in
- Syscall.simple
- (fn () =>
- Prim.Ctl.setSockOpt (s, level, optname,
- Word8Vector.toPoly optval,
- C_Socklen.fromInt optlen))
+ ()
end
fun getIOCtl (request: request) s : 'a =
let
- val optval = Word8Array.array (optlen, 0wx0)
+ val optval = Array.array (optlen, 0wx0)
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.getIOCtl (s, request, optval))
in
- Syscall.simple
- (fn () =>
- Prim.Ctl.getIOCtl
- (s, request, Word8Array.toPoly optval))
- ; unmarshal (optval, optlen, 0)
+ unmarshal optval
end
- fun setIOCtl (request: request) (s, optval: 'a): unit =
+ fun setIOCtl (request: request) (s, optval: 'a) : unit =
let
val optval = marshal optval
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.setIOCtl (s, request, optval))
in
- Syscall.simple
- (fn () =>
- Prim.Ctl.setIOCtl
- (s, request, Word8Vector.toPoly optval))
+ ()
end
in
(getSockOpt, getIOCtl, setSockOpt, setIOCtl)
@@ -187,8 +302,10 @@
make (intLen, marshalInt, unmarshalInt)
val (getSockOptBool, getIOCtlBool, setSockOptBool, _) =
make (boolLen, marshalBool, unmarshalBool)
- val (getSockOptTimeOpt, _, setSockOptTimeOpt, _) =
- make (timeOptLen, marshalTimeOpt, unmarshalTimeOpt)
+ val (getSockOptSize, getIOCtlSize, setSockOptSize, _) =
+ make (sizeLen, marshalSize, unmarshalSize)
+ val (getSockOptOptTime, getIOCtlOptTime, setSockOptOptTime, _) =
+ make (optTimeLen, marshalOptTime, unmarshalOptTime)
end
val getDEBUG = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DEBUG)
@@ -199,16 +316,16 @@
val setKEEPALIVE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_KEEPALIVE)
val getDONTROUTE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
val setDONTROUTE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
+ val getLINGER = getSockOptOptTime (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
+ val setLINGER = setSockOptOptTime (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
val getBROADCAST = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
- val getLINGER = getSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
- val setLINGER = setSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
val setBROADCAST = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
val getOOBINLINE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
val setOOBINLINE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
- val getSNDBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
- val setSNDBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
- val getRCVBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
- val setRCVBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
+ val getSNDBUF = getSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
+ val setSNDBUF = setSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
+ val getRCVBUF = getSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
+ val setRCVBUF = setSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
fun getTYPE s = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_TYPE) s
fun getERROR s =
let
@@ -216,10 +333,10 @@
in
if 0 = se
then NONE
- else SOME (Posix.Error.errorMsg se, SOME se)
+ else SOME (Posix.Error.errorMsg se, SOME se)
end handle Error.SysErr z => SOME z
local
- fun getName (s, f: sock * pre_sock_addr * C_Socklen.t ref -> int) =
+ fun getName (s, f: sock * pre_sock_addr * C_Socklen.t ref -> C_Int.int C_Errno.t) =
let
val (sa, salen, finish) = new_sock_addr ()
val () = Syscall.simple (fn () => f (s, sa, salen))
@@ -230,7 +347,7 @@
fun getPeerName s = getName (s, Prim.Ctl.getPeerName)
fun getSockName s = getName (s, Prim.Ctl.getSockName)
end
- val getNREAD = getIOCtlInt Prim.Ctl.FIONREAD
+ val getNREAD = getIOCtlSize Prim.Ctl.FIONREAD
val getATMARK = getIOCtlBool Prim.Ctl.SIOCATMARK
end
@@ -243,27 +360,24 @@
fun sameAddr (SA sa1, SA sa2) = sa1 = sa2
-fun familyOfAddr (SA sa) = NetHostDB.intToAddrFamily (Prim.familyOfAddr sa)
+fun familyOfAddr (SA sa) = Prim.familyOfAddr sa
fun bind (s, SA sa) =
Syscall.simple (fn () => Prim.bind (s, sa, C_Socklen.fromInt (Vector.length sa)))
fun listen (s, n) =
- Syscall.simple (fn () => Prim.listen (s, n))
+ Syscall.simple (fn () => Prim.listen (s, C_Int.fromInt n))
fun nonBlock' ({restart: bool},
- f : unit -> int, post : int -> 'a, again, no : 'a) =
+ errVal : ''a, f : unit -> ''a C_Errno.t, post : ''a -> 'b, again, no : 'b) =
Syscall.syscallErr
- ({clear = false, restart = restart},
- fn () => let val res = f ()
- in
- {return = res,
- post = fn () => post res,
- handlers = [(again, fn () => no)]}
- end)
+ ({clear = false, restart = restart, errVal = errVal}, fn () =>
+ {return = f (),
+ post = post,
+ handlers = [(again, fn () => no)]})
-fun nonBlock (f, post, no) =
- nonBlock' ({restart = true}, f, post, Error.again, no)
+fun nonBlock (errVal, f, post, no) =
+ nonBlock' ({restart = true}, errVal, f, post, Error.again, no)
local
structure PIO = PrimitiveFFI.Posix.IO
@@ -273,17 +387,15 @@
val fd = s
val flags =
Syscall.simpleResultRestart (fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
- val _ =
- Syscall.simpleResultRestart
+ val () =
+ Syscall.simpleRestart
(fn () =>
PIO.fcntl3 (fd, PIO.F_SETFL,
- Word.toIntX
- (Word.orb (Word.fromInt flags,
- SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.NONBLOCK))))
+ C_Int.orb (flags, PrimitiveFFI.Posix.FileSys.O.NONBLOCK)))
in
DynamicWind.wind
(f, fn () =>
- Syscall.simple (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
+ Syscall.simpleRestart (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
end
end
@@ -292,7 +404,7 @@
fun connectNB (s, SA sa) =
nonBlock'
- ({restart = false}, fn () =>
+ ({restart = false}, C_Int.fromInt ~1, fn () =>
withNonBlock (s, fn () => Prim.connect (s, sa, C_Socklen.fromInt (Vector.length sa))),
fn _ => true,
Error.inprogress, false)
@@ -310,7 +422,8 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
+ (C_Int.fromInt ~1,
+ fn () => withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
fn s => SOME (s, finish ()),
NONE)
end
@@ -378,25 +491,27 @@
type out_flags = {don't_route: bool, oob: bool}
-fun mk_out_flags {don't_route, oob} =
- Word.orb (if don't_route then Word.fromInt Prim.MSG_DONTROUTE else 0wx0,
- Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
- 0wx0))
val no_out_flags = {don't_route = false, oob = false}
+fun mk_out_flags {don't_route, oob} =
+ C_Int.orb (if don't_route then Prim.MSG_DONTROUTE else 0x0,
+ C_Int.orb (if oob then Prim.MSG_OOB else 0x0,
+ 0x0))
+
local
- fun make (base, toPoly, primSend, primSendTo) =
+ fun make (base, primSend, primSendTo) =
let
val base = fn sl => let val (buf, i, sz) = base sl
- in (toPoly buf, i, sz)
+ in (buf, i, sz)
end
fun send' (s, sl, out_flags) =
let
val (buf, i, sz) = base sl
in
- Syscall.simpleResultRestart
- (fn () => primSend (s, buf, i, C_Size.fromInt sz,
- Word.toInt (mk_out_flags out_flags)))
+ (C_SSize.toInt o Syscall.simpleResultRestart')
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primSend (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_out_flags out_flags))
end
fun send (sock, buf) = send' (sock, buf, no_out_flags)
fun sendNB' (s, sl, out_flags) =
@@ -404,12 +519,11 @@
val (buf, i, sz) = base sl
in
nonBlock
- (fn () =>
- primSend (s, buf, i, C_Size.fromInt sz,
- Word.toInt (
- Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
- mk_out_flags out_flags))),
- SOME,
+ (C_SSize.fromInt ~1,
+ fn () =>
+ primSend (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ C_Int.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags)),
+ SOME o C_SSize.toInt,
NONE)
end
fun sendNB (sock, sl) = sendNB' (sock, sl, no_out_flags)
@@ -417,10 +531,10 @@
let
val (buf, i, sz) = base sl
in
- Syscall.simpleRestart
- (fn () =>
- primSendTo (s, buf, i, C_Size.fromInt sz,
- Word.toInt (mk_out_flags out_flags),
+ Syscall.simpleRestart'
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primSendTo (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_out_flags out_flags,
sa, C_Socklen.fromInt (Vector.length sa)))
end
fun sendTo (sock, sock_addr, sl) =
@@ -430,11 +544,10 @@
val (buf, i, sz) = base sl
in
nonBlock
- (fn () =>
- primSendTo (s, buf, i, C_Size.fromInt sz,
- Word.toInt (
- Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
- mk_out_flags out_flags)),
+ (C_SSize.fromInt ~1,
+ fn () =>
+ primSendTo (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ C_Int.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags),
sa, C_Socklen.fromInt (Vector.length sa)),
fn _ => true,
false)
@@ -447,12 +560,10 @@
in
val (sendArr, sendArr', sendArrNB, sendArrNB',
sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') =
- make (Word8ArraySlice.base, Word8Array.toPoly,
- Prim.sendArr, Prim.sendArrTo)
+ make (Word8ArraySlice.base, Prim.sendArr, Prim.sendArrTo)
val (sendVec, sendVec', sendVecNB, sendVecNB',
sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') =
- make (Word8VectorSlice.base, Word8Vector.toPoly,
- Prim.sendVec, Prim.sendVecTo)
+ make (Word8VectorSlice.base, Prim.sendVec, Prim.sendVecTo)
end
type in_flags = {peek: bool, oob: bool}
@@ -460,17 +571,18 @@
val no_in_flags = {peek = false, oob = false}
fun mk_in_flags {peek, oob} =
- Word.orb (if peek then Word.fromInt Prim.MSG_PEEK else 0wx0,
- Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
- 0wx0))
+ C_Int.orb (if peek then Prim.MSG_PEEK else 0x0,
+ C_Int.orb (if oob then Prim.MSG_OOB else 0x0,
+ 0x0))
fun recvArr' (s, sl, in_flags) =
let
val (buf, i, sz) = Word8ArraySlice.base sl
in
- Syscall.simpleResultRestart
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flags in_flags)))
+ (C_SSize.toInt o Syscall.simpleResultRestart')
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ Prim.recv (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flags in_flags))
end
fun getVec (a, n, bytesRead) =
@@ -480,7 +592,7 @@
fun recvVec' (sock, n, in_flags) =
let
- val a = Word8Array.rawArray n
+ val a = Word8Array.arrayUninit n
val bytesRead =
recvArr' (sock, Word8ArraySlice.full a, in_flags)
in
@@ -496,17 +608,18 @@
val (buf, i, sz) = Word8ArraySlice.base sl
val (sa, salen, finish) = new_sock_addr ()
val n =
- Syscall.simpleResultRestart
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flags in_flags),
- sa, salen))
+ (C_SSize.toInt o Syscall.simpleResultRestart')
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ Prim.recvFrom (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flags in_flags,
+ sa, salen))
in
(n, finish ())
end
fun recvVecFrom' (sock, n, in_flags) =
let
- val a = Word8Array.fromPoly (Primitive.Array.array n)
+ val a = Word8Array.arrayUninit n
val (bytesRead, sock_addr) =
recvArrFrom' (sock, Word8ArraySlice.full a, in_flags)
in
@@ -517,27 +630,29 @@
fun recvVecFrom (sock, n) = recvVecFrom' (sock, n, no_in_flags)
-fun mk_in_flagsNB z = Word.orb (mk_in_flags z, Word.fromInt Prim.MSG_DONTWAIT)
+fun mk_in_flagsNB in_flags = C_Int.orb (mk_in_flags in_flags, Prim.MSG_DONTWAIT)
fun recvArrNB' (s, sl, in_flags) =
let
val (buf, i, sz) = Word8ArraySlice.base sl
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flagsNB in_flags)),
- SOME,
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recv (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flagsNB in_flags),
+ SOME o C_SSize.toInt,
NONE)
end
fun recvVecNB' (s, n, in_flags) =
let
- val a = Word8Array.rawArray n
+ val a = Word8Array.arrayUninit n
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
- Word.toInt (mk_in_flagsNB in_flags)),
- fn bytesRead => SOME (getVec (a, n, bytesRead)),
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recv (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
+ mk_in_flagsNB in_flags),
+ fn bytesRead => SOME (getVec (a, n, C_SSize.toInt bytesRead)),
NONE)
end
@@ -551,21 +666,23 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flagsNB in_flags), sa, salen),
- fn n => SOME (n, finish ()),
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recvFrom (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flagsNB in_flags, sa, salen),
+ fn n => SOME (C_SSize.toInt n, finish ()),
NONE)
end
fun recvVecFromNB' (s, n, in_flags) =
let
- val a = Word8Array.fromPoly (Primitive.Array.array n)
+ val a = Word8Array.arrayUninit n
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
- Word.toInt (mk_in_flagsNB in_flags), sa, salen),
- fn bytesRead => SOME (getVec (a, n, bytesRead), finish ()),
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
+ mk_in_flagsNB in_flags, sa, salen),
+ fn bytesRead => SOME (getVec (a, n, C_SSize.toInt bytesRead), finish ()),
NONE)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -14,7 +14,7 @@
type 'mode stream_sock = 'mode Socket.stream sock
type dgram_sock = Socket.dgram sock
type sock_addr = unix Socket.sock_addr
- val unixAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.UNIX
+ val unixAF = PrimitiveFFI.Socket.AF.UNIX
fun toAddr s =
let
@@ -29,7 +29,6 @@
fun fromAddr sa =
let
val sa = Socket.unpackSockAddr sa
- val sa = Word8Vector.toPoly sa
val len = Prim.pathLen sa
val a = CharArray.array (C_Size.toInt len, #"\000")
val _ = Prim.fromAddr (sa, CharArray.toPoly a, len)
@@ -40,13 +39,11 @@
structure Strm =
struct
fun socket () = GenericSock.socket (unixAF, Socket.SOCK.stream)
- fun socketPair () =
- GenericSock.socketPair (unixAF, Socket.SOCK.stream)
+ fun socketPair () = GenericSock.socketPair (unixAF, Socket.SOCK.stream)
end
structure DGrm =
struct
fun socket () = GenericSock.socket (unixAF, Socket.SOCK.dgram)
- fun socketPair () =
- GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
+ fun socketPair () = GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
end
end
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 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2006-05-02 01:46:55 UTC (rev 4433)
@@ -30,7 +30,7 @@
return num;
}
-void NetHostDB_getEntryAddrsN(C_Int_t n, Array(C_Char_t) addr) {
+void NetHostDB_getEntryAddrsN(C_Int_t n, Array(Word8_t) addr) {
int i;
for (i = 0; i < hostent->h_length; i++) {
((char*)addr)[i] = hostent->h_addr_list[n][i];
@@ -38,13 +38,13 @@
return;
}
-Bool_t NetHostDB_getByAddress(Vector(C_Char_t) addr, C_Socklen_t len) {
- hostent = gethostbyaddr((void*)addr, len, AF_INET);
+Bool_t NetHostDB_getByAddress(Vector(Word8_t) addr, C_Socklen_t len) {
+ hostent = gethostbyaddr((const char*)addr, len, AF_INET);
return (hostent != NULL and hostent->h_name != NULL);
}
Bool_t NetHostDB_getByName(NullString8_t name) {
- hostent = gethostbyname((char*)name);
+ hostent = gethostbyname((const char*)name);
return (hostent != NULL and hostent->h_name != NULL);
}
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-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-05-02 01:46:55 UTC (rev 4433)
@@ -257,13 +257,11 @@
} while (0)
static char* mlTypesHSuffix[] = {
- "",
"#endif /* _MLTON_MLTYPES_H_ */",
NULL
};
static char* cTypesHSuffix[] = {
- "",
"#define C_Errno_t(t) t",
"",
"#endif /* _MLTON_CTYPES_H_ */",
@@ -271,7 +269,6 @@
};
static char* cTypesSMLSuffix[] = {
- "",
NULL
};
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 19:06:30
|
Refactored everything but Net; starting on Net
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml
----------------------------------------------------------------------
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-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-01 02:06:27 UTC (rev 4432)
@@ -117,6 +117,7 @@
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
+ ../config/header/$(HEADER_WORD)
../config/objptr/$(OBJPTR_REP)
../config/c/misc/$(CTYPES)
../config/c/position.sml
@@ -149,6 +150,8 @@
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
+ ../config/header/$(HEADER_WORD)
+ ../config/objptr/$(OBJPTR_REP)
../config/c/misc/$(CTYPES)
../config/c/position.sml
../config/c/sys-word.sml
@@ -192,6 +195,8 @@
../config/bind/real-top.sml
../config/bind/word-top.sml
in ann "forceUsed" in
+ ../config/header/$(HEADER_WORD)
+ ../config/objptr/$(OBJPTR_REP)
../config/c/misc/$(CTYPES)
../config/c/position.sml
../config/c/sys-word.sml
@@ -290,7 +295,6 @@
../system/timer.sig
../system/timer.sml
- (*
../net/net.sig
../net/net.sml
../net/net-host-db.sig
@@ -300,14 +304,13 @@
../net/net-serv-db.sig
../net/net-serv-db.sml
../net/socket.sig
- ../net/socket.sml
- ../net/generic-sock.sig
- ../net/generic-sock.sml
- ../net/inet-sock.sig
- ../net/inet-sock.sml
- ../net/unix-sock.sig
- ../net/unix-sock.sml
- *)
+ (* ../net/socket.sml *)
+ (* ../net/generic-sock.sig *)
+ (* ../net/generic-sock.sml *)
+ (* ../net/inet-sock.sig *)
+ (* ../net/inet-sock.sml *)
+ (* ../net/unix-sock.sig *)
+ (* ../net/unix-sock.sml *)
../mlton/array.sig
../mlton/cont.sig
@@ -349,7 +352,6 @@
../mlton/word.sig
../mlton/world.sig
../mlton/world.sml
-(*
../mlton/mlton.sig
../mlton/mlton.sml
@@ -358,6 +360,7 @@
../sml-nj/unsafe.sig
../sml-nj/unsafe.sml
+(*
top-level/basis.sig
ann
"allowRebindEquals true"
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -42,7 +42,7 @@
structure Rlimit: MLTON_RLIMIT
structure Rusage: MLTON_RUSAGE
structure Signal: MLTON_SIGNAL
- structure Socket: MLTON_SOCKET
+(* structure Socket: MLTON_SOCKET *)
structure Syslog: MLTON_SYSLOG
structure TextIO: MLTON_TEXT_IO
structure Thread: MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -27,16 +27,19 @@
; GC.collect ())
fun size x =
- let val refOverhead = 8 (* header + indirect *)
- in Primitive.MLton.size (ref x) - refOverhead
+ let
+ val refOverhead =
+ HeaderWord.wordSize + ObjptrWord.wordSize
+ in
+ C_Size.toInt (Primitive.MLton.size (ref x)) - refOverhead
end
(* fun cleanAtExit () = let open Cleaner in clean atExit end *)
-val debug = Primitive.debug
-val eq = Primitive.eq
+val debug = Primitive.Controls.debug
+val eq = Primitive.MLton.eq
(* val errno = Primitive.errno *)
-val safe = Primitive.safe
+val safe = Primitive.Controls.safe
structure Array = Array
structure BinIO = MLtonIO (BinIO)
@@ -60,7 +63,7 @@
structure Rlimit = MLtonRlimit
structure Rusage = MLtonRusage
structure Signal = MLtonSignal
-structure Socket = MLtonSocket
+(* structure Socket = MLtonSocket *)
structure Syslog = MLtonSyslog
structure TextIO = MLtonIO (TextIO)
structure Thread = MLtonThread
@@ -69,12 +72,12 @@
structure World = MLtonWorld
structure Word =
struct
- open Primitive.Word32
+ open Word32
type t = word
end
structure Word8 =
struct
- open Primitive.Word8
+ open Word8
type t = word
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -5,8 +5,6 @@
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
-
-type word = Word.word
signature MLTON_WORD =
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -23,11 +23,17 @@
type pre_in_addr
val addrFamilyToInt: addr_family -> int
+(*
val any: unit -> in_addr
+*)
val inAddrToWord8Vector: in_addr -> Word8.word vector
+(*
val inAddrToWord: in_addr -> word
+*)
val intToAddrFamily: int -> addr_family
val new_in_addr: unit -> pre_in_addr * (unit -> in_addr)
val preInAddrToWord8Array: pre_in_addr -> Word8.word array
+(*
val wordToInAddr: word -> in_addr
+*)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -15,16 +15,17 @@
val preInAddrToWord8Array = fn a => a
val inAddrToWord8Vector = fn v => v
-
+
structure PW = PackWord32Big
fun new_in_addr () =
let
- val inAddrLen = Word32.toIntX Prim.inAddrSize
+ val inAddrLen = C_Size.toInt Prim.inAddrSize
val ia: pre_in_addr = Array.array (inAddrLen, 0wx0: Word8.word)
fun finish () = Array.vector ia
in
(ia, finish)
end
+(*
fun inAddrToWord (ia: in_addr) =
Word.fromLargeWord (PW.subVec (Word8Vector.fromPoly ia, 0))
fun wordToInAddr w =
@@ -35,10 +36,11 @@
finish ()
end
fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
+*)
+
type addr_family = C_Int.t
-
- val intToAddrFamily = fn z => z
- val addrFamilyToInt = fn z => z
+ val intToAddrFamily = C_Int.fromInt
+ val addrFamilyToInt = C_Int.toInt
datatype entry = T of {name: string,
aliases: string list,
@@ -59,15 +61,15 @@
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.getEntryName ())
+ val name = CUtil.C_String.toString (Prim.getEntryName ())
val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
- if n < numAliases
+ if C_Int.< (n, numAliases)
then let
val alias =
- COld.CS.toString (Prim.getEntryAliasesN n)
+ CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
- fill (n + 1, alias::aliases)
+ fill (C_Int.+ (n, 1), alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
@@ -75,15 +77,15 @@
val length = Prim.getEntryLength ()
val numAddrs = Prim.getEntryAddrsNum ()
fun fill (n, addrs) =
- if n < numAddrs
+ if C_Int.< (n, numAddrs)
then let
- val addr = Word8Array.array (length, 0wx0)
+ val addr = Word8Array.array (C_Int.toInt length, 0wx0)
val _ =
Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
val addr =
Word8Vector.toPoly (Word8Array.vector addr)
in
- fill (n + 1, addr::addrs)
+ fill (C_Int.+ (n, 1), addr::addrs)
end
else List.rev addrs
val addrs = fill (0, [])
@@ -145,8 +147,8 @@
end
val l = loop (4, state, [])
fun get1 w =
- (Word8.fromLarge (Word32.toLarge (Word32.andb (w, 0wxFF))),
- Word32.>>(w, 0w8))
+ (Word8.fromLarge (Word.toLarge (Word.andb (w, 0wxFF))),
+ Word.>>(w, 0w8))
fun get2 w =
let
val (a,w) = get1 w
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -11,29 +11,29 @@
datatype entry = T of {name: string,
aliases: string list,
- protocol: int}
+ protocol: C_Int.t}
local
fun make s (T r) = s r
in
val name = make #name
val aliases = make #aliases
- val protocol = make #protocol
+ val protocol = C_Int.toInt o (make #protocol)
end
local
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.getEntryName ())
+ val name = CUtil.C_String.toString (Prim.getEntryName ())
val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
- if n < numAliases
+ if C_Int.< (n, numAliases)
then let
val alias =
- COld.CS.toString (Prim.getEntryAliasesN n)
+ CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
- fill (n + 1, alias::aliases)
+ fill (C_Int.+ (n, 1), alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
@@ -48,6 +48,6 @@
fun getByName name =
get (Prim.getByName (NullString.nullTerm name))
fun getByNumber proto =
- get (Prim.getByNumber proto)
+ get (Prim.getByNumber (C_Int.fromInt proto))
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -11,7 +11,7 @@
datatype entry = T of {name: string,
aliases: string list,
- port: int,
+ port: C_Int.t,
protocol: string}
local
@@ -19,7 +19,7 @@
in
val name = make #name
val aliases = make #aliases
- val port = make #port
+ val port = C_Int.toInt o (make #port)
val protocol = make #protocol
end
@@ -27,20 +27,20 @@
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.getEntryName ())
+ val name = CUtil.C_String.toString (Prim.getEntryName ())
val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
- if n < numAliases
+ if C_Int.< (n, numAliases)
then let
val alias =
- COld.CS.toString (Prim.getEntryAliasesN n)
+ CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
- fill (n + 1, alias::aliases)
+ fill (C_Int.+ (n, 1), alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
- val port = Net.ntohl (Prim.getEntryPort ())
- val protocol = COld.CS.toString (Prim.getEntryProto ())
+ val port = Net.C_Int.ntoh (Prim.getEntryPort ())
+ val protocol = CUtil.C_String.toString (Prim.getEntryProto ())
in
SOME (T {name = name,
aliases = aliases,
@@ -56,7 +56,7 @@
| NONE => get (Prim.getByNameNull (NullString.nullTerm name))
fun getByPort (port, proto) =
let
- val port = Net.htonl port
+ val port = Net.C_Int.hton (C_Int.fromInt port)
in
case proto of
NONE => get (Prim.getByPortNull port)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -1,7 +1,15 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
signature NET =
sig
- val htonl: Int32.int -> Int32.int
- val ntohl: Int32.int -> Int32.int
- val htons: Int16.int -> Int16.int
- val ntohs: Int16.int -> Int16.int
+ structure C_Int :
+ sig
+ val hton: C_Int.t -> C_Int.t
+ val ntoh: C_Int.t -> C_Int.t
+ end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -9,8 +9,51 @@
struct
structure Prim = PrimitiveFFI.Net
- val htonl = Primitive.Word32.toInt32 o Prim.htonl o Primitive.Word32.fromInt32
- val ntohl = Primitive.Word32.toInt32 o Prim.ntohl o Primitive.Word32.fromInt32
- val htons = Primitive.Word16.toInt16 o Prim.htons o Primitive.Word16.fromInt16
- val ntohs = Primitive.Word16.toInt16 o Prim.ntohs o Primitive.Word16.fromInt16
+ structure Word32 =
+ struct
+ val hton = Prim.htonl
+ val ntoh = Prim.ntohl
+ end
+ structure Word16 =
+ struct
+ val hton = Prim.htons
+ val ntoh = Prim.ntohs
+ end
+
+ structure Int32 =
+ struct
+ val hton = Primitive.Word32.toInt32Unsafe o Word32.hton o Primitive.Word32.fromInt32Unsafe
+ val ntoh = Primitive.Word32.toInt32Unsafe o Word32.ntoh o Primitive.Word32.fromInt32Unsafe
+ end
+ structure Int16 =
+ struct
+ val hton = Primitive.Word16.toInt16Unsafe o Word16.hton o Primitive.Word16.fromInt16Unsafe
+ val ntoh = Primitive.Word16.toInt16Unsafe o Word16.ntoh o Primitive.Word16.fromInt16Unsafe
+ end
+
+ structure C_Int =
+ struct
+ local
+ structure S =
+ C_Int_ChooseIntN
+ (type 'a t = 'a -> 'a
+ val fInt8 = fn _ => raise Fail "Net.C_Int.hton: fInt8"
+ val fInt16 = Int16.hton
+ val fInt32 = Int32.hton
+ val fInt64 = fn _ => raise Fail "Net.C_Int.hton: fInt64")
+ in
+ val hton = S.f
+ end
+ local
+ structure S =
+ C_Int_ChooseIntN
+ (type 'a t = 'a -> 'a
+ val fInt8 = fn _ => raise Fail "Net.C_Int.ntoh: fInt8"
+ val fInt16 = Int16.ntoh
+ val fInt32 = Int32.ntoh
+ val fInt64 = fn _ => raise Fail "Net.C_Int.ntoh: fInt64")
+ in
+ val ntoh = S.f
+ end
+ end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -175,29 +175,23 @@
structure CtlExtra:
sig
- type level = int
- type optname = int
- type request = int
+ type level = C_Int.int
+ type optname = C_Int.int
+ type request = C_Int.int
-(* val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
-(* val setSockOptWord:
- * level * optname -> ('af, 'sock_type) sock * word -> unit
- *)
- val getERROR:
- ('af, 'sock_type) sock
- -> (string * Posix.Error.syserror option) option
+ (* val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
+ (* val setSockOptWord: level * optname -> ('af, 'sock_type) sock * word -> unit *)
+ val getERROR: ('af, 'sock_type) sock -> (string * Posix.Error.syserror option) option
val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
- val setSockOptInt:
- level * optname -> ('af, 'sock_type) sock * int -> unit
+ val setSockOptInt: level * optname -> ('af, 'sock_type) sock * int -> unit
val getSockOptBool: level * optname -> ('af, 'sock_type) sock -> bool
- val setSockOptBool:
- level * optname -> ('af, 'sock_type) sock * bool -> unit
+ val setSockOptBool: level * optname -> ('af, 'sock_type) sock * bool -> unit
-(* val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
-(* val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
+ (* val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
+ (* val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
val getIOCtlInt: request -> ('af, 'sock_type) sock -> int
-(* val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
+ (* val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
-(* val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
+ (* val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -7,8 +7,7 @@
structure Socket:> SOCKET_EXTRA
where type SOCK.sock_type = C_Int.t
- where type pre_sock_addr = Word8.word array
-=
+ where type pre_sock_addr = Word8.word array =
struct
structure Prim = PrimitiveFFI.Socket
@@ -44,12 +43,11 @@
structure AF =
struct
type addr_family = NetHostDB.addr_family
- val i2a = NetHostDB.intToAddrFamily
val names = [
- ("UNIX", i2a Prim.AF.UNIX),
- ("INET", i2a Prim.AF.INET),
- ("INET6", i2a Prim.AF.INET6),
- ("UNSPEC", i2a Prim.AF.UNSPEC)
+ ("UNIX", Prim.AF.UNIX),
+ ("INET", Prim.AF.INET),
+ ("INET6", Prim.AF.INET6),
+ ("UNSPEC", Prim.AF.UNSPEC)
]
fun list () = names
fun toString af' =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -12,7 +12,7 @@
val sub = unsafeSub
val update = unsafeUpdate
- val create = fromPoly o Primitive.Array.array
+ val create = fromPoly o Array.arrayUninit
end
functor UnsafeMonoVector (V: MONO_VECTOR_EXTRA): UNSAFE_MONO_VECTOR =
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 17:38:29
|
Refactored MLton (all but Socket)
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
----------------------------------------------------------------------
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-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-01 00:38:26 UTC (rev 4431)
@@ -290,75 +290,73 @@
../system/timer.sig
../system/timer.sml
-(*
- ../../net/net.sig
- ../../net/net.sml
- ../../net/net-host-db.sig
- ../../net/net-host-db.sml
- ../../net/net-prot-db.sig
- ../../net/net-prot-db.sml
- ../../net/net-serv-db.sig
- ../../net/net-serv-db.sml
- ../../net/socket.sig
- ../../net/socket.sml
- ../../net/generic-sock.sig
- ../../net/generic-sock.sml
- ../../net/inet-sock.sig
- ../../net/inet-sock.sml
- ../../net/unix-sock.sig
- ../../net/unix-sock.sml
-*)
+ (*
+ ../net/net.sig
+ ../net/net.sml
+ ../net/net-host-db.sig
+ ../net/net-host-db.sml
+ ../net/net-prot-db.sig
+ ../net/net-prot-db.sml
+ ../net/net-serv-db.sig
+ ../net/net-serv-db.sml
+ ../net/socket.sig
+ ../net/socket.sml
+ ../net/generic-sock.sig
+ ../net/generic-sock.sml
+ ../net/inet-sock.sig
+ ../net/inet-sock.sml
+ ../net/unix-sock.sig
+ ../net/unix-sock.sml
+ *)
+ ../mlton/array.sig
+ ../mlton/cont.sig
+ ../mlton/cont.sml
+ ../mlton/random.sig
+ ../mlton/random.sml
+ ../mlton/io.sig
+ ../mlton/io.fun
+ ../mlton/text-io.sig
+ ../mlton/bin-io.sig
+ ../mlton/itimer.sig
+ ../mlton/itimer.sml
+ ../mlton/ffi.sig
+ ann
+ "ffiStr MLtonFFI"
+ in
+ ../mlton/ffi.sml
+ end
+ ../mlton/int-inf.sig
+ ../mlton/platform.sig
+ ../mlton/platform.sml
+ ../mlton/proc-env.sig
+ ../mlton/proc-env.sml
+ ../mlton/profile.sig
+ ../mlton/profile.sml
+ (* ../mlton/ptrace.sig *)
+ (* ../mlton/ptrace.sml *)
+ ../mlton/rlimit.sig
+ ../mlton/rlimit.sml
+ (* ../mlton/socket.sig *)
+ (* ../mlton/socket.sml *)
+ ../mlton/syslog.sig
+ ../mlton/syslog.sml
+ ../mlton/vector.sig
+ ../mlton/weak.sig
+ ../mlton/weak.sml
+ ../mlton/finalizable.sig
+ ../mlton/finalizable.sml
+ ../mlton/word.sig
+ ../mlton/world.sig
+ ../mlton/world.sml
(*
- ../../mlton/array.sig
- ../../mlton/cont.sig
- ../../mlton/cont.sml
- ../../mlton/random.sig
- ../../mlton/random.sml
- ../../mlton/io.sig
- ../../mlton/io.fun
- ../../mlton/text-io.sig
- ../../mlton/bin-io.sig
- ../../mlton/itimer.sig
- ../../mlton/itimer.sml
- ../../mlton/ffi.sig
- ann
- "ffiStr MLtonFFI"
- in
- ../../mlton/ffi.sml
- end
- ../../mlton/int-inf.sig
- ../../mlton/platform.sig
- ../../mlton/platform.sml
- ../../mlton/proc-env.sig
- ../../mlton/proc-env.sml
- ../../mlton/profile.sig
- ../../mlton/profile.sml
- (*
- # mlton/ptrace.sig
- # mlton/ptrace.sml
- *)
- ../../mlton/rlimit.sig
- ../../mlton/rlimit.sml
- ../../mlton/socket.sig
- ../../mlton/socket.sml
- ../../mlton/syslog.sig
- ../../mlton/syslog.sml
- ../../mlton/vector.sig
- ../../mlton/weak.sig
- ../../mlton/weak.sml
- ../../mlton/finalizable.sig
- ../../mlton/finalizable.sml
- ../../mlton/word.sig
- ../../mlton/world.sig
- ../../mlton/world.sml
- ../../mlton/mlton.sig
- ../../mlton/mlton.sml
+ ../mlton/mlton.sig
+ ../mlton/mlton.sml
- ../../sml-nj/sml-nj.sig
- ../../sml-nj/sml-nj.sml
- ../../sml-nj/unsafe.sig
- ../../sml-nj/unsafe.sml
+ ../sml-nj/sml-nj.sig
+ ../sml-nj/sml-nj.sml
+ ../sml-nj/unsafe.sig
+ ../sml-nj/unsafe.sml
top-level/basis.sig
ann
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -9,18 +9,17 @@
structure MLtonCont:> MLTON_CONT =
struct
-structure Thread = Primitive.Thread
-val gcState = Primitive.GCState.gcState
+structure Thread = Primitive.MLton.Thread
-(* This mess with dummy is so that if callcc is ever used anywhere in the
- * program, then Primitive.usesCallcc is set to true during basis library
- * evaluation. This relies on the dead code elimination algorithm
- * (core-ml/dead-code.fun), which will keep dummy around only if callcc is used.
- *)
-val dummy =
- (Primitive.usesCallcc := true
- ; fn () => ())
+fun die (s: string): 'a =
+ (PrimitiveFFI.Stdio.print s
+ ; PrimitiveFFI.Posix.Process.exit 1
+ ; let exception DieFailed
+ in raise DieFailed
+ end)
+val gcState = Primitive.MLton.GCState.gcState
+
type 'a t = (unit -> 'a) -> unit
fun callcc (f: 'a t -> 'a): 'a =
@@ -58,7 +57,7 @@
Thread.switchTo new
end)
end
- end)
+ end
fun ('a, 'b) throw' (k: 'a t, v: unit -> 'a): 'b =
(k v; raise Fail "throw bug")
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -11,8 +11,10 @@
val atomicEnd: unit -> unit
val getBool: int -> bool
val getChar8: int -> Char.char
+(*
val getChar16: int -> Char16.char
val getChar32: int -> Char32.char
+*)
val getInt8: int -> Int8.int
val getInt16: int -> Int16.int
val getInt32: int -> Int32.int
@@ -27,8 +29,10 @@
val register: int * (unit -> unit) -> unit
val setBool: bool -> unit
val setChar8: Char.char -> unit
+(*
val setChar16: Char16.char -> unit
val setChar32: Char32.char -> unit
+*)
val setInt8: Int8.int -> unit
val setInt16: Int16.int -> unit
val setInt32: Int32.int -> unit
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -8,13 +8,14 @@
structure MLtonFFI: MLTON_FFI =
struct
-structure Prim = Primitive.FFI
+structure Prim = Primitive.MLton.FFI
-structure Pointer = Primitive.Pointer
+structure Pointer = Primitive.MLton.Pointer
local
fun make (p: Pointer.t, get, set) =
- (fn i => get (p, i), fn x => set (p, 0, x))
+ (fn i => get (p, C_Ptrdiff.fromInt i),
+ fn x => set (p, C_Ptrdiff.fromInt 0, x))
in
val (getInt8, setInt8) =
make (Prim.int8Array, Pointer.getInt8, Pointer.setInt8)
@@ -24,8 +25,8 @@
make (Prim.int32Array, Pointer.getInt32, Pointer.setInt32)
val (getInt64, setInt64) =
make (Prim.int64Array, Pointer.getInt64, Pointer.setInt64)
- fun getPointer i = Pointer.getPointer (Prim.pointerArray, i)
- fun setPointer x = Pointer.setPointer (Prim.pointerArray, 0, x)
+ fun getPointer i = Pointer.getPointer (Prim.pointerArray, C_Ptrdiff.fromInt i)
+ fun setPointer x = Pointer.setPointer (Prim.pointerArray, C_Ptrdiff.fromInt 0, x)
val (getReal32, setReal32) =
make (Prim.real32Array, Pointer.getReal32, Pointer.setReal32)
val (getReal64, setReal64) =
@@ -45,20 +46,20 @@
val register = MLtonThread.register
(* To the C-world, booleans and chars are signed integers. *)
-fun intToBool (i: int): bool = i <> 0
+fun intToBool (i: Int32.t): bool = i <> 0
val getBool = intToBool o getInt32
-val getChar8 = Primitive.Char.fromInt8 o getInt8
-val getChar16 = Primitive.Char2.fromInt16 o getInt16
-val getChar32 = Primitive.Char4.fromInt32 o getInt32
+val getChar8 = Primitive.Char8.fromInt8Unsafe o getInt8
+val getChar16 = Primitive.Char16.fromInt16Unsafe o getInt16
+val getChar32 = Primitive.Char32.fromInt32Unsafe o getInt32
-fun boolToInt (b: bool): int = if b then 1 else 0
+fun boolToInt (b: bool): Int32.t = if b then 1 else 0
val setBool = setInt32 o boolToInt
-val setChar8 = setInt8 o Primitive.Char.toInt8
-val setChar16 = setInt16 o Primitive.Char2.toInt16
-val setChar32 = setInt32 o Primitive.Char4.toInt32
+val setChar8 = setInt8 o Primitive.Char8.toInt8Unsafe
+val setChar16 = setInt16 o Primitive.Char16.toInt16Unsafe
+val setChar32 = setInt32 o Primitive.Char32.toInt32Unsafe
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -21,7 +21,7 @@
finalizers: ('a -> unit) list ref,
value: 'a ref}
-fun touch (T {value, ...}) = Primitive.touch value
+fun touch (T {value, ...}) = Primitive.MLton.Finalizable.touch value
fun withValue (f as T {value, ...}, g) =
DynamicWind.wind (fn () => g (!value),
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -5,18 +5,18 @@
* See the file MLton-LICENSE for details.
*)
-type int = Int.int
-type word = Word.word
-
signature MLTON_INT_INF =
sig
type t
+
+ structure BigWord : WORD
+ structure SmallInt : INTEGER
val areSmall: t * t -> bool
val gcd: t * t -> t
val isSmall: t -> bool
datatype rep =
- Big of word vector
- | Small of int
+ Big of BigWord.word vector
+ | Small of SmallInt.int
val rep: t -> rep
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -26,9 +26,10 @@
let
fun split t =
let
- val (q, r) = IntInf.quotRem (Time.toMicroseconds t, 1000000)
+ val q = LargeInt.quot (Time.toMicroseconds t, 1000000)
+ val r = LargeInt.rem (Time.toMicroseconds t, 1000000)
in
- (IntInf.toInt q, IntInf.toInt r)
+ (C_Time.fromLarge q, C_SUSeconds.fromLarge r)
end
val (s1, u1) = split interval
val (s2, u2) = split value
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -25,6 +25,6 @@
val n = Vector.length v
in
PosixError.SysCall.simple
- (fn () => PrimitiveFFI.Posix.ProcEnv.setgroups (n, v))
+ (fn () => PrimitiveFFI.Posix.ProcEnv.setgroups (C_Int.fromInt n, v))
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -10,7 +10,7 @@
structure P = Primitive.MLton.Profile
-val gcState = Primitive.GCState.gcState
+val gcState = Primitive.MLton.GCState.gcState
val isOn = P.isOn
@@ -81,7 +81,7 @@
creat (file,
flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth])
end
- val _ = P.Data.write (gcState, raw, Posix.FileSys.fdToWord fd)
+ val _ = P.Data.write (gcState, raw, fd)
val _ = Posix.IO.close fd
in
()
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -5,9 +5,6 @@
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
-
-type int = Int.int
-type word = Word.word
signature MLTON_RANDOM =
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -8,9 +8,9 @@
signature MLTON_RLIMIT =
sig
- type rlim = Word64.word
+ structure RLim : WORD
- val infinity: rlim
+ val infinity: RLim.word
type t
@@ -27,7 +27,7 @@
val numProcesses: t (* NPROC max number of processes *)
val residentSetSize: t (* RSS max resident set size *)
*)
-
- val get: t -> {hard: rlim, soft: rlim}
- val set: t * {hard: rlim, soft: rlim} -> unit
+
+ val get: t -> {hard: RLim.word, soft: RLim.word}
+ val set: t * {hard: RLim.word, soft: RLim.word} -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -9,14 +9,14 @@
structure MLtonRlimit: MLTON_RLIMIT =
struct
open PrimitiveFFI.MLton.Rlimit
- type rlim = C_RLim.t
+ structure RLim = C_RLim
type t = C_Int.t
val get =
fn (r: t) =>
PosixError.SysCall.syscall
(fn () =>
- (get r, fn () =>
+ (get r, fn _ =>
{hard = getHard (),
soft = getSoft ()}))
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -70,20 +70,17 @@
val WARNING = LOG_WARNING
end
-fun zt s = s ^ "\000"
-
val openlog = fn (s, opt, fac) =>
let
- val optf =
- Word32.toInt (foldl Word32.orb 0w0 (map Word32.fromInt opt))
+ val optf = foldl C_Int.orb 0 opt
in
- openlog (NullString.fromString (zt s), optf, fac)
+ openlog (NullString.nullTerm s, optf, fac)
end
val closelog = fn () =>
closelog ()
val log = fn (lev, msg) =>
- syslog (lev, NullString.fromString (zt msg))
+ syslog (lev, NullString.nullTerm msg)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -8,9 +8,9 @@
structure MLtonWorld: MLTON_WORLD =
struct
- structure Prim = Primitive.World
+ structure Prim = Primitive.MLton.World
- val gcState = Primitive.GCState.gcState
+ val gcState = Primitive.MLton.GCState.gcState
datatype status = Clone | Original
@@ -24,8 +24,7 @@
let
open Posix.FileSys
val flags =
- O.flags [O.trunc,
- SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.BINARY]
+ O.flags [O.trunc, PrimitiveFFI.Posix.FileSys.O.BINARY]
val mode =
let
open S
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -229,7 +229,7 @@
struct
type t = Pointer.t
- (* val dummy:t = 0w0 *)
+ val dummy = Pointer.null
val free = _import "GC_profileFree": GCState.t * t -> unit;
val malloc = _import "GC_profileMalloc": GCState.t -> t;
val write = _import "GC_profileWrite": GCState.t * t * C_Fd.t -> unit;
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 15:19:02
|
Refactored System (complete)
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-04-30 22:18:59 UTC (rev 4430)
@@ -23,8 +23,7 @@
OBJPTR_REP_MAPS = objptr-rep32.map objptr-rep64.map
HEADER_MAPS = header-word32.map header-word64.map
SEQ_INDEX_MAPS = seqindex-int32.map seqindex-int64.map
-# CTYPES_MAPS = c-types.m32.map c-types.m64.map c-types.weird.map
-CTYPES_MAPS = c-types.m32.map c-types.m64.map
+CTYPES_MAPS = c-types.m32.map c-types.m64.map c-types.weird.map
DEFAULT_CHAR_MAPS = default-char8.map
DEFAULT_INT_MAPS = default-int32.map default-int64.map default-int-inf.map
DEFAULT_REAL_MAPS = default-real32.map default-real64.map
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-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 22:18:59 UTC (rev 4430)
@@ -279,18 +279,18 @@
../mlton/rusage.sig
../mlton/rusage.sml
+ ../system/process.sig
+ ../system/process.sml
+ ../system/io.sig
+ ../system/io.sml
+ ../system/os.sig
+ ../system/os.sml
+ ../system/unix.sig
+ ../system/unix.sml
+ ../system/timer.sig
+ ../system/timer.sml
+
(*
- ../../system/process.sig
- ../../system/process.sml
- ../../system/io.sig
- ../../system/io.sml
- ../../system/os.sig
- ../../system/os.sml
- ../../system/unix.sig
- ../../system/unix.sml
- ../../system/timer.sig
- ../../system/timer.sml
-
../../net/net.sig
../../net/net.sml
../../net/net-host-db.sig
@@ -307,7 +307,9 @@
../../net/inet-sock.sml
../../net/unix-sock.sig
../../net/unix-sock.sml
+*)
+(*
../../mlton/array.sig
../../mlton/cont.sig
../../mlton/cont.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -44,9 +44,12 @@
structure C_Size = struct open Word16 type t = word end
functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
-structure C_Pointer = Pointer
-structure C_String = Pointer
-structure C_StringArray = Pointer
+structure C_Pointer = struct open Word32 type t = word end
+functor C_Pointer_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_String = struct open Word32 type t = word end
+functor C_String_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_StringArray = struct open Word32 type t = word end
+functor C_StringArray_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* Generic integers *)
structure C_Fd = C_Int
@@ -65,6 +68,10 @@
functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
structure C_UIntmax = struct open Word32 type t = word end
functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Intptr = struct open Int32 type t = int end
+functor C_Intptr_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UIntptr = struct open Word32 type t = word end
+functor C_UIntptr_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* from <dirent.h> *)
structure C_DirP = struct open Word16 type t = word end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -33,10 +33,10 @@
type uid = C_UId.t
type gid = C_GId.t
- val fdToWord = SysWord.fromLargeInt o C_Fd.toLarge
- val wordToFD = C_Fd.fromLarge o SysWord.toLargeInt
- val fdToIOD = OS.IO.fromFD
- val iodToFD = SOME o OS.IO.toFD
+ val fdToWord = C_Fd.toSysWord
+ val wordToFD = C_Fd.fromSysWord
+ val fdToIOD = fn x => x
+ val iodToFD = SOME o (fn x => x)
(*------------------------------------*)
(* dirstream *)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -1,6 +1,7 @@
(* modified from SML/NJ sources by Stephen Weeks 1998-6-25 *)
(* modified by Matthew Fluet 2002-10-11 *)
(* modified by Matthew Fluet 2002-11-21 *)
+(* modified by Matthew Fluet 2006-04-30 *)
(* os-io.sml
*
@@ -22,25 +23,18 @@
datatype iodesc_kind = K of string
- type file_desc = Primitive.FileDesc.t
+ type file_desc = Posix.FileSys.file_desc
- fun toFD (iod: iodesc): file_desc =
- valOf (Posix.FileSys.iodToFD iod)
+ val iodToFd = fn x => x
+ val fdToIod = fn x => x
- val FD = Primitive.FileDesc.fromInt
- val unFD = Primitive.FileDesc.toInt
+ val iodescToWord = C_Fd.toSysWord
- fun fromInt i = Posix.FileSys.fdToIOD (FD i)
-
- val toInt: iodesc -> int = unFD o toFD
-
- val toWord = Posix.FileSys.fdToWord o toFD
-
(* return a hash value for the I/O descriptor. *)
- val hash = toWord
+ val hash = SysWord.toWord o iodescToWord
(* compare two I/O descriptors *)
- fun compare (i, i') = Word.compare (toWord i, toWord i')
+ fun compare (i, i') = SysWord.compare (iodescToWord i, iodescToWord i')
structure Kind =
struct
@@ -55,7 +49,7 @@
(* return the kind of I/O descriptor *)
fun kind (iod) = let
- val stat = Posix.FileSys.fstat (toFD iod)
+ val stat = Posix.FileSys.fstat (iodToFd iod)
in
if (Posix.FileSys.ST.isReg stat) then Kind.file
else if (Posix.FileSys.ST.isDir stat) then Kind.dir
@@ -96,26 +90,23 @@
local
structure Prim = PrimitiveFFI.OS.IO
fun join (false, _, w) = w
- | join (true, b, w) = Word16.orb(w, b)
- fun test (w, b) = (Word16.andb(w, b) <> 0w0)
- val rdBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLIN
- and wrBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLOUT
- and priBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLPRI
+ | join (true, b, w) = C_Short.orb(w, b)
+ fun test (w, b) = (C_Short.andb(w, b) <> 0)
+ val rdBit = PrimitiveFFI.OS.IO.POLLIN
+ and wrBit = PrimitiveFFI.OS.IO.POLLOUT
+ and priBit = PrimitiveFFI.OS.IO.POLLPRI
fun fromPollDesc (PollDesc (iod, {rd, wr, pri})) =
- ( toInt iod,
- Primitive.Word16.toInt16 (
+ ( iodToFd iod,
join (rd, rdBit,
join (wr, wrBit,
- join (pri, priBit, 0w0))))
+ join (pri, priBit, 0)))
)
fun toPollInfo (fd, i) =
- let val w = Primitive.Word16.fromInt16 i
- in PollInfo (fromInt fd, {
- rd = test(w, rdBit),
- wr = test(w, wrBit),
- pri = test(w, priBit)
+ PollInfo (fdToIod fd, {
+ rd = test(i, rdBit),
+ wr = test(i, wrBit),
+ pri = test(i, priBit)
})
- end
in
fun poll (pds, timeOut) = let
val (fds, eventss) = ListPair.unzip (List.map fromPollDesc pds)
@@ -128,7 +119,7 @@
| SOME t =>
if Time.< (t, Time.zeroTime)
then let open PosixError in raiseSys inval end
- else (Int.fromLarge (Time.toMilliseconds t)
+ else (C_Int.fromLarge (Time.toMilliseconds t)
handle Overflow => Error.raiseSys Error.inval)
val reventss = Array.array (n, 0)
val _ = Posix.Error.SysCall.simpleRestart
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -11,17 +11,9 @@
struct
type status = C_Status.t
end
- structure IO :> sig
- eqtype iodesc
-
- val fromFD: C_Fd.t -> iodesc
- val toFD: iodesc -> C_Fd.t
- end =
+ structure IO =
struct
type iodesc = C_Fd.t
-
- val fromFD = fn z => z
- val toFD = fn z => z
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig 2006-04-30 22:18:59 UTC (rev 4430)
@@ -19,7 +19,7 @@
structure Status:
sig
- type t
+ type t = status
val fromInt: int -> t
val fromPosix: Posix.Process.exit_status -> t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -17,8 +17,14 @@
structure Status =
struct
- open Primitive.Status
+ type t = C_Status.t
+ val fromInt = C_Status.fromInt
+ val toInt = C_Status.toInt
+
+ val failure = fromInt 1
+ val success = fromInt 0
+
val fromPosix =
fn es =>
let
@@ -26,7 +32,7 @@
in
case es of
W_EXITED => success
- | W_EXITSTATUS w => fromInt (Word8.toInt w)
+ | W_EXITSTATUS w => C_Status.fromSysWord (Word8.toSysWord w)
| W_SIGNALED _ => failure
| W_STOPPED _ => failure
end
@@ -39,8 +45,9 @@
fun isSuccess st = st = success
fun system cmd =
- PrimitiveFFI.Posix.Process.system (NullString.fromString
- (concat [cmd, "\000"]))
+ Posix.Error.SysCall.simpleResult
+ (fn () =>
+ PrimitiveFFI.Posix.Process.system (NullString.nullTerm cmd))
val atExit = MLtonProcess.atExit
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 14:32:16
|
Refactoring MLton (partial)
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/call-stack.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exn.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/gc.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rusage.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/thread.sml
----------------------------------------------------------------------
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-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 21:32:15 UTC (rev 4429)
@@ -262,22 +262,22 @@
../general/sml90.sml
../mlton/pointer.sig
- (* ../mlton/pointer.sml *)
- (* ../mlton/call-stack.sig *)
- (* ../mlton/call-stack.sml *)
- (* ../mlton/exit.sml *)
- (* ../mlton/exn.sig *)
- (* ../mlton/exn.sml *)
- (* ../mlton/thread.sig *)
- (* ../mlton/thread.sml *)
- (* ../mlton/signal.sig *)
- (* ../mlton/signal.sml *)
- (* ../mlton/process.sig *)
- (* ../mlton/process.sml *)
- (* ../mlton/gc.sig *)
- (* ../mlton/gc.sml *)
- (* ../mlton/rusage.sig *)
- (* ../mlton/rusage.sml *)
+ ../mlton/pointer.sml
+ ../mlton/call-stack.sig
+ ../mlton/call-stack.sml
+ ../mlton/exit.sml
+ ../mlton/exn.sig
+ ../mlton/exn.sml
+ ../mlton/thread.sig
+ ../mlton/thread.sml
+ ../mlton/signal.sig
+ ../mlton/signal.sml
+ ../mlton/process.sig
+ ../mlton/process.sml
+ ../mlton/gc.sig
+ ../mlton/gc.sml
+ ../mlton/rusage.sig
+ ../mlton/rusage.sml
(*
../../system/process.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/call-stack.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/call-stack.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/call-stack.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -7,18 +7,18 @@
structure MLtonCallStack =
struct
- open Primitive.CallStack
+ open Primitive.MLton.CallStack
- val gcState = Primitive.GCState.gcState
+ val gcState = Primitive.MLton.GCState.gcState
structure Pointer = MLtonPointer
val current: unit -> t =
fn () =>
if not keep
- then T (Array.array (0, 0))
+ then T (Array.array (0, 0wx0))
else
let
- val a = Array.array (numStackFrames gcState, ~1)
+ val a = Array.arrayUninit (Word32.toInt (numStackFrames gcState))
val () = callStack (gcState, a)
in
T a
@@ -39,13 +39,12 @@
else
let
val p = frameIndexSourceSeq (gcState, frameIndex)
- val max = Pointer.getInt32 (p, 0)
+ val max = Int32.toInt (Pointer.getInt32 (p, 0))
fun loop (j, ac) =
if j > max
then ac
else loop (j + 1,
- COld.CS.toString (sourceName
- (gcState, Pointer.getInt32 (p, j)))
+ CUtil.C_String.toString (sourceName (gcState, Pointer.getWord32 (p, j)))
:: ac)
in
loop (1, ac)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -33,7 +33,7 @@
in
if 0 <= i andalso i < 256
then (let open Cleaner in clean atExit end
- ; Primitive.halt status
+ ; Primitive.MLton.halt status
; raise Fail "exit")
else raise Fail (concat ["exit must have 0 <= status < 256: saw ",
Int.toString i])
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exn.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exn.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exn.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -7,7 +7,7 @@
structure MLtonExn =
struct
- open Primitive.Exn
+ open Primitive.MLton.Exn
type t = exn
@@ -42,7 +42,7 @@
else fn _ => []
local
- val message = Primitive.Stdio.print
+ val message = PrimitiveFFI.Stdio.print
in
fun 'a topLevelHandler (exn: exn): 'a =
(message (concat ["unhandled exception: ", exnMessage exn, "\n"])
@@ -54,7 +54,7 @@
l)))
; Exit.exit Exit.Status.failure)
handle _ => (message "Toplevel handler raised exception.\n"
- ; Primitive.halt Exit.Status.failure
+ ; Primitive.MLton.halt Exit.Status.failure
(* The following raise is unreachable, but must be there
* so that the expression is of type 'a.
*)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/gc.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/gc.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/gc.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -8,9 +8,9 @@
structure MLtonGC =
struct
- open Primitive.GC
+ open Primitive.MLton.GC
- val gcState = Primitive.GCState.gcState
+ val gcState = Primitive.MLton.GCState.gcState
val pack : unit -> unit =
fn () => pack gcState
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sig 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sig 2006-04-30 21:32:15 UTC (rev 4429)
@@ -12,7 +12,7 @@
val add: t * word -> t
val compare: t * t -> order
val diff: t * t -> word
-(* val free: t -> unit *)
+ (* val free: t -> unit *)
val getInt8: t * int -> Int8.int
val getInt16: t * int -> Int16.int
val getInt32: t * int -> Int32.int
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/pointer.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -8,11 +8,45 @@
structure MLtonPointer: MLTON_POINTER =
struct
-open Primitive.Pointer
+open Primitive.MLton.Pointer
-fun add (p, t) = fromWord (Word.+ (toWord p, t))
-fun compare (p, p') = Word.compare (toWord p, toWord p')
-fun diff (p, p') = Word.- (toWord p, toWord p')
-fun sub (p, t) = fromWord (Word.- (toWord p, t))
-
+fun add (p, t) = fromWord (C_Pointer.+ (toWord p, C_Pointer.fromWord t))
+fun compare (p, p') = C_Pointer.compare (toWord p, toWord p')
+fun diff (p, p') = C_Pointer.toWord (C_Pointer.- (toWord p, toWord p'))
+fun sub (p, t) = fromWord (C_Pointer.- (toWord p, C_Pointer.fromWord t))
+
+local
+ fun wrap f (p, i) =
+ f (p, C_Ptrdiff.fromInt i)
+in
+ val getInt8 = wrap getInt8
+ val getInt16 = wrap getInt16
+ val getInt32 = wrap getInt32
+ val getInt64 = wrap getInt64
+ val getPointer = wrap getPointer
+ val getReal32 = wrap getReal32
+ val getReal64 = wrap getReal64
+ val getWord8 = wrap getWord8
+ val getWord16 = wrap getWord16
+ val getWord32 = wrap getWord32
+ val getWord64 = wrap getWord64
end
+
+local
+ fun wrap f (p, i, x) =
+ f (p, C_Ptrdiff.fromInt i, x)
+in
+ val setInt8 = wrap setInt8
+ val setInt16 = wrap setInt16
+ val setInt32 = wrap setInt32
+ val setInt64 = wrap setInt64
+ val setPointer = wrap setPointer
+ val setReal32 = wrap setReal32
+ val setReal64 = wrap setReal64
+ val setWord8 = wrap setWord8
+ val setWord16 = wrap setWord16
+ val setWord32 = wrap setWord32
+ val setWord64 = wrap setWord64
+end
+
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/process.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/process.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -20,7 +20,7 @@
structure Mask = MLtonSignal.Mask
structure SysCall = PosixError.SysCall
- type pid = Pid.t
+ type pid = C_PId.t
exception MisuseOfForget
exception DoublyRedirected
@@ -254,9 +254,10 @@
dquote]
fun create (cmd, args, env, stdin, stdout, stderr) =
- SysCall.syscall
- (fn () =>
+ SysCall.simpleResult'
+ ({errVal = C_PId.fromInt ~1}, fn () =>
let
+(*
val cmd =
let
open MLton.Platform.OS
@@ -266,12 +267,10 @@
| MinGW => cmd
| _ => raise Fail "create"
end
- val p =
- PrimitiveFFI.Windows.Process.create
- (NullString.nullTerm cmd, args, env, stdin, stdout, stderr)
- val p' = Pid.toInt p
+*)
in
- (p', fn () => p)
+ PrimitiveFFI.Windows.Process.create
+ (NullString.nullTerm cmd, args, env, stdin, stdout, stderr)
end)
fun launchWithCreate (path, args, env, stdin, stdout, stderr) =
@@ -322,14 +321,12 @@
then
let
val path = NullString.nullTerm path
- val args = COld.CSS.fromList args
- val env = COld.CSS.fromList env
+ val args = CUtil.C_StringArray.fromList args
+ val env = CUtil.C_StringArray.fromList env
in
- SysCall.syscall
- (fn () =>
- let val pid = Prim.spawne (path, args, env)
- in (Pid.toInt pid, fn () => pid)
- end)
+ SysCall.simpleResult'
+ ({errVal = C_PId.fromInt ~1}, fn () =>
+ Prim.spawne (path, args, env))
end
else
case Posix.Process.fork () of
@@ -346,13 +343,11 @@
then
let
val file = NullString.nullTerm file
- val args = COld.CSS.fromList args
+ val args = CUtil.C_StringArray.fromList args
in
- SysCall.syscall
- (fn () =>
- let val pid = Prim.spawnp (file, args)
- in (Pid.toInt pid, fn () => pid)
- end)
+ SysCall.simpleResult'
+ ({errVal = C_PId.fromInt ~1}, fn () =>
+ Prim.spawnp (file, args))
end
else
case Posix.Process.fork () of
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rusage.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rusage.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rusage.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -17,9 +17,9 @@
fun toTime (sec, usec) =
let
val time_sec =
- Time.fromSeconds (LargeInt.fromInt (sec ()))
+ Time.fromSeconds (C_Time.toLarge (sec ()))
val time_usec =
- Time.fromMicroseconds (LargeInt.fromInt (usec ()))
+ Time.fromMicroseconds (C_SUSeconds.toLarge (usec ()))
in
Time.+ (time_sec, time_usec)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -18,8 +18,6 @@
type t = signal
type how = C_Int.t
-
-(* val toString = SysWord.toString o toWord *)
fun raiseInval () =
let
@@ -30,8 +28,8 @@
val validSignals =
Array.tabulate
- (Prim.NSIG, fn i =>
- Prim.sigismember(fromInt i) <> ~1)
+ (C_Int.toInt Prim.NSIG, fn i =>
+ (C_Errno.check (Prim.sigismember(fromInt i))) <> (C_Int.fromInt ~1))
structure Mask =
struct
@@ -50,9 +48,9 @@
(Array.foldri
(fn (i, b, sigs) =>
if b
- then if (Prim.sigismember(fromInt i)) = 1
- then (fromInt i)::sigs
- else sigs
+ then if (C_Errno.check (Prim.sigismember(fromInt i))) = (C_Int.fromInt ~1)
+ then sigs
+ else (fromInt i)::sigs
else sigs)
[]
validSignals)
@@ -103,7 +101,7 @@
val r = ref false
in
fun initHandler (s: signal): Handler.t =
- if 0 = Prim.isDefault (s, r)
+ if C_Errno.check (Prim.isDefault (s, r)) = C_Int.fromInt 0
then if !r
then Default
else Ignore
@@ -112,7 +110,7 @@
val (getHandler, setHandler, handlers) =
let
- val handlers = Array.tabulate (Prim.NSIG, initHandler o fromInt)
+ val handlers = Array.tabulate (C_Int.toInt Prim.NSIG, initHandler o fromInt)
val _ =
Cleaner.addNew
(Cleaner.atLoadWorld, fn () =>
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/thread.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/thread.sml 2006-04-30 20:08:35 UTC (rev 4428)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/thread.sml 2006-04-30 21:32:15 UTC (rev 4429)
@@ -8,10 +8,17 @@
structure MLtonThread:> MLTON_THREAD_EXTRA =
struct
-structure Prim = Primitive.Thread
+structure Prim = Primitive.MLton.Thread
-val gcState = Primitive.GCState.gcState
+fun die (s: string): 'a =
+ (PrimitiveFFI.Stdio.print s
+ ; PrimitiveFFI.Posix.Process.exit 1
+ ; let exception DieFailed
+ in raise DieFailed
+ end)
+val gcState = Primitive.MLton.GCState.gcState
+
structure AtomicState =
struct
datatype t = NonAtomic | Atomic of int
@@ -24,8 +31,8 @@
val atomicEnd = atomicEnd
val atomicState = fn () =>
case canHandle () of
- 0 => AtomicState.NonAtomic
- | n => AtomicState.Atomic n
+ 0wx0 => AtomicState.NonAtomic
+ | w => AtomicState.Atomic (Word32.toInt w)
end
fun atomically f =
@@ -167,7 +174,7 @@
fun setSignalHandler (f: Runnable.t -> Runnable.t): unit =
let
- val _ = Primitive.installSignalHandler ()
+ val _ = Primitive.MLton.installSignalHandler ()
fun loop (): unit =
let
(* Atomic 1 *)
@@ -217,8 +224,9 @@
in
val register: int * (unit -> unit) -> unit =
let
- val exports = Array.array (Primitive.FFI.numExports, fn () =>
- raise Fail "undefined export")
+ val exports =
+ Array.array (Int32.toInt (Primitive.MLton.FFI.numExports),
+ fn () => raise Fail "undefined export")
fun loop (): unit =
let
(* Atomic 2 *)
@@ -228,7 +236,7 @@
(* Atomic 1 *)
val _ =
(* atomicEnd() after getting args *)
- (Array.sub (exports, Primitive.FFI.getOp ()) ())
+ (Array.sub (exports, Int32.toInt (Primitive.MLton.FFI.getOp ())) ())
handle e =>
(TextIO.output
(TextIO.stdErr, "Call from C to SML raised exception.\n")
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 13:08:37
|
Define MLton.Pointer.t = C_Pointer.t
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.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/primitive/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-04-30 20:08:35 UTC (rev 4428)
@@ -23,7 +23,8 @@
OBJPTR_REP_MAPS = objptr-rep32.map objptr-rep64.map
HEADER_MAPS = header-word32.map header-word64.map
SEQ_INDEX_MAPS = seqindex-int32.map seqindex-int64.map
-CTYPES_MAPS = c-types.m32.map c-types.m64.map c-types.weird.map
+# CTYPES_MAPS = c-types.m32.map c-types.m64.map c-types.weird.map
+CTYPES_MAPS = c-types.m32.map c-types.m64.map
DEFAULT_CHAR_MAPS = default-char8.map
DEFAULT_INT_MAPS = default-int32.map default-int64.map default-int-inf.map
DEFAULT_REAL_MAPS = default-real32.map default-real64.map
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-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 20:08:35 UTC (rev 4428)
@@ -21,7 +21,7 @@
../integer/word0.sml
local
../config/bind/int-prim.sml
- ../config/bind/pointer-prim.sml
+ (* ../config/bind/pointer-prim.sml *)
../config/bind/real-prim.sml
../config/bind/word-prim.sml
in ann "forceUsed" in
@@ -113,7 +113,7 @@
../integer/word.sml
local
../config/bind/int-top.sml
- ../config/bind/pointer-prim.sml
+ (* ../config/bind/pointer-prim.sml *)
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
@@ -145,7 +145,7 @@
../integer/pack-word.sml
local
../config/bind/int-top.sml
- ../config/bind/pointer-prim.sml
+ (* ../config/bind/pointer-prim.sml *)
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
@@ -188,7 +188,7 @@
../real/real-global.sml
local
../config/bind/int-top.sml
- ../config/bind/pointer-prim.sml
+ (* ../config/bind/pointer-prim.sml *)
../config/bind/real-top.sml
../config/bind/word-top.sml
in ann "forceUsed" in
@@ -261,25 +261,25 @@
../general/sml90.sig
../general/sml90.sml
+ ../mlton/pointer.sig
+ (* ../mlton/pointer.sml *)
+ (* ../mlton/call-stack.sig *)
+ (* ../mlton/call-stack.sml *)
+ (* ../mlton/exit.sml *)
+ (* ../mlton/exn.sig *)
+ (* ../mlton/exn.sml *)
+ (* ../mlton/thread.sig *)
+ (* ../mlton/thread.sml *)
+ (* ../mlton/signal.sig *)
+ (* ../mlton/signal.sml *)
+ (* ../mlton/process.sig *)
+ (* ../mlton/process.sml *)
+ (* ../mlton/gc.sig *)
+ (* ../mlton/gc.sml *)
+ (* ../mlton/rusage.sig *)
+ (* ../mlton/rusage.sml *)
+
(*
- ../../mlton/pointer.sig
- ../../mlton/pointer.sml
- ../../mlton/call-stack.sig
- ../../mlton/call-stack.sml
- ../../mlton/exit.sml
- ../../mlton/exn.sig
- ../../mlton/exn.sml
- ../../mlton/thread.sig
- ../../mlton/thread.sml
- ../../mlton/signal.sig
- ../../mlton/signal.sml
- ../../mlton/process.sig
- ../../mlton/process.sml
- ../../mlton/gc.sig
- ../../mlton/gc.sml
- ../../mlton/rusage.sig
- ../../mlton/rusage.sml
-
../../system/process.sig
../../system/process.sml
../../system/io.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-04-30 20:08:35 UTC (rev 4428)
@@ -44,9 +44,12 @@
structure C_Size = struct open Word32 type t = word end
functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure C_Pointer = Pointer
-structure C_String = Pointer
-structure C_StringArray = Pointer
+structure C_Pointer = struct open Word32 type t = word end
+functor C_Pointer_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_String = struct open Word32 type t = word end
+functor C_String_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_StringArray = struct open Word32 type t = word end
+functor C_StringArray_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* Generic integers *)
structure C_Fd = C_Int
@@ -65,6 +68,10 @@
functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
structure C_UIntmax = struct open Word64 type t = word end
functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Intptr = struct open Int32 type t = int end
+functor C_Intptr_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UIntptr = struct open Word32 type t = word end
+functor C_UIntptr_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* from <dirent.h> *)
structure C_DirP = struct open Word32 type t = word end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-04-30 20:08:35 UTC (rev 4428)
@@ -44,9 +44,12 @@
structure C_Size = struct open Word32 type t = word end
functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure C_Pointer = Pointer
-structure C_String = Pointer
-structure C_StringArray = Pointer
+structure C_Pointer = struct open Word32 type t = word end
+functor C_Pointer_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_String = struct open Word32 type t = word end
+functor C_String_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_StringArray = struct open Word32 type t = word end
+functor C_StringArray_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* Generic integers *)
structure C_Fd = C_Int
@@ -65,6 +68,10 @@
functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
structure C_UIntmax = struct open Word64 type t = word end
functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Intptr = struct open Int32 type t = int end
+functor C_Intptr_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UIntptr = struct open Word32 type t = word end
+functor C_UIntptr_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* from <dirent.h> *)
structure C_DirP = struct open Word32 type t = word end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-04-30 20:08:35 UTC (rev 4428)
@@ -44,9 +44,12 @@
structure C_Size = struct open Word64 type t = word end
functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
-structure C_Pointer = Pointer
-structure C_String = Pointer
-structure C_StringArray = Pointer
+structure C_Pointer = struct open Word64 type t = word end
+functor C_Pointer_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_String = struct open Word64 type t = word end
+functor C_String_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_StringArray = struct open Word64 type t = word end
+functor C_StringArray_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
(* Generic integers *)
structure C_Fd = C_Int
@@ -65,6 +68,10 @@
functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
structure C_UIntmax = struct open Word64 type t = word end
functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Intptr = struct open Int64 type t = int end
+functor C_Intptr_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_UIntptr = struct open Word64 type t = word end
+functor C_UIntptr_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
(* from <dirent.h> *)
structure C_DirP = struct open Word64 type t = word end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml 2006-04-30 20:08:35 UTC (rev 4428)
@@ -44,9 +44,12 @@
structure C_Size = struct open Word32 type t = word end
functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure C_Pointer = Pointer
-structure C_String = Pointer
-structure C_StringArray = Pointer
+structure C_Pointer = struct open Word32 type t = word end
+functor C_Pointer_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_String = struct open Word32 type t = word end
+functor C_String_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_StringArray = struct open Word32 type t = word end
+functor C_StringArray_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* Generic integers *)
structure C_Fd = C_Int
@@ -65,6 +68,10 @@
functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
structure C_UIntmax = struct open Word64 type t = word end
functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Intptr = struct open Int32 type t = int end
+functor C_Intptr_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UIntptr = struct open Word32 type t = word end
+functor C_UIntptr_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* from <dirent.h> *)
structure C_DirP = struct open Word32 type t = word end
@@ -125,4 +132,3 @@
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure C_Errno = struct type 'a t = 'a end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml 2006-04-30 20:08:35 UTC (rev 4428)
@@ -432,10 +432,12 @@
end
(* Primitive Basis (MLton Extensions) *)
+(*
structure Pointer =
struct
type t = pointer
end
+*)
structure Thread =
struct
type t = thread
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-30 20:08:35 UTC (rev 4428)
@@ -25,6 +25,42 @@
val installSignalHandler =
_prim "MLton_installSignalHandler": unit -> unit;
+structure Pointer =
+ struct
+ (* open Pointer *)
+ type t = C_Pointer.t
+
+ val fromWord = fn x => x
+ val toWord = fn x => x
+
+ val null: t = fromWord 0w0
+
+ fun isNull p = p = null
+
+ val getInt8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Int8.int;
+ val getInt16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Int16.int;
+ val getInt32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Int32.int;
+ val getInt64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Int64.int;
+ val getPointer = _prim "Pointer_getPointer": t * C_Ptrdiff.t -> 'a;
+ val getReal32 = _prim "Pointer_getReal32": t * C_Ptrdiff.t -> Real32.real;
+ val getReal64 = _prim "Pointer_getReal64": t * C_Ptrdiff.t -> Real64.real;
+ val getWord8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Word8.word;
+ val getWord16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Word16.word;
+ val getWord32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Word32.word;
+ val getWord64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Word64.word;
+ val setInt8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Int8.int -> unit;
+ val setInt16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Int16.int -> unit;
+ val setInt32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Int32.int -> unit;
+ val setInt64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Int64.int -> unit;
+ val setPointer = _prim "Pointer_setPointer": t * C_Ptrdiff.t * 'a -> unit;
+ val setReal32 = _prim "Pointer_setReal32": t * C_Ptrdiff.t * Real32.real -> unit;
+ val setReal64 = _prim "Pointer_setReal64": t * C_Ptrdiff.t * Real64.real -> unit;
+ val setWord8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Word8.word -> unit;
+ val setWord16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Word16.word -> unit;
+ val setWord32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Word32.word -> unit;
+ val setWord64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Word64.word -> unit;
+ end
+
structure GCState =
struct
type t = Pointer.t
@@ -186,41 +222,6 @@
end
end
-structure Pointer =
- struct
- open Pointer
-
- val fromWord = _prim "WordU32_toWord32": Word32.word -> t;
- val toWord = _prim "WordU32_toWord32": t -> Word32.word;
-
- val null: t = fromWord 0w0
-
- fun isNull p = p = null
-
- val getInt8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Int8.int;
- val getInt16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Int16.int;
- val getInt32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Int32.int;
- val getInt64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Int64.int;
- val getPointer = _prim "Pointer_getPointer": t * C_Ptrdiff.t -> 'a;
- val getReal32 = _prim "Pointer_getReal32": t * C_Ptrdiff.t -> Real32.real;
- val getReal64 = _prim "Pointer_getReal64": t * C_Ptrdiff.t -> Real64.real;
- val getWord8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Word8.word;
- val getWord16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Word16.word;
- val getWord32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Word32.word;
- val getWord64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Word64.word;
- val setInt8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Int8.int -> unit;
- val setInt16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Int16.int -> unit;
- val setInt32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Int32.int -> unit;
- val setInt64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Int64.int -> unit;
- val setPointer = _prim "Pointer_setPointer": t * C_Ptrdiff.t * 'a -> unit;
- val setReal32 = _prim "Pointer_setReal32": t * C_Ptrdiff.t * Real32.real -> unit;
- val setReal64 = _prim "Pointer_setReal64": t * C_Ptrdiff.t * Real64.real -> unit;
- val setWord8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Word8.word -> unit;
- val setWord16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Word16.word -> unit;
- val setWord32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Word32.word -> unit;
- val setWord64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Word64.word -> unit;
- end
-
structure Profile =
struct
val isOn = _build_const "MLton_Profile_isOn": bool;
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-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-04-30 20:08:35 UTC (rev 4428)
@@ -38,7 +38,7 @@
local
../config/bind/int-prim.sml
- ../config/bind/pointer-prim.sml
+ (* ../config/bind/pointer-prim.sml *)
../config/bind/real-prim.sml
../config/bind/word-prim.sml
in ann "forceUsed" in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-04-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-04-30 20:08:35 UTC (rev 4428)
@@ -8,47 +8,9 @@
(* Primitive names are special -- see atoms/prim.fun. *)
-structure Char = Char8
-type char = Char.char
-structure Int = Int32
-type int = Int.int
-structure Real = Real64
-type real = Real.real
-
-structure String = String8
-type string = String.string
-
-structure Word = Word32
-type word = Word.word
-structure LargeWord = Word64
-
structure Primitive =
struct
- structure TextIO =
- struct
- val bufSize = _command_line_const "TextIO.bufSize": int = 4096;
- end
-
- structure Word8Array =
- struct
- val subWord =
- _prim "Word8Array_subWord": Word8.word array * int -> word;
- val subWordRev =
- _import "Word8Array_subWord32Rev": Word8.word array * int -> word;
- val updateWord =
- _prim "Word8Array_updateWord": Word8.word array * int * word -> unit;
- val updateWordRev =
- _import "Word8Array_updateWord32Rev": Word8.word array * int * word -> unit;
- end
- structure Word8Vector =
- struct
- val subWord =
- _prim "Word8Vector_subWord": Word8.word vector * int -> word;
- val subWordRev =
- _import "Word8Vector_subWord32Rev": Word8.word vector * int -> word;
- end
-
structure Cygwin =
struct
val toFullWindowsPath =
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-30 19:24:40 UTC (rev 4427)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-04-30 20:08:35 UTC (rev 4428)
@@ -215,6 +215,11 @@
writeString (cTypesSMLFd, " = Pointer"); \
writeNewline (cTypesSMLFd); \
} while (0)
+#undef ptrtype
+#define ptrtype(t, name) \
+ do { \
+ systype(t, "Word", name); \
+ } while (0)
#define aliastype(name1, bt, name2) \
do { \
@@ -312,7 +317,9 @@
// chksystype(long double, "LongDouble");
chksystype(size_t, "Size");
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
- ptrtype(void*, "Pointer");
+ ptrtype(unsigned char*, "Pointer");
+ // ptrtype(void*, "Pointer");
+ // ptrtype(uintptr_t, "Pointer");
ptrtype(char*, "String");
ptrtype(char**, "StringArray");
@@ -330,6 +337,8 @@
chksystype(ptrdiff_t, "Ptrdiff");
chksystype(intmax_t, "Intmax");
chksystype(uintmax_t, "UIntmax");
+ chksystype(intptr_t, "Intptr");
+ chksystype(uintptr_t, "UIntptr");
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
writeStringWithNewline (cTypesHFd, "/* from <dirent.h> */");
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 12:24:41
|
Refactored System
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/command-line.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/file-sys.sml
----------------------------------------------------------------------
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-30 19:13:21 UTC (rev 4426)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 19:24:40 UTC (rev 4427)
@@ -251,17 +251,17 @@
../io/text-io.sig
../io/text-io.sml
-(*
- ../../system/path.sig
- ../../system/path.sml
- ../../system/file-sys.sig
- ../../system/file-sys.sml
- ../../system/command-line.sig
- ../../system/command-line.sml
+ ../system/path.sig
+ ../system/path.sml
+ ../system/file-sys.sig
+ ../system/file-sys.sml
+ ../system/command-line.sig
+ ../system/command-line.sml
- ../../general/sml90.sig
- ../../general/sml90.sml
+ ../general/sml90.sig
+ ../general/sml90.sml
+(*
../../mlton/pointer.sig
../../mlton/pointer.sml
../../mlton/call-stack.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/command-line.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/command-line.sml 2006-04-30 19:13:21 UTC (rev 4426)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/command-line.sml 2006-04-30 19:24:40 UTC (rev 4427)
@@ -11,9 +11,9 @@
structure Prim = PrimitiveFFI.CommandLine
fun name () =
- COld.CS.toString (Prim.commandNameGet ())
+ CUtil.C_String.toString (Prim.commandNameGet ())
fun arguments () =
- (Array.toList o COld.CSS.toArrayOfLength)
- (Prim.argvGet (), Prim.argcGet ())
+ (Array.toList o CUtil.C_StringArray.toArrayOfLength)
+ (Prim.argvGet (), C_Int.toInt (Prim.argcGet ()))
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/file-sys.sml 2006-04-30 19:13:21 UTC (rev 4426)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/file-sys.sml 2006-04-30 19:24:40 UTC (rev 4427)
@@ -34,7 +34,7 @@
val readLink = P_FSys.readlink
(* the maximum number of links allowed *)
- val maxLinks = 64
+ val maxLinks: int = 64
structure P = OS_Path
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 12:13:23
|
Vert minor refactoring of {Bin,Text}IO; it was already very well factored
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/bin-io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/imperative-io.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/text-io.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig 2006-04-30 18:58:08 UTC (rev 4425)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig 2006-04-30 19:13:21 UTC (rev 4426)
@@ -39,6 +39,8 @@
and type vector = vector
and type vector_slice = vector_slice
+ val arrayUninit: int -> array
+
val concat: array list -> array
val duplicate: array -> array
val fromPoly: elem Array.array -> array
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-30 18:58:08 UTC (rev 4425)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 19:13:21 UTC (rev 4426)
@@ -238,20 +238,20 @@
../posix/posix.sig
../posix/posix.sml
-(*
- ../../platform/cygwin.sml
+ (* ../platform/cygwin.sml *)
- ../../io/stream-io.sig
- ../../io/stream-io.fun
- ../../io/imperative-io.sig
- ../../io/imperative-io.fun
- ../../io/bin-stream-io.sig
- ../../io/bin-io.sig
- ../../io/bin-io.sml
- ../../io/text-stream-io.sig
- ../../io/text-io.sig
- ../../io/text-io.sml
+ ../io/stream-io.sig
+ ../io/stream-io.fun
+ ../io/imperative-io.sig
+ ../io/imperative-io.fun
+ ../io/bin-stream-io.sig
+ ../io/bin-io.sig
+ ../io/bin-io.sml
+ ../io/text-stream-io.sig
+ ../io/text-io.sig
+ ../io/text-io.sml
+(*
../../system/path.sig
../../system/path.sml
../../system/file-sys.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/bin-io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/bin-io.sml 2006-04-30 18:58:08 UTC (rev 4425)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/bin-io.sml 2006-04-30 19:13:21 UTC (rev 4426)
@@ -12,8 +12,8 @@
structure PrimIO = BinPrimIO
structure Vector = Word8Vector
structure VectorSlice = Word8VectorSlice
- val chunkSize = Primitive.TextIO.bufSize
- val fileTypeFlags = [SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.BINARY]
+ val chunkSize = Int32.toInt (Primitive.Controls.bufSize)
+ val fileTypeFlags = [PrimitiveFFI.Posix.FileSys.O.BINARY]
val line = NONE
val mkReader = Posix.IO.mkBinReader
val mkWriter = Posix.IO.mkBinWriter
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/imperative-io.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/imperative-io.fun 2006-04-30 18:58:08 UTC (rev 4425)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/imperative-io.fun 2006-04-30 19:13:21 UTC (rev 4426)
@@ -9,7 +9,7 @@
sig
structure Array: sig
include MONO_ARRAY
- val rawArray: int -> array
+ val arrayUninit: int -> array
val unsafeSub: array * int -> elem
end
structure ArraySlice: MONO_ARRAY_SLICE
@@ -218,7 +218,7 @@
local
val augmentedReader = PIO.nullRd ()
- val buf = A.rawArray 0
+ val buf = A.arrayUninit 0
val first = ref 0
val last = ref 0
val reader = PIO.nullRd ()
@@ -373,7 +373,7 @@
(ib, "inputN", fn () =>
let
val readArr = readArr ib
- val inp = A.rawArray n
+ val inp = A.arrayUninit n
fun fill k =
if k >= size
then ()
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/text-io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/text-io.sml 2006-04-30 18:58:08 UTC (rev 4425)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/text-io.sml 2006-04-30 19:13:21 UTC (rev 4426)
@@ -15,8 +15,8 @@
structure PrimIO = TextPrimIO
structure Vector = CharVector
structure VectorSlice = CharVectorSlice
- val chunkSize = Primitive.TextIO.bufSize
- val fileTypeFlags = [SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.TEXT]
+ val chunkSize = Int32.toInt (Primitive.Controls.bufSize)
+ val fileTypeFlags = [PrimitiveFFI.Posix.FileSys.O.TEXT]
val line = SOME {isLine = fn c => c = #"\n",
lineElem = #"\n"}
val mkReader = Posix.IO.mkTextReader
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 11:58:10
|
Refactored Posix
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/fcntl-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
----------------------------------------------------------------------
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-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 18:58:08 UTC (rev 4425)
@@ -228,15 +228,15 @@
../posix/file-sys.sig
../posix/file-sys.sml
../posix/io.sig
- (* ../posix/io.sml *)
+ ../posix/io.sml
../posix/process.sig
- (* ../posix/process.sml *)
+ ../posix/process.sml
../posix/sys-db.sig
- (* ../posix/sys-db.sml *)
+ ../posix/sys-db.sml
../posix/tty.sig
- (* ../posix/tty.sml *)
- (* ../posix/posix.sig *)
- (* ../posix/posix.sml *)
+ ../posix/tty.sml
+ ../posix/posix.sig
+ ../posix/posix.sml
(*
../../platform/cygwin.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml 2006-04-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml 2006-04-30 18:58:08 UTC (rev 4425)
@@ -9,8 +9,10 @@
sig
type 'a t
val check: 'a t -> 'a
+ val inject: 'a -> 'a t
end =
struct
type 'a t = 'a
val check = fn x => x
+ val inject = fn x => x
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml 2006-04-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml 2006-04-30 18:58:08 UTC (rev 4425)
@@ -15,24 +15,21 @@
structure SysCall = Error.SysCall
structure FS = PosixFileSys
-type file_desc = C_Fd.t
+type file_desc = C_Fd.t (* = C_Int.t *)
type pid = C_PId.t
-val FD = C_Fd.fromInt
-val unFD = C_Fd.toInt
-
local
- val a: file_desc array = Array.array (2, FD 0)
+ val a: file_desc array = Array.array (2, C_Fd.fromInt 0)
in
fun pipe () =
SysCall.syscall
(fn () =>
(Prim.pipe a,
- fn () => {infd = Array.sub (a, 0),
- outfd = Array.sub (a, 1)}))
+ fn _ => {infd = Array.sub (a, 0),
+ outfd = Array.sub (a, 1)}))
end
-fun dup fd = FD (SysCall.simpleResult (fn () => Prim.dup fd))
+fun dup fd = SysCall.simpleResult (fn () => Prim.dup fd)
fun dup2 {new, old} = SysCall.simple (fn () => Prim.dup2 (old, new))
@@ -40,8 +37,9 @@
structure FD =
struct
- open FD BitFlags
- val cloexec = SysWord.fromInt CLOEXEC
+ structure Flags = BitFlags(structure S = C_Int)
+ open FD Flags
+ val cloexec = CLOEXEC
end
structure O = PosixFileSys.O
@@ -49,30 +47,28 @@
datatype open_mode = datatype PosixFileSys.open_mode
fun dupfd {base, old} =
- FD (SysCall.simpleResultRestart
- (fn () => Prim.fcntl3 (old, F_DUPFD, unFD base)))
+ SysCall.simpleResultRestart
+ (fn () => Prim.fcntl3 (old, F_DUPFD, base))
fun getfd fd =
- Word.fromInt (SysCall.simpleResultRestart
- (fn () => Prim.fcntl2 (fd, F_GETFD)))
+ SysCall.simpleResultRestart
+ (fn () => Prim.fcntl2 (fd, F_GETFD))
fun setfd (fd, flags): unit =
SysCall.simpleRestart
- (fn () => Prim.fcntl3 (fd, F_SETFD, Word.toIntX flags))
+ (fn () => Prim.fcntl3 (fd, F_SETFD, flags))
fun getfl fd : O.flags * open_mode =
let
- val n =
- SysCall.simpleResultRestart (fn () => Prim.fcntl2 (fd, F_GETFL))
- val w = Word.fromInt n
- val flags = Word.andb (w, Word.notb (Word.fromInt O_ACCMODE))
- val mode = Word.andb (w, (Word.fromInt O_ACCMODE))
- in (flags, PosixFileSys.wordToOpenMode mode)
+ val n = SysCall.simpleResultRestart (fn () => Prim.fcntl2 (fd, F_GETFL))
+ val flags = C_Int.andb (n, C_Int.notb O_ACCMODE)
+ val mode = C_Int.andb (n, O_ACCMODE)
+ in (flags, PosixFileSys.flagsToOpenMode mode)
end
fun setfl (fd, flags: O.flags): unit =
SysCall.simpleRestart
- (fn () => Prim.fcntl3 (fd, F_SETFL, Word.toIntX flags))
+ (fn () => Prim.fcntl3 (fd, F_SETFL, flags))
datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
@@ -82,11 +78,9 @@
| SEEK_END => Prim.SEEK_END
fun lseek (fd, n: Position.int, w: whence): Position.int =
- SysCall.syscall
- (fn () =>
- let val n = Prim.lseek (fd, n, whenceToInt w)
- in (if n = ~1 then ~1 else 0, fn () => n)
- end)
+ SysCall.simpleResult'
+ ({errVal = C_Off.fromInt ~1}, fn () =>
+ Prim.lseek (fd, n, whenceToInt w))
fun fsync fd : unit = SysCall.simple (fn () => Prim.fsync fd)
@@ -99,15 +93,12 @@
if n = Prim.FLock.SEEK_SET
then SEEK_SET
else if n = Prim.FLock.SEEK_CUR
- then SEEK_CUR
- else if n = Prim.FLock.SEEK_END
- then SEEK_END
- else raise Fail "Posix.IO.intToWhence"
+ then SEEK_CUR
+ else if n = Prim.FLock.SEEK_END
+ then SEEK_END
+ else raise Fail "Posix.IO.intToWhence"
-datatype lock_type =
- F_RDLCK
- | F_WRLCK
- | F_UNLCK
+datatype lock_type = F_RDLCK | F_WRLCK | F_UNLCK
val lockTypeToInt =
fn F_RDLCK => Prim.FLock.F_RDLCK
@@ -118,10 +109,10 @@
if n = Prim.FLock.F_RDLCK
then F_RDLCK
else if n = Prim.FLock.F_WRLCK
- then F_WRLCK
- else if n = Prim.FLock.F_UNLCK
- then F_UNLCK
- else raise Fail "Posix.IO.intToLockType"
+ then F_WRLCK
+ else if n = Prim.FLock.F_UNLCK
+ then F_UNLCK
+ else raise Fail "Posix.IO.intToLockType"
structure FLock =
struct
@@ -153,7 +144,7 @@
; P.setWhence (whenceToInt whence)
; P.setStart start
; P.setLen len
- ; P.fcntl (fd, cmd)), fn () =>
+ ; P.fcntl (fd, cmd)), fn _ =>
{ltype = intToLockType (P.getType ()),
whence = intToWhence (P.getWhence ()),
start = P.getStart (),
@@ -210,9 +201,12 @@
endPos = NONE,
verifyPos = NONE}
- fun make {RD, WR, fromVector, read, setMode, toArraySlice, toVectorSlice,
- vectorLength, write, writeVec} =
+ fun make {RD, WR, fromVector, readArr, setMode, toArraySlice, toVectorSlice,
+ vectorLength, writeArr, writeVec} =
let
+ val primReadArr = readArr
+ val primWriteArr = writeArr
+ val primWriteVec = writeVec
val setMode =
fn fd =>
if let
@@ -227,35 +221,49 @@
fun readArr (fd, sl): int =
let
val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
+ val bytesRead =
+ SysCall.simpleResultRestart'
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primReadArr (fd, buf, C_Int.fromInt i, C_Size.fromInt sz))
+ val bytesRead = C_SSize.toInt bytesRead
in
- SysCall.simpleResultRestart (fn () => read (fd, buf, i, C_Size.fromInt sz))
+ bytesRead
end
fun readVec (fd, n) =
let
- val a = Primitive.Array.array n
+ val buf = Array.arrayUninit n
val bytesRead =
- SysCall.simpleResultRestart (fn () => read (fd, a, 0, C_Size.fromInt n))
+ SysCall.simpleResultRestart'
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primReadArr (fd, buf, C_Int.fromInt 0, C_Size.fromInt n))
+ val bytesRead = C_SSize.toInt bytesRead
in
fromVector
(if n = bytesRead
- then Vector.fromArray a
- else ArraySlice.vector (ArraySlice.slice
- (a, 0, SOME bytesRead)))
+ then Vector.fromArray buf
+ else ArraySlice.vector (ArraySlice.slice (buf, 0, SOME bytesRead)))
end
- fun writeArr (fd, sl) =
+ fun writeArr (fd, sl): int =
let
val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
+ val bytesWrote =
+ SysCall.simpleResultRestart'
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primWriteArr (fd, buf, C_Int.fromInt i, C_Size.fromInt sz))
+ val bytesWrote = C_SSize.toInt bytesWrote
in
- SysCall.simpleResultRestart
- (fn () => write (fd, buf, i, C_Size.fromInt sz))
+ bytesWrote
end
- val writeVec =
- fn (fd, sl) =>
+ fun writeVec (fd, sl): int =
let
val (buf, i, sz) = VectorSlice.base (toVectorSlice sl)
+ val bytesWrote =
+ SysCall.simpleResultRestart'
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primWriteVec (fd, buf, C_Int.fromInt i, C_Size.fromInt sz))
+ val bytesWrote = C_SSize.toInt bytesWrote
in
- SysCall.simpleResultRestart
- (fn () => writeVec (fd, buf, i, C_Size.fromInt sz))
+ bytesWrote
end
fun mkReader {fd, name, initBlkMode} =
let
@@ -304,7 +312,7 @@
RD {avail = avail,
block = NONE,
canInput = NONE,
- chunkSize = Primitive.TextIO.bufSize,
+ chunkSize = Int32.toInt Primitive.Controls.bufSize,
close = close,
endPos = endPos,
getPos = getPos,
@@ -378,23 +386,23 @@
make {RD = BinPrimIO.RD,
WR = BinPrimIO.WR,
fromVector = Word8Vector.fromPoly,
- read = readWord8,
+ readArr = readWord8,
setMode = Prim.setbin,
toArraySlice = Word8ArraySlice.toPoly,
toVectorSlice = Word8VectorSlice.toPoly,
vectorLength = Word8Vector.length,
- write = writeWord8Arr,
+ writeArr = writeWord8Arr,
writeVec = writeWord8Vec}
val {mkReader = mkTextReader, mkWriter = mkTextWriter, ...} =
make {RD = TextPrimIO.RD,
WR = TextPrimIO.WR,
fromVector = fn v => v,
- read = readChar8,
+ readArr = readChar8,
setMode = Prim.settext,
toArraySlice = CharArraySlice.toPoly,
toVectorSlice = CharVectorSlice.toPoly,
vectorLength = CharVector.length,
- write = writeChar8Arr,
+ writeArr = writeChar8Arr,
writeVec = writeChar8Vec}
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml 2006-04-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml 2006-04-30 18:58:08 UTC (rev 4425)
@@ -14,19 +14,16 @@
structure SysCall = Error.SysCall
type signal = PosixSignal.signal
- type pid = Pid.t
+ type pid = C_PId.t
- val wordToPid = Pid.fromInt o SysWord.toInt
- val pidToWord = SysWord.fromInt o Pid.toInt
+ val wordToPid = C_PId.fromSysWord
+ val pidToWord = C_PId.toSysWord
fun fork () =
- SysCall.syscall
- (fn () =>
- let
- val p = Prim.fork ()
- val p' = Pid.toInt p
- in (p', fn () => if p' = 0 then NONE else SOME p)
- end)
+ SysCall.syscall'
+ ({errVal = C_PId.fromInt ~1}, fn () =>
+ (Prim.fork (), fn p =>
+ if p = C_PId.fromInt 0 then NONE else SOME p))
val fork =
if Primitive.MLton.Platform.OS.forkIsEnabled
@@ -34,7 +31,7 @@
else fn () => Error.raiseSys Error.nosys
val conv = NullString.nullTerm
- val convs = COld.CSS.fromList
+ val convs = CUtil.C_StringArray.fromList
fun exece (path, args, env): 'a =
let
@@ -76,7 +73,7 @@
if Prim.ifExited status
then (case Prim.exitStatus status of
0 => W_EXITED
- | n => W_EXITSTATUS (Word8.fromInt n))
+ | n => W_EXITSTATUS (Word8.fromSysWord (C_Int.toSysWord n)))
else if Prim.ifSignaled status
then W_SIGNALED (Prim.termSig status)
else if Prim.ifStopped status
@@ -85,10 +82,11 @@
structure W =
struct
- open W BitFlags
- val continued = SysWord.fromInt CONTINUED
- val nohang = SysWord.fromInt NOHANG
- val untraced = SysWord.fromInt UNTRACED
+ structure Flags = BitFlags(structure S = C_Int)
+ open W Flags
+ val continued = CONTINUED
+ val nohang = NOHANG
+ val untraced = UNTRACED
end
local
@@ -98,24 +96,23 @@
val useCwait =
Primitive.MLton.Platform.OS.useWindowsProcess
andalso case wa of W_CHILD _ => true | _ => false
- val p =
+ val pid =
case wa of
- W_ANY_CHILD => ~1
- | W_CHILD pid => Pid.toInt pid
- | W_SAME_GROUP => 0
- | W_GROUP pid => ~ (Pid.toInt pid)
+ W_ANY_CHILD => C_PId.fromInt ~1
+ | W_CHILD pid => pid
+ | W_SAME_GROUP => C_PId.fromInt 0
+ | W_GROUP pid => C_PId.~ pid
val flags = W.flags flags
in
- SysCall.syscallRestart
- (fn () =>
+ SysCall.simpleResultRestart'
+ ({errVal = C_PId.fromInt ~1}, fn () =>
let
val pid =
if useCwait
- then PrimitiveFFI.MLton.Process.cwait (Pid.fromInt p, status)
- else Prim.waitpid (Pid.fromInt p, status,
- SysWord.toInt flags)
+ then PrimitiveFFI.MLton.Process.cwait (pid, status)
+ else Prim.waitpid (pid, status, flags)
in
- (Pid.toInt pid, fn () => pid)
+ pid
end)
end
fun getStatus () = fromStatus (!status)
@@ -131,7 +128,7 @@
let
val pid = wait (wa, status, W.nohang :: flags)
in
- if 0 = Pid.toInt pid
+ if C_PId.fromInt 0 = pid
then NONE
else SOME (pid, getStatus ())
end
@@ -143,7 +140,7 @@
(* Posix.Process.exit does not call atExit cleaners, as per the basis
* library spec.
*)
- (Prim.exit (Word8.toInt w)
+ (Prim.exit (C_Status.fromSysWord (Word8.toSysWord w))
; raise Fail "Posix.Process.exit")
datatype killpid_arg =
@@ -155,22 +152,20 @@
let
val pid =
case ka of
- K_PROC pid => Pid.toInt pid
- | K_SAME_GROUP => ~1
- | K_GROUP pid => ~ (Pid.toInt pid)
+ K_PROC pid => pid
+ | K_SAME_GROUP => C_PId.fromInt ~1
+ | K_GROUP pid => C_PId.~ pid
in
- SysCall.simple (fn () => Prim.kill (Pid.fromInt pid, s))
+ SysCall.simple (fn () => Prim.kill (pid, s))
end
local
fun wrap prim (t: Time.time): Time.time =
Time.fromSeconds
- (LargeInt.fromInt
- (C_UInt.toInt
- (prim
- (C_UInt.fromInt
- (LargeInt.toInt (Time.toSeconds t)
- handle Overflow => Error.raiseSys Error.inval)))))
+ (C_UInt.toLargeInt
+ (prim
+ ((C_UInt.fromLargeInt (Time.toSeconds t))
+ handle Overflow => Error.raiseSys Error.inval)))
in
val alarm = wrap Prim.alarm
(* val sleep = wrap Prim.sleep *)
@@ -178,18 +173,20 @@
fun sleep (t: Time.time): Time.time =
let
- val (sec, nsec) = IntInf.quotRem (Time.toNanoseconds t, 1000000000)
+ val t = Time.toNanoseconds t
+ val sec = LargeInt.quot (t, 1000000000)
+ val nsec = LargeInt.rem (t, 1000000000)
val (sec, nsec) =
- (IntInf.toInt sec, IntInf.toInt nsec)
+ (C_Time.fromLarge sec, C_Long.fromLarge nsec)
handle Overflow => Error.raiseSys Error.inval
val secRem = ref sec
val nsecRem = ref nsec
- fun remaining () =
- Time.+ (Time.fromSeconds (Int.toLarge (!secRem)),
- Time.fromNanoseconds (Int.toLarge (!nsecRem)))
+ fun remaining _ =
+ Time.+ (Time.fromSeconds (C_Time.toLarge (!secRem)),
+ Time.fromNanoseconds (C_Long.toLarge (!nsecRem)))
in
SysCall.syscallErr
- ({clear = false, restart = false}, fn () =>
+ ({clear = false, restart = false, errVal = C_Int.fromInt ~1}, fn () =>
{handlers = [(Error.intr, remaining)],
post = remaining,
return = Prim.nanosleep (secRem, nsecRem)})
@@ -198,9 +195,9 @@
(* FIXME: pause *)
fun pause () =
SysCall.syscallErr
- ({clear = false, restart = false},
+ ({clear = false, restart = false, errVal = C_Int.fromInt ~1},
fn () =>
{return = Prim.pause (),
- post = fn () => (),
+ post = fn _ => (),
handlers = [(Error.intr, fn () => ())]})
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml 2006-04-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml 2006-04-30 18:58:08 UTC (rev 4425)
@@ -8,7 +8,6 @@
structure PosixSysDB: POSIX_SYS_DB =
struct
- structure CS = COld.CS
structure Prim = PrimitiveFFI.Posix.SysDB
structure Error = PosixError
structure SysCall = Error.SysCall
@@ -27,14 +26,14 @@
structure Passwd = Prim.Passwd
fun fromC (f: unit -> bool): passwd =
- SysCall.syscall
- (fn () =>
- (if f () then 0 else ~1,
- fn () => {name = CS.toString(Passwd.getName ()),
- uid = Passwd.getUId (),
- gid = Passwd.getGId (),
- home = CS.toString(Passwd.getDir ()),
- shell = CS.toString(Passwd.getShell ())}))
+ SysCall.syscall'
+ ({errVal = false}, fn () =>
+ (C_Errno.inject (f ()),
+ fn _ => {name = CUtil.C_String.toString (Passwd.getName ()),
+ uid = Passwd.getUId (),
+ gid = Passwd.getGId (),
+ home = CUtil.C_String.toString (Passwd.getDir ()),
+ shell = CUtil.C_String.toString (Passwd.getShell ())}))
val name: passwd -> string = #name
val uid: passwd -> uid = #uid
@@ -59,12 +58,12 @@
structure Group = Prim.Group
fun fromC (f: unit -> bool): group =
- SysCall.syscall
- (fn () =>
- (if f () then 0 else ~1,
- fn () => {name = CS.toString(Group.getName ()),
- gid = Group.getGId (),
- members = COld.CSS.toList(Group.getMem ())}))
+ SysCall.syscall'
+ ({errVal = false}, fn () =>
+ (C_Errno.inject (f ()),
+ fn _ => {name = CUtil.C_String.toString (Group.getName ()),
+ gid = Group.getGId (),
+ members = CUtil.C_StringArray.toList (Group.getMem ())}))
val name: group -> string = #name
val gid: group -> gid = #gid
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml 2006-04-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml 2006-04-30 18:58:08 UTC (rev 4425)
@@ -8,7 +8,6 @@
structure PosixTTY: POSIX_TTY =
struct
- structure Cstring = COld.CS
structure Prim = PrimitiveFFI.Posix.TTY
open Prim
structure Error = PosixError
@@ -21,27 +20,29 @@
structure V =
struct
open V
- val nccs = NCCS
- val eof = VEOF
- val eol = VEOL
- val erase = VERASE
- val intr = VINTR
- val kill = VKILL
- val min = VMIN
- val quit = VQUIT
- val susp = VSUSP
- val time = VTIME
- val start = VSTART
- val stop = VSTOP
+ val nccs = C_Int.toInt NCCS
+ val eof = C_Int.toInt VEOF
+ val eol = C_Int.toInt VEOL
+ val erase = C_Int.toInt VERASE
+ val intr = C_Int.toInt VINTR
+ val kill = C_Int.toInt VKILL
+ val min = C_Int.toInt VMIN
+ val quit = C_Int.toInt VQUIT
+ val susp = C_Int.toInt VSUSP
+ val time = C_Int.toInt VTIME
+ val start = C_Int.toInt VSTART
+ val stop = C_Int.toInt VSTOP
type cc = C_CC.t array
- val default = Byte.charToByte #"\000"
+ val default = C_CC.fromSysWord 0w0
- fun new () = Array.array (NCCS, default)
+ fun new () = Array.array (nccs, default)
fun updates (a, l) =
- List.app (fn (i, cc) => Array.update (a, i, Byte.charToByte cc)) l
+ List.app (fn (i, cc) =>
+ Array.update (a, i, (C_CC.fromSysWord o Word8.toSysWord o Byte.charToByte) cc))
+ l
fun cc l = let val a = new ()
in updates (a, l)
@@ -55,12 +56,13 @@
; a'
end
- val sub = Byte.byteToChar o Array.sub
+ val sub = (Byte.byteToChar o Word8.fromSysWord o C_CC.toSysWord) o Array.sub
end
+ structure Flags = BitFlags(structure S = C_TCFlag)
structure I =
struct
- open I BitFlags
+ open I Flags
val brkint = BRKINT
val icrnl = ICRNL
val ignbrk = IGNBRK
@@ -77,7 +79,7 @@
structure O =
struct
- open O BitFlags
+ open O Flags
val bs0 = BS0
val bs1 = BS1
val bsdly = BSDLY
@@ -110,7 +112,7 @@
structure C =
struct
- open C BitFlags
+ open C Flags
val clocal = CLOCAL
val cread = CREAD
val cs5 = CS5
@@ -126,7 +128,7 @@
structure L =
struct
- open L BitFlags
+ open L Flags
val echo = ECHO
val echoe = ECHOE
val echok = ECHOK
@@ -157,10 +159,9 @@
val b75 = B75
val b9600 = B9600
- val compareSpeed = SysWord.compare
- fun id x = x
- val speedToWord = id
- val wordToSpeed = id
+ val compareSpeed = C_Speed.compare
+ val speedToWord = C_Speed.toSysWord
+ val wordToSpeed = C_Speed.fromSysWord
type termios = {iflag: I.flags,
oflag: O.flags,
@@ -170,6 +171,7 @@
ispeed: speed,
ospeed: speed}
+ val id = fn x => x
val termios = id
val fieldsOf = id
@@ -230,7 +232,7 @@
fun getattr fd =
SysCall.syscallRestart
(fn () =>
- (Prim.TC.getattr fd, fn () =>
+ (Prim.TC.getattr fd, fn _ =>
{iflag = Termios.getIFlag (),
oflag = Termios.getOFlag (),
cflag = Termios.getCFlag (),
@@ -252,10 +254,10 @@
; SysCall.simple (fn () => Termios.cfSetOSpeed ospeed)
; SysCall.simple (fn () => Termios.cfSetISpeed ispeed)
; Termios.setCC cc
- ; (Prim.TC.setattr (fd, a), fn () => ())))
+ ; (Prim.TC.setattr (fd, a), fn _ => ())))
fun sendbreak (fd, n) =
- SysCall.simpleRestart (fn () => Prim.TC.sendbreak (fd, n))
+ SysCall.simpleRestart (fn () => Prim.TC.sendbreak (fd, C_Int.fromInt n))
fun drain fd = SysCall.simpleRestart (fn () => Prim.TC.drain fd)
@@ -266,11 +268,9 @@
SysCall.simpleRestart (fn () => Prim.TC.flow (fd, n))
fun getpgrp fd =
- SysCall.syscallRestart
- (fn () =>
- let val pid = Prim.TC.getpgrp fd
- in (Pid.toInt pid, fn () => pid)
- end)
+ SysCall.simpleResultRestart'
+ ({errVal = C_PId.fromInt ~1}, fn () =>
+ Prim.TC.getpgrp fd)
fun setpgrp (fd, pid) =
SysCall.simpleRestart (fn () => Prim.TC.setpgrp (fd, pid))
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-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-04-30 18:58:08 UTC (rev 4425)
@@ -499,7 +499,7 @@
val fcntl3 = _import "Posix_IO_fcntl3" : C_Fd.t * C_Int.t * C_Int.t -> (C_Int.t) C_Errno.t;
structure FD =
struct
-val CLOEXEC = _const "Posix_IO_FD_CLOEXEC" : C_Fd.t;
+val CLOEXEC = _const "Posix_IO_FD_CLOEXEC" : C_Int.t;
end
structure FLock =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml 2006-04-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml 2006-04-30 18:58:08 UTC (rev 4425)
@@ -33,6 +33,7 @@
val debug = _command_line_const "MLton.debug": bool = false;
val detectOverflow = _command_line_const "MLton.detectOverflow": bool = true;
val safe = _command_line_const "MLton.safe": bool = true;
+ val bufSize = _command_line_const "TextIO.bufSize": Int32.int = 4096;
end
structure Exn =
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/fcntl-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/fcntl-consts.c 2006-04-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/fcntl-consts.c 2006-04-30 18:58:08 UTC (rev 4425)
@@ -8,6 +8,6 @@
const C_Int_t Posix_IO_F_SETFL = F_SETFL;
const C_Int_t Posix_IO_F_SETOWN = F_SETOWN;
-const C_Fd_t Posix_IO_FD_CLOEXEC = FD_CLOEXEC;
+const C_Int_t Posix_IO_FD_CLOEXEC = FD_CLOEXEC;
const C_Int_t Posix_IO_O_ACCMODE = O_ACCMODE;
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-30 14:07:24 UTC (rev 4424)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-04-30 18:58:08 UTC (rev 4425)
@@ -368,7 +368,7 @@
Posix.FileSys.truncate = _import : NullString8.t * C_Off.t -> C_Int.t C_Errno.t
Posix.FileSys.umask = _import : C_Mode.t -> C_Mode.t
Posix.FileSys.unlink = _import : NullString8.t -> C_Int.t C_Errno.t
-Posix.IO.FD.CLOEXEC = _const : C_Fd.t
+Posix.IO.FD.CLOEXEC = _const : C_Int.t
Posix.IO.FLock.F_GETLK = _const : C_Int.t
Posix.IO.FLock.F_RDLCK = _const : C_Short.t
Posix.IO.FLock.F_SETLK = _const : C_Int.t
|
|
From: Matthew F. <fl...@ml...> - 2006-04-30 07:07:25
|
Refactored Posix.FileSys
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml
----------------------------------------------------------------------
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-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 14:07:24 UTC (rev 4424)
@@ -220,13 +220,13 @@
../posix/stub-mingw.sml
../posix/flags.sig
- (* ../posix/flags.sml *)
+ ../posix/flags.sml
../posix/signal.sig
../posix/signal.sml
../posix/proc-env.sig
../posix/proc-env.sml
../posix/file-sys.sig
- (* ../posix/file-sys.sml *)
+ ../posix/file-sys.sml
../posix/io.sig
(* ../posix/io.sml *)
../posix/process.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-04-30 14:07:24 UTC (rev 4424)
@@ -21,6 +21,16 @@
val fromInt32: Primitive.Int32.int -> int
val fromInt64: Primitive.Int64.int -> int
val fromIntInf: Primitive.IntInf.int -> int
+ (* Overflow checking, unsigned interp. *)
+ val fromWord8: Primitive.Word8.word -> int
+ val fromWord16: Primitive.Word16.word -> int
+ val fromWord32: Primitive.Word32.word -> int
+ val fromWord64: Primitive.Word64.word -> int
+ (* Overflow checking, signed interp. *)
+ val fromWord8X: Primitive.Word8.word -> int
+ val fromWord16X: Primitive.Word16.word -> int
+ val fromWord32X: Primitive.Word32.word -> int
+ val fromWord64X: Primitive.Word64.word -> int
(* Lowbits or sign-extend. *)
val toInt8Unsafe: int -> Primitive.Int8.int
val toInt16Unsafe: int -> Primitive.Int16.int
@@ -33,6 +43,16 @@
val toInt32: int -> Primitive.Int32.int
val toInt64: int -> Primitive.Int64.int
val toIntInf: int -> Primitive.IntInf.int
+ (* Lowbits or zero extend. *)
+ val toWord8: int -> Primitive.Word8.word
+ val toWord16: int -> Primitive.Word16.word
+ val toWord32: int -> Primitive.Word32.word
+ val toWord64: int -> Primitive.Word64.word
+ (* Lowbits or sign extend. *)
+ val toWord8X: int -> Primitive.Word8.word
+ val toWord16X: int -> Primitive.Word16.word
+ val toWord32X: int -> Primitive.Word32.word
+ val toWord64X: int -> Primitive.Word64.word
end
signature INT_FROM_TO_RES =
@@ -41,17 +61,25 @@
val fromIntUnsafe: Int.int -> int
val fromInt: Int.int -> int
- val fromLargeIntUnsafe: LargeInt.int -> int
- val fromLargeUnsafe: LargeInt.int -> int
val fromLargeInt: LargeInt.int -> int
val fromLarge: LargeInt.int -> int
+ val fromWord: Word.word -> int
+ val fromWordX: Word.word -> int
+ val fromLargeWord: LargeWord.word -> int
+ val fromLargeWordX: LargeWord.word -> int
+ val fromSysWord: SysWord.word -> int
+ val fromSysWordX: SysWord.word -> int
val toIntUnsafe: int -> Int.int
val toInt: int -> Int.int
- val toLargeIntUnsafe: int -> LargeInt.int
- val toLargeUnsafe: int -> LargeInt.int
val toLargeInt: int -> LargeInt.int
val toLarge: int -> LargeInt.int
+ val toWord: int -> Word.word
+ val toWordX: int -> Word.word
+ val toLargeWord: int -> LargeWord.word
+ val toLargeWordX: int -> LargeWord.word
+ val toSysWord: int -> SysWord.word
+ val toSysWordX: int -> SysWord.word
end
functor IntFromTo(I: INT_FROM_TO_ARG): INT_FROM_TO_RES where type int = I.int =
@@ -86,19 +114,6 @@
structure S =
LargeInt_ChooseInt
(type 'a t = 'a -> int
- val fInt8 = I.fromInt8Unsafe
- val fInt16 = I.fromInt16Unsafe
- val fInt32 = I.fromInt32Unsafe
- val fInt64 = I.fromInt64Unsafe
- val fIntInf = I.fromIntInfUnsafe)
- in
- val fromLargeIntUnsafe = S.f
- val fromLargeUnsafe = fromLargeIntUnsafe
- end
- local
- structure S =
- LargeInt_ChooseInt
- (type 'a t = 'a -> int
val fInt8 = I.fromInt8
val fInt16 = I.fromInt16
val fInt32 = I.fromInt32
@@ -108,6 +123,72 @@
val fromLargeInt = S.f
val fromLarge = fromLargeInt
end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8
+ val fWord16 = I.fromWord16
+ val fWord32 = I.fromWord32
+ val fWord64 = I.fromWord64)
+ in
+ val fromWord = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8X
+ val fWord16 = I.fromWord16X
+ val fWord32 = I.fromWord32X
+ val fWord64 = I.fromWord64X)
+ in
+ val fromWordX = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8
+ val fWord16 = I.fromWord16
+ val fWord32 = I.fromWord32
+ val fWord64 = I.fromWord64)
+ in
+ val fromLargeWord = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8X
+ val fWord16 = I.fromWord16X
+ val fWord32 = I.fromWord32X
+ val fWord64 = I.fromWord64X)
+ in
+ val fromLargeWordX = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8
+ val fWord16 = I.fromWord16
+ val fWord32 = I.fromWord32
+ val fWord64 = I.fromWord64)
+ in
+ val fromSysWord = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8X
+ val fWord16 = I.fromWord16X
+ val fWord32 = I.fromWord32X
+ val fWord64 = I.fromWord64X)
+ in
+ val fromSysWordX = S.f
+ end
local
structure S =
@@ -137,19 +218,6 @@
structure S =
LargeInt_ChooseInt
(type 'a t = int -> 'a
- val fInt8 = I.toInt8Unsafe
- val fInt16 = I.toInt16Unsafe
- val fInt32 = I.toInt32Unsafe
- val fInt64 = I.toInt64Unsafe
- val fIntInf = I.toIntInfUnsafe)
- in
- val toLargeIntUnsafe = S.f
- val toLargeUnsafe = toLargeIntUnsafe
- end
- local
- structure S =
- LargeInt_ChooseInt
- (type 'a t = int -> 'a
val fInt8 = I.toInt8
val fInt16 = I.toInt16
val fInt32 = I.toInt32
@@ -159,6 +227,72 @@
val toLargeInt = S.f
val toLarge = toLargeInt
end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8
+ val fWord16 = I.toWord16
+ val fWord32 = I.toWord32
+ val fWord64 = I.toWord64)
+ in
+ val toWord = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8X
+ val fWord16 = I.toWord16X
+ val fWord32 = I.toWord32X
+ val fWord64 = I.toWord64X)
+ in
+ val toWordX = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8
+ val fWord16 = I.toWord16
+ val fWord32 = I.toWord32
+ val fWord64 = I.toWord64)
+ in
+ val toLargeWord = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8X
+ val fWord16 = I.toWord16X
+ val fWord32 = I.toWord32X
+ val fWord64 = I.toWord64X)
+ in
+ val toLargeWordX = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8
+ val fWord16 = I.toWord16
+ val fWord32 = I.toWord32
+ val fWord64 = I.toWord64)
+ in
+ val toSysWord = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8X
+ val fWord16 = I.toWord16X
+ val fWord32 = I.toWord32X
+ val fWord64 = I.toWord64X)
+ in
+ val toSysWordX = S.f
+ end
end
structure Primitive = struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-30 14:07:24 UTC (rev 4424)
@@ -68,6 +68,9 @@
val leu: int * int -> bool
val gtu: int * int -> bool
val geu: int * int -> bool
+
+ val fromSysWord: SysWord.word -> int
+ val toSysWord: int -> SysWord.word
end
signature INTEGER =
@@ -114,4 +117,7 @@
val leu: int * int -> bool
val gtu: int * int -> bool
val geu: int * int -> bool
+
+ val fromSysWord: SysWord.word -> int
+ val toSysWord: int -> SysWord.word
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig 2006-04-30 14:07:24 UTC (rev 4424)
@@ -124,5 +124,5 @@
sig
include POSIX_FILE_SYS
- val wordToOpenMode: SysWord.word -> open_mode
+ val flagsToOpenMode: O.flags -> open_mode
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-30 14:07:24 UTC (rev 4424)
@@ -10,20 +10,20 @@
struct
structure Error = PosixError
- (* Patch to make Time look like it deals with Int.int
+ (* Patch to make Time look like it deals with C_Time.t
* instead of LargeInt.int.
*)
structure Time =
struct
open Time
- val fromSeconds = fromSeconds o LargeInt.fromInt
+ val fromSeconds = fromSeconds o C_Time.toLarge
fun toSeconds t =
- LargeInt.toInt (Time.toSeconds t)
+ C_Time.fromLarge (Time.toSeconds t)
handle Overflow => Error.raiseSys Error.inval
end
-
+
structure SysCall = Error.SysCall
structure Prim = PrimitiveFFI.Posix.FileSys
open Prim
@@ -151,13 +151,8 @@
structure S =
struct
- open S
- local
- structure Flags = BitFlags(structure W = C_Mode
- val all = 0wxFFFF)
- in
- open Flags
- end
+ structure Flags = BitFlags(structure S = C_Mode)
+ open S Flags
type mode = C_Mode.t
val ifblk = IFBLK
val ifchr = IFCHR
@@ -186,6 +181,7 @@
structure O =
struct
+ structure Flags = BitFlags(structure S = C_Int)
open O Flags
val append = APPEND
val binary = BINARY
@@ -205,13 +201,13 @@
datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
- fun wordToOpenMode w =
- if w = O.rdonly then O_RDONLY
- else if w = O.wronly then O_WRONLY
- else if w = O.rdwr then O_RDWR
- else raise Fail "wordToOpenMode: unknown word"
+ fun flagsToOpenMode f =
+ if f = O.rdonly then O_RDONLY
+ else if f = O.wronly then O_WRONLY
+ else if f = O.rdwr then O_RDWR
+ else raise Fail "flagsToOpenMode: unknown flag"
- val openModeToWord =
+ val openModeToFlags =
fn O_RDONLY => O.rdonly
| O_WRONLY => O.wronly
| O_RDWR => O.rdwr
@@ -219,12 +215,13 @@
fun createf (pathname, openMode, flags, mode) =
let
val pathname = NullString.nullTerm pathname
- val flags = Flags.flags [openModeToWord openMode,
- flags,
- O.creat]
+ val flags = O.Flags.flags [openModeToFlags openMode,
+ flags,
+ O.creat]
+ val flags = C_Int.fromSysWord (O.Flags.toWord flags)
val fd =
SysCall.simpleResult
- (fn () => Prim.open3 (pathname, SysWord.toInt flags, mode))
+ (fn () => Prim.open3 (pathname, flags, mode))
in
fd
end
@@ -232,10 +229,11 @@
fun openf (pathname, openMode, flags) =
let
val pathname = NullString.nullTerm pathname
- val flags = Flags.flags [openModeToWord openMode, flags]
+ val flags = O.Flags.flags [openModeToFlags openMode, flags]
+ val flags = C_Int.fromSysWord (O.Flags.toWord flags)
val fd =
SysCall.simpleResult
- (fn () => Prim.open3 (pathname, SysWord.toInt flags, C_Mode.fromWord 0w0))
+ (fn () => Prim.open3 (pathname, flags, C_Mode.fromInt 0))
in
fd
end
@@ -278,7 +276,7 @@
SysCall.syscall'
({errVal = C_SSize.fromInt ~1}, fn () =>
(Prim.readlink (path, buf, C_Size.fromInt size), fn len =>
- ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len))))
+ ArraySlice.vector (ArraySlice.slice (buf, 0, SOME (C_SSize.toInt len)))))
end
end
@@ -362,7 +360,7 @@
fun access (path: string, mode: access_mode list): bool =
let
- val mode = SysWord.toInt (Flags.flags (map SysWord.fromInt (A.F_OK :: (map conv_access_mode mode))))
+ val mode = List.foldl C_Int.orb 0 (A.F_OK :: (map conv_access_mode mode))
val path = NullString.nullTerm path
in
SysCall.syscallErr
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml 2006-04-30 14:07:24 UTC (rev 4424)
@@ -7,27 +7,29 @@
*)
functor BitFlags(structure S : sig
- type t
- val all: t
+ eqtype t
val toSysWord: t -> SysWord.word
val fromSysWord: SysWord.word -> t
+ val andb: t * t -> t
+ val notb: t -> t
+ val orb: t * t -> t
end): BIT_FLAGS_EXTRA =
struct
type flags = S.t
- val all: flags = S.all
+ val all: flags = S.fromSysWord (SysWord.~ 0w1)
val empty: flags = S.fromSysWord 0w0
- fun toWord f = W.toSysWord f
- fun fromWord w = W.fromSysWord (SysWord.andb(w, toWord all))
+ fun toWord f = S.toSysWord f
+ fun fromWord w = S.fromSysWord (SysWord.andb (w, toWord all))
- val flags: flags list -> flags = List.foldl W.orb empty
+ val flags: flags list -> flags = List.foldl S.orb empty
- val intersect: flags list -> flags = List.foldl W.andb all
+ val intersect: flags list -> flags = List.foldl S.andb all
- fun clear(f, f') = W.andb(W.notb f, f')
+ fun clear (f, f') = S.andb (S.notb f, f')
- fun allSet(f, f') = W.andb(f, f') = f
+ fun allSet (f, f') = S.andb (f, f') = f'
- fun anySet(f, f') = W.andb(f, f') <> empty
+ fun anySet (f, f') = S.andb (f, f') <> empty
end
|
|
From: Matthew F. <fl...@ml...> - 2006-04-27 08:48:09
|
Working on Flags
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
----------------------------------------------------------------------
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-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-27 15:48:05 UTC (rev 4423)
@@ -29,6 +29,8 @@
../config/header/$(HEADER_WORD)
../config/seq/$(SEQ_INDEX)
../config/c/misc/$(CTYPES)
+ ../config/c/position.sml
+ ../config/c/sys-word.sml
end end
../integer/int-inf0.sml
local
@@ -117,6 +119,8 @@
in ann "forceUsed" in
../config/objptr/$(OBJPTR_REP)
../config/c/misc/$(CTYPES)
+ ../config/c/position.sml
+ ../config/c/sys-word.sml
end end
../integer/int-inf.sig
../integer/int-inf.sml
@@ -146,6 +150,8 @@
../config/bind/word-top.sml
in ann "forceUsed" in
../config/c/misc/$(CTYPES)
+ ../config/c/position.sml
+ ../config/c/sys-word.sml
end end
../text/char.sig
@@ -214,7 +220,7 @@
../posix/stub-mingw.sml
../posix/flags.sig
- ../posix/flags.sml
+ (* ../posix/flags.sml *)
../posix/signal.sig
../posix/signal.sml
../posix/proc-env.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig 2006-04-27 15:48:05 UTC (rev 4423)
@@ -17,6 +17,7 @@
signature INT_INF_EXTRA =
sig
include INT_INF
+ type t = int
structure BigWord : WORD
structure SmallInt : INTEGER
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -9,6 +9,7 @@
structure IntInf: INT_INF_EXTRA =
struct
open Primitive.IntInf
+ type t = int
structure BigWord = C_MPLimb
structure SmallInt = ObjptrInt
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -1072,6 +1072,7 @@
open Word8
val fromIntInfUnsafe = IntInf.toWord8Unsafe
val fromIntInf = IntInf.toWord8
+ val fromIntInfZ = IntInf.toWord8
val toIntInfUnsafe = IntInf.fromWord8Unsafe
val toIntInf = IntInf.fromWord8
val toIntInfXUnsafe = IntInf.fromWord8XUnsafe
@@ -1082,6 +1083,7 @@
open Word16
val fromIntInfUnsafe = IntInf.toWord16Unsafe
val fromIntInf = IntInf.toWord16
+ val fromIntInfZ = IntInf.toWord16
val toIntInfUnsafe = IntInf.fromWord16Unsafe
val toIntInf = IntInf.fromWord16
val toIntInfXUnsafe = IntInf.fromWord16XUnsafe
@@ -1092,6 +1094,7 @@
open Word32
val fromIntInfUnsafe = IntInf.toWord32Unsafe
val fromIntInf = IntInf.toWord32
+ val fromIntInfZ = IntInf.toWord32
val toIntInfUnsafe = IntInf.fromWord32Unsafe
val toIntInf = IntInf.fromWord32
val toIntInfXUnsafe = IntInf.fromWord32XUnsafe
@@ -1102,6 +1105,7 @@
open Word64
val fromIntInfUnsafe = IntInf.toWord64Unsafe
val fromIntInf = IntInf.toWord64
+ val fromIntInfZ = IntInf.toWord64
val toIntInfUnsafe = IntInf.fromWord64Unsafe
val toIntInf = IntInf.fromWord64
val toIntInfXUnsafe = IntInf.fromWord64XUnsafe
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -10,6 +10,7 @@
struct
open I
+type t = int
val precision': Int.int = Primitive.Int32.toInt precision'
val precision: Int.int option = SOME precision'
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -38,13 +38,19 @@
signature INT_FROM_TO_RES =
sig
type int
+
val fromIntUnsafe: Int.int -> int
+ val fromInt: Int.int -> int
+ val fromLargeIntUnsafe: LargeInt.int -> int
val fromLargeUnsafe: LargeInt.int -> int
- val fromInt: Int.int -> int
+ val fromLargeInt: LargeInt.int -> int
val fromLarge: LargeInt.int -> int
+
val toIntUnsafe: int -> Int.int
+ val toInt: int -> Int.int
+ val toLargeIntUnsafe: int -> LargeInt.int
val toLargeUnsafe: int -> LargeInt.int
- val toInt: int -> Int.int
+ val toLargeInt: int -> LargeInt.int
val toLarge: int -> LargeInt.int
end
@@ -66,18 +72,6 @@
end
local
structure S =
- LargeInt_ChooseInt
- (type 'a t = 'a -> int
- val fInt8 = I.fromInt8Unsafe
- val fInt16 = I.fromInt16Unsafe
- val fInt32 = I.fromInt32Unsafe
- val fInt64 = I.fromInt64Unsafe
- val fIntInf = I.fromIntInfUnsafe)
- in
- val fromLargeUnsafe = S.f
- end
- local
- structure S =
Int_ChooseInt
(type 'a t = 'a -> int
val fInt8 = I.fromInt8
@@ -92,14 +86,29 @@
structure S =
LargeInt_ChooseInt
(type 'a t = 'a -> int
+ val fInt8 = I.fromInt8Unsafe
+ val fInt16 = I.fromInt16Unsafe
+ val fInt32 = I.fromInt32Unsafe
+ val fInt64 = I.fromInt64Unsafe
+ val fIntInf = I.fromIntInfUnsafe)
+ in
+ val fromLargeIntUnsafe = S.f
+ val fromLargeUnsafe = fromLargeIntUnsafe
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = 'a -> int
val fInt8 = I.fromInt8
val fInt16 = I.fromInt16
val fInt32 = I.fromInt32
val fInt64 = I.fromInt64
val fIntInf = I.fromIntInf)
in
- val fromLarge = S.f
+ val fromLargeInt = S.f
+ val fromLarge = fromLargeInt
end
+
local
structure S =
Int_ChooseInt
@@ -114,18 +123,6 @@
end
local
structure S =
- LargeInt_ChooseInt
- (type 'a t = int -> 'a
- val fInt8 = I.toInt8Unsafe
- val fInt16 = I.toInt16Unsafe
- val fInt32 = I.toInt32Unsafe
- val fInt64 = I.toInt64Unsafe
- val fIntInf = I.toIntInfUnsafe)
- in
- val toLargeUnsafe = S.f
- end
- local
- structure S =
Int_ChooseInt
(type 'a t = int -> 'a
val fInt8 = I.toInt8
@@ -140,15 +137,28 @@
structure S =
LargeInt_ChooseInt
(type 'a t = int -> 'a
+ val fInt8 = I.toInt8Unsafe
+ val fInt16 = I.toInt16Unsafe
+ val fInt32 = I.toInt32Unsafe
+ val fInt64 = I.toInt64Unsafe
+ val fIntInf = I.toIntInfUnsafe)
+ in
+ val toLargeIntUnsafe = S.f
+ val toLargeUnsafe = toLargeIntUnsafe
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = int -> 'a
val fInt8 = I.toInt8
val fInt16 = I.toInt16
val fInt32 = I.toInt32
val fInt64 = I.toInt64
val fIntInf = I.toIntInf)
in
- val toLarge = S.f
+ val toLargeInt = S.f
+ val toLarge = toLargeInt
end
-
end
structure Primitive = struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-27 15:48:05 UTC (rev 4423)
@@ -89,6 +89,7 @@
signature INTEGER_EXTRA =
sig
include INTEGER
+ type t = int
val precision' : Int.int
val maxInt' : int
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig 2006-04-27 15:48:05 UTC (rev 4423)
@@ -51,8 +51,13 @@
val wordSizeWord: Primitive.Word32.word
val fromWord: Word.word -> word
+ val fromWordX: Word.word -> word
+ val fromSysWord: SysWord.word -> word
+ val fromSysWordX: SysWord.word -> word
val toWord: word -> Word.word
val toWordX: word -> Word.word
+ val toSysWord: word -> SysWord.word
+ val toSysWordX: word -> SysWord.word
val << : word * Primitive.Word32.word -> word
val >> : word * Primitive.Word32.word -> word
@@ -83,11 +88,18 @@
signature WORD_EXTRA =
sig
include WORD
+ type t = word
+
val wordSizeWord: Word.word
val fromWord: Word.word -> word
+ val fromWordX: Word.word -> word
+ val fromSysWord: SysWord.word -> word
+ val fromSysWordX: SysWord.word -> word
val toWord: word -> Word.word
val toWordX: word -> Word.word
+ val toSysWord: word -> SysWord.word
+ val toSysWordX: word -> SysWord.word
val rol: word * Word.word -> word
val ror: word * Word.word -> word
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -10,6 +10,7 @@
struct
open W
+type t = word
val wordSize: Int.int = Primitive.Int32.toInt wordSize
val wordSizeWord: Word.word = Primitive.Word32.toWord wordSizeWord
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -31,13 +31,11 @@
val fromInt32: Primitive.Int32.int -> word
val fromInt64: Primitive.Int64.int -> word
-(*
(* Lowbits or zero extend. *)
val fromInt8Z: Primitive.Int8.int -> word
val fromInt16Z: Primitive.Int16.int -> word
val fromInt32Z: Primitive.Int32.int -> word
val fromInt64Z: Primitive.Int64.int -> word
-*)
(* Lowbits or zero extend. *)
val fromWord8: Primitive.Word8.word -> word
@@ -146,7 +144,7 @@
end
local
- fun 'a make {fromIntUnsafe: 'a -> word, (* fromIntZUnsafe: 'a -> word, *)
+ fun 'a make {fromIntUnsafe: 'a -> word, fromIntZUnsafe: 'a -> word,
toIntUnsafe: word -> 'a, toIntXUnsafe: word -> 'a,
other : {precision': Primitive.Int32.int,
maxInt': 'a,
@@ -167,38 +165,38 @@
else toIntXUnsafe w
in
(fromIntUnsafe,
- (* fromIntZUnsafe, *)
+ fromIntZUnsafe,
toInt,
toIntX)
end
in
- val (fromInt8, (* fromInt8Z, *) toInt8, toInt8X) =
+ val (fromInt8, fromInt8Z, toInt8, toInt8X) =
make {fromIntUnsafe = fromInt8Unsafe,
- (* fromIntZUnsafe = fromInt8ZUnsafe, *)
+ fromIntZUnsafe = fromInt8ZUnsafe,
toIntUnsafe = toInt8Unsafe,
toIntXUnsafe = toInt8XUnsafe,
other = {precision' = Primitive.Int8.precision',
maxInt' = Primitive.Int8.maxInt',
minInt' = Primitive.Int8.minInt'}}
- val (fromInt16, (* fromInt16Z, *) toInt16, toInt16X) =
+ val (fromInt16, fromInt16Z, toInt16, toInt16X) =
make {fromIntUnsafe = fromInt16Unsafe,
- (* fromIntZUnsafe = fromInt16ZUnsafe, *)
+ fromIntZUnsafe = fromInt16ZUnsafe,
toIntUnsafe = toInt16Unsafe,
toIntXUnsafe = toInt16XUnsafe,
other = {precision' = Primitive.Int16.precision',
maxInt' = Primitive.Int16.maxInt',
minInt' = Primitive.Int16.minInt'}}
- val (fromInt32, (* fromInt32Z, *) toInt32, toInt32X) =
+ val (fromInt32, fromInt32Z, toInt32, toInt32X) =
make {fromIntUnsafe = fromInt32Unsafe,
- (* fromIntZUnsafe = fromInt32ZUnsafe, *)
+ fromIntZUnsafe = fromInt32ZUnsafe,
toIntUnsafe = toInt32Unsafe,
toIntXUnsafe = toInt32XUnsafe,
other = {precision' = Primitive.Int32.precision',
maxInt' = Primitive.Int32.maxInt',
minInt' = Primitive.Int32.minInt'}}
- val (fromInt64, (* fromInt64Z, *) toInt64, toInt64X) =
+ val (fromInt64, fromInt64Z, toInt64, toInt64X) =
make {fromIntUnsafe = fromInt64Unsafe,
- (* fromIntZUnsafe = fromInt64ZUnsafe, *)
+ fromIntZUnsafe = fromInt64ZUnsafe,
toIntUnsafe = toInt64Unsafe,
toIntXUnsafe = toInt64XUnsafe,
other = {precision' = Primitive.Int64.precision',
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -16,10 +16,21 @@
val fromInt64: Primitive.Int64.int -> word
val fromIntInf: Primitive.IntInf.int -> word
(* Lowbits or zero extend. *)
+ val fromInt8Z: Primitive.Int8.int -> word
+ val fromInt16Z: Primitive.Int16.int -> word
+ val fromInt32Z: Primitive.Int32.int -> word
+ val fromInt64Z: Primitive.Int64.int -> word
+ val fromIntInfZ: Primitive.IntInf.int -> word
+ (* Lowbits or zero extend. *)
val fromWord8: Primitive.Word8.word -> word
val fromWord16: Primitive.Word16.word -> word
val fromWord32: Primitive.Word32.word -> word
val fromWord64: Primitive.Word64.word -> word
+ (* Lowbits or sign extend. *)
+ val fromWord8X: Primitive.Word8.word -> word
+ val fromWord16X: Primitive.Word16.word -> word
+ val fromWord32X: Primitive.Word32.word -> word
+ val fromWord64X: Primitive.Word64.word -> word
(* Overflow checking, unsigned interp. *)
val toInt8: word -> Primitive.Int8.int
val toInt16: word -> Primitive.Int16.int
@@ -49,21 +60,30 @@
type word
val fromInt: Int.int -> word
+ val fromIntZ: Int.int -> word
+ val fromLargeInt: LargeInt.int -> word
+ val fromLargeIntZ: LargeInt.int -> word
val fromWord: Word.word -> word
+ val fromWordX: Word.word -> word
+ val fromLargeWord: LargeWord.word -> word
val fromLarge: LargeWord.word -> word
- val fromLargeInt: LargeInt.int -> word
- val fromLargeWord: LargeWord.word -> word
+ val fromLargeWordX: LargeWord.word -> word
+ val fromLargeX: LargeWord.word -> word
+ val fromSysWord: SysWord.word -> word
+ val fromSysWordX: SysWord.word -> word
val toInt: word -> Int.int
val toIntX: word -> Int.int
+ val toLargeInt: word -> LargeInt.int
+ val toLargeIntX: word -> LargeInt.int
val toWord: word -> Word.word
val toWordX: word -> Word.word
+ val toLargeWord: word -> LargeWord.word
val toLarge: word -> LargeWord.word
+ val toLargeWordX: word -> LargeWord.word
val toLargeX: word -> LargeWord.word
- val toLargeInt: word -> LargeInt.int
- val toLargeIntX: word -> LargeInt.int
- val toLargeWord: word -> LargeWord.word
- val toLargeWordX: word -> LargeWord.word
+ val toSysWord: word -> SysWord.word
+ val toSysWordX: word -> SysWord.word
end
functor WordFromTo (W: WORD_FROM_TO_ARG): WORD_FROM_TO_RES where type word = W.word =
@@ -84,6 +104,18 @@
end
local
structure S =
+ Int_ChooseInt
+ (type 'a t = 'a -> word
+ val fInt8 = W.fromInt8Z
+ val fInt16 = W.fromInt16Z
+ val fInt32 = W.fromInt32Z
+ val fInt64 = W.fromInt64Z
+ val fIntInf = W.fromIntInfZ)
+ in
+ val fromIntZ = S.f
+ end
+ local
+ structure S =
LargeInt_ChooseInt
(type 'a t = 'a -> word
val fInt8 = W.fromInt8
@@ -96,6 +128,18 @@
end
local
structure S =
+ LargeInt_ChooseInt
+ (type 'a t = 'a -> word
+ val fInt8 = W.fromInt8Z
+ val fInt16 = W.fromInt16Z
+ val fInt32 = W.fromInt32Z
+ val fInt64 = W.fromInt64Z
+ val fIntInf = W.fromIntInfZ)
+ in
+ val fromLargeIntZ = S.f
+ end
+ local
+ structure S =
Word_ChooseWordN
(type 'a t = 'a -> word
val fWord8 = W.fromWord8
@@ -107,6 +151,17 @@
end
local
structure S =
+ Word_ChooseWordN
+ (type 'a t = 'a -> word
+ val fWord8 = W.fromWord8X
+ val fWord16 = W.fromWord16X
+ val fWord32 = W.fromWord32X
+ val fWord64 = W.fromWord64X)
+ in
+ val fromWordX = S.f
+ end
+ local
+ structure S =
LargeWord_ChooseWordN
(type 'a t = 'a -> word
val fWord8 = W.fromWord8
@@ -114,9 +169,43 @@
val fWord32 = W.fromWord32
val fWord64 = W.fromWord64)
in
- val fromLarge = S.f
- val fromLargeWord = fromLarge
+ val fromLargeWord = S.f
+ val fromLarge = fromLargeWord
end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = 'a -> word
+ val fWord8 = W.fromWord8X
+ val fWord16 = W.fromWord16X
+ val fWord32 = W.fromWord32X
+ val fWord64 = W.fromWord64X)
+ in
+ val fromLargeWordX = S.f
+ val fromLargeX = fromLargeWordX
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = 'a -> word
+ val fWord8 = W.fromWord8
+ val fWord16 = W.fromWord16
+ val fWord32 = W.fromWord32
+ val fWord64 = W.fromWord64)
+ in
+ val fromSysWord = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = 'a -> word
+ val fWord8 = W.fromWord8X
+ val fWord16 = W.fromWord16X
+ val fWord32 = W.fromWord32X
+ val fWord64 = W.fromWord64X)
+ in
+ val fromSysWordX = S.f
+ end
local
structure S =
@@ -179,6 +268,17 @@
end
local
structure S =
+ Word_ChooseWordN
+ (type 'a t = word -> 'a
+ val fWord8 = W.toWord8X
+ val fWord16 = W.toWord16X
+ val fWord32 = W.toWord32X
+ val fWord64 = W.toWord64X)
+ in
+ val toWordX = S.f
+ end
+ local
+ structure S =
LargeWord_ChooseWordN
(type 'a t = word -> 'a
val fWord8 = W.toWord8
@@ -186,34 +286,43 @@
val fWord32 = W.toWord32
val fWord64 = W.toWord64)
in
- val toLarge = S.f
- val toLargeWord = toLarge
+ val toLargeWord = S.f
+ val toLarge = toLargeWord
end
local
structure S =
- Word_ChooseWordN
+ LargeWord_ChooseWordN
(type 'a t = word -> 'a
val fWord8 = W.toWord8X
val fWord16 = W.toWord16X
val fWord32 = W.toWord32X
val fWord64 = W.toWord64X)
in
- val toWordX = S.f
+ val toLargeWordX = S.f
+ val toLargeX = toLargeWordX
end
local
structure S =
- LargeWord_ChooseWordN
+ SysWord_ChooseWordN
(type 'a t = word -> 'a
+ val fWord8 = W.toWord8
+ val fWord16 = W.toWord16
+ val fWord32 = W.toWord32
+ val fWord64 = W.toWord64)
+ in
+ val toSysWord = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = word -> 'a
val fWord8 = W.toWord8X
val fWord16 = W.toWord16X
val fWord32 = W.toWord32X
val fWord64 = W.toWord64X)
in
- val toLargeX = S.f
- val toLargeWordX = toLargeX
+ val toSysWordX = S.f
end
-
-
end
structure Primitive = struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -28,7 +28,6 @@
structure Prim = PrimitiveFFI.Posix.FileSys
open Prim
structure Stat = Prim.Stat
- structure Flags = BitFlags
type file_desc = C_Fd.t
type uid = C_UId.t
@@ -152,7 +151,13 @@
structure S =
struct
- open S Flags
+ open S
+ local
+ structure Flags = BitFlags(structure W = C_Mode
+ val all = 0wxFFFF)
+ in
+ open Flags
+ end
type mode = C_Mode.t
val ifblk = IFBLK
val ifchr = IFCHR
@@ -182,20 +187,20 @@
structure O =
struct
open O Flags
- val append = SysWord.fromInt APPEND
- val binary = SysWord.fromInt BINARY
- val creat = SysWord.fromInt CREAT
- val dsync = SysWord.fromInt DSYNC
- val excl = SysWord.fromInt EXCL
- val noctty = SysWord.fromInt NOCTTY
- val nonblock = SysWord.fromInt NONBLOCK
- val rdonly = SysWord.fromInt RDONLY
- val rdwr = SysWord.fromInt RDWR
- val rsync = SysWord.fromInt RSYNC
- val sync = SysWord.fromInt SYNC
- val text = SysWord.fromInt TEXT
- val trunc = SysWord.fromInt TRUNC
- val wronly = SysWord.fromInt WRONLY
+ val append = APPEND
+ val binary = BINARY
+ val creat = CREAT
+ val dsync = DSYNC
+ val excl = EXCL
+ val noctty = NOCTTY
+ val nonblock = NONBLOCK
+ val rdonly = RDONLY
+ val rdwr = RDWR
+ val rsync = RSYNC
+ val sync = SYNC
+ val text = TEXT
+ val trunc = TRUNC
+ val wronly = WRONLY
end
datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sig 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sig 2006-04-27 15:48:05 UTC (rev 4423)
@@ -1,3 +1,11 @@
+(* 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.
+ *)
+
signature BIT_FLAGS =
sig
eqtype flags
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -6,25 +6,28 @@
* See the file MLton-LICENSE for details.
*)
-functor BitFlags(val all: SysWord.word): BIT_FLAGS_EXTRA =
+functor BitFlags(structure S : sig
+ type t
+ val all: t
+ val toSysWord: t -> SysWord.word
+ val fromSysWord: SysWord.word -> t
+ end): BIT_FLAGS_EXTRA =
struct
- type flags = SysWord.word
+ type flags = S.t
- val all: flags = all
- val empty: flags = 0w0
+ val all: flags = S.all
+ val empty: flags = S.fromSysWord 0w0
- fun toWord f = f
- fun fromWord f = SysWord.andb(f, all)
+ fun toWord f = W.toSysWord f
+ fun fromWord w = W.fromSysWord (SysWord.andb(w, toWord all))
- val flags: flags list -> flags = List.foldl SysWord.orb empty
+ val flags: flags list -> flags = List.foldl W.orb empty
- val intersect: flags list -> flags = List.foldl SysWord.andb all
+ val intersect: flags list -> flags = List.foldl W.andb all
- fun clear(f, f') = SysWord.andb(SysWord.notb f, f')
+ fun clear(f, f') = W.andb(W.notb f, f')
- fun allSet(f, f') = SysWord.andb(f, f') = f
+ fun allSet(f, f') = W.andb(f, f') = f
- fun anySet(f, f') = SysWord.andb(f, f') <> 0w0
-
+ fun anySet(f, f') = W.andb(f, f') <> empty
end
-structure BitFlags = BitFlags(val all = 0wxFFFF: SysWord.word)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml 2006-04-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml 2006-04-27 15:48:05 UTC (rev 4423)
@@ -45,13 +45,11 @@
val fromInt32Unsafe: Primitive.Int32.int -> word
val fromInt64Unsafe: Primitive.Int64.int -> word
-(*
(* Lowbits or zero extend. *)
val fromInt8ZUnsafe: Primitive.Int8.int -> word
val fromInt16ZUnsafe: Primitive.Int16.int -> word
val fromInt32ZUnsafe: Primitive.Int32.int -> word
val fromInt64ZUnsafe: Primitive.Int64.int -> word
-*)
(* Lowbits or zero extend. *)
val fromWord8Unsafe: Primitive.Word8.word -> word
@@ -179,12 +177,10 @@
val fromInt32Unsafe = _prim "WordS32_toWord8": Int32.int -> word;
val fromInt64Unsafe = _prim "WordS64_toWord8": Int64.int -> word;
-(*
val fromInt8ZUnsafe = _prim "WordU8_toWord8": Int8.int -> word;
val fromInt16ZUnsafe = _prim "WordU16_toWord8": Int16.int -> word;
val fromInt32ZUnsafe = _prim "WordU32_toWord8": Int32.int -> word;
val fromInt64ZUnsafe = _prim "WordU64_toWord8": Int64.int -> word;
-*)
val fromWord8Unsafe = _prim "WordU8_toWord8": Word8.word -> word;
val fromWord16Unsafe = _prim "WordU16_toWord8": Word16.word -> word;
@@ -310,12 +306,10 @@
val fromInt32Unsafe = _prim "WordS32_toWord16": Int32.int -> word;
val fromInt64Unsafe = _prim "WordS64_toWord16": Int64.int -> word;
-(*
val fromInt8ZUnsafe = _prim "WordU8_toWord16": Int8.int -> word;
val fromInt16ZUnsafe = _prim "WordU16_toWord16": Int16.int -> word;
val fromInt32ZUnsafe = _prim "WordU32_toWord16": Int32.int -> word;
val fromInt64ZUnsafe = _prim "WordU64_toWord16": Int64.int -> word;
-*)
val fromWord8Unsafe = _prim "WordU8_toWord16": Word8.word -> word;
val fromWord16Unsafe = _prim "WordU16_toWord16": Word16.word -> word;
@@ -505,12 +499,10 @@
val fromInt32Unsafe = _prim "WordS32_toWord32": Int32.int -> word;
val fromInt64Unsafe = _prim "WordS64_toWord32": Int64.int -> word;
-(*
val fromInt8ZUnsafe = _prim "WordU8_toWord32": Int8.int -> word;
val fromInt16ZUnsafe = _prim "WordU16_toWord32": Int16.int -> word;
val fromInt32ZUnsafe = _prim "WordU32_toWord32": Int32.int -> word;
val fromInt64ZUnsafe = _prim "WordU64_toWord32": Int64.int -> word;
-*)
val fromWord8Unsafe = _prim "WordU8_toWord32": Word8.word -> word;
val fromWord16Unsafe = _prim "WordU16_toWord32": Word16.word -> word;
@@ -580,12 +572,10 @@
val fromInt32Unsafe = _prim "WordS32_toWord64": Int32.int -> word;
val fromInt64Unsafe = _prim "WordS64_toWord64": Int64.int -> word;
-(*
val fromInt8ZUnsafe = _prim "WordU8_toWord64": Int8.int -> word;
val fromInt16ZUnsafe = _prim "WordU16_toWord64": Int16.int -> word;
val fromInt32ZUnsafe = _prim "WordU32_toWord64": Int32.int -> word;
val fromInt64ZUnsafe = _prim "WordU64_toWord64": Int64.int -> word;
-*)
val fromWord8Unsafe = _prim "WordU8_toWord64": Word8.word -> word;
val fromWord16Unsafe = _prim "WordU16_toWord64": Word16.word -> word;
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-26 02:25:30 UTC (rev 4422)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-04-27 15:48:05 UTC (rev 4423)
@@ -45,8 +45,10 @@
../config/objptr/$(OBJPTR_REP)
../config/header/$(HEADER_WORD)
../config/seq/$(SEQ_INDEX)
+ ../config/c/misc/$(CTYPES)
../config/c/errno.sml
- ../config/c/misc/$(CTYPES)
+ ../config/c/position.sml
+ ../config/c/sys-word.sml
end end
prim-seq.sml
prim-nullstring.sml
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 19:25:32
|
Starting on Posix
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/posix.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/stub-mingw.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/getgroups.c
U mlton/branches/on-20050822-x86_64-branch/runtime/TODO
----------------------------------------------------------------------
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 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-26 02:25:30 UTC (rev 4422)
@@ -209,27 +209,30 @@
../io/io.sml
../io/prim-io.sig
../io/prim-io.fun
+ ../io/bin-prim-io.sml
+ ../io/text-prim-io.sml
+
+ ../posix/stub-mingw.sml
+ ../posix/flags.sig
+ ../posix/flags.sml
+ ../posix/signal.sig
+ ../posix/signal.sml
+ ../posix/proc-env.sig
+ ../posix/proc-env.sml
+ ../posix/file-sys.sig
+ (* ../posix/file-sys.sml *)
+ ../posix/io.sig
+ (* ../posix/io.sml *)
+ ../posix/process.sig
+ (* ../posix/process.sml *)
+ ../posix/sys-db.sig
+ (* ../posix/sys-db.sml *)
+ ../posix/tty.sig
+ (* ../posix/tty.sml *)
+ (* ../posix/posix.sig *)
+ (* ../posix/posix.sml *)
+
(*
- ../../posix/stub-mingw.sml
- ../../posix/flags.sig
- ../../posix/flags.sml
- ../../posix/signal.sig
- ../../posix/signal.sml
- ../../posix/proc-env.sig
- ../../posix/proc-env.sml
- ../../posix/file-sys.sig
- ../../posix/file-sys.sml
- ../../posix/io.sig
- ../../posix/io.sml
- ../../posix/process.sig
- ../../posix/process.sml
- ../../posix/sys-db.sig
- ../../posix/sys-db.sml
- ../../posix/tty.sig
- ../../posix/tty.sml
- ../../posix/posix.sig
- ../../posix/posix.sml
-
../../platform/cygwin.sml
../../io/stream-io.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-25 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-26 02:25:30 UTC (rev 4422)
@@ -34,8 +34,8 @@
type uid = C_UId.t
type gid = C_GId.t
- val fdToWord = Primitive.FileDesc.toWord
- val wordToFD = Primitive.FileDesc.fromWord
+ val fdToWord = SysWord.fromLargeInt o C_Fd.toLarge
+ val wordToFD = C_Fd.fromLarge o SysWord.toLargeInt
val fdToIOD = OS.IO.fromFD
val iodToFD = SOME o OS.IO.toFD
@@ -58,15 +58,10 @@
let
val s = NullString.nullTerm s
in
- SysCall.syscall
- (fn () =>
- let
- val d = Prim.openDir s
- val p = Primitive.Pointer.fromWord d
- in
- (if Primitive.Pointer.isNull p then ~1 else 0,
- fn () => DS (ref (SOME d)))
- end)
+ SysCall.syscall'
+ ({errVal = C_DirP.fromWord 0w0}, fn () =>
+ (Prim.openDir s, fn d =>
+ DS (ref (SOME d))))
end
fun readdir d =
@@ -76,31 +71,24 @@
let
val res =
SysCall.syscallErr
- ({clear = true, restart = false},
- fn () =>
- let
- val cs = Prim.readDir d
- in
- {return = if Primitive.Pointer.isNull cs
- then ~1
- else 0,
- post = fn () => SOME cs,
- handlers = [(Error.cleared, fn () => NONE),
- (* MinGW sets errno to ENOENT when it
- * returns NULL.
- *)
- (Error.noent, fn () => NONE)]}
- end)
+ ({clear = true, restart = false, errVal = Primitive.MLton.Pointer.null}, fn () =>
+ {return = Prim.readDir d,
+ post = fn cs => SOME cs,
+ handlers = [(Error.cleared, fn () => NONE),
+ (* MinGW sets errno to ENOENT when it
+ * returns NULL.
+ *)
+ (Error.noent, fn () => NONE)]})
in
case res of
NONE => NONE
| SOME cs =>
let
- val s = COld.CS.toString cs
+ val s = CUtil.C_String.toString cs
in
if s = "." orelse s = ".."
then loop ()
- else SOME s
+ else SOME s
end
end
in loop ()
@@ -108,16 +96,7 @@
fun rewinddir d =
let val d = get d
- in
- SysCall.syscallErr
- ({clear = true, restart = false},
- fn () =>
- let val () = Prim.rewindDir d
- in
- {return = ~1,
- post = fn () => (),
- handlers = [(Error.cleared, fn () => ())]}
- end)
+ in Prim.rewindDir d
end
fun closedir (DS r) =
@@ -131,7 +110,7 @@
local
val size: int ref = ref 1
- fun make () = Primitive.Array.array (!size)
+ fun make () = Array.arrayUninit (!size)
val buffer = ref (make ())
fun extractToChar (a, c) =
@@ -140,7 +119,7 @@
(* find the null terminator *)
fun loop i =
if i >= n
- then raise Fail "String.extractFromC didn't find terminator"
+ then raise Fail "extractToChar didn't find terminator"
else if c = Array.sub (a, i)
then i
else loop (i + 1)
@@ -151,19 +130,26 @@
fun extract a = extractToChar (a, #"\000")
in
fun getcwd () =
- if Primitive.Pointer.isNull (Prim.getcwd (!buffer, C_Size.fromInt (!size)))
- then (size := 2 * !size
- ; buffer := make ()
- ; getcwd ())
- else extract (!buffer)
+ let
+ val res =
+ SysCall.syscallErr
+ ({clear = false, restart = false, errVal = Primitive.MLton.Pointer.null}, fn () =>
+ {return = Prim.getcwd (!buffer, C_Size.fromInt (!size)),
+ post = fn _ => true,
+ handlers = [(Error.range, fn _ => false)]})
+ in
+ if res
+ then extract (!buffer)
+ else (size := 2 * !size
+ ; buffer := make ()
+ ; getcwd ())
+ end
end
- val FD = Primitive.FileDesc.fromInt
+ val stdin : C_Fd.t = 0
+ val stdout : C_Fd.t = 1
+ val stderr : C_Fd.t = 2
- val stdin = FD 0
- val stdout = FD 1
- val stderr = FD 2
-
structure S =
struct
open S Flags
@@ -235,7 +221,7 @@
SysCall.simpleResult
(fn () => Prim.open3 (pathname, SysWord.toInt flags, mode))
in
- FD fd
+ fd
end
fun openf (pathname, openMode, flags) =
@@ -244,8 +230,9 @@
val flags = Flags.flags [openModeToWord openMode, flags]
val fd =
SysCall.simpleResult
- (fn () => Prim.open3 (pathname, SysWord.toInt flags, Flags.empty))
- in FD fd
+ (fn () => Prim.open3 (pathname, SysWord.toInt flags, C_Mode.fromWord 0w0))
+ in
+ fd
end
fun creat (s, m) = createf (s, O_WRONLY, O.trunc, m)
@@ -283,13 +270,10 @@
let
val path = NullString.nullTerm path
in
- SysCall.syscall
- (fn () =>
- let val len = Prim.readlink (path, buf, C_Size.fromInt size)
- in
- (len, fn () =>
- ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len)))
- end)
+ SysCall.syscall'
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ (Prim.readlink (path, buf, C_Size.fromInt size), fn len =>
+ ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len))))
end
end
@@ -357,7 +341,7 @@
local
fun make prim arg =
- SysCall.syscall (fn () => (prim arg, fn () => ST.fromC ()))
+ SysCall.syscall (fn () => (prim arg, fn _ => ST.fromC ()))
in
val stat = (make Prim.Stat.stat) o NullString.nullTerm
val lstat = (make Prim.Stat.lstat) o NullString.nullTerm
@@ -377,19 +361,15 @@
val path = NullString.nullTerm path
in
SysCall.syscallErr
- ({clear = false, restart = false},
- fn () =>
- let val return = Prim.access (path, mode)
- in
- {return = return,
- post = fn () => true,
- handlers = [(Error.acces, fn () => false),
- (Error.loop, fn () => false),
- (Error.nametoolong, fn () => false),
- (Error.noent, fn () => false),
- (Error.notdir, fn () => false),
- (Error.rofs, fn () => false)]}
- end)
+ ({clear = false, restart = false, errVal = C_Int.fromInt ~1}, fn () =>
+ {return = Prim.access (path, mode),
+ post = fn _ => true,
+ handlers = [(Error.acces, fn () => false),
+ (Error.loop, fn () => false),
+ (Error.nametoolong, fn () => false),
+ (Error.noent, fn () => false),
+ (Error.notdir, fn () => false),
+ (Error.rofs, fn () => false)]})
end
local
@@ -412,7 +392,7 @@
(fn () =>
(U.setAcTime a
; U.setModTime m
- ; (U.utime f, fn () =>
+ ; (U.utime f, fn _ =>
())))
end
end
@@ -452,18 +432,12 @@
fun make prim (f, s) =
SysCall.syscallErr
- ({clear = true, restart = false},
- fn () =>
- let
- val return = prim (f, convertProperty s)
- in
- {return = return,
- post = fn () => SOME (SysWord.fromInt return),
- handlers = [(Error.cleared, fn () => NONE)]}
- end)
+ ({clear = true, restart = false, errVal = C_Long.fromInt ~1}, fn () =>
+ {return = prim (f, convertProperty s),
+ post = fn ret => SOME (SysWord.fromLargeInt (C_Long.toLarge ret)),
+ handlers = [(Error.cleared, fn () => NONE)]})
in
- val pathconf =
- make (fn (path, s) => Prim.pathconf (NullString.nullTerm path, s))
+ val pathconf = make (fn (path, s) => Prim.pathconf (NullString.nullTerm path, s))
val fpathconf = make Prim.fpathconf
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/posix.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/posix.sig 2006-04-25 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/posix.sig 2006-04-26 02:25:30 UTC (rev 4422)
@@ -9,8 +9,7 @@
structure SysDB: POSIX_SYS_DB
structure TTY: POSIX_TTY
- sharing type FileSys.file_desc = ProcEnv.file_desc = IO.file_desc
- = TTY.file_desc
+ sharing type FileSys.file_desc = ProcEnv.file_desc = IO.file_desc = TTY.file_desc
sharing type ProcEnv.gid = FileSys.gid = SysDB.gid
sharing type FileSys.open_mode = IO.open_mode
sharing type Process.pid = ProcEnv.pid = IO.pid = TTY.pid
@@ -29,8 +28,7 @@
structure SysDB: POSIX_SYS_DB
structure TTY: POSIX_TTY
- sharing type FileSys.file_desc = ProcEnv.file_desc = IO.file_desc
- = TTY.file_desc
+ sharing type FileSys.file_desc = ProcEnv.file_desc = IO.file_desc = TTY.file_desc
sharing type ProcEnv.gid = FileSys.gid = SysDB.gid
sharing type FileSys.open_mode = IO.open_mode
sharing type Process.pid = ProcEnv.pid = IO.pid = TTY.pid
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml 2006-04-25 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml 2006-04-26 02:25:30 UTC (rev 4422)
@@ -11,7 +11,8 @@
structure Prim = PrimitiveFFI.Posix.ProcEnv
structure Error = PosixError
structure SysCall = Error.SysCall
- structure CS = COld.CS
+ structure CS = CUtil.C_String
+ structure CSS = CUtil.C_StringArray
type pid = C_PId.t
type uid = C_UId.t
@@ -34,31 +35,27 @@
fun setsid () = SysCall.simpleResult (Prim.setsid)
- fun id x = x
- val uidToWord = id
- val wordToUid = id
- val gidToWord = id
- val wordToGid = id
+ val uidToWord = SysWord.fromLarge o C_UId.toLarge
+ val wordToUid = C_UId.fromLarge o SysWord.toLarge
+ val gidToWord = SysWord.fromLarge o C_GId.toLarge
+ val wordToGid = C_GId.fromLarge o SysWord.toLarge
- local
- val n = Prim.getgroupsN ()
- val a: word array = Primitive.Array.array n
- in
- fun getgroups () =
- SysCall.syscall
- (fn () =>
- let val n = Prim.getgroups (n, a)
- in (n, fn () =>
- ArraySlice.toList (ArraySlice.slice (a, 0, SOME n)))
- end)
- end
+ fun getgroups () =
+ SysCall.syscall
+ (fn () =>
+ let
+ val n = Prim.getgroupsN ()
+ val a: C_GId.t array = Array.arrayUninit (C_Int.toInt n)
+ in
+ (Prim.getgroups (n, a), fn n =>
+ ArraySlice.toList (ArraySlice.slice (a, 0, SOME (C_Int.toInt n))))
+ end)
fun getlogin () =
- let val cs = Prim.getlogin ()
- in if Primitive.Pointer.isNull cs
- then raise (Error.SysErr ("no login name", NONE))
- else CS.toString cs
- end
+ SysCall.syscall'
+ ({errVal = Primitive.MLton.Pointer.null}, fn () =>
+ (Prim.getlogin (), fn cs =>
+ CS.toString cs))
fun setpgid {pid, pgid} =
let
@@ -72,7 +69,7 @@
fun uname () =
SysCall.syscall
(fn () =>
- (Prim.uname (), fn () =>
+ (Prim.uname (), fn _ =>
[("sysname", CS.toString (Prim.Uname.getSysName ())),
("nodename", CS.toString (Prim.Uname.getNodeName ())),
("release", CS.toString (Prim.Uname.getRelease ())),
@@ -213,14 +210,14 @@
case List.find (fn (_, s') => s = s') sysconfNames of
NONE => Error.raiseSys Error.inval
| SOME (n, _) =>
- (SysWord.fromInt o SysCall.simpleResult)
- (fn () => Prim.sysconf n)
+ (SysWord.fromLargeInt o C_Long.toLarge o SysCall.simpleResult')
+ ({errVal = C_Long.fromInt ~1}, fn () => Prim.sysconf n)
end
local
structure Times = Prim.Times
- val ticksPerSec = Int.toLarge (SysWord.toIntX (sysconf "CLK_TCK"))
+ val ticksPerSec = SysWord.toLargeIntX (sysconf "CLK_TCK")
fun cvt (ticks: C_Clock.t) =
Time.fromTicks (LargeInt.quot
@@ -229,25 +226,23 @@
ticksPerSec))
in
fun times () =
- SysCall.syscall
- (fn () =>
- let val elapsed = Prim.times ()
- in (0, fn () =>
- {elapsed = cvt elapsed,
- utime = cvt (Times.getUTime ()),
- stime = cvt (Times.getSTime ()),
- cutime = cvt (Times.getCUTime ()),
- cstime = cvt (Times.getCSTime ())})
- end)
+ SysCall.syscall'
+ ({errVal = C_Clock.fromInt ~1}, fn () =>
+ (Prim.times (), fn elapsed =>
+ {elapsed = cvt elapsed,
+ utime = cvt (Times.getUTime ()),
+ stime = cvt (Times.getSTime ()),
+ cutime = cvt (Times.getCUTime ()),
+ cstime = cvt (Times.getCSTime ())}))
end
- fun environ () = COld.CSS.toList (Prim.environGet ())
+ fun environ () = CSS.toList (Prim.environGet ())
fun getenv name =
let
val cs = Prim.getenv (NullString.nullTerm name)
in
- if Primitive.Pointer.isNull cs
+ if Primitive.MLton.Pointer.isNull cs
then NONE
else SOME (CS.toString cs)
end
@@ -257,11 +252,8 @@
fun isatty fd = Prim.isatty fd
fun ttyname fd =
- SysCall.syscall
- (fn () =>
- let val cs = Prim.ttyname fd
- in
- (if Primitive.Pointer.isNull cs then ~1 else 0,
- fn () => CS.toString cs)
- end)
+ SysCall.syscall'
+ ({errVal = Primitive.MLton.Pointer.null}, fn () =>
+ (Prim.ttyname fd, fn cs =>
+ CS.toString cs))
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/stub-mingw.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/stub-mingw.sml 2006-04-25 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/stub-mingw.sml 2006-04-26 02:25:30 UTC (rev 4422)
@@ -10,14 +10,13 @@
structure Error = PosixError
val stub: string * ('a -> 'b) -> ('a -> 'b) =
fn (msg, f) =>
- if let open Primitive.MLton.Platform.OS
- in MinGW = host
- end
- then fn _ => (if true then ()
- else (Primitive.Stdio.print msg
- ; Primitive.Stdio.print "\n")
+ if let open Primitive.MLton.Platform.OS in MinGW = host end
+ then fn _ => (if true
+ then ()
+ else (PrimitiveFFI.Stdio.print msg
+ ; PrimitiveFFI.Stdio.print "\n")
; Error.raiseSys Error.nosys)
- else f
+ else f
in
structure PrimitiveFFI =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-25 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-26 02:25:30 UTC (rev 4422)
@@ -190,12 +190,13 @@
struct
open Pointer
- local
- exception IsNull
- in
- val isNull : t -> bool = fn _ => raise IsNull
- end
+ val fromWord = _prim "WordU32_toWord32": Word32.word -> t;
+ val toWord = _prim "WordU32_toWord32": t -> Word32.word;
+
+ val null: t = fromWord 0w0
+ fun isNull p = p = null
+
val getInt8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Int8.int;
val getInt16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Int16.int;
val getInt32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Int32.int;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/getgroups.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/getgroups.c 2006-04-25 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/getgroups.c 2006-04-26 02:25:30 UTC (rev 4422)
@@ -1,6 +1,6 @@
#include "platform.h"
-C_Errno_t(C_Int_t) Posix_ProcEnv_getgroupsN (void) {
+C_Int_t Posix_ProcEnv_getgroupsN (void) {
return getgroups (0, (gid_t*)NULL);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-25 22:30:23 UTC (rev 4421)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-26 02:25:30 UTC (rev 4422)
@@ -4,9 +4,15 @@
* Use C99 <assert.h> instead of util/assert.{c,h}
-Fix PackWord{16,32,64}_{sub,update}{,Rev} to use byte offset; This
-requires fixing the semantics of the primitives as well.
+Replace Word8{Array,Vector}_{sub,update}{,Rev} primitives with
+PackWord{8,16,32,64}_{sub,update}{,Rev} primitives; possibly refine
+the semantics to use index offset rather than byte offset (the
+advantage of index offset is that we can take advantage of scaling in
+address modes).
+Avoid SysWord.fromLarge o C_UId.toLarge conversions.
+
+
Rename primitives to indicate that these are not bit-wise identities
Real_toWord
Real_toReal
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 15:30:26
|
Make 'a C_Errno.t an opaque type, requires check to extract value
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/prim-io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.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/system/date.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
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 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-25 22:30:23 UTC (rev 4421)
@@ -197,20 +197,19 @@
../util/cleaner.sml
../system/pre-os.sml
+
+ ../posix/error.sig
+ ../posix/error.sml
+
../system/time.sig
../system/time.sml
../system/date.sig
../system/date.sml
+ ../io/io.sig
+ ../io/io.sml
+ ../io/prim-io.sig
+ ../io/prim-io.fun
(*
- ../../io/io.sig
- ../../io/io.sml
- ../../io/prim-io.sig
- ../../io/prim-io.fun
- ../../io/bin-prim-io.sml
- ../../io/text-prim-io.sml
-
- ../../posix/error.sig
- ../../posix/error.sml
../../posix/stub-mingw.sml
../../posix/flags.sig
../../posix/flags.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-04-25 22:30:23 UTC (rev 4421)
@@ -125,4 +125,3 @@
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure C_Errno = struct type 'a t = 'a end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/errno.sml 2006-04-25 22:30:23 UTC (rev 4421)
@@ -0,0 +1,16 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure C_Errno :>
+ sig
+ type 'a t
+ val check: 'a t -> 'a
+ end =
+ struct
+ type 'a t = 'a
+ val check = fn x => x
+ end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-04-25 22:30:23 UTC (rev 4421)
@@ -125,4 +125,3 @@
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure C_Errno = struct type 'a t = 'a end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-04-25 22:30:23 UTC (rev 4421)
@@ -125,4 +125,3 @@
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
-structure C_Errno = struct type 'a t = 'a end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-04-25 22:30:23 UTC (rev 4421)
@@ -125,4 +125,3 @@
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
-structure C_Errno = struct type 'a t = 'a end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/io.sig 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/io.sig 2006-04-25 22:30:23 UTC (rev 4421)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
signature IO =
sig
exception Io of {name : string,
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/prim-io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/prim-io.sig 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/io/prim-io.sig 2006-04-25 22:30:23 UTC (rev 4421)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
signature PRIM_IO =
sig
type elem
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sig 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sig 2006-04-25 22:30:23 UTC (rev 4421)
@@ -70,34 +70,63 @@
val restartFlag: bool ref
val syscallErr:
- {clear: bool, restart: bool} *
- (unit -> {return: int,
- post: unit -> 'a,
- handlers: (syserror * (unit -> 'a)) list}) -> 'a
+ {clear: bool, restart: bool, errVal: ''a} *
+ (unit -> {return: ''a C_Errno.t,
+ post: ''a -> 'b,
+ handlers: (syserror * (unit -> 'b)) list}) -> 'b
- (* clear = false, restart = false,
- * post = fn () => (), handlers = []
+ (* clear = false, restart = false, errVal = ~1
+ * post = fn _ => (), handlers = []
*)
- val simple: (unit -> int) -> unit
- (* clear = false, restart = true,
- * post = fn () => (), handlers = []
+ val simple: (unit -> C_Int.t C_Errno.t) -> unit
+ (* clear = false, restart = false,
+ * post = fn _ => (), handlers = []
*)
- val simpleRestart: (unit -> int) -> unit
- (* clear = false, restart = false,
- * post = fn () => return, handlers = []
+ val simple': {errVal: ''a} * (unit -> ''a C_Errno.t) -> unit
+
+ (* clear = false, restart = true, errVal = ~1
+ * post = fn _ => (), handlers = []
*)
- val simpleResult: (unit -> int) -> int
- (* clear = false, restart = true,
- * post = fn () => return, handlers = []
+ val simpleRestart: (unit -> C_Int.t C_Errno.t) -> unit
+ (* clear = false, restart = true,
+ * post = fn _ => (), handlers = []
*)
- val simpleResultRestart: (unit -> int) -> int
- (* clear = false, restart = false,
+ val simpleRestart': {errVal: ''a} * (unit -> ''a C_Errno.t) -> unit
+
+ (* clear = false, restart = false, errVal = ~1
+ * post = fn ret => ret, handlers = []
+ *)
+ val simpleResult: (unit -> C_Int.t C_Errno.t) -> C_Int.t
+ (* clear = false, restart = false,
+ * post = fn ret => ret, handlers = []
+ *)
+ val simpleResult': {errVal: ''a} * (unit -> ''a C_Errno.t) -> ''a
+
+ (* clear = false, restart = true, errVal = ~1
+ * post = fn ret => ret, handlers = []
+ *)
+ val simpleResultRestart: (unit -> C_Int.t C_Errno.t) -> C_Int.t
+ (* clear = false, restart = true,
+ * post = fn ret => ret, handlers = []
+ *)
+ val simpleResultRestart': {errVal: ''a} * (unit -> ''a C_Errno.t) -> ''a
+
+ (* clear = false, restart = false, errVal = ~1
* handlers = []
*)
- val syscall: (unit -> int * (unit -> 'a)) -> 'a
- (* clear = false, restart = true,
+ val syscall: (unit -> C_Int.t C_Errno.t * (C_Int.t -> 'a)) -> 'a
+ (* clear = false, restart = false,
* handlers = []
*)
- val syscallRestart: (unit -> int * (unit -> 'a)) -> 'a
+ val syscall': {errVal: ''a} * (unit -> ''a C_Errno.t * (''a -> 'b)) -> 'b
+
+ (* clear = false, restart = true, errVal = ~1
+ * handlers = []
+ *)
+ val syscallRestart: (unit -> C_Int.t C_Errno.t * (C_Int.t -> 'a)) -> 'a
+ (* clear = false, restart = true,
+ * handlers = []
+ *)
+ val syscallRestart': {errVal: ''a} * (unit -> ''a C_Errno.t * (''a -> 'b)) -> 'b
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml 2006-04-25 22:30:23 UTC (rev 4421)
@@ -178,8 +178,8 @@
exception SysErr of string * syserror option
- val toWord = SysWord.fromInt
- val fromWord = SysWord.toInt
+ val toWord = SysWord.fromLargeInt o C_Int.toLarge
+ val fromWord = C_Int.fromLarge o SysWord.toLargeInt
val cleared : syserror = 0
@@ -204,41 +204,42 @@
NONE => NONE
| SOME (n, _) => SOME n
- fun errorMsg (n: int) =
+ fun errorMsg (n: C_Int.t) =
let
val cs = strError n
in
- if cs = Primitive.Pointer.null
+ if Primitive.MLton.Pointer.isNull cs
then "Unknown error"
- else COld.CS.toString cs
+ else CUtil.C_String.toString cs
end
fun raiseSys n = raise SysErr (errorMsg n, SOME n)
structure SysCall =
struct
- structure Thread = Primitive.Thread
+ structure Thread = Primitive.MLton.Thread
val blocker: (unit -> (unit -> unit)) ref =
ref (fn () => (fn () => ()))
(* ref (fn () => raise Fail "blocker not installed") *)
val restartFlag = ref true
- val syscallErr: {clear: bool, restart: bool} *
- (unit -> {return: int,
- post: unit -> 'a,
- handlers: (syserror * (unit -> 'a)) list}) -> 'a =
- fn ({clear, restart}, f) =>
+ val syscallErr: {clear: bool, restart: bool, errVal: ''a} *
+ (unit -> {return: ''a C_Errno.t,
+ post: ''a -> 'b,
+ handlers: (syserror * (unit -> 'b)) list}) -> 'b =
+ fn ({clear, restart, errVal}, f) =>
let
fun call (err: {errno: syserror,
- handlers: (syserror * (unit -> 'a)) list} -> 'a): 'a =
+ handlers: (syserror * (unit -> 'b)) list} -> 'b): 'b =
let
val () = Thread.atomicBegin ()
val () = if clear then clearErrno () else ()
val {return, post, handlers} =
f () handle exn => (Thread.atomicEnd (); raise exn)
+ val return = C_Errno.check return
in
- if ~1 = return
+ if errVal = return
then
(* Must getErrno () in the critical section. *)
let
@@ -247,24 +248,24 @@
in
err {errno = e, handlers = handlers}
end
- else DynamicWind.wind (post, Thread.atomicEnd)
+ else DynamicWind.wind (fn () => post return , Thread.atomicEnd)
end
- fun err {default: unit -> 'a,
+ fun err {default: unit -> 'b,
errno: syserror,
- handlers: (syserror * (unit -> 'a)) list}: 'a =
+ handlers: (syserror * (unit -> 'b)) list}: 'b =
case List.find (fn (e',_) => errno = e') handlers of
NONE => default ()
| SOME (_, handler) => handler ()
fun errBlocked {errno: syserror,
- handlers: (syserror * (unit -> 'a)) list}: 'a =
+ handlers: (syserror * (unit -> 'b)) list}: 'b =
err {default = fn () => raiseSys errno,
errno = errno, handlers = handlers}
fun errUnblocked
{errno: syserror,
- handlers: (syserror * (unit -> 'a)) list}: 'a =
+ handlers: (syserror * (unit -> 'b)) list}: 'b =
err {default = fn () =>
if restart andalso errno = intr andalso !restartFlag
- then if Thread.canHandle () = 0
+ then if Thread.canHandle () = 0w0
then call errUnblocked
else let val finish = !blocker ()
in
@@ -278,33 +279,49 @@
end
local
- val simpleResult' = fn ({restart}, f) =>
+ val simpleResultAux = fn ({restart, errVal}, f) =>
syscallErr
- ({clear = false, restart = restart}, fn () =>
+ ({clear = false, restart = restart, errVal = errVal}, fn () =>
let val return = f ()
- in {return = return, post = fn () => return, handlers = []}
+ in {return = return,
+ post = fn ret => ret,
+ handlers = []}
end)
in
val simpleResultRestart = fn f =>
- simpleResult' ({restart = true}, f)
+ simpleResultAux ({restart = true, errVal = C_Int.fromInt ~1}, f)
val simpleResult = fn f =>
- simpleResult' ({restart = false}, f)
+ simpleResultAux ({restart = false, errVal = C_Int.fromInt ~1}, f)
+
+ val simpleResultRestart' = fn ({errVal}, f) =>
+ simpleResultAux ({restart = true, errVal = errVal}, f)
+ val simpleResult' = fn ({errVal}, f) =>
+ simpleResultAux ({restart = false, errVal = errVal}, f)
end
val simpleRestart = ignore o simpleResultRestart
val simple = ignore o simpleResult
- val syscallRestart = fn f =>
+ val simpleRestart' = fn ({errVal}, f) =>
+ ignore (simpleResultRestart' ({errVal = errVal}, f))
+ val simple' = fn ({errVal}, f) =>
+ ignore (simpleResult' ({errVal = errVal}, f))
+
+ val syscallRestart' = fn ({errVal}, f) =>
syscallErr
- ({clear = false, restart = true}, fn () =>
+ ({clear = false, restart = true, errVal = errVal}, fn () =>
let val (return, post) = f ()
in {return = return, post = post, handlers = []}
end)
- val syscall = fn f =>
+ val syscall' = fn ({errVal}, f) =>
syscallErr
- ({clear = false, restart = false}, fn () =>
+ ({clear = false, restart = false, errVal = errVal}, fn () =>
let val (return, post) = f ()
in {return = return, post = post, handlers = []}
end)
+ val syscallRestart = fn f =>
+ syscallRestart' ({errVal = C_Int.fromInt ~1}, f)
+ val syscall = fn f =>
+ syscall' ({errVal = C_Int.fromInt ~1}, f)
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 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-04-25 22:30:23 UTC (rev 4421)
@@ -45,6 +45,7 @@
../config/objptr/$(OBJPTR_REP)
../config/header/$(HEADER_WORD)
../config/seq/$(SEQ_INDEX)
+ ../config/c/errno.sml
../config/c/misc/$(CTYPES)
end end
prim-seq.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/date.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/date.sml 2006-04-25 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/date.sml 2006-04-25 22:30:23 UTC (rev 4421)
@@ -98,7 +98,7 @@
; Tm.setYDay tm_yday
; Tm.setYear tm_year)
- fun mktime_ (t: tmoz): C_Time.t = (setTmBuf t; Prim.mkTime ())
+ fun mktime_ (t: tmoz): C_Time.t = C_Errno.check (setTmBuf t; Prim.mkTime ())
(* The offset to add to local time to get UTC: positive West of UTC *)
val localoffset: int = C_Double.round (Prim.localOffset ())
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 21:02:35 UTC (rev 4420)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-04-25 22:30:23 UTC (rev 4421)
@@ -267,7 +267,6 @@
static char* cTypesSMLSuffix[] = {
"",
- "structure C_Errno = struct type 'a t = 'a end",
NULL
};
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 14:02:36
|
Refactor Date and Time
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/date.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml
----------------------------------------------------------------------
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 20:25:43 UTC (rev 4419)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-25 21:02:35 UTC (rev 4420)
@@ -196,13 +196,12 @@
../util/cleaner.sig
../util/cleaner.sml
+ ../system/pre-os.sml
+ ../system/time.sig
+ ../system/time.sml
+ ../system/date.sig
+ ../system/date.sml
(*
- ../../system/pre-os.sml
- ../../system/time.sig
- ../../system/time.sml
- ../../system/date.sig
- ../../system/date.sml
-
../../io/io.sig
../../io/io.sml
../../io/prim-io.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/date.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/date.sml 2006-04-25 20:25:43 UTC (rev 4419)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/date.sml 2006-04-25 21:02:35 UTC (rev 4420)
@@ -1,4 +1,5 @@
(* Modified from the ML Kit 4.1.4; basislib/Date.sml
+ * by mf...@ac... on 2006-4-25
* by mf...@ac... on 2005-8-10 based on
* modifications from the ML Kit Version 3; basislib/Date.sml
* by sw...@re... on 1999-1-3 and
@@ -59,18 +60,17 @@
(* 86400 = 24*60*6 is the number of seconds per day *)
- type tmoz = {tm_hour : int,
- tm_isdst : int, (* 0 = no, 1 = yes, ~1 = don't know *)
- tm_mday : int,
- tm_min : int,
- tm_mon : int,
- tm_sec : int,
- tm_wday : int,
- tm_yday : int,
- tm_year : int}
-
+ type tmoz = {tm_hour : C_Int.t,
+ tm_isdst : C_Int.t, (* 0 = no, 1 = yes, ~1 = don't know *)
+ tm_mday : C_Int.t,
+ tm_min : C_Int.t,
+ tm_mon : C_Int.t,
+ tm_sec : C_Int.t,
+ tm_wday : C_Int.t,
+ tm_yday : C_Int.t,
+ tm_year : C_Int.t}
local
- fun make (f: int ref -> int) (n: int): tmoz =
+ fun make (f: C_Time.t ref -> C_Int.t C_Errno.t) (n: C_Time.t) : tmoz =
(ignore (f (ref n))
; {tm_hour = Tm.getHour (),
tm_isdst = Tm.getIsDst (),
@@ -86,8 +86,8 @@
val getgmtime_ = make Prim.gmTime
end
- fun setTmBuf {tm_hour, tm_isdst, tm_mday, tm_min, tm_mon, tm_sec, tm_wday,
- tm_yday, tm_year} =
+ fun setTmBuf ({tm_hour, tm_isdst, tm_mday, tm_min, tm_mon,
+ tm_sec, tm_wday, tm_yday, tm_year}: tmoz) : unit =
(Tm.setHour tm_hour
; Tm.setIsDst tm_isdst
; Tm.setMDay tm_mday
@@ -98,10 +98,10 @@
; Tm.setYDay tm_yday
; Tm.setYear tm_year)
- fun mktime_ (t: tmoz): int = (setTmBuf t; Prim.mkTime ())
+ fun mktime_ (t: tmoz): C_Time.t = (setTmBuf t; Prim.mkTime ())
(* The offset to add to local time to get UTC: positive West of UTC *)
- val localoffset: int = Real.round (Prim.localOffset ())
+ val localoffset: int = C_Double.round (Prim.localOffset ())
val toweekday: int -> weekday =
fn 0 => Sun | 1 => Mon | 2 => Tue | 3 => Wed
@@ -123,21 +123,21 @@
| May => 4 | Jun => 5 | Jul => 6 | Aug => 7
| Sep => 8 | Oct => 9 | Nov => 10 | Dec => 11
- fun tmozToDate ({tm_hour, tm_isdst, tm_mday, tm_min, tm_mon, tm_sec,
- tm_wday, tm_yday, tm_year}: tmoz) offset =
- T {day = tm_mday,
- hour = tm_hour,
+ fun tmozToDate ({tm_hour, tm_isdst, tm_mday, tm_min, tm_mon,
+ tm_sec, tm_wday, tm_yday, tm_year}: tmoz) offset =
+ T {day = C_Int.toInt tm_mday,
+ hour = C_Int.toInt tm_hour,
isDst = (case tm_isdst of
0 => SOME false
| 1 => SOME true
| _ => NONE),
- minute = tm_min,
- month = tomonth tm_mon,
+ minute = C_Int.toInt tm_min,
+ month = tomonth (C_Int.toInt tm_mon),
offset = offset,
- second = tm_sec,
- weekDay = toweekday tm_wday,
- year = tm_year + 1900,
- yearDay = tm_yday}
+ second = C_Int.toInt tm_sec,
+ weekDay = toweekday (C_Int.toInt tm_wday),
+ yearDay = C_Int.toInt tm_yday,
+ year = (C_Int.toInt tm_year) + 1900}
fun leapyear (y: int) =
y mod 4 = 0 andalso y mod 100 <> 0 orelse y mod 400 = 0
@@ -170,18 +170,18 @@
weekDay, yearDay, isDst, ...}): tmoz =
if not (okDate dt)
then raise Date
- else {tm_hour = hour,
- tm_mday = day,
- tm_min = minute,
- tm_mon = frommonth month,
- tm_sec = second,
- tm_year = year -? 1900,
+ else {tm_hour = C_Int.fromInt hour,
tm_isdst = (case isDst of
SOME false => 0
| SOME true => 1
| NONE=> ~1),
- tm_wday = fromwday weekDay,
- tm_yday = yearDay}
+ tm_mday = C_Int.fromInt day,
+ tm_min = C_Int.fromInt minute,
+ tm_mon = C_Int.fromInt (frommonth month),
+ tm_sec = C_Int.fromInt second,
+ tm_wday = C_Int.fromInt (fromwday weekDay),
+ tm_yday = C_Int.fromInt yearDay,
+ tm_year = C_Int.fromInt (year - 1900)}
(* -------------------------------------------------- *)
(* Translated from Emacs's calendar.el: *)
@@ -279,10 +279,10 @@
end
fun fromTimeLocal t =
- tmozToDate (getlocaltime_ (Time.toSeconds t)) NONE
+ tmozToDate (getlocaltime_ (C_Time.fromInt (Time.toSeconds t))) NONE
fun fromTimeUniv t =
- tmozToDate (getgmtime_ (Time.toSeconds t)) (SOME 0)
+ tmozToDate (getgmtime_ (C_Time.fromInt (Time.toSeconds t))) (SOME 0)
(* The following implements conversion from a local date to
* a Time.time. It IGNORES wday and yday.
@@ -294,7 +294,7 @@
case offset of
NONE => 0
| SOME secs => localoffset + secs
- val clock = mktime_ (dateToTmoz date) - secoffset
+ val clock = C_Time.toInt (mktime_ (dateToTmoz date)) - secoffset
in
if clock < 0 then raise Date
else Time.fromSeconds clock
@@ -307,7 +307,7 @@
let
val a = Array.tabulate (Char.maxOrd + 1, fn _ => false)
val validChars = "aAbBcdHIjmMpSUwWxXyYZ%"
- in Util.naturalForeach
+ in Natural.foreach
(size validChars, fn i =>
Array.update (a, Char.ord (String.sub (validChars, i)), true));
fn c => Array.sub (a, Char.ord c)
@@ -317,14 +317,14 @@
let
val _ = setTmBuf (dateToTmoz d)
val bufLen = 50 (* more than enough for a single format char *)
- val buf = Primitive.Array.array bufLen
+ val buf = Array.arrayUninit bufLen
fun strftime fmtChar =
let
val len =
Prim.strfTime
- (buf, Word.fromInt bufLen,
+ (buf, C_Size.fromInt bufLen,
NullString.fromString (concat ["%", str fmtChar, "\000"]))
- val len = Word.toInt len
+ val len = C_Size.toInt len
in if len = 0
then raise Fail "Date.fmt"
else ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len))
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml 2006-04-25 20:25:43 UTC (rev 4419)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml 2006-04-25 21:02:35 UTC (rev 4420)
@@ -17,12 +17,12 @@
val fromFD: C_Fd.t -> iodesc
val toFD: iodesc -> C_Fd.t
end =
- struct
- type iodesc = C_Fd.t
+ struct
+ type iodesc = C_Fd.t
- val fromFD = fn z => z
- val toFD = fn z => z
- end
+ val fromFD = fn z => z
+ val toFD = fn z => z
+ end
end
structure PreOS = OS
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml 2006-04-25 20:25:43 UTC (rev 4419)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml 2006-04-25 21:02:35 UTC (rev 4420)
@@ -23,12 +23,13 @@
val zeroTime = T 0
fun fromReal r =
- T (Real.toLargeInt IEEEReal.TO_NEAREST
- (Real.* (r, Real.fromLargeInt ticksPerSecond)))
+ T (LargeReal.toLargeInt IEEEReal.TO_NEAREST
+ (LargeReal.* (r, LargeReal.fromLargeInt ticksPerSecond)))
handle Overflow => raise Time
fun toReal (T i) =
- Real./ (Real.fromLargeInt i, Real.fromLargeInt ticksPerSecond)
+ LargeReal./ (LargeReal.fromLargeInt i,
+ LargeReal.fromLargeInt ticksPerSecond)
local
fun make ticksPer =
@@ -87,7 +88,7 @@
end
val fmt: int -> time -> string =
- fn n => (Real.fmt (StringCvt.FIX (SOME n))) o toReal
+ fn n => (LargeReal.fmt (StringCvt.FIX (SOME n))) o toReal
val toString = fmt 3
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 13:25:45
|
Pointer casts
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/TODO
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/gen/gen-types.c
U mlton/branches/on-20050822-x86_64-branch/runtime/util/pointer.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-25 20:10:36 UTC (rev 4418)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-25 20:25:43 UTC (rev 4419)
@@ -4,7 +4,7 @@
* Use C99 <assert.h> instead of util/assert.{c,h}
-Fix PackWord{16,32,64}_{sub,upadate}{,Rev} to use byte offset; This
+Fix PackWord{16,32,64}_{sub,update}{,Rev} to use byte offset; This
requires fixing the semantics of the primitives as well.
Rename primitives to indicate that these are not bit-wise identities
@@ -18,5 +18,3 @@
basis/Int/Word.c
basis/MLton/allocTooLarge.c
basis/MLton/bug.c
-basis/Real/PackReal.c
-basis/Int/PackWord.c
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2006-04-25 20:10:36 UTC (rev 4418)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.c 2006-04-25 20:25:43 UTC (rev 4419)
@@ -44,7 +44,7 @@
size_t cardMapIndexToSize (GC_cardMapIndex i) {
return (size_t)i << CARD_SIZE_LOG2;
}
-pointer pointerToCardMapAddr (GC_state s, pointer p) {
+GC_cardMapElem *pointerToCardMapAddr (GC_state s, pointer p) {
pointer res;
res = &s->generationalMaps.cardMapAbsolute[pointerToCardMapIndexAbsolute (p)];
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2006-04-25 20:10:36 UTC (rev 4418)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/generational.h 2006-04-25 20:25:43 UTC (rev 4419)
@@ -59,7 +59,7 @@
static inline GC_cardMapIndex pointerToCardMapIndexAbsolute (pointer p);
static inline GC_cardMapIndex sizeToCardMapIndex (size_t z);
static inline size_t cardMapIndexToSize (GC_cardMapIndex i);
-static inline pointer pointerToCardMapAddr (GC_state s, pointer p);
+static inline GC_cardMapElem *pointerToCardMapAddr (GC_state s, pointer p);
static inline bool isCardMarked (GC_state s, pointer p);
static inline void markCard (GC_state s, pointer p);
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 20:10:36 UTC (rev 4418)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-04-25 20:25:43 UTC (rev 4419)
@@ -63,7 +63,9 @@
static char* mlTypesHStd[] = {
"/* ML types */",
- "typedef unsigned char* /* uintptr_t */ Pointer;",
+ "typedef unsigned char* Pointer;",
+ // "typedef void* Pointer;",
+ // "typedef uintptr_t Pointer;",
"#define Array(t) Pointer",
"#define Ref(t) Pointer",
"#define Vector(t) const Pointer",
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/util/pointer.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/util/pointer.h 2006-04-25 20:10:36 UTC (rev 4418)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/pointer.h 2006-04-25 20:25:43 UTC (rev 4419)
@@ -7,5 +7,6 @@
*/
typedef unsigned char* pointer;
+// typedef void* pointer;
#define POINTER_SIZE sizeof(pointer)
#define FMTPTR "0x%016"PRIxPTR
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 13:10:39
|
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 */
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 11:56:21
|
Pointer cast
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 18:35:12 UTC (rev 4416)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 18:56:21 UTC (rev 4417)
@@ -35,7 +35,7 @@
result = gdtoa (&fpi, ex, bits, &i, mode, ndig, (int*)decpt, NULL);
if (DEBUG)
fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
- result, (double)f, mode, ndig, *decpt);
+ result, (double)f, mode, ndig, *((int*)decpt));
return (C_String_t)result;
}
@@ -69,6 +69,6 @@
result = gdtoa (&fpi, ex, bits, &i, mode, ndig, (int*)decpt, NULL);
if (DEBUG)
fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
- result, d, mode, ndig, *decpt);
+ result, d, mode, ndig, *((int*)decpt));
return (C_String_t)result;
}
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 11:35:26
|
Refactored PackReal
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
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-real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.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/primitive/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/pack-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
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 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-25 18:35:12 UTC (rev 4416)
@@ -172,7 +172,7 @@
../real/real.sig
../real/real.sml
../real/pack-real.sig
- (* ../real/pack-real.sml *)
+ ../real/pack-real.sml
local
../config/bind/real-top.sml
in ann "forceUsed" in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig 2006-04-25 18:35:12 UTC (rev 4416)
@@ -33,4 +33,9 @@
val *? : int * int -> int
val -? : int * int -> int
val ~? : int -> int
+
+ val ltu: int * int -> bool
+ val leu: int * int -> bool
+ val gtu: int * int -> bool
+ val geu: int * int -> bool
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-25 18:35:12 UTC (rev 4416)
@@ -63,6 +63,11 @@
val ~>> : int * Primitive.Word32.word -> int
val >> : int * Primitive.Word32.word -> int
val xorb: int * int -> int
+
+ val ltu: int * int -> bool
+ val leu: int * int -> bool
+ val gtu: int * int -> bool
+ val geu: int * int -> bool
end
signature INTEGER =
@@ -103,4 +108,9 @@
val ~>> : int * Word.word -> int
val >> : int * Word.word -> int
val xorb: int * int -> int
+
+ val ltu: int * int -> bool
+ val leu: int * int -> bool
+ val gtu: int * int -> bool
+ val geu: int * int -> bool
end
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 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -204,6 +204,24 @@
val POLLPRI = _const "OS_IO_POLLPRI" : C_Short.t;
end
end
+structure PackReal32 =
+struct
+val subArr = _import "PackReal32_subArr" : (Word8.t) array * C_Ptrdiff.t -> Real32.t;
+val subArrRev = _import "PackReal32_subArrRev" : (Word8.t) array * C_Ptrdiff.t -> Real32.t;
+val subVec = _import "PackReal32_subVec" : (Word8.t) vector * C_Ptrdiff.t -> Real32.t;
+val subVecRev = _import "PackReal32_subVecRev" : (Word8.t) vector * C_Ptrdiff.t -> Real32.t;
+val update = _import "PackReal32_update" : (Word8.t) array * C_Ptrdiff.t * Real32.t -> unit;
+val updateRev = _import "PackReal32_updateRev" : (Word8.t) array * C_Ptrdiff.t * Real32.t -> unit;
+end
+structure PackReal64 =
+struct
+val subArr = _import "PackReal64_subArr" : (Word8.t) array * C_Ptrdiff.t -> Real64.t;
+val subArrRev = _import "PackReal64_subArrRev" : (Word8.t) array * C_Ptrdiff.t -> Real64.t;
+val subVec = _import "PackReal64_subVec" : (Word8.t) vector * C_Ptrdiff.t -> Real64.t;
+val subVecRev = _import "PackReal64_subVecRev" : (Word8.t) vector * C_Ptrdiff.t -> Real64.t;
+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 Posix =
struct
structure Error =
@@ -894,6 +912,78 @@
end
end
end
+structure Real32 =
+struct
+val abs = _import "Real32_abs" : Real32.t -> Real32.t;
+val class = _import "Real32_class" : Real32.t -> C_Int.t;
+val frexp = _import "Real32_frexp" : Real32.t * (C_Int.t) ref -> Real32.t;
+val gdtoa = _import "Real32_gdtoa" : Real32.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t;
+val ldexp = _import "Real32_ldexp" : Real32.t * C_Int.t -> Real32.t;
+structure Math =
+struct
+val acos = _import "Real32_Math_acos" : Real32.t -> Real32.t;
+val asin = _import "Real32_Math_asin" : Real32.t -> Real32.t;
+val atan = _import "Real32_Math_atan" : Real32.t -> Real32.t;
+val atan2 = _import "Real32_Math_atan2" : Real32.t * Real32.t -> Real32.t;
+val cos = _import "Real32_Math_cos" : Real32.t -> Real32.t;
+val cosh = _import "Real32_Math_cosh" : Real32.t -> Real32.t;
+val (eGet, eSet) = _symbol "Real32_Math_e": (unit -> (Real32.t)) * ((Real32.t) -> unit);
+val exp = _import "Real32_Math_exp" : Real32.t -> Real32.t;
+val ln = _import "Real32_Math_ln" : Real32.t -> Real32.t;
+val log10 = _import "Real32_Math_log10" : Real32.t -> Real32.t;
+val (piGet, piSet) = _symbol "Real32_Math_pi": (unit -> (Real32.t)) * ((Real32.t) -> unit);
+val pow = _import "Real32_Math_pow" : Real32.t * Real32.t -> Real32.t;
+val sin = _import "Real32_Math_sin" : Real32.t -> Real32.t;
+val sinh = _import "Real32_Math_sinh" : Real32.t -> Real32.t;
+val sqrt = _import "Real32_Math_sqrt" : Real32.t -> Real32.t;
+val tan = _import "Real32_Math_tan" : Real32.t -> Real32.t;
+val tanh = _import "Real32_Math_tanh" : Real32.t -> Real32.t;
+end
+val (maxFiniteGet, maxFiniteSet) = _symbol "Real32_maxFinite": (unit -> (Real32.t)) * ((Real32.t) -> unit);
+val (minNormalPosGet, minNormalPosSet) = _symbol "Real32_minNormalPos": (unit -> (Real32.t)) * ((Real32.t) -> unit);
+val (minPosGet, minPosSet) = _symbol "Real32_minPos": (unit -> (Real32.t)) * ((Real32.t) -> unit);
+val modf = _import "Real32_modf" : Real32.t * (Real32.t) ref -> Real32.t;
+val nextAfter = _import "Real32_nextAfter" : Real32.t * Real32.t -> Real32.t;
+val round = _import "Real32_round" : Real32.t -> Real32.t;
+val signBit = _import "Real32_signBit" : Real32.t -> C_Int.t;
+val strto = _import "Real32_strto" : NullString8.t -> Real32.t;
+end
+structure Real64 =
+struct
+val abs = _import "Real64_abs" : Real64.t -> Real64.t;
+val class = _import "Real64_class" : Real64.t -> C_Int.t;
+val frexp = _import "Real64_frexp" : Real64.t * (C_Int.t) ref -> Real64.t;
+val gdtoa = _import "Real64_gdtoa" : Real64.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t;
+val ldexp = _import "Real64_ldexp" : Real64.t * C_Int.t -> Real64.t;
+structure Math =
+struct
+val acos = _import "Real64_Math_acos" : Real64.t -> Real64.t;
+val asin = _import "Real64_Math_asin" : Real64.t -> Real64.t;
+val atan = _import "Real64_Math_atan" : Real64.t -> Real64.t;
+val atan2 = _import "Real64_Math_atan2" : Real64.t * Real64.t -> Real64.t;
+val cos = _import "Real64_Math_cos" : Real64.t -> Real64.t;
+val cosh = _import "Real64_Math_cosh" : Real64.t -> Real64.t;
+val (eGet, eSet) = _symbol "Real64_Math_e": (unit -> (Real64.t)) * ((Real64.t) -> unit);
+val exp = _import "Real64_Math_exp" : Real64.t -> Real64.t;
+val ln = _import "Real64_Math_ln" : Real64.t -> Real64.t;
+val log10 = _import "Real64_Math_log10" : Real64.t -> Real64.t;
+val (piGet, piSet) = _symbol "Real64_Math_pi": (unit -> (Real64.t)) * ((Real64.t) -> unit);
+val pow = _import "Real64_Math_pow" : Real64.t * Real64.t -> Real64.t;
+val sin = _import "Real64_Math_sin" : Real64.t -> Real64.t;
+val sinh = _import "Real64_Math_sinh" : Real64.t -> Real64.t;
+val sqrt = _import "Real64_Math_sqrt" : Real64.t -> Real64.t;
+val tan = _import "Real64_Math_tan" : Real64.t -> Real64.t;
+val tanh = _import "Real64_Math_tanh" : Real64.t -> Real64.t;
+end
+val (maxFiniteGet, maxFiniteSet) = _symbol "Real64_maxFinite": (unit -> (Real64.t)) * ((Real64.t) -> unit);
+val (minNormalPosGet, minNormalPosSet) = _symbol "Real64_minNormalPos": (unit -> (Real64.t)) * ((Real64.t) -> unit);
+val (minPosGet, minPosSet) = _symbol "Real64_minPos": (unit -> (Real64.t)) * ((Real64.t) -> unit);
+val modf = _import "Real64_modf" : Real64.t * (Real64.t) ref -> Real64.t;
+val nextAfter = _import "Real64_nextAfter" : Real64.t * Real64.t -> Real64.t;
+val round = _import "Real64_round" : Real64.t -> Real64.t;
+val signBit = _import "Real64_signBit" : Real64.t -> C_Int.t;
+val strto = _import "Real64_strto" : NullString8.t -> Real64.t;
+end
structure Socket =
struct
val accept = _import "Socket_accept" : C_Sock.t * (Word8.t) array * (C_Socklen.t) ref -> (C_Int.t) C_Errno.t;
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-pack-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-pack-real.sml 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-pack-real.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -0,0 +1,37 @@
+(* 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 PR1 = Primitive.PackReal32
+ structure PR2 = PrimitiveFFI.PackReal32
+ in
+ val () = check (PR1.subArr, PR2.subArr)
+ val () = check (PR1.subArrRev, PR2.subArrRev)
+ val () = check (PR1.subVec, PR2.subVec)
+ val () = check (PR1.subVecRev, PR2.subVecRev)
+ val () = check (PR1.update, PR2.update)
+ val () = check (PR1.updateRev, PR2.updateRev)
+ end
+
+ local
+ structure PR1 = Primitive.PackReal64
+ structure PR2 = PrimitiveFFI.PackReal64
+ in
+ val () = check (PR1.subArr, PR2.subArr)
+ val () = check (PR1.subArrRev, PR2.subArrRev)
+ val () = check (PR1.subVec, PR2.subVec)
+ val () = check (PR1.subVecRev, PR2.subVecRev)
+ val () = check (PR1.update, PR2.update)
+ val () = check (PR1.updateRev, PR2.updateRev)
+ end
+in
+
+end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-real.sml 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/check-real.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -0,0 +1,88 @@
+(* 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 R1 = Primitive.Real32
+ structure R2 = PrimitiveFFI.Real32
+ in
+ val () = check (R1.Math.acos, R2.Math.acos)
+ val () = check (R1.Math.asin, R2.Math.asin)
+ val () = check (R1.Math.atan, R2.Math.atan)
+ val () = check (R1.Math.atan2, R2.Math.atan2)
+ val () = check (R1.Math.cos, R2.Math.cos)
+ val () = check (R1.Math.cosh, R2.Math.cosh)
+ val () = check (fn () => R1.Math.e, R2.Math.eGet)
+ val () = check (R1.Math.exp, R2.Math.exp)
+ val () = check (R1.Math.ln, R2.Math.ln)
+ val () = check (R1.Math.log10, R2.Math.log10)
+ val () = check (fn () => R1.Math.pi, R2.Math.piGet)
+ val () = check (R1.Math.pow, R2.Math.pow)
+ val () = check (R1.Math.sin, R2.Math.sin)
+ val () = check (R1.Math.sinh, R2.Math.sinh)
+ val () = check (R1.Math.sqrt, R2.Math.sqrt)
+ val () = check (R1.Math.tan, R2.Math.tan)
+ val () = check (R1.Math.tanh, R2.Math.tanh)
+
+ val () = check (R1.abs, R2.abs)
+ val () = check (R1.class, R2.class)
+ val () = check (R1.frexp, R2.frexp)
+ val () = check (R1.gdtoa, R2.gdtoa)
+ val () = check (R1.ldexp, R2.ldexp)
+ val () = check (fn () => R1.maxFinite, R2.maxFiniteGet)
+ val () = check (fn () => R1.minNormalPos, R2.minNormalPosGet)
+ val () = check (fn () => R1.minPos, R2.minPosGet)
+ val () = check (R1.modf, R2.modf)
+ val () = check (R1.nextAfter, R2.nextAfter)
+ val () = check (R1.round, R2.round)
+ val () = check (R1.signBit, R2.signBit)
+ val () = check (R1.strto, R2.strto)
+ end
+
+ local
+ structure R1 = Primitive.Real64
+ structure R2 = PrimitiveFFI.Real64
+ in
+ val () = check (R1.Math.acos, R2.Math.acos)
+ val () = check (R1.Math.asin, R2.Math.asin)
+ val () = check (R1.Math.atan, R2.Math.atan)
+ val () = check (R1.Math.atan2, R2.Math.atan2)
+ val () = check (R1.Math.cos, R2.Math.cos)
+ val () = check (R1.Math.cosh, R2.Math.cosh)
+ val () = check (fn () => R1.Math.e, R2.Math.eGet)
+ val () = check (R1.Math.exp, R2.Math.exp)
+ val () = check (R1.Math.ln, R2.Math.ln)
+ val () = check (R1.Math.log10, R2.Math.log10)
+ val () = check (fn () => R1.Math.pi, R2.Math.piGet)
+ val () = check (R1.Math.pow, R2.Math.pow)
+ val () = check (R1.Math.sin, R2.Math.sin)
+ val () = check (R1.Math.sinh, R2.Math.sinh)
+ val () = check (R1.Math.sqrt, R2.Math.sqrt)
+ val () = check (R1.Math.tan, R2.Math.tan)
+ val () = check (R1.Math.tanh, R2.Math.tanh)
+
+ val () = check (R1.abs, R2.abs)
+ val () = check (R1.class, R2.class)
+ val () = check (R1.frexp, R2.frexp)
+ val () = check (R1.gdtoa, R2.gdtoa)
+ val () = check (R1.ldexp, R2.ldexp)
+ val () = check (fn () => R1.maxFinite, R2.maxFiniteGet)
+ val () = check (fn () => R1.minNormalPos, R2.minNormalPosGet)
+ val () = check (fn () => R1.minPos, R2.minPosGet)
+ val () = check (R1.modf, R2.modf)
+ val () = check (R1.nextAfter, R2.nextAfter)
+ val () = check (R1.round, R2.round)
+ val () = check (R1.signBit, R2.signBit)
+ val () = check (R1.strto, R2.strto)
+ end
+
+in
+
+end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-real.sml 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-pack-real.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -0,0 +1,51 @@
+(* 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 PackReal32 =
+ struct
+ type real = Real32.real
+
+ val subArr =
+ _import "PackReal32_subArr": Word8.word array * C_Ptrdiff.t -> real;
+ val subArrRev =
+ _import "PackReal32_subArrRev": Word8.word array * C_Ptrdiff.t -> real;
+ val subVec =
+ _import "PackReal32_subVec": Word8.word vector * C_Ptrdiff.t -> real;
+ val subVecRev =
+ _import "PackReal32_subVecRev": Word8.word vector * C_Ptrdiff.t -> real;
+ val update =
+ _import "PackReal32_update": Word8.word array * C_Ptrdiff.t * real -> unit;
+ val updateRev =
+ _import "PackReal32_updateRev": Word8.word array * C_Ptrdiff.t * real -> unit;
+ end
+
+structure PackReal64 =
+ struct
+ type real = Real64.real
+
+ val subArr =
+ _import "PackReal64_subArr": Word8.word array * C_Ptrdiff.t -> real;
+ val subArrRev =
+ _import "PackReal64_subArrRev": Word8.word array * C_Ptrdiff.t -> real;
+ val subVec =
+ _import "PackReal64_subVec": Word8.word vector * C_Ptrdiff.t -> real;
+ val subVecRev =
+ _import "PackReal64_subVecRev": Word8.word vector * C_Ptrdiff.t -> real;
+ val update =
+ _import "PackReal64_update": Word8.word array * C_Ptrdiff.t * real -> unit;
+ val updateRev =
+ _import "PackReal64_updateRev": Word8.word array * C_Ptrdiff.t * real -> unit;
+ end
+
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -13,6 +13,7 @@
type real
type t = real
+ val realSize: Primitive.Int32.int
val precision: Primitive.Int32.int
val radix: Primitive.Int32.int
@@ -45,6 +46,7 @@
val + : real * real -> real
val - : real * real -> real
val / : real * real -> real
+ val ~ : real -> real
val < : real * real -> bool
val <= : real * real -> bool
val == : real * real -> bool
@@ -62,7 +64,6 @@
val round: real -> real
val signBit: real -> C_Int.t
val strto: Primitive.NullString8.t -> real
- val ~ : real -> real
(* Integer to float; depends on rounding mode. *)
val fromInt8Unsafe: Primitive.Int8.int -> real
@@ -93,6 +94,7 @@
struct
open Real32
+ val realSize : Int32.int = 32
val precision : Int32.int = 24
val radix : Int32.int = 2
@@ -174,6 +176,7 @@
struct
open Real64
+ val realSize : Int32.int = 64
val precision : Int32.int = 53
val radix : Int32.int = 2
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 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-04-25 18:35:12 UTC (rev 4416)
@@ -56,9 +56,14 @@
prim-string.sml
prim-real.sml
+ prim-pack-real.sml
prim-mlton.sml
basis-ffi.sml
prim2.sml
+
+ (* Check compatibility between primitives and runtime functions. *)
+ check-real.sml
+ check-pack-real.sml
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -25,32 +25,6 @@
structure Primitive =
struct
- structure PackReal32 =
- struct
- type real = Real32.real
-
- val subVec = _import "PackReal32_subVec": Word8.word vector * int -> real;
- val subVecRev =
- _import "PackReal32_subVecRev": Word8.word vector * int -> real;
- val update =
- _import "PackReal32_update": Word8.word array * int * real -> unit;
- val updateRev =
- _import "PackReal32_updateRev": Word8.word array * int * real -> unit;
- end
-
- structure PackReal64 =
- struct
- type real = Real64.real
-
- val subVec = _import "PackReal64_subVec": Word8.word vector * int -> real;
- val subVecRev =
- _import "PackReal64_subVecRev": Word8.word vector * int -> real;
- val update =
- _import "PackReal64_update": Word8.word array * int * real -> unit;
- val updateRev =
- _import "PackReal64_updateRev": Word8.word array * int * real -> unit;
- end
-
structure TextIO =
struct
val bufSize = _command_line_const "TextIO.bufSize": int = 4096;
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 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/pack-real.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -8,71 +8,248 @@
functor PackReal (S: sig
type real
- val bytesPerElem: int
+ val realSize: int
val isBigEndian: bool
- val subVec: Word8.word vector * int -> real
- val subVecRev: Word8.word vector * int -> real
- val update: Word8.word array * int * real -> unit
- val updateRev: Word8.word array * int * real -> unit
+ val subArr: Word8.word array * C_Ptrdiff.t -> real
+ val subArrRev: Word8.word array * C_Ptrdiff.t -> real
+ val subVec: Word8.word vector * C_Ptrdiff.t -> real
+ val subVecRev: Word8.word vector * C_Ptrdiff.t -> real
+ val update: Word8.word array * C_Ptrdiff.t * real -> unit
+ val updateRev: Word8.word array * C_Ptrdiff.t * real -> unit
end): PACK_REAL =
struct
open S
-val (sub, up) =
+val bytesPerElem = Int.div (realSize, 8)
+
+val (subA, subV, updA) =
if isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
- then (subVec, update)
- else (subVecRev, updateRev)
+ 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, r) =
let
+ val i = offset (i, Word8Array.length a)
val a = Word8Array.toPoly a
- val _ = Array.checkSlice (a, i, SOME bytesPerElem)
in
- up (a, i, r)
+ updA (a, i, r)
end
local
- val a = Word8Array.array (bytesPerElem, 0w0)
+ val a = Array.arrayUninit bytesPerElem
in
fun toBytes (r: real): Word8Vector.vector =
- (up (Word8Array.toPoly a, 0, r)
- ; Byte.stringToBytes (Byte.unpackString (Word8ArraySlice.full a)))
+ (updA (a, 0, r)
+ ; 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
+
fun subVec (v, i) =
let
+ val i = offset (i, Word8Vector.length v)
val v = Word8Vector.toPoly v
- val _ = Vector.checkSlice (v, i, SOME bytesPerElem)
in
- sub (v, i)
+ subV (v, i)
end
fun fromBytes v = subVec (v, 0)
-fun subArr (a, i) =
- subVec (Word8Vector.fromPoly
- (Primitive.Vector.fromArray (Word8Array.toPoly a)),
- i)
-
end
structure PackReal32Big: PACK_REAL =
- PackReal (val bytesPerElem: int = 4
+ PackReal (val realSize = Real32.realSize
val isBigEndian = true
open Primitive.PackReal32)
structure PackReal32Little: PACK_REAL =
- PackReal (val bytesPerElem: int = 4
+ PackReal (val realSize = Real32.realSize
val isBigEndian = false
open Primitive.PackReal32)
structure PackReal64Big: PACK_REAL =
- PackReal (val bytesPerElem: int = 8
+ PackReal (val realSize = Real64.realSize
val isBigEndian = true
open Primitive.PackReal64)
structure PackReal64Little: PACK_REAL =
- PackReal (val bytesPerElem: int = 8
+ PackReal (val realSize = Real64.realSize
val isBigEndian = false
open Primitive.PackReal64)
+local
+ local
+ structure S =
+ Real_ChooseRealN
+ (type 'a t = int
+ val fReal32 = Real32.realSize
+ val fReal64 = Real64.realSize)
+ in
+ val realSize = S.f
+ end
-structure PackRealBig = PackReal64Big
-structure PackRealLittle = PackReal64Little
+ structure PackReal =
+ struct
+ type real = Real.real
+ local
+ structure S =
+ Real_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subArr
+ val fReal64 = Primitive.PackReal64.subArr)
+ in
+ val subArr = S.f
+ end
+ local
+ structure S =
+ Real_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subArrRev
+ val fReal64 = Primitive.PackReal64.subArrRev)
+ in
+ val subArrRev = S.f
+ end
+ local
+ structure S =
+ Real_ChooseRealN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subVec
+ val fReal64 = Primitive.PackReal64.subVec)
+ in
+ val subVec = S.f
+ end
+ local
+ structure S =
+ Real_ChooseRealN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subVecRev
+ val fReal64 = Primitive.PackReal64.subVecRev)
+ in
+ val subVecRev = S.f
+ end
+ local
+ structure S =
+ Real_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fReal32 = Primitive.PackReal32.update
+ val fReal64 = Primitive.PackReal64.update)
+ in
+ val update = S.f
+ end
+ local
+ structure S =
+ Real_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fReal32 = Primitive.PackReal32.updateRev
+ val fReal64 = Primitive.PackReal64.updateRev)
+ in
+ val updateRev = S.f
+ end
+
+ end
+in
+structure PackRealBig: PACK_REAL =
+ PackReal (val realSize = realSize
+ val isBigEndian = true
+ open PackReal)
+structure PackRealLittle: PACK_REAL =
+ PackReal (val realSize = realSize
+ val isBigEndian = false
+ open PackReal)
+end
+local
+ local
+ structure S =
+ LargeReal_ChooseRealN
+ (type 'a t = int
+ val fReal32 = Real32.realSize
+ val fReal64 = Real64.realSize)
+ in
+ val realSize = S.f
+ end
+
+ structure PackLargeReal =
+ struct
+ type real = LargeReal.real
+ local
+ structure S =
+ LargeReal_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subArr
+ val fReal64 = Primitive.PackReal64.subArr)
+ in
+ val subArr = S.f
+ end
+ local
+ structure S =
+ LargeReal_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subArrRev
+ val fReal64 = Primitive.PackReal64.subArrRev)
+ in
+ val subArrRev = S.f
+ end
+ local
+ structure S =
+ LargeReal_ChooseRealN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subVec
+ val fReal64 = Primitive.PackReal64.subVec)
+ in
+ val subVec = S.f
+ end
+ local
+ structure S =
+ LargeReal_ChooseRealN
+ (type 'a t = Word8.word vector * C_Ptrdiff.t -> 'a
+ val fReal32 = Primitive.PackReal32.subVecRev
+ val fReal64 = Primitive.PackReal64.subVecRev)
+ in
+ val subVecRev = S.f
+ end
+ local
+ structure S =
+ LargeReal_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fReal32 = Primitive.PackReal32.update
+ val fReal64 = Primitive.PackReal64.update)
+ in
+ val update = S.f
+ end
+ local
+ structure S =
+ LargeReal_ChooseRealN
+ (type 'a t = Word8.word array * C_Ptrdiff.t * 'a -> unit
+ val fReal32 = Primitive.PackReal32.updateRev
+ val fReal64 = Primitive.PackReal64.updateRev)
+ in
+ val updateRev = S.f
+ end
+
+ end
+in
+structure PackLargeRealBig: PACK_REAL =
+ PackReal (val realSize = realSize
+ val isBigEndian = true
+ open PackLargeReal)
+structure PackLargeRealLittle: PACK_REAL =
+ PackReal (val realSize = realSize
+ val isBigEndian = false
+ open PackLargeReal)
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig 2006-04-25 18:35:12 UTC (rev 4416)
@@ -27,6 +27,7 @@
val minNormalPos: real
val minPos: real
+ val realSize: Primitive.Int32.int
val precision: Primitive.Int32.int
val radix: Primitive.Int32.int
@@ -133,3 +134,9 @@
val toString: real -> string
val unordered: real * real -> bool
end
+
+signature REAL_EXTRA =
+ sig
+ include REAL
+ val realSize: Int.int
+ end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml 2006-04-25 18:35:12 UTC (rev 4416)
@@ -5,7 +5,7 @@
* See the file MLton-LICENSE for details.
*)
-functor Real (R: PRE_REAL): REAL =
+functor Real (R: PRE_REAL): REAL_EXTRA =
struct
structure MLton = Primitive.MLton
structure Prim = R
@@ -46,6 +46,7 @@
val minNormalPos = minNormalPos
val minPos = minPos
+ val realSize = Primitive.Int32.toInt realSize
val precision = Primitive.Int32.toInt precision
val radix = Primitive.Int32.toInt radix
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 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -4,7 +4,7 @@
#define Vec(t) Vector(t)
#define mkSubSeq(kind, Seq) \
-Word##kind##_t PackWord##kind##_sub##Seq (Seq(Word8_t) seq, Int offset) { \
+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); \
@@ -15,7 +15,7 @@
return w; \
}
#define mkSubSeqRev(kind, Seq) \
-Word##kind##_t PackWord##kind##_sub##Seq##Rev (Seq(Word8_t) seq, Int offset) { \
+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); \
@@ -27,7 +27,7 @@
}
#define mkUpdate(kind) \
-void PackWord##kind##_update (Arr(Word8_t) a, Int offset, Word##kind##_t w) { \
+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); \
int i; \
@@ -36,7 +36,7 @@
s[i] = p[i]; \
}
#define mkUpdateRev(kind) \
-void PackWord##kind##_updateRev (Arr(Word8_t) a, Int offset, Word##kind##_t w) { \
+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); \
int i; \
@@ -63,14 +63,14 @@
#undef all
-Word32_t Word8Array_subWord32Rev (Array(Word8_t) a, Int offset) {
+Word32_t Word8Array_subWord32Rev (Array(Word8_t) a, C_Ptrdiff_t offset) {
return PackWord32_subArrRev (a, offset);
}
-void Word8Array_updateWord32Rev (Array(Word32_t) a, Int offset, Word32_t w) {
+void Word8Array_updateWord32Rev (Array(Word32_t) a, C_Ptrdiff_t offset, Word32_t w) {
PackWord32_updateRev (a, offset, w);
}
-Word32_t Word8Vector_subWord32Rev (Vector(Word8_t) v, Int offset) {
+Word32_t Word8Vector_subWord32Rev (Vector(Word8_t) v, C_Ptrdiff_t offset) {
return PackWord32_subArrRev (v, offset);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -1,11 +1,9 @@
#include "platform.h"
#define unaryReal(g, h) \
-Real64_t Real64_##g (Real64_t x); \
Real64_t Real64_##g (Real64_t x) { \
return h (x); \
} \
-Real32_t Real32_##g (Real32_t x); \
Real32_t Real32_##g (Real32_t x) { \
return h##f (x); \
}
@@ -14,11 +12,9 @@
#undef unaryReal
#define binaryReal(g, h) \
-Real64_t Real64_Math_##g (Real64_t x, Real64_t y); \
Real64_t Real64_Math_##g (Real64_t x, Real64_t y) { \
return h (x, y); \
} \
-Real32_t Real32_Math_##g (Real32_t x, Real32_t y); \
Real32_t Real32_Math_##g (Real32_t x, Real32_t y) { \
return h##f (x, y); \
}
@@ -27,12 +23,10 @@
#undef binaryReal
#define unaryReal(g, h) \
-Real64_t Real64_##g (Real64_t x); \
-Real64_t Real64_##g (Real64_t x) { \
+Real64_t Real64_Math_##g (Real64_t x) { \
return h (x); \
} \
-Real32_t Real32_##g (Real32_t x); \
-Real32_t Real32_##g (Real32_t x) { \
+Real32_t Real32_Math_##g (Real32_t x) { \
return h##f (x); \
}
unaryReal(acos, acos)
@@ -50,12 +44,12 @@
unaryReal(tanh, tanh)
#undef unaryReal
-Real64_t Real64_ldexp (Real64_t x, C_Int_t i);
-Real64_t Real64_ldexp (Real64_t x, C_Int_t i) {
- return ldexp (x, i);
+#define binaryRealInt(g, h) \
+Real64_t Real64_##g (Real64_t x, C_Int_t i) { \
+ return h (x, i); \
+} \
+Real32_t Real32_##g (Real32_t x, C_Int_t i) { \
+ return h##f (x, i); \
}
-
-Real32_t Real32_ldexp (Real32_t x, C_Int_t i);
-Real32_t Real32_ldexp (Real32_t x, C_Int_t i) {
- return ldexpf (x, i);
-}
+binaryRealInt(ldexp, ldexp)
+#undef binaryRealInt
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -4,10 +4,10 @@
#define Vec(t) Vector(t)
#define mkSubSeq(kind, Seq) \
-Real##kind##_t PackReal##kind##_sub##Seq (Seq(Word8_t) seq, Int offset) { \
+Real##kind##_t PackReal##kind##_sub##Seq (Seq(Word8_t) seq, C_Ptrdiff_t offset) { \
Real##kind##_t r; \
- pointer p = (pointer)&r; \
- pointer s = (pointer)seq + offset; \
+ Word8_t* p = (Word8_t*)&r; \
+ Word8_t* s = (Word8_t*)seq + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
@@ -15,10 +15,10 @@
return r; \
}
#define mkSubSeqRev(kind, Seq) \
-Real##kind##_t PackReal##kind##_sub##Seq##Rev (Seq(Word8_t) seq, Int offset) { \
+Real##kind##_t PackReal##kind##_sub##Seq##Rev (Seq(Word8_t) seq, C_Ptrdiff_t offset) { \
Real##kind##_t r; \
- pointer p = (pointer)&r; \
- pointer s = (pointer)seq + offset; \
+ Word8_t* p = (Word8_t*)&r; \
+ Word8_t* s = (Word8_t*)seq + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
@@ -27,18 +27,18 @@
}
#define mkUpdate(kind) \
-void PackReal##kind##_update (Arr(Word8_t) a, Int offset, Real##kind##_t r) { \
- pointer p = (pointer)&r; \
- pointer s = (pointer)a + offset; \
+void PackReal##kind##_update (Arr(Word8_t) a, C_Ptrdiff_t offset, Real##kind##_t r) { \
+ Word8_t* p = (Word8_t*)&r; \
+ Word8_t* s = (Word8_t*)a + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
s[i] = p[i]; \
}
#define mkUpdateRev(kind) \
-void PackReal##kind##_updateRev (Arr(Word8_t) a, Int offset, Real##kind##_t r) { \
- pointer p = (pointer)&r; \
- pointer s = (pointer)a + offset; \
+void PackReal##kind##_updateRev (Arr(Word8_t) a, C_Ptrdiff_t offset, Real##kind##_t r) { \
+ Word8_t* p = (Word8_t*)&r; \
+ Word8_t* s = (Word8_t*)a + offset; \
int i; \
\
for (i = 0; i < kind / 8; ++i) \
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -1,7 +1,5 @@
#include "platform.h"
-C_Int_t Real32_class (Real32_t f);
-
#if HAS_FPCLASSIFY
C_Int_t Real32_class (Real32_t f) {
@@ -56,8 +54,6 @@
#endif
-C_Int_t Real64_class (Real64_t d);
-
#if HAS_FPCLASSIFY
C_Int_t Real64_class (Real64_t d) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -1,11 +1,11 @@
#include "platform.h"
-Real32_t Real32_frexp (Real32_t x, Ref(C_Int_t) exp);
-Real32_t Real32_frexp (Real32_t x, Ref(C_Int_t) exp) {
- return frexpf (x, (int*)exp);
+#define binaryRealIntRef(g, h) \
+Real64_t Real64_##g (Real64_t x, Ref(C_Int_t) i) { \
+ return h (x, (int*)i); \
+} \
+Real32_t Real32_##g (Real32_t x, Ref(C_Int_t) i) { \
+ return h##f (x, (int*)i); \
}
-
-Real64_t Real64_frexp (Real64_t x, Ref(C_Int_t) exp);
-Real64_t Real64_frexp (Real64_t x, Ref(C_Int_t) exp) {
- return frexp (x, (int*)exp);
-}
+binaryRealIntRef(frexp, frexp)
+#undef binaryRealIntRef
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -6,7 +6,6 @@
#endif
/* This code is patterned on g_dfmt from the gdtoa sources. */
-C_String_t Real32_gdtoa (Real32_t f, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt);
C_String_t Real32_gdtoa (Real32_t f, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt) {
ULong bits[1];
int ex;
@@ -40,7 +39,6 @@
return (C_String_t)result;
}
-C_String_t Real64_gdtoa (Real64_t d, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt);
C_String_t Real64_gdtoa (Real64_t d, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt) {
ULong bits[2];
int ex;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -1,11 +1,11 @@
#include "platform.h"
-Real64_t Real64_modf (Real64_t x, Ref(Real64_t) exp);
-Real64_t Real64_modf (Real64_t x, Ref(Real64_t) exp) {
- return modf (x, (Real64_t*)exp);
+#define binaryRealRealRef(g, h) \
+Real64_t Real64_##g (Real64_t x, Ref(Real64_t) yp) { \
+ return h (x, (Real64_t*)yp); \
+} \
+Real32_t Real32_##g (Real32_t x, Ref(Real32_t) yp) { \
+ return h##f (x, (Real32_t*)yp); \
}
-
-Real32_t Real32_modf (Real32_t x, Ref(Real32_t) exp);
-Real32_t Real32_modf (Real32_t x, Ref(Real32_t) exp) {
- return modff (x, (Real32_t*)exp);
-}
+binaryRealRealRef(modf, modf)
+#undef binaryRealRealRef
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -1,12 +1,10 @@
#include "platform.h"
/* nextafter is a macro, so we must have a C wrapper to work correctly. */
-Real32_t Real32_nextAfter (Real32_t x1, Real32_t x2);
Real32_t Real32_nextAfter (Real32_t x1, Real32_t x2) {
return nextafterf (x1, x2);
}
-Real64_t Real64_nextAfter (Real64_t x1, Real64_t x2);
Real64_t Real64_nextAfter (Real64_t x1, Real64_t x2) {
return nextafter (x1, x2);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -1,8 +1,5 @@
#include "platform.h"
-C_Int_t Real32_signBit (Real32_t f);
-C_Int_t Real64_signBit (Real64_t d);
-
#if HAS_SIGNBIT
C_Int_t Real32_signBit (Real32_t f) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c 2006-04-25 18:35:12 UTC (rev 4416)
@@ -3,7 +3,6 @@
Real32_t gdtoa_strtof (char *s, char **endptr);
Real64_t gdtoa_strtod (char *s, char **endptr);
-Real32_t Real32_strto (NullString8_t s);
Real32_t Real32_strto (NullString8_t s) {
char *endptr;
Real32_t res;
@@ -13,10 +12,9 @@
return res;
}
-Real64_t Real64_strto (NullString8_t s);
Real64_t Real64_strto (NullString8_t s) {
char *endptr;
- Real64 res;
+ Real64_t res;
res = gdtoa_strtod ((char*)s, &endptr);
assert (NULL != endptr);
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 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-04-25 18:35:12 UTC (rev 4416)
@@ -1,6 +1,3 @@
-# Posix.FileSys.PC.2_SYMLINKS = _const : C_Int.t
-# Posix.FileSys.Stat.getBlkCnt = _import : unit -> C_BlkCnt.t
-# Posix.FileSys.Stat.getBlkSize = _import : unit -> C_BlkSize.t
CommandLine.argc = _symbol : C_Int.t
CommandLine.argv = _symbol : C_StringArray.t
CommandLine.commandName = _symbol : C_String.t
@@ -139,6 +136,18 @@
OS.IO.POLLOUT = _const : C_Short.t
OS.IO.POLLPRI = _const : C_Short.t
OS.IO.poll = _import : C_Fd.t vector * C_Short.t vector * C_NFds.t * C_Int.t * C_Short.t array -> C_Int.t C_Errno.t
+PackReal32.subArr = _import : Word8.t array * C_Ptrdiff.t -> Real32.t
+PackReal32.subArrRev = _import : Word8.t array * C_Ptrdiff.t -> Real32.t
+PackReal32.subVec = _import : Word8.t vector * C_Ptrdiff.t -> Real32.t
+PackReal32.subVecRev = _import : Word8.t vector * C_Ptrdiff.t -> Real32.t
+PackReal32.update = _import : Word8.t array * C_Ptrdiff.t * Real32.t -> unit
+PackReal32.updateRev = _import : Word8.t array * C_Ptrdiff.t * Real32.t -> unit
+PackReal64.subArr = _import : Word8.t array * C_Ptrdiff.t -> Real64.t
+PackReal64.subArrRev = _import : Word8.t array * C_Ptrdiff.t -> Real64.t
+PackReal64.subVec = _import : Word8.t vector * C_Ptrdiff.t -> Real64.t
+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
Posix.Error.E2BIG = _const : C_Int.t
Posix.Error.EACCES = _const : C_Int.t
Posix.Error.EADDRINUSE = _const : C_Int.t
@@ -243,6 +252,7 @@
Posix.FileSys.O.TEXT = _const : C_Int.t
Posix.FileSys.O.TRUNC = _const : C_Int.t
Posix.FileSys.O.WRONLY = _const : C_Int.t
+# Posix.FileSys.PC.2_SYMLINKS = _const : C_Int.t
Posix.FileSys.PC.ALLOC_SIZE_MIN = _const : C_Int.t
Posix.FileSys.PC.ASYNC_IO = _const : C_Int.t
Posix.FileSys.PC.CHOWN_RESTRICTED = _const : C_Int.t
@@ -294,6 +304,8 @@
Posix.FileSys.ST.isSock = _import : C_Mode.t -> Bool.t
Posix.FileSys.Stat.fstat = _import : C_Fd.t -> C_Int.t C_Errno.t
Posix.FileSys.Stat.getATime = _import : unit -> C_Time.t
+# Posix.FileSys.Stat.getBlkCnt = _import : unit -> C_BlkCnt.t
+# Posix.FileSys.Stat.getBlkSize = _import : unit -> C_BlkSize.t
Posix.FileSys.Stat.getCTime = _import : unit -> C_Time.t
Posix.FileSys.Stat.getDev = _import : unit -> C_Dev.t
Posix.FileSys.Stat.getGId = _import : unit -> C_GId.t
@@ -736,6 +748,66 @@
Posix.TTY.V.VSTOP = _const : C_Int.t
Posix.TTY.V.VSUSP = _const : C_Int.t
Posix.TTY.V.VTIME = _const : C_Int.t
+Real32.Math.acos = _import : Real32.t -> Real32.t
+Real32.Math.asin = _import : Real32.t -> Real32.t
+Real32.Math.atan = _import : Real32.t -> Real32.t
+Real32.Math.atan2 = _import : Real32.t * Real32.t -> Real32.t
+Real32.Math.cos = _import : Real32.t -> Real32.t
+Real32.Math.cosh = _import : Real32.t -> Real32.t
+Real32.Math.e = _symbol : Real32.t
+Real32.Math.exp = _import : Real32.t -> Real32.t
+Real32.Math.ln = _import : Real32.t -> Real32.t
+Real32.Math.log10 = _import : Real32.t -> Real32.t
+Real32.Math.pi = _symbol : Real32.t
+Real32.Math.pow = _import : Real32.t * Real32.t -> Real32.t
+Real32.Math.sin = _import : Real32.t -> Real32.t
+Real32.Math.sinh = _import : Real32.t -> Real32.t
+Real32.Math.sqrt = _import : Real32.t -> Real32.t
+Real32.Math.tan = _import : Real32.t -> Real32.t
+Real32.Math.tanh = _import : Real32.t -> Real32.t
+Real32.abs = _import : Real32.t -> Real32.t
+Real32.class = _import : Real32.t -> C_Int.t
+Real32.frexp = _import : Real32.t * C_Int.t ref -> Real32.t
+Real32.gdtoa = _import : Real32.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t
+Real32.ldexp = _import : Real32.t * C_Int.t -> Real32.t
+Real32.maxFinite = _symbol : Real32.t
+Real32.minNormalPos = _symbol : Real32.t
+Real32.minPos = _symbol : Real32.t
+Real32.modf = _import : Real32.t * Real32.t ref -> Real32.t
+Real32.nextAfter = _import : Real32.t * Real32.t -> Real32.t
+Real32.round = _import : Real32.t -> Real32.t
+Real32.signBit = _import : Real32.t -> C_Int.t
+Real32.strto = _import : NullString8.t -> Real32.t
+Real64.Math.acos = _import : Real64.t -> Real64.t
+Real64.Math.asin = _import : Real64.t -> Real64.t
+Real64.Math.atan = _import : Real64.t -> Real64.t
+Real64.Math.atan2 = _import : Real64.t * Real64.t -> Real64.t
+Real64.Math.cos = _import : Real64.t -> Real64.t
+Real64.Math.cosh = _import : Real64.t -> Real64.t
+Real64.Math.e = _symbol : Real64.t
+Real64.Math.exp = _import : Real64.t -> Real64.t
+Real64.Math.ln = _import : Real64.t -> Real64.t
+Real64.Math.log10 = _import : Real64.t -> Real64.t
+Real64.Math.pi = _symbol : Real64.t
+Real64.Math.pow = _import : Real64.t * Real64.t -> Real64.t
+Real64.Math.sin = _import : Real64.t -> Real64.t
+Real64.Math.sinh = _import : Real64.t -> Real64.t
+Real64.Math.sqrt = _import : Real64.t -> Real64.t
+Real64.Math.tan = _import : Real64.t -> Real64.t
+Real64.Math.tanh = _import : Real64.t -> Real64.t
+Real64.abs = _import : Real64.t -> Real64.t
+Real64.class = _import : Real64.t -> C_Int.t
+Real64.frexp = _import : Real64.t * C_Int.t ref -> Real64.t
+Real64.gdtoa = _import : Real64.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t
+Real64.ldexp = _import : Real64.t * C_Int.t -> Real64.t
+Real64.maxFinite = _symbol : Real64.t
+Real64.minNormalPos = _symbol : Real64.t
+Real64.minPos = _symbol : Real64.t
+Real64.modf = _import : Real64.t * Real64.t ref -> Real64.t
+Real64.nextAfter = _import : Real64.t * Real64.t -> Real64.t
+Real64.round = _import : Real64.t -> Real64.t
+Real64.signBit = _import : Real64.t -> C_Int.t
+Real64.strto = _import : NullString8.t -> Real64.t
Socket.AF.INET = _const : C_Int.t
Socket.AF.INET6 = _const : C_Int.t
Socket.AF.UNIX = _const : C_Int.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 17:35:46 UTC (rev 4415)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 18:35:12 UTC (rev 4416)
@@ -185,23 +185,6 @@
extern Bool MLton_Platform_CygwinUseMmap;
/* ------------------------------------------------- */
-/* PackReal */
-/* ------------------------------------------------- */
-
-Real32_t PackReal32_subArr (Array(Word8_t) v, Int offset);
-Real32_t PackReal32_subArrRev (Array(Word8_t) v, Int offset);
-Real64_t PackReal64_subArr (Array(Word8_t) v, Int offset);
-Real64_t PackReal64_subArrRev (Array(Word8_t) v, Int offset);
-Real32_t PackReal32_subVec (Vector(Word8_t) v, Int offset);
-Real32_t PackReal32_subVecRev (Vector(Word8_t) v, Int offset);
-Real64_t PackReal64_subVec (Vector(Word8_t) v, Int offset);
-Real64_t PackReal64_subVecRev (Vector(Word8_t) v, Int offset);
-void PackReal32_update (Array(Word8_t) a, Int offset, Real32_t r);
-void PackReal32_updateRev (Array(Word8_t) a, Int offset, Real32_t r);
-void PackReal64_update (Array(Word8_t) a, Int offset, Real64_t r);
-void PackReal64_updateRev (Array(Word8_t) a, Int offset, Real64_t r);
-
-/* ------------------------------------------------- */
/* PackWord */
/* ------------------------------------------------- */
|
|
From: Stephen W. <sw...@ml...> - 2006-04-25 10:35:49
|
Tweaked to use the same "offset" function for PackReal and PackWord.
----------------------------------------------------------------------
U mlton/trunk/basis-library/integer/pack-word32.sml
U mlton/trunk/basis-library/real/pack-real.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/integer/pack-word32.sml
===================================================================
--- mlton/trunk/basis-library/integer/pack-word32.sml 2006-04-25 17:24:44 UTC (rev 4414)
+++ mlton/trunk/basis-library/integer/pack-word32.sml 2006-04-25 17:35:46 UTC (rev 4415)
@@ -22,14 +22,16 @@
Primitive.Word8Array.updateWordRev,
Primitive.Word8Vector.subWordRev)
-fun start (i, n) =
+fun offset (i, n) =
let
val i = Int.* (bytesPerElem, i)
- val _ =
+ val () =
if Primitive.safe
- andalso Primitive.Int.geu (Int.+ (i, Int.- (bytesPerElem, 1)), n)
- then raise Subscript
- else ()
+ andalso (Primitive.Int.geu
+ (Int.+ (i, Int.- (bytesPerElem, 1)), n)) then
+ raise Subscript
+ else
+ ()
in
i
end handle Overflow => raise Subscript
@@ -37,7 +39,7 @@
local
fun make (sub, length, toPoly) (av, i) =
let
- val _ = start (i, length av)
+ val _ = offset (i, length av)
in
Word.toLarge (sub (toPoly av, i))
end
@@ -51,7 +53,7 @@
fun update (a, i, w) =
let
val a = Word8Array.toPoly a
- val _ = start (i, Array.length a)
+ val _ = offset (i, Array.length a)
in
up (a, i, Word.fromLarge w)
end
Modified: mlton/trunk/basis-library/real/pack-real.sml
===================================================================
--- mlton/trunk/basis-library/real/pack-real.sml 2006-04-25 17:24:44 UTC (rev 4414)
+++ mlton/trunk/basis-library/real/pack-real.sml 2006-04-25 17:35:46 UTC (rev 4415)
@@ -24,19 +24,23 @@
then (subVec, update)
else (subVecRev, updateRev)
-fun offset (size, i) =
+fun offset (i, n) =
let
- val off = Int.* (bytesPerElem, i)
+ val i = Int.* (bytesPerElem, i)
+ val () =
+ if Primitive.safe
+ andalso (Primitive.Int.geu
+ (Int.+ (i, Int.- (bytesPerElem, 1)), n)) then
+ raise Subscript
+ else
+ ()
in
- if Int.< (i, 0) orelse Int.> (off, size -? bytesPerElem)
- then raise Subscript
- else off
- end
- handle Overflow => raise Subscript
+ i
+ end handle Overflow => raise Subscript
fun update (a, i, r) =
let
- val i = offset (Word8Array.length a, i)
+ val i = offset (i, Word8Array.length a)
val a = Word8Array.toPoly a
in
up (a, i, r)
@@ -52,7 +56,7 @@
fun subVec (v, i) =
let
- val i = offset (Word8Vector.length v, i)
+ val i = offset (i, Word8Vector.length v)
val v = Word8Vector.toPoly v
in
sub (v, i)
|
|
From: Stephen W. <sw...@ml...> - 2006-04-25 10:24:45
|
Noted HP-UX port.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2006-04-25 16:58:10 UTC (rev 4413)
+++ mlton/trunk/doc/changelog 2006-04-25 17:24:44 UTC (rev 4414)
@@ -1,9 +1,10 @@
Here are the changes since version 20051202.
* 2006-04-25
+ - Ported to HPPA-HPUX.
- Fixed PackReal{,32,64}{Big,Little} to follow the Basis Library
specification.
-
+
* 2006-04-19
- Fixed a bug in MLton.share that could cause a segfault.
|
|
From: Stephen W. <sw...@ml...> - 2006-04-25 09:58:11
|
Added correct output for mlton.share regression on sparc-solaris. It needs different output because the default alignment on this platform is 8. ---------------------------------------------------------------------- A mlton/trunk/regression/mlton.share.sparc-solaris.ok ---------------------------------------------------------------------- Added: mlton/trunk/regression/mlton.share.sparc-solaris.ok =================================================================== --- mlton/trunk/regression/mlton.share.sparc-solaris.ok 2006-04-25 16:56:59 UTC (rev 4412) +++ mlton/trunk/regression/mlton.share.sparc-solaris.ok 2006-04-25 16:58:10 UTC (rev 4413) @@ -0,0 +1,718 @@ +size of a is 2000 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 512 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 1232 +0 => NONE +1 => (1, 1) +2 => (1, 1) +3 => (0, 0) +4 => (1, 1) +5 => (2, 2) +6 => (1, 1) +7 => (1, 1) +8 => (1, 1) +9 => (0, 0) +10 => (1, 1) +11 => (2, 2) +12 => (1, 1) +13 => (1, 1) +14 => (1, 1) +15 => (0, 0) +16 => (1, 1) +17 => (2, 2) +18 => (1, 1) +19 => (1, 1) +20 => (1, 1) +21 => (0, 0) +22 => (1, 1) +23 => (2, 2) +24 => (1, 1) +25 => (1, 1) +26 => (1, 1) +27 => (0, 0) +28 => (1, 1) +29 => (2, 2) +30 => (1, 1) +31 => (1, 1) +32 => (1, 1) +33 => (0, 0) +34 => (1, 1) +35 => (2, 2) +36 => (1, 1) +37 => (1, 1) +38 => (1, 1) +39 => (0, 0) +40 => (1, 1) +41 => (2, 2) +42 => (1, 1) +43 => (1, 1) +44 => (1, 1) +45 => (0, 0) +46 => (1, 1) +47 => (2, 2) +48 => (1, 1) +49 => (1, 1) +50 => (1, 1) +51 => (0, 0) +52 => (1, 1) +53 => (2, 2) +54 => (1, 1) +55 => (1, 1) +56 => (1, 1) +57 => (0, 0) +58 => (1, 1) +59 => (2, 2) +60 => (1, 1) +61 => (1, 1) +62 => (1, 1) +63 => (0, 0) +64 => (1, 1) +65 => (2, 2) +66 => (1, 1) +67 => (1, 1) +68 => (1, 1) +69 => (0, 0) +70 => (1, 1) +71 => (2, 2) +72 => (1, 1) +73 => (1, 1) +74 => (1, 1) +75 => (0, 0) +76 => (1, 1) +77 => (2, 2) +78 => (1, 1) +79 => (1, 1) +80 => (1, 1) +81 => (0, 0) +82 => (1, 1) +83 => (2, 2) +84 => (1, 1) +85 => (1, 1) +86 => (1, 1) +87 => (0, 0) +88 => (1, 1) +89 => (2, 2) +90 => (1, 1) +91 => (1, 1) +92 => (1, 1) +93 => (0, 0) +94 => (1, 1) +95 => (2, 2) +96 => (1, 1) +97 => (1, 1) +98 => (1, 1) +99 => (0, 0) +size of a is 464 +0 => NONE +1 => (1, 1) +2 => (1, 1) +3 => (0, 0) +4 => (1, 1) +5 => (2, 2) +6 => (1, 1) +7 => (1, 1) +8 => (1, 1) +9 => (0, 0) +10 => (1, 1) +11 => (2, 2) +12 => (1, 1) +13 => (1, 1) +14 => (1, 1) +15 => (0, 0) +16 => (1, 1) +17 => (2, 2) +18 => (1, 1) +19 => (1, 1) +20 => (1, 1) +21 => (0, 0) +22 => (1, 1) +23 => (2, 2) +24 => (1, 1) +25 => (1, 1) +26 => (1, 1) +27 => (0, 0) +28 => (1, 1) +29 => (2, 2) +30 => (1, 1) +31 => (1, 1) +32 => (1, 1) +33 => (0, 0) +34 => (1, 1) +35 => (2, 2) +36 => (1, 1) +37 => (1, 1) +38 => (1, 1) +39 => (0, 0) +40 => (1, 1) +41 => (2, 2) +42 => (1, 1) +43 => (1, 1) +44 => (1, 1) +45 => (0, 0) +46 => (1, 1) +47 => (2, 2) +48 => (1, 1) +49 => (1, 1) +50 => (1, 1) +51 => (0, 0) +52 => (1, 1) +53 => (2, 2) +54 => (1, 1) +55 => (1, 1) +56 => (1, 1) +57 => (0, 0) +58 => (1, 1) +59 => (2, 2) +60 => (1, 1) +61 => (1, 1) +62 => (1, 1) +63 => (0, 0) +64 => (1, 1) +65 => (2, 2) +66 => (1, 1) +67 => (1, 1) +68 => (1, 1) +69 => (0, 0) +70 => (1, 1) +71 => (2, 2) +72 => (1, 1) +73 => (1, 1) +74 => (1, 1) +75 => (0, 0) +76 => (1, 1) +77 => (2, 2) +78 => (1, 1) +79 => (1, 1) +80 => (1, 1) +81 => (0, 0) +82 => (1, 1) +83 => (2, 2) +84 => (1, 1) +85 => (1, 1) +86 => (1, 1) +87 => (0, 0) +88 => (1, 1) +89 => (2, 2) +90 => (1, 1) +91 => (1, 1) +92 => (1, 1) +93 => (0, 0) +94 => (1, 1) +95 => (2, 2) +96 => (1, 1) +97 => (1, 1) +98 => (1, 1) +99 => (0, 0) +size of a is 2800 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 1312 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 2800 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 2000000 +(1, 1) +size of a is 400112 +(1, 1) +size is 200 +size is 80 +abcdef abcdef +size is 64 +size is 40 +abcdef abcdef +1 2 |
|
From: Stephen W. <sw...@ml...> - 2006-04-25 09:57:01
|
Added correct output for mlton.share regression on hppa-hpux. It needs different output because the default alignment on this platform is 8. ---------------------------------------------------------------------- A mlton/trunk/regression/mlton.share.hppa-hpux.ok ---------------------------------------------------------------------- Added: mlton/trunk/regression/mlton.share.hppa-hpux.ok =================================================================== --- mlton/trunk/regression/mlton.share.hppa-hpux.ok 2006-04-25 16:42:23 UTC (rev 4411) +++ mlton/trunk/regression/mlton.share.hppa-hpux.ok 2006-04-25 16:56:59 UTC (rev 4412) @@ -0,0 +1,718 @@ +size of a is 2000 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 512 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 1232 +0 => NONE +1 => (1, 1) +2 => (1, 1) +3 => (0, 0) +4 => (1, 1) +5 => (2, 2) +6 => (1, 1) +7 => (1, 1) +8 => (1, 1) +9 => (0, 0) +10 => (1, 1) +11 => (2, 2) +12 => (1, 1) +13 => (1, 1) +14 => (1, 1) +15 => (0, 0) +16 => (1, 1) +17 => (2, 2) +18 => (1, 1) +19 => (1, 1) +20 => (1, 1) +21 => (0, 0) +22 => (1, 1) +23 => (2, 2) +24 => (1, 1) +25 => (1, 1) +26 => (1, 1) +27 => (0, 0) +28 => (1, 1) +29 => (2, 2) +30 => (1, 1) +31 => (1, 1) +32 => (1, 1) +33 => (0, 0) +34 => (1, 1) +35 => (2, 2) +36 => (1, 1) +37 => (1, 1) +38 => (1, 1) +39 => (0, 0) +40 => (1, 1) +41 => (2, 2) +42 => (1, 1) +43 => (1, 1) +44 => (1, 1) +45 => (0, 0) +46 => (1, 1) +47 => (2, 2) +48 => (1, 1) +49 => (1, 1) +50 => (1, 1) +51 => (0, 0) +52 => (1, 1) +53 => (2, 2) +54 => (1, 1) +55 => (1, 1) +56 => (1, 1) +57 => (0, 0) +58 => (1, 1) +59 => (2, 2) +60 => (1, 1) +61 => (1, 1) +62 => (1, 1) +63 => (0, 0) +64 => (1, 1) +65 => (2, 2) +66 => (1, 1) +67 => (1, 1) +68 => (1, 1) +69 => (0, 0) +70 => (1, 1) +71 => (2, 2) +72 => (1, 1) +73 => (1, 1) +74 => (1, 1) +75 => (0, 0) +76 => (1, 1) +77 => (2, 2) +78 => (1, 1) +79 => (1, 1) +80 => (1, 1) +81 => (0, 0) +82 => (1, 1) +83 => (2, 2) +84 => (1, 1) +85 => (1, 1) +86 => (1, 1) +87 => (0, 0) +88 => (1, 1) +89 => (2, 2) +90 => (1, 1) +91 => (1, 1) +92 => (1, 1) +93 => (0, 0) +94 => (1, 1) +95 => (2, 2) +96 => (1, 1) +97 => (1, 1) +98 => (1, 1) +99 => (0, 0) +size of a is 464 +0 => NONE +1 => (1, 1) +2 => (1, 1) +3 => (0, 0) +4 => (1, 1) +5 => (2, 2) +6 => (1, 1) +7 => (1, 1) +8 => (1, 1) +9 => (0, 0) +10 => (1, 1) +11 => (2, 2) +12 => (1, 1) +13 => (1, 1) +14 => (1, 1) +15 => (0, 0) +16 => (1, 1) +17 => (2, 2) +18 => (1, 1) +19 => (1, 1) +20 => (1, 1) +21 => (0, 0) +22 => (1, 1) +23 => (2, 2) +24 => (1, 1) +25 => (1, 1) +26 => (1, 1) +27 => (0, 0) +28 => (1, 1) +29 => (2, 2) +30 => (1, 1) +31 => (1, 1) +32 => (1, 1) +33 => (0, 0) +34 => (1, 1) +35 => (2, 2) +36 => (1, 1) +37 => (1, 1) +38 => (1, 1) +39 => (0, 0) +40 => (1, 1) +41 => (2, 2) +42 => (1, 1) +43 => (1, 1) +44 => (1, 1) +45 => (0, 0) +46 => (1, 1) +47 => (2, 2) +48 => (1, 1) +49 => (1, 1) +50 => (1, 1) +51 => (0, 0) +52 => (1, 1) +53 => (2, 2) +54 => (1, 1) +55 => (1, 1) +56 => (1, 1) +57 => (0, 0) +58 => (1, 1) +59 => (2, 2) +60 => (1, 1) +61 => (1, 1) +62 => (1, 1) +63 => (0, 0) +64 => (1, 1) +65 => (2, 2) +66 => (1, 1) +67 => (1, 1) +68 => (1, 1) +69 => (0, 0) +70 => (1, 1) +71 => (2, 2) +72 => (1, 1) +73 => (1, 1) +74 => (1, 1) +75 => (0, 0) +76 => (1, 1) +77 => (2, 2) +78 => (1, 1) +79 => (1, 1) +80 => (1, 1) +81 => (0, 0) +82 => (1, 1) +83 => (2, 2) +84 => (1, 1) +85 => (1, 1) +86 => (1, 1) +87 => (0, 0) +88 => (1, 1) +89 => (2, 2) +90 => (1, 1) +91 => (1, 1) +92 => (1, 1) +93 => (0, 0) +94 => (1, 1) +95 => (2, 2) +96 => (1, 1) +97 => (1, 1) +98 => (1, 1) +99 => (0, 0) +size of a is 2800 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 1312 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 2800 +0 => NONE +1 => (1, 1) +2 => (0, 2) +3 => (1, 0) +4 => (0, 1) +5 => (1, 2) +6 => (0, 0) +7 => (1, 1) +8 => (0, 2) +9 => (1, 0) +10 => (0, 1) +11 => (1, 2) +12 => (0, 0) +13 => (1, 1) +14 => (0, 2) +15 => (1, 0) +16 => (0, 1) +17 => (1, 2) +18 => (0, 0) +19 => (1, 1) +20 => (0, 2) +21 => (1, 0) +22 => (0, 1) +23 => (1, 2) +24 => (0, 0) +25 => (1, 1) +26 => (0, 2) +27 => (1, 0) +28 => (0, 1) +29 => (1, 2) +30 => (0, 0) +31 => (1, 1) +32 => (0, 2) +33 => (1, 0) +34 => (0, 1) +35 => (1, 2) +36 => (0, 0) +37 => (1, 1) +38 => (0, 2) +39 => (1, 0) +40 => (0, 1) +41 => (1, 2) +42 => (0, 0) +43 => (1, 1) +44 => (0, 2) +45 => (1, 0) +46 => (0, 1) +47 => (1, 2) +48 => (0, 0) +49 => (1, 1) +50 => (0, 2) +51 => (1, 0) +52 => (0, 1) +53 => (1, 2) +54 => (0, 0) +55 => (1, 1) +56 => (0, 2) +57 => (1, 0) +58 => (0, 1) +59 => (1, 2) +60 => (0, 0) +61 => (1, 1) +62 => (0, 2) +63 => (1, 0) +64 => (0, 1) +65 => (1, 2) +66 => (0, 0) +67 => (1, 1) +68 => (0, 2) +69 => (1, 0) +70 => (0, 1) +71 => (1, 2) +72 => (0, 0) +73 => (1, 1) +74 => (0, 2) +75 => (1, 0) +76 => (0, 1) +77 => (1, 2) +78 => (0, 0) +79 => (1, 1) +80 => (0, 2) +81 => (1, 0) +82 => (0, 1) +83 => (1, 2) +84 => (0, 0) +85 => (1, 1) +86 => (0, 2) +87 => (1, 0) +88 => (0, 1) +89 => (1, 2) +90 => (0, 0) +91 => (1, 1) +92 => (0, 2) +93 => (1, 0) +94 => (0, 1) +95 => (1, 2) +96 => (0, 0) +97 => (1, 1) +98 => (0, 2) +99 => (1, 0) +size of a is 2000000 +(1, 1) +size of a is 400112 +(1, 1) +size is 200 +size is 80 +abcdef abcdef +size is 64 +size is 40 +abcdef abcdef +1 2 |
|
From: Matthew F. <fl...@ml...> - 2006-04-25 09:42:24
|
Fixed PackReal{,32,64}{Big,Little} to follow the Basis Library specification
----------------------------------------------------------------------
U mlton/trunk/basis-library/real/pack-real.sml
U mlton/trunk/doc/changelog
A mlton/trunk/regression/pack-real.2.ok
A mlton/trunk/regression/pack-real.2.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/real/pack-real.sml
===================================================================
--- mlton/trunk/basis-library/real/pack-real.sml 2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/basis-library/real/pack-real.sml 2006-04-25 16:42:23 UTC (rev 4411)
@@ -24,15 +24,19 @@
then (subVec, update)
else (subVecRev, updateRev)
-fun check (size, i) =
- if Int.< (i, 0) orelse Int.> (i, size -? bytesPerElem) then
- raise Subscript
- else
- ()
+fun offset (size, i) =
+ let
+ val off = Int.* (bytesPerElem, i)
+ in
+ if Int.< (i, 0) orelse Int.> (off, size -? bytesPerElem)
+ then raise Subscript
+ else off
+ end
+ handle Overflow => raise Subscript
fun update (a, i, r) =
let
- val () = check (Word8Array.length a, i)
+ val i = offset (Word8Array.length a, i)
val a = Word8Array.toPoly a
in
up (a, i, r)
@@ -48,7 +52,7 @@
fun subVec (v, i) =
let
- val () = check (Word8Vector.length v, i)
+ val i = offset (Word8Vector.length v, i)
val v = Word8Vector.toPoly v
in
sub (v, i)
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/doc/changelog 2006-04-25 16:42:23 UTC (rev 4411)
@@ -1,5 +1,9 @@
Here are the changes since version 20051202.
+* 2006-04-25
+ - Fixed PackReal{,32,64}{Big,Little} to follow the Basis Library
+ specification.
+
* 2006-04-19
- Fixed a bug in MLton.share that could cause a segfault.
Added: mlton/trunk/regression/pack-real.2.ok
===================================================================
--- mlton/trunk/regression/pack-real.2.ok 2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/regression/pack-real.2.ok 2006-04-25 16:42:23 UTC (rev 4411)
@@ -0,0 +1,4 @@
+576.105263158
+576.105263158
+9.93985099471E~242
+9.93985099471E~242
Added: mlton/trunk/regression/pack-real.2.sml
===================================================================
--- mlton/trunk/regression/pack-real.2.sml 2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/regression/pack-real.2.sml 2006-04-25 16:42:23 UTC (rev 4411)
@@ -0,0 +1,15 @@
+
+val v =
+ Word8Vector.fromList
+ [0wx0D,0wxE5,0wx35,0wx94,0wxD7,0wx00,0wx82,0wx40,
+ 0wx0D,0wxE5,0wx35,0wx94,0wxD7,0wx00,0wx82,0wx40]
+
+val r = PackReal64Little.subVec(v, 0)
+val () = print (concat [Real64.toString r, "\n"])
+val r = PackReal64Little.subVec(v, 1)
+val () = print (concat [Real64.toString r, "\n"])
+
+val r = PackReal64Big.subVec(v, 0)
+val () = print (concat [Real64.toString r, "\n"])
+val r = PackReal64Big.subVec(v, 1)
+val () = print (concat [Real64.toString r, "\n"])
|
|
From: Matthew F. <fl...@ml...> - 2006-04-25 08:29:05
|
Refactored real
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -928,11 +928,11 @@
struct
type t = int
- val inf = _const "FP_INFINITE": t;
- val nan = _const "FP_NAN": t;
- val normal = _const "FP_NORMAL": t;
- val subnormal = _const "FP_SUBNORMAL": t;
- val zero = _const "FP_ZERO": t;
+ val inf = _const "IEEEReal_FloatClass_FP_INFINITE": t;
+ val nan = _const "IEEEReal_FloatClass_FP_NAN": t;
+ val normal = _const "IEEEReal_FloatClass_FP_NORMAL": t;
+ val subnormal = _const "IEEEReal_FloatClass_FP_SUBNORMAL": t;
+ val zero = _const "IEEEReal_FloatClass_FP_ZERO": t;
end
structure Math =
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,147 +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.
- *)
-
-(* Patch in fromLarge and toLarge now that IntInf is defined. *)
-
-structure Int8: INTEGER_EXTRA =
- struct
- open Int8
-
- val fromLarge = fromInt o IntInf.toInt
- val toLarge = IntInf.fromInt o toInt
- end
-
-structure Int16: INTEGER_EXTRA =
- struct
- open Int16
-
- val fromLarge = fromInt o IntInf.toInt
- val toLarge = IntInf.fromInt o toInt
- end
-
-structure Int32: INTEGER_EXTRA =
- struct
- open Int32
-
- val fromLarge = IntInf.toInt
- val toLarge = IntInf.fromInt
- end
-
-structure Int64: INTEGER_EXTRA =
- struct
- open Int64
-
- val fromLarge = IntInf.toInt64
- val toLarge = IntInf.fromInt64
-
- val op * =
- if Primitive.detectOverflow
- then fn (i, j) => fromLarge (IntInf.* (toLarge i, toLarge j))
- else op *?
-
- (* Must redefine scan because the Integer functor defines it in terms of
- * Int64.*, which wasn't defined yet.
- *)
- fun scan radix reader state =
- case IntInf.scan radix reader state of
- NONE => NONE
- | SOME (i, s) => SOME (fromLarge i, s)
-
- val fromString = StringCvt.scanString (scan StringCvt.DEC)
- end
-
-structure Int = Int32
-structure Position = Int64
-structure FixedInt = Int64
-
-structure Word8: WORD_EXTRA =
- struct
- open Word8
-
- val toLargeIntX = LargeInt.fromInt o toIntX
- val toLargeInt = LargeInt.fromInt o toInt
-
- fun fromLargeInt (i: LargeInt.int): word =
- fromInt (LargeInt.toInt (LargeInt.mod (i, 0x100)))
- end
-
-structure Word16: WORD_EXTRA =
- struct
- open Word16
-
- val toLargeIntX = LargeInt.fromInt o toIntX
- val toLargeInt = LargeInt.fromInt o toInt
-
- fun fromLargeInt (i: LargeInt.int): word =
- fromInt (LargeInt.toInt (LargeInt.mod (i, 0x10000)))
- end
-
-structure Word32: WORD32_EXTRA =
- struct
- open Word32
-
- val toLargeIntX = IntInf.fromInt o toIntX
-
- fun highBitSet w = w >= 0wx80000000
-
- fun toLargeInt (w: word): LargeInt.int =
- if highBitSet w
- then IntInf.+ (0x80000000, toLargeIntX (andb (w, 0wx7FFFFFFF)))
- else toLargeIntX w
-
- local
- val t32: LargeInt.int = 0x100000000
- val t31: LargeInt.int = 0x80000000
- in
- fun fromLargeInt (i: IntInf.int): word =
- fromInt
- (let
- open IntInf
- val low32 = i mod t32
- in
- toInt (if low32 >= t31
- then low32 - t32
- else low32)
- end)
- end
- end
-
-structure Word = Word32
-
-structure SysWord = Word32
-
-structure Word64: WORD =
- struct
- open Word64
-
- structure W = Word64
-
- val t32: LargeInt.int = 0x100000000
- val t64: LargeInt.int = 0x10000000000000000
-
- fun toLargeInt w =
- IntInf.+
- (Word32.toLargeInt (Word32.fromLarge w),
- IntInf.<< (Word32.toLargeInt (Word32.fromLarge (>> (w, 0w32))),
- 0w32))
-
- fun toLargeIntX w =
- if Word32.toLarge 0w0 = andb (w, << (Word32.toLarge 0w1, 0w63))
- then toLargeInt w
- else IntInf.- (toLargeInt w, t64)
-
- fun fromLargeInt (i: IntInf.int): word =
- let
- val (d, m) = IntInf.divMod (i, t32)
- in
- W.orb (W.<< (Word32.toLarge (Word32.fromLargeInt d), 0w32),
- Word32.toLarge (Word32.fromLargeInt m))
- end
- end
-
-structure LargeWord = Word64
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 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -40,6 +40,14 @@
end
structure IEEEReal =
struct
+structure FloatClass =
+struct
+val FP_INFINITE = _const "IEEEReal_FloatClass_FP_INFINITE" : C_Int.t;
+val FP_NAN = _const "IEEEReal_FloatClass_FP_NAN" : C_Int.t;
+val FP_NORMAL = _const "IEEEReal_FloatClass_FP_NORMAL" : C_Int.t;
+val FP_SUBNORMAL = _const "IEEEReal_FloatClass_FP_SUBNORMAL" : C_Int.t;
+val FP_ZERO = _const "IEEEReal_FloatClass_FP_ZERO" : C_Int.t;
+end
val getRoundingMode = _import "IEEEReal_getRoundingMode" : unit -> C_Int.t;
structure RoundingMode =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -16,16 +16,6 @@
val precision: Primitive.Int32.int
val radix: Primitive.Int32.int
- structure Class :
- sig
- eqtype t
- val inf: t
- val nan: t
- val normal: t
- val subnormal: t
- val zero: t
- end
-
structure Math :
sig
type real
@@ -60,17 +50,17 @@
val == : real * real -> bool
val ?= : real * real -> bool
val abs: real -> real
- val class: real -> Class.t
- val frexp: real * C_Int.int ref -> real
- val gdtoa: real * C_Int.int * C_Int.int * C_Int.int ref -> C_String.t
- val ldexp: real * C_Int.int -> real
+ val class: real -> C_Int.t
+ val frexp: real * C_Int.t ref -> real
+ val gdtoa: real * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t
+ val ldexp: real * C_Int.t -> real
val maxFinite: real
val minNormalPos: real
val minPos: real
val modf: real * real ref -> real
val nextAfter: real * real -> real
val round: real -> real
- val signBit: real -> C_Int.int
+ val signBit: real -> C_Int.t
val strto: Primitive.NullString8.t -> real
val ~ : real -> real
@@ -99,30 +89,13 @@
open Primitive
-local
-
- structure Class =
- struct
- type t = C_Int.int
-
- val inf = _const "FP_INFINITE": t;
- val nan = _const "FP_NAN": t;
- val normal = _const "FP_NORMAL": t;
- val subnormal = _const "FP_SUBNORMAL": t;
- val zero = _const "FP_ZERO": t;
- end
-
-in
-
-structure Real32 =
+structure Real32 : PRIM_REAL =
struct
open Real32
val precision : Int32.int = 24
val radix : Int32.int = 2
- structure Class = Class
-
structure Math =
struct
type real = real
@@ -132,18 +105,18 @@
val atan = _prim "Real32_Math_atan": real -> real;
val atan2 = _prim "Real32_Math_atan2": real * real -> real;
val cos = _prim "Real32_Math_cos": real -> real;
- val cosh = _import "coshf": real -> real;
+ val cosh = _import "Real32_Math_cosh": real -> real;
val e = #1 _symbol "Real32_Math_e": real GetSet.t; ()
val exp = _prim "Real32_Math_exp": real -> real;
val ln = _prim "Real32_Math_ln": real -> real;
val log10 = _prim "Real32_Math_log10": real -> real;
val pi = #1 _symbol "Real32_Math_pi": real GetSet.t; ()
- val pow = _import "powf": real * real -> real;
+ val pow = _import "Real32_Math_pow": real * real -> real;
val sin = _prim "Real32_Math_sin": real -> real;
- val sinh = _import "sinhf": real -> real;
+ val sinh = _import "Real32_Math_sinh": real -> real;
val sqrt = _prim "Real32_Math_sqrt": real -> real;
val tan = _prim "Real32_Math_tan": real -> real;
- val tanh = _import "tanhf": real -> real;
+ val tanh = _import "Real32_Math_tanh": real -> real;
end
val * = _prim "Real32_mul": real * real -> real;
@@ -152,24 +125,24 @@
val + = _prim "Real32_add": real * real -> real;
val - = _prim "Real32_sub": real * real -> real;
val / = _prim "Real32_div": real * real -> real;
+ val ~ = _prim "Real32_neg": real -> real;
val op < = _prim "Real32_lt": real * real -> bool;
val op <= = _prim "Real32_le": real * real -> bool;
val == = _prim "Real32_equal": real * real -> bool;
val ?= = _prim "Real32_qequal": real * real -> bool;
val abs = _prim "Real32_abs": real -> real;
- val class = _import "Real32_class": real -> Class.t;
- val frexp = _import "Real32_frexp": real * C_Int.int ref -> real;
- val gdtoa = _import "Real32_gdtoa": real * C_Int.int * C_Int.int * C_Int.int ref -> C_String.t;
- val ldexp = _prim "Real32_ldexp": real * C_Int.int -> real;
+ val class = _import "Real32_class": real -> C_Int.t;
+ val frexp = _import "Real32_frexp": real * C_Int.t ref -> real;
+ val gdtoa = _import "Real32_gdtoa": real * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t;
+ val ldexp = _prim "Real32_ldexp": real * C_Int.t -> real;
val maxFinite = #1 _symbol "Real32_maxFinite": real GetSet.t; ()
val minNormalPos = #1 _symbol "Real32_minNormalPos": real GetSet.t; ()
val minPos = #1 _symbol "Real32_minPos": real GetSet.t; ()
val modf = _import "Real32_modf": real * real ref -> real;
val nextAfter = _import "Real32_nextAfter": real * real -> real;
val round = _prim "Real32_round": real -> real;
- val signBit = _import "Real32_signBit": real -> C_Int.int;
+ val signBit = _import "Real32_signBit": real -> C_Int.t;
val strto = _import "Real32_strto": NullString8.t -> real;
- val ~ = _prim "Real32_neg": real -> real;
val fromInt8Unsafe = _prim "WordS8_toReal32": Int8.int -> real;
val fromInt16Unsafe = _prim "WordS16_toReal32": Int16.int -> real;
@@ -197,15 +170,13 @@
end
end
-structure Real64 =
+structure Real64 : PRIM_REAL =
struct
open Real64
val precision : Int32.int = 53
val radix : Int32.int = 2
- structure Class = Class
-
structure Math =
struct
type real = real
@@ -215,44 +186,44 @@
val atan = _prim "Real64_Math_atan": real -> real;
val atan2 = _prim "Real64_Math_atan2": real * real -> real;
val cos = _prim "Real64_Math_cos": real -> real;
- val cosh = _import "cosh": real -> real;
+ val cosh = _import "Real64_Math_cosh": real -> real;
val e = #1 _symbol "Real64_Math_e": real GetSet.t; ()
val exp = _prim "Real64_Math_exp": real -> real;
val ln = _prim "Real64_Math_ln": real -> real;
val log10 = _prim "Real64_Math_log10": real -> real;
val pi = #1 _symbol "Real64_Math_pi": real GetSet.t; ()
- val pow = _import "pow": real * real -> real;
+ val pow = _import "Real64_Math_pow": real * real -> real;
val sin = _prim "Real64_Math_sin": real -> real;
- val sinh = _import "sinh": real -> real;
+ val sinh = _import "Real64_Math_sinh": real -> real;
val sqrt = _prim "Real64_Math_sqrt": real -> real;
val tan = _prim "Real64_Math_tan": real -> real;
- val tanh = _import "tanh": real -> real;
+ val tanh = _import "Real64_Math_tanh": real -> real;
end
-
+
val * = _prim "Real64_mul": real * real -> real;
val *+ = _prim "Real64_muladd": real * real * real -> real;
val *- = _prim "Real64_mulsub": real * real * real -> real;
val + = _prim "Real64_add": real * real -> real;
val - = _prim "Real64_sub": real * real -> real;
val / = _prim "Real64_div": real * real -> real;
+ val ~ = _prim "Real64_neg": real -> real;
val op < = _prim "Real64_lt": real * real -> bool;
val op <= = _prim "Real64_le": real * real -> bool;
val == = _prim "Real64_equal": real * real -> bool;
val ?= = _prim "Real64_qequal": real * real -> bool;
val abs = _prim "Real64_abs": real -> real;
- val class = _import "Real64_class": real -> Class.t;
- val frexp = _import "Real64_frexp": real * C_Int.int ref -> real;
- val gdtoa = _import "Real64_gdtoa": real * C_Int.int * C_Int.int * C_Int.int ref -> C_String.t;
- val ldexp = _prim "Real64_ldexp": real * C_Int.int -> real;
+ val class = _import "Real64_class": real -> C_Int.t;
+ val frexp = _import "Real64_frexp": real * C_Int.t ref -> real;
+ val gdtoa = _import "Real64_gdtoa": real * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t;
+ val ldexp = _prim "Real64_ldexp": real * C_Int.t -> real;
val maxFinite = #1 _symbol "Real64_maxFinite": real GetSet.t; ()
val minNormalPos = #1 _symbol "Real64_minNormalPos": real GetSet.t; ()
val minPos = #1 _symbol "Real64_minPos": real GetSet.t; ()
val modf = _import "Real64_modf": real * real ref -> real;
val nextAfter = _import "Real64_nextAfter": real * real -> real;
val round = _prim "Real64_round": real -> real;
- val signBit = _import "Real64_signBit": real -> C_Int.int;
+ val signBit = _import "Real64_signBit": real -> C_Int.t;
val strto = _import "Real64_strto": NullString8.t -> real;
- val ~ = _prim "Real64_neg": real -> real;
val fromInt8Unsafe = _prim "WordS8_toReal64": Int8.int -> real;
val fromInt16Unsafe = _prim "WordS16_toReal64": Int16.int -> real;
@@ -281,5 +252,3 @@
end
end
-
-end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig 2006-04-25 15:28:59 UTC (rev 4410)
@@ -34,5 +34,6 @@
sig
include IEEE_REAL
+ val mkClass: ('a -> C_Int.t) -> 'a -> float_class
val withRoundingMode: rounding_mode * (unit -> 'a) -> 'a
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -15,15 +15,40 @@
exception Unordered
datatype real_order = LESS | EQUAL | GREATER | UNORDERED
+ structure Prim = PrimitiveFFI.IEEEReal
+
datatype float_class =
INF
| NAN
| NORMAL
| SUBNORMAL
| ZERO
-
- structure Prim = PrimitiveFFI.IEEEReal
+ local
+ val classes =
+ let
+ open Prim.FloatClass
+ in
+ (* order here is chosen based on putting the more
+ * commonly used classes at the front.
+ *)
+ [(FP_NORMAL, NORMAL),
+ (FP_ZERO, ZERO),
+ (FP_INFINITE, INF),
+ (FP_NAN, NAN),
+ (FP_SUBNORMAL, SUBNORMAL)]
+ end
+ in
+ fun mkClass class x =
+ let
+ val i = class x
+ in
+ case List.find (fn (i', _) => i = i') classes of
+ NONE => raise Fail "Real_class returned bogus integer"
+ | SOME (_, c) => c
+ end
+ end
+
structure RoundingMode =
struct
datatype t =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig 2006-04-25 15:28:59 UTC (rev 4410)
@@ -8,16 +8,6 @@
sig
include PRE_REAL_GLOBAL
- structure Class :
- sig
- eqtype t
- val inf: t
- val nan: t
- val normal: t
- val subnormal: t
- val zero: t
- end
-
val * : real * real -> real
val *+ : real * real * real -> real
val *- : real * real * real -> real
@@ -40,10 +30,9 @@
val precision: Primitive.Int32.int
val radix: Primitive.Int32.int
+ val class: real -> C_Int.t
val signBit: real -> C_Int.t
- val class: real -> Class.t
-
val nextAfter: real * real -> real
val frexp: real * C_Int.int ref -> real
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -108,30 +108,7 @@
val nan = posInf + negInf
- local
- val classes =
- let
- open R.Class
- in
- (* order here is chosen based on putting the more
- * commonly used classes at the front.
- *)
- [(normal, NORMAL),
- (zero, ZERO),
- (inf, INF),
- (nan, NAN),
- (subnormal, SUBNORMAL)]
- end
- in
- fun class x =
- let
- val i = R.class x
- in
- case List.find (fn (i', _) => i = i') classes of
- NONE => raise Fail "Real_class returned bogus integer"
- | SOME (_, c) => c
- end
- end
+ val class = IEEEReal.mkClass R.class
val abs =
if MLton.Codegen.isNative
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -0,0 +1,18 @@
+(* 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.
+ *)
+
+structure NullString =
+ struct
+ open Primitive.NullString8
+
+ val nullTerm = fromString o String.nullTerm
+ end
+structure NullStringArray =
+ struct
+ open Primitive.NullString8Array
+ end
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-04-25 15:28:59 UTC (rev 4410)
@@ -184,6 +184,7 @@
cd gen && mlton gen-basis-ffi.sml
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
gc-gdb.o: gc.c $(GCCFILES) $(HFILES)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-25 15:28:59 UTC (rev 4410)
@@ -16,15 +16,7 @@
that correspond to bit-wise identities.
basis/Int/Word.c
-basis/IntInf.c
basis/MLton/allocTooLarge.c
basis/MLton/bug.c
-basis/Real/Math.c
-basis/Real/class.c
-basis/Real/frexp.c
-basis/Real/gdtoa.c
-basis/Real/modf.c
-basis/Real/nextAfter.c
-basis/Real/real.c
-basis/Real/signBit.c
-basis/Real/strto.c
+basis/Real/PackReal.c
+basis/Int/PackWord.c
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,5 +1,30 @@
#include "platform.h"
+#if not HAS_FPCLASSIFY
+#ifndef FP_INFINITE
+#define FP_INFINITE 1
+#endif
+#ifndef FP_NAN
+#define FP_NAN 0
+#endif
+#ifndef FP_NORMAL
+#define FP_NORMAL 4
+#endif
+#ifndef FP_SUBNORMAL
+#define FP_SUBNORMAL 3
+#endif
+#ifndef FP_ZERO
+#define FP_ZERO 2
+#endif
+#endif
+
+const C_Int_t IEEEReal_FloatClass_FP_INFINITE = FP_INFINITE;
+const C_Int_t IEEEReal_FloatClass_FP_NAN = FP_NAN;
+const C_Int_t IEEEReal_FloatClass_FP_NORMAL = FP_NORMAL;
+const C_Int_t IEEEReal_FloatClass_FP_SUBNORMAL = FP_SUBNORMAL;
+const C_Int_t IEEEReal_FloatClass_FP_ZERO = FP_ZERO;
+
+
#define FE_NOSUPPORT -1
/* Can't handle undefined rounding modes with code like the following.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,57 +1,61 @@
#include "platform.h"
-#define unaryReal(f, g) \
- Real64 Real64_##f (Real64 x); \
- Real64 Real64_##f (Real64 x) { \
- return g (x); \
- } \
- Real32 Real32_##f (Real32 x); \
- Real32 Real32_##f (Real32 x) { \
- return (Real32)(Real64_##f ((Real64)x)); \
- }
+#define unaryReal(g, h) \
+Real64_t Real64_##g (Real64_t x); \
+Real64_t Real64_##g (Real64_t x) { \
+ return h (x); \
+} \
+Real32_t Real32_##g (Real32_t x); \
+Real32_t Real32_##g (Real32_t x) { \
+ return h##f (x); \
+}
unaryReal(abs, fabs)
unaryReal(round, rint)
#undef unaryReal
-#define binaryReal(f, g) \
- Real64 Real64_Math_##f (Real64 x, Real64 y); \
- Real64 Real64_Math_##f (Real64 x, Real64 y) { \
- return g (x, y); \
- } \
- Real32 Real32_Math_##f (Real32 x, Real32 y); \
- Real32 Real32_Math_##f (Real32 x, Real32 y) { \
- return (Real32)(Real64_Math_##f ((Real64)x, (Real64)y)); \
- }
+#define binaryReal(g, h) \
+Real64_t Real64_Math_##g (Real64_t x, Real64_t y); \
+Real64_t Real64_Math_##g (Real64_t x, Real64_t y) { \
+ return h (x, y); \
+} \
+Real32_t Real32_Math_##g (Real32_t x, Real32_t y); \
+Real32_t Real32_Math_##g (Real32_t x, Real32_t y) { \
+ return h##f (x, y); \
+}
binaryReal(atan2, atan2)
+binaryReal(pow, pow)
#undef binaryReal
-#define unaryReal(f, g) \
- Real64 Real64_Math_##f (Real64 x); \
- Real64 Real64_Math_##f (Real64 x) { \
- return g (x); \
- } \
- Real32 Real32_Math_##f (Real32 x); \
- Real32 Real32_Math_##f (Real32 x) { \
- return (Real32)(Real64_Math_##f ((Real64)x)); \
- }
+#define unaryReal(g, h) \
+Real64_t Real64_##g (Real64_t x); \
+Real64_t Real64_##g (Real64_t x) { \
+ return h (x); \
+} \
+Real32_t Real32_##g (Real32_t x); \
+Real32_t Real32_##g (Real32_t x) { \
+ return h##f (x); \
+}
unaryReal(acos, acos)
unaryReal(asin, asin)
unaryReal(atan, atan)
unaryReal(cos, cos)
+unaryReal(cosh, cosh)
unaryReal(exp, exp)
unaryReal(ln, log)
unaryReal(log10, log10)
unaryReal(sin, sin)
+unaryReal(sinh, sinh)
unaryReal(sqrt, sqrt)
unaryReal(tan, tan)
+unaryReal(tanh, tanh)
#undef unaryReal
-Real64 Real64_ldexp (Real64 x, Int32 i);
-Real64 Real64_ldexp (Real64 x, Int32 i) {
- return ldexp (x, i);
+Real64_t Real64_ldexp (Real64_t x, C_Int_t i);
+Real64_t Real64_ldexp (Real64_t x, C_Int_t i) {
+ return ldexp (x, i);
}
-Real32 Real32_ldexp (Real32 x, Int32 i);
-Real32 Real32_ldexp (Real32 x, Int32 i) {
- return (Real32)Real64_ldexp ((Real64)x, i);
+Real32_t Real32_ldexp (Real32_t x, C_Int_t i);
+Real32_t Real32_ldexp (Real32_t x, C_Int_t i) {
+ return ldexpf (x, i);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,57 +1,73 @@
#include "platform.h"
+C_Int_t Real32_class (Real32_t f);
+
#if HAS_FPCLASSIFY
-Int Real32_class (Real32 f) {
- return fpclassify (f);
+C_Int_t Real32_class (Real32_t f) {
+ return fpclassify (f);
}
#elif HAS_FPCLASSIFY32
-Int Real32_class (Real32 f) {
- return fpclassify32 (f);
+C_Int_t Real32_class (Real32_t f) {
+ return fpclassify32 (f);
}
#else
+/* This code assumes IEEE 754/854 and little endian.
+ *
+ * In memory, the 32 bits of a float are layed out as follows.
+ *
+ * d[0] bits 7-0 of mantissa
+ * d[1] bits 15-8 of mantissa
+ * d[2] bit 0 of exponent
+ * bits 22-16 of mantissa
+ * d[7] sign bit
+ * bits 7-2 of exponent
+ */
+
/* masks for word 0 */
#define EXPONENT_MASK32 0x7F800000
#define MANTISSA_MASK32 0x007FFFFF
#define SIGNBIT_MASK32 0x80000000
#define MANTISSA_HIGHBIT_MASK32 0x00400000
-Int Real32_class (Real32 f) {
- uint word0;
- int res;
+C_Int_t Real32_class (Real32_t f) {
+ uint32_t word0;
+ int res;
- word0 = ((uint *)&f)[0]; /* this generates a gcc warning */
- if ((word0 & EXPONENT_MASK32) == EXPONENT_MASK32) {
- if (word0 & MANTISSA_MASK32)
- res = FP_NAN;
- else
- res = FP_INFINITE;
- } else if (word0 & EXPONENT_MASK32)
- res = FP_NORMAL;
- else if (word0 & MANTISSA_MASK32)
- res = FP_SUBNORMAL;
- else
- res = FP_ZERO;
- return res;
+ word0 = ((uint32_t *)&f)[0]; /* this generates a gcc warning */
+ if ((word0 & EXPONENT_MASK32) == EXPONENT_MASK32) {
+ if (word0 & MANTISSA_MASK32)
+ res = FP_NAN;
+ else
+ res = FP_INFINITE;
+ } else if (word0 & EXPONENT_MASK32)
+ res = FP_NORMAL;
+ else if (word0 & MANTISSA_MASK32)
+ res = FP_SUBNORMAL;
+ else
+ res = FP_ZERO;
+ return res;
}
#endif
+C_Int_t Real64_class (Real64_t d);
+
#if HAS_FPCLASSIFY
-Int Real64_class (Real64 d) {
- return fpclassify (d);
+C_Int_t Real64_class (Real64_t d) {
+ return fpclassify (d);
}
#elif HAS_FPCLASSIFY64
-Int Real64_class (Real64 d) {
- return fpclassify64 (d);
+C_Int_t Real64_class (Real64_t d) {
+ return fpclassify64 (d);
}
#else
@@ -72,16 +88,6 @@
* bits 51-48 of mantissa
* d[7] sign bit
* bits 10-4 of exponent
- *
- *
- * In memory, the 32 bits of a float are layed out as follows.
- *
- * d[0] bits 7-0 of mantissa
- * d[1] bits 15-8 of mantissa
- * d[2] bit 0 of exponent
- * bits 22-16 of mantissa
- * d[7] sign bit
- * bits 7-2 of exponent
*/
/* masks for word 1 */
@@ -90,24 +96,24 @@
#define SIGNBIT_MASK64 0x80000000
#define MANTISSA_HIGHBIT_MASK64 0x00080000
-Int Real64_class (Real64 d) {
- Word word0, word1;
- Int res;
+C_Int_t Real64_class (Real64_t d) {
+ uint32_t word0, word1;
+ int res;
- word0 = ((Word *)&d)[0];
- word1 = ((Word *)&d)[1];
- if ((word1 & EXPONENT_MASK64) == EXPONENT_MASK64) {
- if (word0 or (word1 & MANTISSA_MASK64))
- res = FP_NAN;
- else
- res = FP_INFINITE;
- } else if (word1 & EXPONENT_MASK64)
- res = FP_NORMAL;
- else if (word0 or (word1 & MANTISSA_MASK64))
- res = FP_SUBNORMAL;
- else
- res = FP_ZERO;
- return res;
+ word0 = ((uint32_t*)&d)[0];
+ word1 = ((uint32_t*)&d)[1];
+ if ((word1 & EXPONENT_MASK64) == EXPONENT_MASK64) {
+ if (word0 or (word1 & MANTISSA_MASK64))
+ res = FP_NAN;
+ else
+ res = FP_INFINITE;
+ } else if (word1 & EXPONENT_MASK64)
+ res = FP_NORMAL;
+ else if (word0 or (word1 & MANTISSA_MASK64))
+ res = FP_SUBNORMAL;
+ else
+ res = FP_ZERO;
+ return res;
}
#else
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,9 +1,11 @@
#include "platform.h"
-Real64 Real64_frexp (Real64 x, Int *exp) {
- int exp_;
- Real64 res;
- res = frexp (x, &exp_);
- *exp = exp_;
- return res;
+Real32_t Real32_frexp (Real32_t x, Ref(C_Int_t) exp);
+Real32_t Real32_frexp (Real32_t x, Ref(C_Int_t) exp) {
+ return frexpf (x, (int*)exp);
}
+
+Real64_t Real64_frexp (Real64_t x, Ref(C_Int_t) exp);
+Real64_t Real64_frexp (Real64_t x, Ref(C_Int_t) exp) {
+ return frexp (x, (int*)exp);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -6,69 +6,71 @@
#endif
/* This code is patterned on g_dfmt from the gdtoa sources. */
-C_String_t Real64_gdtoa (double d, int mode, int ndig, int *decpt) {
- ULong bits[2];
- int ex;
- static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
- int i;
- ULong *L;
- char *result;
- ULong sign;
- int x0, x1;
-
- if (MLton_Platform_Arch_bigendian) {
- x0 = 0;
- x1 = 1;
- } else {
- x0 = 1;
- x1 = 0;
- }
- L = (ULong*)&d;
- sign = L[x0] & 0x80000000L;
- bits[0] = L[x1];
- bits[1] = L[x0] & 0xfffff;
- if (0 != (ex = (L[x0] >> 20) & 0x7ff))
- bits[1] |= 0x100000;
- else
- ex = 1;
- ex -= 0x3ff + 52;
- i = STRTOG_Normal;
- result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
- if (DEBUG)
- fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
- result, d, mode, ndig, *decpt);
- return (C_String_t)result;
+C_String_t Real32_gdtoa (Real32_t f, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt);
+C_String_t Real32_gdtoa (Real32_t f, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt) {
+ ULong bits[1];
+ int ex;
+ static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, 0 };
+ int i;
+ ULong *L;
+ char *result;
+ ULong sign;
+ int x0, x1;
+
+ if (MLton_Platform_Arch_bigendian) {
+ x0 = 0;
+ x1 = 1;
+ } else {
+ x0 = 1;
+ x1 = 0;
+ }
+ L = (ULong*)&f;
+ sign = L[0] & 0x80000000L;
+ bits[0] = L[0] & 0x7fffff;
+ if (0 != (ex = (L[0] >> 23) & 0xff))
+ bits[0] |= 0x800000;
+ else
+ ex = 1;
+ ex -= 0x7f + 23;
+ i = STRTOG_Normal;
+ result = gdtoa (&fpi, ex, bits, &i, mode, ndig, (int*)decpt, NULL);
+ if (DEBUG)
+ fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
+ result, (double)f, mode, ndig, *decpt);
+ return (C_String_t)result;
}
-C_String_t Real32_gdtoa (float f, int mode, int ndig, int *decpt) {
- ULong bits[1];
- int ex;
- static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, 0 };
- int i;
- ULong *L;
- char *result;
- ULong sign;
- int x0, x1;
-
- if (MLton_Platform_Arch_bigendian) {
- x0 = 0;
- x1 = 1;
- } else {
- x0 = 1;
- x1 = 0;
- }
- L = (ULong*)&f;
- sign = L[0] & 0x80000000L;
- bits[0] = L[0] & 0x7fffff;
- if (0 != (ex = (L[0] >> 23) & 0xff))
- bits[0] |= 0x800000;
- else
- ex = 1;
- ex -= 0x7f + 23;
- i = STRTOG_Normal;
- result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
- if (DEBUG)
- fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
- result, (double)f, mode, ndig, *decpt);
- return (C_String_t)result;
+C_String_t Real64_gdtoa (Real64_t d, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt);
+C_String_t Real64_gdtoa (Real64_t d, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt) {
+ ULong bits[2];
+ int ex;
+ static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
+ int i;
+ ULong *L;
+ char *result;
+ ULong sign;
+ int x0, x1;
+
+ if (MLton_Platform_Arch_bigendian) {
+ x0 = 0;
+ x1 = 1;
+ } else {
+ x0 = 1;
+ x1 = 0;
+ }
+ L = (ULong*)&d;
+ sign = L[x0] & 0x80000000L;
+ bits[0] = L[x1];
+ bits[1] = L[x0] & 0xfffff;
+ if (0 != (ex = (L[x0] >> 20) & 0x7ff))
+ bits[1] |= 0x100000;
+ else
+ ex = 1;
+ ex -= 0x3ff + 52;
+ i = STRTOG_Normal;
+ result = gdtoa (&fpi, ex, bits, &i, mode, ndig, (int*)decpt, NULL);
+ if (DEBUG)
+ fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
+ result, d, mode, ndig, *decpt);
+ return (C_String_t)result;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,12 +1,11 @@
#include "platform.h"
-Real64 Real64_modf (Real64 x, Real64 *exp) {
- return modf (x, exp);
+Real64_t Real64_modf (Real64_t x, Ref(Real64_t) exp);
+Real64_t Real64_modf (Real64_t x, Ref(Real64_t) exp) {
+ return modf (x, (Real64_t*)exp);
}
-Real32 Real32_modf (Real32 x, Real32 *exp) {
- Real64 exp_, res;
- res = modf ((Real64) x, &exp_);
- *exp = (Real32)exp_;
- return (Real32)res;
+Real32_t Real32_modf (Real32_t x, Ref(Real32_t) exp);
+Real32_t Real32_modf (Real32_t x, Ref(Real32_t) exp) {
+ return modff (x, (Real32_t*)exp);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,6 +1,12 @@
#include "platform.h"
/* nextafter is a macro, so we must have a C wrapper to work correctly. */
-Real64 Real64_nextAfter (Real64 x1, Real64 x2) {
- return nextafter (x1, x2);
+Real32_t Real32_nextAfter (Real32_t x1, Real32_t x2);
+Real32_t Real32_nextAfter (Real32_t x1, Real32_t x2) {
+ return nextafterf (x1, x2);
}
+
+Real64_t Real64_nextAfter (Real64_t x1, Real64_t x2);
+Real64_t Real64_nextAfter (Real64_t x1, Real64_t x2) {
+ return nextafter (x1, x2);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,23 +1,25 @@
#include "platform.h"
-Real32 Real32_Math_pi = (Real32)3.14159265358979323846;
-Real32 Real32_Math_e = (Real32)2.7182818284590452354;
+Real32_t Real32_Math_pi = (Real32_t)3.14159265358979323846;
+Real32_t Real32_Math_e = (Real32_t)2.7182818284590452354;
-Real32 Real32_maxFinite = 3.40282347e+38;
-Real32 Real32_minNormalPos = 1.17549435e-38;
-Real32 Real32_minPos = 1.40129846e-45;
+Real32_t Real32_maxFinite = 3.40282347e+38;
+Real32_t Real32_minNormalPos = 1.17549435e-38;
+Real32_t Real32_minPos = 1.40129846e-45;
-Real64 Real64_Math_pi = 3.14159265358979323846;
-Real64 Real64_Math_e = 2.7182818284590452354;
+Real64_t Real64_Math_pi = 3.14159265358979323846;
+Real64_t Real64_Math_e = 2.7182818284590452354;
-Real64 Real64_maxFinite = 1.7976931348623157e+308;
-Real64 Real64_minNormalPos = 2.2250738585072014e-308;
-Real64 Real64_minPos = 4.9406564584124654e-324;
+Real64_t Real64_maxFinite = 1.7976931348623157e+308;
+Real64_t Real64_minNormalPos = 2.2250738585072014e-308;
+Real64_t Real64_minPos = 4.9406564584124654e-324;
-#define ternary(size, name, op) \
- Real##size Real##size##_mul##name \
- (Real##size r1, Real##size r2, Real##size r3) { \
- return r1 * r2 op r3; \
+#define ternary(size, name, op) \
+ Real##size##_t Real##size##_mul##name \
+ (Real##size##_t r1, Real##size##_t r2, Real##size##_t r3); \
+ Real##size##_t Real##size##_mul##name \
+ (Real##size##_t r1, Real##size##_t r2, Real##size##_t r3) { \
+ return r1 * r2 op r3; \
}
ternary(32, add, +)
ternary(64, add, +)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,13 +1,16 @@
#include "platform.h"
+C_Int_t Real32_signBit (Real32_t f);
+C_Int_t Real64_signBit (Real64_t d);
+
#if HAS_SIGNBIT
-Int Real32_signBit (Real32 f) {
- return signbit (f);
+C_Int_t Real32_signBit (Real32_t f) {
+ return signbit (f);
}
-Int Real64_signBit (Real64 d) {
- return signbit (d);
+C_Int_t Real64_signBit (Real64_t d) {
+ return signbit (d);
}
#else
@@ -15,15 +18,15 @@
#if (defined __i386__)
enum {
- R32_byte = 3,
- R64_byte = 7,
+ R32_byte = 3,
+ R64_byte = 7,
};
#elif (defined __ppc__ || defined __sparc__)
enum {
- R32_byte = 0,
- R64_byte = 0,
+ R32_byte = 0,
+ R64_byte = 0,
};
#else
@@ -32,12 +35,12 @@
#endif
-Int Real32_signBit (Real32 f) {
- return (((unsigned char *)&f)[R32_byte] & 0x80) >> 7;
+C_Int_t Real32_signBit (Real32_t f) {
+ return (((unsigned char *)&f)[R32_byte] & 0x80) >> 7;
}
-Int Real64_signBit (Real64 d) {
- return (((unsigned char *)&d)[R64_byte] & 0x80) >> 7;
+C_Int_t Real64_signBit (Real64_t d) {
+ return (((unsigned char *)&d)[R64_byte] & 0x80) >> 7;
}
#endif
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,22 +1,24 @@
#include "platform.h"
-Real32 gdtoa_strtof (char *s, char **endptr);
-Real64 gdtoa_strtod (char *s, char **endptr);
+Real32_t gdtoa_strtof (char *s, char **endptr);
+Real64_t gdtoa_strtod (char *s, char **endptr);
-Real32 Real32_strto (Pointer s) {
- char *endptr;
- Real32 res;
-
- res = gdtoa_strtof ((char *)s, &endptr);
- assert (NULL != endptr);
- return res;
+Real32_t Real32_strto (NullString8_t s);
+Real32_t Real32_strto (NullString8_t s) {
+ char *endptr;
+ Real32_t res;
+
+ res = gdtoa_strtof ((char*)s, &endptr);
+ assert (NULL != endptr);
+ return res;
}
-Real64 Real64_strto (Pointer s) {
- char *endptr;
- Real64 res;
-
- res = gdtoa_strtod ((char *)s, &endptr);
- assert (NULL != endptr);
- return res;
+Real64_t Real64_strto (NullString8_t s);
+Real64_t Real64_strto (NullString8_t s) {
+ char *endptr;
+ Real64 res;
+
+ res = gdtoa_strtod ((char*)s, &endptr);
+ assert (NULL != endptr);
+ return res;
}
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 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,3 +1,6 @@
+# Posix.FileSys.PC.2_SYMLINKS = _const : C_Int.t
+# Posix.FileSys.Stat.getBlkCnt = _import : unit -> C_BlkCnt.t
+# Posix.FileSys.Stat.getBlkSize = _import : unit -> C_BlkSize.t
CommandLine.argc = _symbol : C_Int.t
CommandLine.argv = _symbol : C_StringArray.t
CommandLine.commandName = _symbol : C_String.t
@@ -24,6 +27,11 @@
Date.localTime = _import : C_Time.t ref -> C_Int.t C_Errno.t
Date.mkTime = _import : unit -> C_Time.t C_Errno.t
Date.strfTime = _import : Char8.t array * C_Size.t * NullString8.t -> C_Size.t
+IEEEReal.FloatClass.FP_INFINITE = _const : C_Int.t
+IEEEReal.FloatClass.FP_NAN = _const : C_Int.t
+IEEEReal.FloatClass.FP_NORMAL = _const : C_Int.t
+IEEEReal.FloatClass.FP_SUBNORMAL = _const : C_Int.t
+IEEEReal.FloatClass.FP_ZERO = _const : C_Int.t
IEEEReal.RoundingMode.FE_DOWNWARD = _const : C_Int.t
IEEEReal.RoundingMode.FE_NOSUPPORT = _const : C_Int.t
IEEEReal.RoundingMode.FE_TONEAREST = _const : C_Int.t
@@ -235,7 +243,6 @@
Posix.FileSys.O.TEXT = _const : C_Int.t
Posix.FileSys.O.TRUNC = _const : C_Int.t
Posix.FileSys.O.WRONLY = _const : C_Int.t
-# Posix.FileSys.PC.2_SYMLINKS = _const : C_Int.t
Posix.FileSys.PC.ALLOC_SIZE_MIN = _const : C_Int.t
Posix.FileSys.PC.ASYNC_IO = _const : C_Int.t
Posix.FileSys.PC.CHOWN_RESTRICTED = _const : C_Int.t
@@ -287,8 +294,6 @@
Posix.FileSys.ST.isSock = _import : C_Mode.t -> Bool.t
Posix.FileSys.Stat.fstat = _import : C_Fd.t -> C_Int.t C_Errno.t
Posix.FileSys.Stat.getATime = _import : unit -> C_Time.t
-# Posix.FileSys.Stat.getBlkCnt = _import : unit -> C_BlkCnt.t
-# Posix.FileSys.Stat.getBlkSize = _import : unit -> C_BlkSize.t
Posix.FileSys.Stat.getCTime = _import : unit -> C_Time.t
Posix.FileSys.Stat.getDev = _import : unit -> C_Dev.t
Posix.FileSys.Stat.getGId = _import : unit -> C_GId.t
@@ -329,9 +334,9 @@
Posix.FileSys.unlink = _import : NullString8.t -> C_Int.t C_Errno.t
Posix.IO.FD.CLOEXEC = _const : C_Fd.t
Posix.IO.FLock.F_GETLK = _const : C_Int.t
+Posix.IO.FLock.F_RDLCK = _const : C_Short.t
Posix.IO.FLock.F_SETLK = _const : C_Int.t
Posix.IO.FLock.F_SETLKW = _const : C_Int.t
-Posix.IO.FLock.F_RDLCK = _const : C_Short.t
Posix.IO.FLock.F_UNLCK = _const : C_Short.t
Posix.IO.FLock.F_WRLCK = _const : C_Short.t
Posix.IO.FLock.SEEK_CUR = _const : C_Short.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 15:28:59 UTC (rev 4410)
@@ -77,24 +77,6 @@
#define EXECVE execve
#endif
-#if not HAS_FPCLASSIFY
-#ifndef FP_INFINITE
-#define FP_INFINITE 1
-#endif
-#ifndef FP_NAN
-#define FP_NAN 0
-#endif
-#ifndef FP_NORMAL
-#define FP_NORMAL 4
-#endif
-#ifndef FP_SUBNORMAL
-#define FP_SUBNORMAL 3
-#endif
-#ifndef FP_ZERO
-#define FP_ZERO 2
-#endif
-#endif
-
#ifndef SPAWN_MODE
#define SPAWN_MODE 0
#endif
@@ -247,31 +229,6 @@
Word32 Word8Vector_subWord32Rev (Pointer v, Int offset);
/* ------------------------------------------------- */
-/* Real */
-/* ------------------------------------------------- */
-
-Real64 Real64_modf (Real64 x, Real64 *exp);
-Real32 Real32_modf (Real32 x, Real32 *exp);
-Real64 Real64_frexp (Real64 x, Int *exp);
-C_String_t Real64_gdtoa (double d, int mode, int ndig, int *decpt);
-C_String_t Real32_gdtoa (float f, int mode, int ndig, int *decpt);
-Int Real32_class (Real32 f);
-Int Real64_class (Real64 d);
-Real32 Real32_strto (Pointer s);
-Real64 Real64_strto (Pointer s);
-Real64 Real64_nextAfter (Real64 x1, Real64 x2);
-Int Real32_signBit (Real32 f);
-Int Real64_signBit (Real64 d);
-#define ternary(size, name) \
- Real##size Real##size##_mul##name \
- (Real##size r1, Real##size r2, Real##size r3);
-ternary(32, add)
-ternary(64, add)
-ternary(32, sub)
-ternary(64, sub)
-#undef ternary
-
-/* ------------------------------------------------- */
/* Socket */
/* ------------------------------------------------- */
|
|
From: Matthew F. <fl...@ml...> - 2006-04-24 19:43:33
|
Clean up before untarring ---------------------------------------------------------------------- U mlton/trunk/lib/ckit-lib/Makefile U mlton/trunk/lib/smlnj-lib/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/lib/ckit-lib/Makefile =================================================================== --- mlton/trunk/lib/ckit-lib/Makefile 2006-04-25 02:41:19 UTC (rev 4408) +++ mlton/trunk/lib/ckit-lib/Makefile 2006-04-25 02:43:32 UTC (rev 4409) @@ -9,6 +9,7 @@ all: ckit/README.mlton ckit/README.mlton: ckit.tgz ckit.patch + rm -rf ckit gzip -dc ckit.tgz | tar xf - chmod -R a+r ckit chmod -R g-s ckit Modified: mlton/trunk/lib/smlnj-lib/Makefile =================================================================== --- mlton/trunk/lib/smlnj-lib/Makefile 2006-04-25 02:41:19 UTC (rev 4408) +++ mlton/trunk/lib/smlnj-lib/Makefile 2006-04-25 02:43:32 UTC (rev 4409) @@ -9,6 +9,7 @@ all: smlnj-lib/README.mlton smlnj-lib/README.mlton: smlnj-lib.tgz smlnj-lib.patch + rm -rf smlnj-lib gzip -dc smlnj-lib.tgz | tar xf - chmod -R a+r smlnj-lib chmod -R g-s smlnj-lib |
