[MLton-commit] r5501
Matthew Fluet
fluet at mlton.org
Tue Apr 10 09:32:02 PDT 2007
Merge trunk revisions 5461:550 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/pack-word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/string-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/string.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/string0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/util/integral-comparisons.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/util/reader.sml
U mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-util.el
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/Socket.c
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/select.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Posix/FileSys/rename.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/hpux.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2007-04-10 16:31:54 UTC (rev 5501)
@@ -366,6 +366,9 @@
ifeq ($(TARGET_OS), darwin)
PREFIX := /usr/local
endif
+ifeq ($(TARGET_OS), freebsd)
+PREFIX := /usr/local
+endif
ifeq ($(TARGET_OS), mingw)
PREFIX := /mingw
endif
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -17,13 +17,8 @@
open A
val op +? = Int.+?
- val op + = Int.+
- val op -? = Int.-?
- val op - = Int.-
val op < = Int.<
val op <= = Int.<=
- val op > = Int.>
- val op >= = Int.>=
fun wrap2 f = fn (i, x) => f (SeqIndex.toIntUnsafe i, x)
@@ -54,7 +49,7 @@
fun copy (arg as {src, dst, di}) =
let val (src', si', len') = base src
in
- if src' = dst andalso si' < di andalso si' +? len' >= di
+ if src' = dst andalso si' < di andalso di <= si' +? len'
then let val sl = slice (dst, di, SOME (length src))
in
foldri' (fn (i, _, _) =>
@@ -73,7 +68,7 @@
fun make f arr = f (ArraySlice.full arr)
in
fun vector arr = make (ArraySlice.vector) arr
- fun modifyi' f = make (ArraySlice.modifyi' f)
+ (* fun modifyi' f = make (ArraySlice.modifyi' f) *)
fun modifyi f = make (ArraySlice.modifyi f)
fun modify f = make (ArraySlice.modify f)
fun copy {src, dst, di} = ArraySlice.copy {src = ArraySlice.full src,
@@ -87,7 +82,7 @@
val array' = new'
val array = new
- fun update' (arr, i, x) = updateMk' Primitive.Array.updateUnsafe (arr, i, x)
+ (* fun update' (arr, i, x) = updateMk' Primitive.Array.updateUnsafe (arr, i, x) *)
fun update (arr, i, x) = updateMk Primitive.Array.updateUnsafe (arr, i, x)
fun unsafeUpdate' (arr, i, x) = unsafeUpdateMk' Primitive.Array.updateUnsafe (arr, i, x)
fun unsafeUpdate (arr, i, x) = unsafeUpdateMk Primitive.Array.updateUnsafe (arr, i, x)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -99,7 +99,7 @@
end
end
- fun wholeRegion (a as {rows, cols, ...}: 'a array): 'a region =
+ fun wholeRegion (a : 'a array): 'a region =
{base = a, row = 0, col = 0, nrows = NONE, ncols = NONE}
datatype traversal = RowMajor | ColMajor
@@ -145,7 +145,7 @@
rows = 0,
cols = 0}
- fun unsafeSpot' (a as {cols, ...}: 'a array, r, c) =
+ fun unsafeSpot' ({cols, ...}: 'a array, r, c) =
r *? cols +? c
fun spot' (a as {rows, cols, ...}: 'a array, r, c) =
if Primitive.Controls.safe
@@ -190,7 +190,7 @@
| row1 :: _ =>
let
val cols = length row1
- val a as {array, rows = rows', cols = cols', ...} =
+ val a as {array, cols = cols', ...} =
arrayUninit (length rows, cols)
val _ =
List.foldl
@@ -244,7 +244,7 @@
end
else column' (a, SeqIndex.fromIntUnsafe c)
- fun foldi' trv f b (region as {base, row, col, ...}) =
+ fun foldi' trv f b (region as {base, ...}) =
let
val {startRow, stopRow, startCol, stopCol} = checkRegion region
in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun 2007-04-10 16:31:54 UTC (rev 5501)
@@ -77,17 +77,14 @@
val op +? = SeqIndex.+?
val op + = SeqIndex.+
val op -? = SeqIndex.-?
- val op - = SeqIndex.-
val op < = SeqIndex.<
val op <= = SeqIndex.<=
val op > = SeqIndex.>
val op >= = SeqIndex.>=
- val ltu = SeqIndex.ltu
- val leu = SeqIndex.leu
val gtu = SeqIndex.gtu
val geu = SeqIndex.geu
- fun wrap1 f = fn (i) => f (SeqIndex.toIntUnsafe i)
+ (* fun wrap1 f = fn (i) => f (SeqIndex.toIntUnsafe i) *)
fun wrap2 f = fn (i, x) => f (SeqIndex.toIntUnsafe i, x)
fun wrap3 f = fn (i, x, y) => f (SeqIndex.toIntUnsafe i, x, y)
fun unwrap1 f = fn (i) => f (SeqIndex.fromIntUnsafe i)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sig 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sig 2007-04-10 16:31:54 UTC (rev 5501)
@@ -30,6 +30,9 @@
| Small of SmallInt.int
val rep: int -> rep
+ val zero: int
+ val one: int
+
val +? : int * int -> int
val *? : int * int -> int
val -? : int * int -> int
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -379,17 +379,6 @@
in
val zextdFromSeqIndex = S.f
end
- local
- structure S =
- SeqIndex_ChooseIntN
- (type 'a t = 'a -> C_Size.word
- val fInt8 = C_Size.sextdFromInt8
- val fInt16 = C_Size.sextdFromInt16
- val fInt32 = C_Size.sextdFromInt32
- val fInt64 = C_Size.sextdFromInt64)
- in
- val sextdFromSeqIndex = S.f
- end
end
type bigInt = Prim.int
@@ -891,7 +880,7 @@
val badObjptrInt: I.int = I.~>>? (I.minInt', 0w1)
val badObjptrWord: W.word = W.idFromObjptrInt badObjptrInt
val badObjptrWordTagged: W.word = addTag badObjptrWord
- val badObjptrIntTagged: I.int = W.idToObjptrInt badObjptrWordTagged
+ (* val badObjptrIntTagged: I.int = W.idToObjptrInt badObjptrWordTagged *)
val negBadIntInf: bigInt = sextdFromObjptrInt (I.~ badObjptrInt)
(* Given two ObjptrWord.word's, check if they have the same 'high'/'sign' bit.
@@ -1256,12 +1245,6 @@
val zeroTag = zeroTag
val oneTag = oneTag
val oneTagCoerce = oneTagCoerce
-
- val numLimbs = numLimbs
- val bytesPerArrayHeader = bytesPerArrayHeader
- val reserve = reserve
-
- val toString = Prim.toString
end
val abs = bigAbs
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/pack-word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/pack-word.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/pack-word.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -55,19 +55,6 @@
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)
@@ -84,80 +71,56 @@
end
structure PackWord8Big: PACK_WORD =
- PackWord (val wordSize = Word8.wordSize
- val isBigEndian = true
+ PackWord (val isBigEndian = true
open Primitive.PackWord8
open Word8)
structure PackWord8Little: PACK_WORD =
- PackWord (val wordSize = Word8.wordSize
- val isBigEndian = false
+ PackWord (val isBigEndian = false
open Primitive.PackWord8
open Word8)
structure PackWord8Host: PACK_WORD =
- PackWord (val wordSize = Word8.wordSize
- val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.PackWord8
open Word8)
structure PackWord16Big: PACK_WORD =
- PackWord (val wordSize = Word16.wordSize
- val isBigEndian = true
+ PackWord (val isBigEndian = true
open Primitive.PackWord16
open Word16)
structure PackWord16Little: PACK_WORD =
- PackWord (val wordSize = Word16.wordSize
- val isBigEndian = false
+ PackWord (val isBigEndian = false
open Primitive.PackWord16
open Word16)
structure PackWord16Host: PACK_WORD =
- PackWord (val wordSize = Word16.wordSize
- val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.PackWord16
open Word16)
structure PackWord32Big: PACK_WORD =
- PackWord (val wordSize = Word32.wordSize
- val isBigEndian = true
+ PackWord (val isBigEndian = true
open Primitive.PackWord32
open Word32)
structure PackWord32Little: PACK_WORD =
- PackWord (val wordSize = Word32.wordSize
- val isBigEndian = false
+ PackWord (val isBigEndian = false
open Primitive.PackWord32
open Word32)
structure PackWord32Host: PACK_WORD =
- PackWord (val wordSize = Word32.wordSize
- val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.PackWord32
open Word32)
structure PackWord64Big: PACK_WORD =
- PackWord (val wordSize = Word64.wordSize
- val isBigEndian = true
+ PackWord (val isBigEndian = true
open Primitive.PackWord64
open Word64)
structure PackWord64Little: PACK_WORD =
- PackWord (val wordSize = Word64.wordSize
- val isBigEndian = false
+ PackWord (val isBigEndian = false
open Primitive.PackWord64
open Word64)
structure PackWord64Host: PACK_WORD =
- PackWord (val wordSize = Word64.wordSize
- val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.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
@@ -194,36 +157,21 @@
end
in
structure PackWordBig: PACK_WORD =
- PackWord (val wordSize = Word.wordSize
- val isBigEndian = true
+ PackWord (val isBigEndian = true
open PackWord
open Word)
structure PackWordLittle: PACK_WORD =
- PackWord (val wordSize = Word.wordSize
- val isBigEndian = false
+ PackWord (val isBigEndian = false
open PackWord
open Word)
structure PackWordHost: PACK_WORD =
- PackWord (val wordSize = Word.wordSize
- val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ PackWord (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
@@ -260,18 +208,15 @@
end
in
structure PackLargeWordBig: PACK_WORD =
- PackWord (val wordSize = LargeWord.wordSize
- val isBigEndian = true
+ PackWord (val isBigEndian = true
open PackLargeWord
open LargeWord)
structure PackLargeWordLittle: PACK_WORD =
- PackWord (val wordSize = LargeWord.wordSize
- val isBigEndian = false
+ PackWord (val isBigEndian = false
open PackLargeWord
open LargeWord)
structure PackLargeWordHost: PACK_WORD =
- PackWord (val wordSize = LargeWord.wordSize
- val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open PackLargeWord
open LargeWord)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -122,17 +122,23 @@
end)
end
+(*
fun fmt radix (w: word): string =
- let val radix = fromInt (StringCvt.radixToInt radix)
+ let
+ val radix = fromInt (StringCvt.radixToInt radix)
fun loop (q, chars) =
- let val chars = StringCvt.digitToChar (toInt (q mod radix)) :: chars
+ let
+ val chars = StringCvt.digitToChar (toInt (q mod radix)) :: chars
val q = q div radix
- in if q = zero
+ in
+ if q = zero
then String.implode chars
else loop (q, chars)
end
- in loop (w, [])
+ in
+ loop (w, [])
end
+*)
val toString = fmt StringCvt.HEX
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/ffi.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/ffi.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -47,12 +47,16 @@
(* To the C-world, chars are signed integers. *)
val getChar8 = Primitive.Char8.idFromInt8 o getInt8
+(*
val getChar16 = Primitive.Char16.idFromInt16 o getInt16
val getChar32 = Primitive.Char32.idFromInt32 o getInt32
+*)
val setChar8 = setInt8 o Primitive.Char8.idToInt8
+(*
val setChar16 = setInt16 o Primitive.Char16.idToInt16
val setChar32 = setInt32 o Primitive.Char32.idToInt32
+*)
(* To the C-world, booleans are 32-bit integers. *)
fun intToBool (i: Int32.int): bool = i <> 0
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -242,7 +242,7 @@
; dup2 (stdout, FileSys.stdout)
; dup2 (stderr, FileSys.stderr)
; ignore (Process.exece (path, base :: args, env))
- ; Process.exit 0w1 (* just in case *)
+ ; Process.exit 0w127 (* just in case *)
end
| SOME pid => pid (* parent *)
@@ -330,7 +330,8 @@
end
else
case Posix.Process.fork () of
- NONE => Posix.Process.exece (path, args, env)
+ NONE => (Posix.Process.exece (path, args, env) handle _ => ()
+ ; Posix.Process.exit 0w127)
| SOME pid => pid
fun spawn {args, path}=
@@ -352,7 +353,8 @@
end
else
case Posix.Process.fork () of
- NONE => Posix.Process.execp (file, args)
+ NONE => (Posix.Process.execp (file, args) handle _ => ()
+ ; Posix.Process.exit 0w127)
| SOME pid => pid
open Exit
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -19,18 +19,15 @@
fun toAddr (in_addr, port) =
let
- val port = C_Int.fromInt port
- val port = Net.C_Int.hton port
+ val port = Word16.fromInt port
+ handle Overflow => PosixError.raiseSys PosixError.inval
+ val port = Net.Word16.hton port
+ val (sa, salen, finish) = Socket.new_sock_addr ()
+ val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
+ port, sa, salen)
+
in
- if C_Int.< (port, 0) orelse C_Int.>= (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
+ finish ()
end
fun any port = toAddr (NetHostDB.any (), port)
@@ -39,8 +36,8 @@
let
val () = Prim.fromAddr (Socket.unpackSockAddr sa)
val port = Prim.getPort ()
- val port = Net.C_Int.ntoh port
- val port = C_Int.toInt port
+ val port = Net.Word16.ntoh port
+ val port = Word16.toInt port
val (ia, finish) = NetHostDB.new_in_addr ()
val _ = Prim.getInAddr (NetHostDB.preInAddrToWord8Array ia)
in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sig 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sig 2007-04-10 16:31:54 UTC (rev 5501)
@@ -7,6 +7,11 @@
signature NET =
sig
+ structure Word16 :
+ sig
+ val hton: Word16.word -> Word16.word
+ val ntoh: Word16.word -> Word16.word
+ end
structure C_Int :
sig
val hton: C_Int.t -> C_Int.t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -306,7 +306,7 @@
make (boolLen, marshalBool, unmarshalBool)
val (getSockOptSize, getIOCtlSize, setSockOptSize, _) =
make (sizeLen, marshalSize, unmarshalSize)
- val (getSockOptOptTime, getIOCtlOptTime, setSockOptOptTime, _) =
+ val (getSockOptOptTime, _, setSockOptOptTime, _) =
make (optTimeLen, marshalOptTime, unmarshalOptTime)
end
@@ -335,7 +335,7 @@
in
if 0 = se
then NONE
- else SOME (Posix.Error.errorMsg se, SOME se)
+ else SOME (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 -> C_Int.int C_Errno.t) =
@@ -445,51 +445,73 @@
in Syscall.simple (fn () => Prim.shutdown (s, m))
end
-type sock_desc = OS.IO.iodesc
+type sock_desc = FileSys.file_desc
-fun sockDesc sock = FileSys.fdToIOD (sockToFD sock)
+fun sockDesc sock = sockToFD sock
-fun sameDesc (desc1, desc2) =
- OS.IO.compare (desc1, desc2) = EQUAL
+fun sameDesc (desc1, desc2) = desc1 = desc2
fun select {rds: sock_desc list,
wrs: sock_desc list,
exs: sock_desc list,
timeout: Time.time option} =
let
- fun mk poll (sd,pds) =
- let
- val pd = Option.valOf (OS.IO.pollDesc sd)
- val pd = poll pd
- in
- pd::pds
- end
- val pds =
- (List.foldr (mk OS.IO.pollIn)
- (List.foldr (mk OS.IO.pollOut)
- (List.foldr (mk OS.IO.pollPri)
- [] exs) wrs) rds)
- val pis = OS.IO.poll (pds, timeout)
- val {rds, wrs, exs} =
- List.foldr
- (fn (pi,{rds,wrs,exs}) =>
- let
- fun mk (is,l) =
- if is pi
- then (OS.IO.pollToIODesc (OS.IO.infoToPollDesc pi))::l
- else l
- in
- {rds = mk (OS.IO.isIn, rds),
- wrs = mk (OS.IO.isOut, wrs),
- exs = mk (OS.IO.isPri, exs)}
- end)
- {rds = [], wrs = [], exs = []}
- pis
+ local
+ fun mk l =
+ let
+ val vec = Vector.fromList l
+ val arr = Array.array (Vector.length vec, 0)
+ in
+ (vec, arr)
+ end
+ in
+ val (read_vec, read_arr) = mk rds
+ val (write_vec, write_arr) = mk wrs
+ val (except_vec, except_arr) = mk exs
+ end
+ val setTimeout =
+ case timeout of
+ NONE => Prim.setTimeoutNull
+ | SOME t =>
+ if Time.< (t, Time.zeroTime)
+ then Error.raiseSys Error.inval
+ else let
+ val q = LargeInt.quot (Time.toMicroseconds t, 1000000)
+ val q = C_Time.fromLargeInt q
+ val r = LargeInt.rem (Time.toMicroseconds t, 1000000)
+ val r = C_SUSeconds.fromLargeInt r
+ in
+ fn () => Prim.setTimeout (q, r)
+ end handle Overflow => Error.raiseSys Error.inval
+ val res =
+ Syscall.simpleResult
+ (fn () =>
+ (setTimeout ()
+ ; Prim.select (read_vec, write_vec, except_vec,
+ read_arr, write_arr, except_arr)))
+ val (rds, wrs, exs) =
+ if res = 0
+ then ([],[],[])
+ else
+ let
+ fun mk (l, arr) =
+ (List.rev o #1)
+ (List.foldl (fn (sd, (l, i)) =>
+ (if Array.sub (arr, i) <> 0 then sd::l else l, i + 1))
+ ([],0)
+ l)
+ in
+ (mk (rds, read_arr),
+ mk (wrs, write_arr),
+ mk (exs, except_arr))
+ end
in
- {rds = rds, wrs = wrs, exs = exs}
+ {rds = rds,
+ wrs = wrs,
+ exs = exs}
end
-val ioDesc = sockDesc
+val ioDesc = FileSys.fdToIOD o sockDesc
type out_flags = {don't_route: bool, oob: bool}
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sig 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sig 2007-04-10 16:31:54 UTC (rev 5501)
@@ -63,6 +63,7 @@
val cleared: syserror
val raiseSys: syserror -> 'a
+ val raiseSysWithMsg: syserror * string -> 'a
structure SysCall :
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -221,6 +221,7 @@
end
fun raiseSys n = raise SysErr (errorMsg n, SOME n)
+ fun raiseSysWithMsg (n, msg) = raise SysErr ((errorMsg n) ^ ": " ^ msg, SOME n)
structure SysCall =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -224,13 +224,19 @@
local
structure Times = Prim.Times
- val ticksPerSec = SysWord.toLargeIntX (sysconf "CLK_TCK")
+ val clocksPerSec =
+ (* syconf is not implemented on MinGW;
+ * we don't want a SysErr during Basis Library initialization.
+ *)
+ if (let open Primitive.MLton.Platform.OS in host = MinGW end)
+ then LargeInt.zero
+ else SysWord.toLargeIntX (sysconf "CLK_TCK")
- fun cvt (ticks: C_Clock.t) =
+ fun cvt (clocks: C_Clock.t) =
Time.fromTicks (LargeInt.quot
- (LargeInt.* (C_Clock.toLargeInt ticks,
+ (LargeInt.* (C_Clock.toLargeInt clocks,
Time.ticksPerSecond),
- ticksPerSec))
+ clocksPerSec))
in
fun times () =
SysCall.syscall'
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -15,7 +15,7 @@
then ()
else (PrimitiveFFI.Stdio.print msg
; PrimitiveFFI.Stdio.print "\n")
- ; Error.raiseSys Error.nosys)
+ ; Error.raiseSysWithMsg (Error.nosys, msg))
else f
in
structure PrimitiveFFI =
@@ -83,7 +83,6 @@
val getgroups = stub ("getgroups", getgroups)
val getlogin = stub ("getlogin", getlogin)
val getpgrp = stub ("getpgrp", getpgrp)
- val getpid = stub ("getpid", getpid)
val getppid = stub ("getppid", getppid)
val getuid = stub ("getuid", getuid)
val setgid = stub ("setgid", setgid)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -1087,6 +1087,8 @@
val socket = _import "Socket_GenericSock_socket" : C_Int.t * C_Int.t * C_Int.t -> (C_Int.t) C_Errno.t;
val socketPair = _import "Socket_GenericSock_socketPair" : C_Int.t * C_Int.t * C_Int.t * (C_Int.t) array -> (C_Int.t) C_Errno.t;
end
+val getTimeout_sec = _import "Socket_getTimeout_sec" : unit -> C_Time.t;
+val getTimeout_usec = _import "Socket_getTimeout_usec" : unit -> C_SUSeconds.t;
structure INetSock =
struct
structure Ctl =
@@ -1096,8 +1098,8 @@
end
val fromAddr = _import "Socket_INetSock_fromAddr" : (Word8.t) vector -> unit;
val getInAddr = _import "Socket_INetSock_getInAddr" : (Word8.t) array -> unit;
-val getPort = _import "Socket_INetSock_getPort" : unit -> C_Int.t;
-val toAddr = _import "Socket_INetSock_toAddr" : (Word8.t) vector * C_Int.t * (Word8.t) array * (C_Socklen.t) ref -> unit;
+val getPort = _import "Socket_INetSock_getPort" : unit -> Word16.t;
+val toAddr = _import "Socket_INetSock_toAddr" : (Word8.t) vector * Word16.t * (Word8.t) array * (C_Socklen.t) ref -> unit;
end
val listen = _import "Socket_listen" : C_Sock.t * C_Int.t -> (C_Int.t) C_Errno.t;
val MSG_CTRUNC = _const "Socket_MSG_CTRUNC" : C_Int.t;
@@ -1110,10 +1112,13 @@
val MSG_WAITALL = _const "Socket_MSG_WAITALL" : C_Int.t;
val recv = _import "Socket_recv" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t -> (C_SSize.t) C_Errno.t;
val recvFrom = _import "Socket_recvFrom" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t * (Word8.t) array * (C_Socklen.t) ref -> (C_SSize.t) C_Errno.t;
+val select = _import "Socket_select" : (C_Fd.t) vector * (C_Fd.t) vector * (C_Fd.t) vector * (C_Int.t) array * (C_Int.t) array * (C_Int.t) array -> (C_Int.t) C_Errno.t;
val sendArr = _import "Socket_sendArr" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t -> (C_SSize.t) C_Errno.t;
val sendArrTo = _import "Socket_sendArrTo" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t * (Word8.t) vector * C_Socklen.t -> (C_SSize.t) C_Errno.t;
val sendVec = _import "Socket_sendVec" : C_Sock.t * (Word8.t) vector * C_Int.t * C_Size.t * C_Int.t -> (C_SSize.t) C_Errno.t;
val sendVecTo = _import "Socket_sendVecTo" : C_Sock.t * (Word8.t) vector * C_Int.t * C_Size.t * C_Int.t * (Word8.t) vector * C_Socklen.t -> (C_SSize.t) C_Errno.t;
+val setTimeout = _import "Socket_setTimeout" : C_Time.t * C_SUSeconds.t -> unit;
+val setTimeoutNull = _import "Socket_setTimeoutNull" : unit -> unit;
val SHUT_RD = _const "Socket_SHUT_RD" : C_Int.t;
val SHUT_RDWR = _const "Socket_SHUT_RDWR" : C_Int.t;
val SHUT_WR = _const "Socket_SHUT_WR" : C_Int.t;
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -59,9 +59,9 @@
other : {precision: Primitive.Int32.int}} =
if R.precision = #precision other
then (fromRealUnsafe,
- fn (m: rounding_mode) => fromRealUnsafe,
+ fn (_: rounding_mode) => fromRealUnsafe,
toRealUnsafe,
- fn (m: rounding_mode) => toRealUnsafe)
+ fn (_: rounding_mode) => toRealUnsafe)
else (fromRealUnsafe,
fn (m: rounding_mode) => fn r =>
IEEEReal.withRoundingMode (m, fn () => fromRealUnsafe r),
@@ -69,11 +69,11 @@
fn (m: rounding_mode) => fn r =>
IEEEReal.withRoundingMode (m, fn () => toRealUnsafe r))
in
- val (fromReal32,fromReal32M,toReal32,toReal32M) =
+ val (_,fromReal32M,toReal32,_) =
make {fromRealUnsafe = R.fromReal32Unsafe,
toRealUnsafe = R.toReal32Unsafe,
other = {precision = Primitive.Real32.precision}}
- val (fromReal64,fromReal64M,toReal64,toReal64M) =
+ val (_,fromReal64M,toReal64,_) =
make {fromRealUnsafe = R.fromReal64Unsafe,
toRealUnsafe = R.toReal64Unsafe,
other = {precision = Primitive.Real64.precision}}
@@ -135,8 +135,6 @@
fun isNormal r = class r = NORMAL
- fun isNormal r = class r = NORMAL
-
val op ?= =
if MLton.Codegen.isNative
then R.?=
@@ -641,22 +639,22 @@
else raise Overflow)
end
in
- val (fromInt8,fromInt8M,toInt8,toInt8M) =
+ val (fromInt8,_,_,toInt8M) =
make {fromIntUnsafe = R.fromInt8Unsafe,
toIntUnsafe = R.toInt8Unsafe,
other = {maxInt' = Int8.maxInt',
minInt' = Int8.minInt'}}
- val (fromInt16,fromInt16M,toInt16,toInt16M) =
+ val (fromInt16,_,_,toInt16M) =
make {fromIntUnsafe = R.fromInt16Unsafe,
toIntUnsafe = R.toInt16Unsafe,
other = {maxInt' = Int16.maxInt',
minInt' = Int16.minInt'}}
- val (fromInt32,fromInt32M,toInt32,toInt32M) =
+ val (fromInt32,_,_,toInt32M) =
make {fromIntUnsafe = R.fromInt32Unsafe,
toIntUnsafe = R.toInt32Unsafe,
other = {maxInt' = Int32.maxInt',
minInt' = Int32.minInt'}}
- val (fromInt64,fromInt64M,toInt64,toInt64M) =
+ val (fromInt64,_,_,toInt64M) =
make {fromIntUnsafe = R.fromInt64Unsafe,
toIntUnsafe = R.toInt64Unsafe,
other = {maxInt' = Int64.maxInt',
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/system/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/file-sys.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/file-sys.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -38,61 +38,67 @@
structure P = OS_Path
- (* A UNIX specific implementation of fullPath *)
+ val isMinGW = let open Primitive.MLton.Platform.OS in host = MinGW end
+
+ (* An implementation of fullPath which works on Unix and Windows (Cygwin and MinGW) *)
fun fullPath p =
let
val oldCWD = getDir()
- fun mkPath pathFromRoot =
+ fun mkPath (pathFromRoot, vol) =
P.toString {arcs = List.rev pathFromRoot,
isAbs = true,
- vol = ""}
- fun walkPath (n, pathFromRoot, arcs) =
+ vol = vol}
+ fun walkPath (n, pathFromRoot, arcs, vol) =
if n = 0
then raise PosixError.SysErr ("too many links", NONE)
else
case arcs of
- [] => mkPath pathFromRoot
+ [] => mkPath (pathFromRoot, vol)
| arc :: al =>
if arc = "" orelse arc = "."
- then walkPath (n, pathFromRoot, al)
+ then walkPath (n, pathFromRoot, al, vol)
else if arc = ".."
then
case pathFromRoot of
- [] => walkPath (n, [], al)
+ [] => walkPath (n, [], al, vol)
| _ :: r =>
- (chDir ".."; walkPath (n, r, al))
+ (chDir ".."; walkPath (n, r, al, vol))
else
if isLink arc
- then expandLink (n, pathFromRoot, arc, al)
+ then expandLink (n, pathFromRoot, arc, al, vol)
else
case al of
- [] => mkPath (arc :: pathFromRoot)
+ [] => mkPath (arc :: pathFromRoot, vol)
| _ =>
(chDir arc
- ; walkPath (n, arc :: pathFromRoot, al))
- and expandLink (n, pathFromRoot, link, rest) =
+ ; walkPath (n, arc :: pathFromRoot, al, vol))
+ and expandLink (n, pathFromRoot, link, rest, vol) =
let
val {isAbs, arcs, ...} = P.fromString (readLink link)
val arcs = List.@ (arcs, rest)
in
if isAbs
- then gotoRoot (n-1, arcs)
- else walkPath (n-1, pathFromRoot, arcs)
+ then gotoRoot (n-1, arcs, vol)
+ else walkPath (n-1, pathFromRoot, arcs, vol)
end
- and gotoRoot (n, arcs) =
- (chDir "/"; walkPath (n, [], arcs))
- fun computeFullPath arcs =
- (gotoRoot (maxLinks, arcs) before chDir oldCWD)
+ (* If the volume is not empty, chDir to it rather than to "/" *)
+ and gotoRoot (n, arcs, vol) =
+ (if vol <> ""
+ then chDir (vol ^ (if isMinGW then "\\" else "/"))
+ else chDir "/"
+ ; walkPath (n, [], arcs, vol))
+ fun computeFullPath (arcs, vol) =
+ (gotoRoot (maxLinks, arcs, vol) before chDir oldCWD)
handle ex => (chDir oldCWD; raise ex)
in
case (P.fromString p)
of {isAbs=false, arcs, ...} =>
let
- val {arcs=arcs', ...} = P.fromString(oldCWD)
+ val {arcs=arcs', vol=vol, ...} = P.fromString(oldCWD)
in
- computeFullPath (List.@(arcs', arcs))
+ computeFullPath (List.@(arcs', arcs), vol)
end
- | {isAbs=true, arcs, ...} => computeFullPath arcs
+ | {isAbs=true, arcs, vol} => computeFullPath (arcs, vol)
end
fun realPath p =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -23,8 +23,6 @@
datatype iodesc_kind = K of string
- type file_desc = Posix.FileSys.file_desc
-
val iodToFd = fn x => x
val fdToIod = fn x => x
@@ -118,7 +116,7 @@
NONE => ~1
| SOME t =>
if Time.< (t, Time.zeroTime)
- then let open PosixError in raiseSys inval end
+ then Error.raiseSys Error.inval
else (C_Int.fromLarge (Time.toMilliseconds t)
handle Overflow => Error.raiseSys Error.inval)
val reventss = Array.array (n, 0)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/text/string-global.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/text/string-global.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/text/string-global.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -16,10 +16,3 @@
case e of
Fail s => SOME (concat ["Fail: ", s])
| _ => NONE)
-
-structure NullString =
- struct
- open Primitive.NullString8
-
- val nullTerm = fromString o String.nullTerm
- end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/text/string.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/text/string.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/text/string.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -91,14 +91,12 @@
struct
structure Char = Char
structure CharVector = CharVector
- structure CharArray = CharArray
end
structure WideStringArg : STRING_ARG =
struct
structure Char = WideChar
structure CharVector = WideCharVector
- structure CharArray = WideCharArray
end
structure String : STRING_EXTRA = StringFn(StringArg)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/text/string0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/text/string0.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/text/string0.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -6,18 +6,14 @@
* See the file MLton-LICENSE for details.
*)
-(* This is the minimum needed to bootstrap StringCvt *)
structure String =
struct
- (* CharVector comes from mono.sml and default-charX.sml *)
open CharVector
- type char = elem
type string = vector
val size = length
val op ^ = append
val implode = fromList
- val explode = toList
val new = vector
end
@@ -25,13 +21,11 @@
structure WideString =
struct
open WideCharVector
- type char = elem
type string = vector
val size = length
val op ^ = append
val implode = fromList
- val explode = toList
val new = vector
end
*)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/util/integral-comparisons.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/util/integral-comparisons.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/util/integral-comparisons.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -8,7 +8,7 @@
functor IntegralComparisons (type t
val < : t * t -> bool) =
struct
- val < = <
+ val < : t * t -> bool = <
fun <= (a, b) = not (< (b, a))
fun > (a, b) = < (b, a)
fun >= (a, b) = <= (b, a)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/util/reader.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/util/reader.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/util/reader.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -13,30 +13,6 @@
type ('a, 'b) reader = 'b -> ('a * 'b) option
-(* local
- * fun make finish p reader state =
- * let
- * fun loop (state, token, tokens) =
- * case reader state of
- * NONE => SOME (rev (finish (token, tokens)), state)
- * | SOME (x, state) =>
- * let
- * val (token, tokens) =
- * if p x then ([], finish (token, tokens))
- * else (x :: token, tokens)
- * in loop (state, token, tokens)
- * end
- * in loop (state, [], [])
- * end
- * in
- * fun tokens p = make (fn (token, tokens) =>
- * case token of
- * [] => tokens
- * | _ => (rev token) :: tokens) p
- * fun fields p = make (fn (field, fields) => (rev field) :: fields) p
- * end
- *)
-
fun list (reader: ('a, 'b) reader): ('a list, 'b) reader =
fn state =>
let
Modified: mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-util.el
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-util.el 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-util.el 2007-04-10 16:31:54 UTC (rev 5501)
@@ -8,7 +8,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SML metadata
-(defconst esml-sml-symbolic-chars "-!%&$#+/:<=>?@~`^|*\\"
+(defconst esml-sml-symbolic-chars "-!%&$#+/:<=>?@~`^|*\\\\"
"A string of all Standard ML symbolic characters as defined in section
2.4 of the Definition.")
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 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2007-04-10 16:31:54 UTC (rev 5501)
@@ -39,15 +39,18 @@
}
C_Int_t NetHostDB_getByAddress(Vector(Word8_t) addr, C_Socklen_t len) {
+ MLton_initSockets ();
hostent = gethostbyaddr((const char*)addr, len, AF_INET);
return (C_Int_t)(hostent != NULL and hostent->h_name != NULL);
}
C_Int_t NetHostDB_getByName(NullString8_t name) {
+ MLton_initSockets ();
hostent = gethostbyname((const char*)name);
return (C_Int_t)(hostent != NULL and hostent->h_name != NULL);
}
C_Errno_t(C_Int_t) NetHostDB_getHostName(Array(Char8_t) buf, C_Size_t len) {
+ MLton_initSockets ();
return gethostname ((char*)buf, len);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/INetSock.c 2007-04-10 16:31:54 UTC (rev 5501)
@@ -1,17 +1,17 @@
#include "platform.h"
void
-Socket_INetSock_toAddr (Vector(Word8_t) in_addr, C_Int_t port,
+Socket_INetSock_toAddr (Vector(Word8_t) in_addr, Word16_t port,
Array(Word8_t) addr, Ref(C_Socklen_t) addrlen) {
struct sockaddr_in *sa = (struct sockaddr_in*)addr;
sa->sin_family = AF_INET;
- sa->sin_port = port;
+ sa->sin_port = (uint16_t)port;
sa->sin_addr = *(const struct in_addr*)in_addr;
*((socklen_t*)addrlen) = sizeof(struct sockaddr_in);
}
-static int fromAddr_port;
+static uint16_t fromAddr_port;
static struct in_addr fromAddr_in_addr;
void Socket_INetSock_fromAddr (Vector(Word8_t) addr) {
@@ -22,8 +22,8 @@
fromAddr_in_addr = sa->sin_addr;
}
-C_Int_t Socket_INetSock_getPort (void) {
- return fromAddr_port;
+Word16_t Socket_INetSock_getPort (void) {
+ return (Word16_t)fromAddr_port;
}
void Socket_INetSock_getInAddr (Array(Word8_t) addr) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/Socket.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/Socket.c 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/Socket.c 2007-04-10 16:31:54 UTC (rev 5501)
@@ -11,7 +11,11 @@
}
C_Errno_t(C_Int_t) Socket_close(C_Sock_t s) {
+#ifdef __MINGW32__
+ return closesocket(s);
+#else
return close(s);
+#endif
}
C_Errno_t(C_Int_t) Socket_connect (C_Sock_t s, Vector(Word8_t) addr, C_Socklen_t addrlen) {
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/select.c (from rev 5500, mlton/trunk/runtime/basis/Net/Socket/select.c)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Posix/FileSys/rename.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Posix/FileSys/rename.c 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Posix/FileSys/rename.c 2007-04-10 16:31:54 UTC (rev 5501)
@@ -1,5 +1,17 @@
#include "platform.h"
C_Errno_t(C_Int_t) Posix_FileSys_rename (NullString8_t p1, NullString8_t p2) {
- return rename ((const char*) p1, (const char*) p2);
+ C_Errno_t(C_Int_t) res;
+ res = rename ((const char *) p1, (const char *) p2);
+#ifdef __MINGW32__
+ /* the MinGW rename() function does not remove the destination file
+ * if it exists; we emulate the Unix behavior here.
+ */
+ if ((res != 0) && (errno == EEXIST)) {
+ res = unlink ((const char *) p2);
+ if (res == 0)
+ res = rename((const char *) p1, (const char *) p2);
+ }
+#endif
+ return res;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h 2007-04-10 16:31:54 UTC (rev 5501)
@@ -899,12 +899,14 @@
C_Int_t Socket_familyOfAddr(Vector(Word8_t));
C_Errno_t(C_Int_t) Socket_GenericSock_socket(C_Int_t,C_Int_t,C_Int_t);
C_Errno_t(C_Int_t) Socket_GenericSock_socketPair(C_Int_t,C_Int_t,C_Int_t,Array(C_Int_t));
+C_Time_t Socket_getTimeout_sec(void);
+C_SUSeconds_t Socket_getTimeout_usec(void);
extern const C_Int_t Socket_INetSock_Ctl_IPPROTO_TCP;
extern const C_Int_t Socket_INetSock_Ctl_TCP_NODELAY;
void Socket_INetSock_fromAddr(Vector(Word8_t));
void Socket_INetSock_getInAddr(Array(Word8_t));
-C_Int_t Socket_INetSock_getPort(void);
-void Socket_INetSock_toAddr(Vector(Word8_t),C_Int_t,Array(Word8_t),Ref(C_Socklen_t));
+Word16_t Socket_INetSock_getPort(void);
+void Socket_INetSock_toAddr(Vector(Word8_t),Word16_t,Array(Word8_t),Ref(C_Socklen_t));
C_Errno_t(C_Int_t) Socket_listen(C_Sock_t,C_Int_t);
extern const C_Int_t Socket_MSG_CTRUNC;
extern const C_Int_t Socket_MSG_DONTROUTE;
@@ -916,10 +918,13 @@
extern const C_Int_t Socket_MSG_WAITALL;
C_Errno_t(C_SSize_t) Socket_recv(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t);
C_Errno_t(C_SSize_t) Socket_recvFrom(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t,Array(Word8_t),Ref(C_Socklen_t));
+C_Errno_t(C_Int_t) Socket_select(Vector(C_Fd_t),Vector(C_Fd_t),Vector(C_Fd_t),Array(C_Int_t),Array(C_Int_t),Array(C_Int_t));
C_Errno_t(C_SSize_t) Socket_sendArr(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t);
C_Errno_t(C_SSize_t) Socket_sendArrTo(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t,Vector(Word8_t),C_Socklen_t);
C_Errno_t(C_SSize_t) Socket_sendVec(C_Sock_t,Vector(Word8_t),C_Int_t,C_Size_t,C_Int_t);
C_Errno_t(C_SSize_t) Socket_sendVecTo(C_Sock_t,Vector(Word8_t),C_Int_t,C_Size_t,C_Int_t,Vector(Word8_t),C_Socklen_t);
+void Socket_setTimeout(C_Time_t,C_SUSeconds_t);
+void Socket_setTimeoutNull(void);
extern const C_Int_t Socket_SHUT_RD;
extern const C_Int_t Socket_SHUT_RDWR;
extern const C_Int_t Socket_SHUT_WR;
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 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2007-04-10 16:31:54 UTC (rev 5501)
@@ -786,8 +786,8 @@
Socket.INetSock.Ctl.TCP_NODELAY = _const : C_Int.t
Socket.INetSock.fromAddr = _import : Word8.t vector -> unit
Socket.INetSock.getInAddr = _import : Word8.t array -> unit
-Socket.INetSock.getPort = _import : unit -> C_Int.t
-Socket.INetSock.toAddr = _import : Word8.t vector * C_Int.t * Word8.t array * C_Socklen.t ref -> unit
+Socket.INetSock.getPort = _import : unit -> Word16.t
+Socket.INetSock.toAddr = _import : Word8.t vector * Word16.t * Word8.t array * C_Socklen.t ref -> unit
Socket.MSG_CTRUNC = _const : C_Int.t
Socket.MSG_DONTROUTE = _const : C_Int.t
Socket.MSG_DONTWAIT = _const : C_Int.t
@@ -811,13 +811,18 @@
Socket.close = _import : C_Sock.t -> C_Int.t C_Errno.t
Socket.connect = _import : C_Sock.t * Word8.t vector * C_Socklen.t -> C_Int.t C_Errno.t
Socket.familyOfAddr = _import : Word8.t vector -> C_Int.t
+Socket.getTimeout_sec = _import : unit -> C_Time.t
+Socket.getTimeout_usec = _import : unit -> C_SUSeconds.t
Socket.listen = _import : C_Sock.t * C_Int.t -> C_Int.t C_Errno.t
Socket.recv = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t
Socket.recvFrom = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t * Word8.t array * C_Socklen.t ref -> C_SSize.t C_Errno.t
+Socket.select = _import : C_Fd.t vector * C_Fd.t vector * C_Fd.t vector * C_Int.t array * C_Int.t array * C_Int.t array -> C_Int.t C_Errno.t
Socket.sendArr = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t
Socket.sendArrTo = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t * Word8.t vector * C_Socklen.t -> C_SSize.t C_Errno.t
Socket.sendVec = _import : C_Sock.t * Word8.t vector * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t
Socket.sendVecTo = _import : C_Sock.t * Word8.t vector * C_Int.t * C_Size.t * C_Int.t * Word8.t vector * C_Socklen.t -> C_SSize.t C_Errno.t
+Socket.setTimeout = _import : C_Time.t * C_SUSeconds.t -> unit
+Socket.setTimeoutNull = _import : unit -> unit
Socket.shutdown = _import : C_Sock.t * C_Int.t -> C_Int.t C_Errno.t
Socket.sockAddrStorageLen = _const : C_Size.t
Stdio.print = _import : String8.t -> unit
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h 2007-04-10 16:31:54 UTC (rev 5501)
@@ -899,12 +899,14 @@
C_Int_t Socket_familyOfAddr(Vector(Word8_t));
C_Errno_t(C_Int_t) Socket_GenericSock_socket(C_Int_t,C_Int_t,C_Int_t);
C_Errno_t(C_Int_t) Socket_GenericSock_socketPair(C_Int_t,C_Int_t,C_Int_t,Array(C_Int_t));
+C_Time_t Socket_getTimeout_sec(void);
+C_SUSeconds_t Socket_getTimeout_usec(void);
extern const C_Int_t Socket_INetSock_Ctl_IPPROTO_TCP;
extern const C_Int_t Socket_INetSock_Ctl_TCP_NODELAY;
void Socket_INetSock_fromAddr(Vector(Word8_t));
void Socket_INetSock_getInAddr(Array(Word8_t));
-C_Int_t Socket_INetSock_getPort(void);
-void Socket_INetSock_toAddr(Vector(Word8_t),C_Int_t,Array(Word8_t),Ref(C_Socklen_t));
+Word16_t Socket_INetSock_getPort(void);
+void Socket_INetSock_toAddr(Vector(Word8_t),Word16_t,Array(Word8_t),Ref(C_Socklen_t));
C_Errno_t(C_Int_t) Socket_listen(C_Sock_t,C_Int_t);
extern const C_Int_t Socket_MSG_CTRUNC;
extern const C_Int_t Socket_MSG_DONTROUTE;
@@ -916,10 +918,13 @@
extern const C_Int_t Socket_MSG_WAITALL;
C_Errno_t(C_SSize_t) Socket_recv(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t);
C_Errno_t(C_SSize_t) Socket_recvFrom(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t,Array(Word8_t),Ref(C_Socklen_t));
+C_Errno_t(C_Int_t) Socket_select(Vector(C_Fd_t),Vector(C_Fd_t),Vector(C_Fd_t),Array(C_Int_t),Array(C_Int_t),Array(C_Int_t));
C_Errno_t(C_SSize_t) Socket_sendArr(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t);
C_Errno_t(C_SSize_t) Socket_sendArrTo(C_Sock_t,Array(Word8_t),C_Int_t,C_Size_t,C_Int_t,Vector(Word8_t),C_Socklen_t);
C_Errno_t(C_SSize_t) Socket_sendVec(C_Sock_t,Vector(Word8_t),C_Int_t,C_Size_t,C_Int_t);
C_Errno_t(C_SSize_t) Socket_sendVecTo(C_Sock_t,Vector(Word8_t),C_Int_t,C_Size_t,C_Int_t,Vector(Word8_t),C_Socklen_t);
+void Socket_setTimeout(C_Time_t,C_SUSeconds_t);
+void Socket_setTimeoutNull(void);
extern const C_Int_t Socket_SHUT_RD;
extern const C_Int_t Socket_SHUT_RDWR;
extern const C_Int_t Socket_SHUT_WR;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml 2007-04-10 16:31:54 UTC (rev 5501)
@@ -1087,6 +1087,8 @@
val socket = _import "Socket_GenericSock_socket" : C_Int.t * C_Int.t * C_Int.t -> (C_Int.t) C_Errno.t;
val socketPair = _import "Socket_GenericSock_socketPair" : C_Int.t * C_Int.t * C_Int.t * (C_Int.t) array -> (C_Int.t) C_Errno.t;
end
+val getTimeout_sec = _import "Socket_getTimeout_sec" : unit -> C_Time.t;
+val getTimeout_usec = _import "Socket_getTimeout_usec" : unit -> C_SUSeconds.t;
structure INetSock =
struct
structure Ctl =
@@ -1096,8 +1098,8 @@
end
val fromAddr = _import "Socket_INetSock_fromAddr" : (Word8.t) vector -> unit;
val getInAddr = _import "Socket_INetSock_getInAddr" : (Word8.t) array -> unit;
-val getPort = _import "Socket_INetSock_getPort" : unit -> C_Int.t;
-val toAddr = _import "Socket_INetSock_toAddr" : (Word8.t) vector * C_Int.t * (Word8.t) array * (C_Socklen.t) ref -> unit;
+val getPort = _import "Socket_INetSock_getPort" : unit -> Word16.t;
+val toAddr = _import "Socket_INetSock_toAddr" : (Word8.t) vector * Word16.t * (Word8.t) array * (C_Socklen.t) ref -> unit;
end
val listen = _import "Socket_listen" : C_Sock.t * C_Int.t -> (C_Int.t) C_Errno.t;
val MSG_CTRUNC = _const "Socket_MSG_CTRUNC" : C_Int.t;
@@ -1110,10 +1112,13 @@
val MSG_WAITALL = _const "Socket_MSG_WAITALL" : C_Int.t;
val recv = _import "Socket_recv" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t -> (C_SSize.t) C_Errno.t;
val recvFrom = _import "Socket_recvFrom" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t * (Word8.t) array * (C_Socklen.t) ref -> (C_SSize.t) C_Errno.t;
+val select = _import "Socket_select" : (C_Fd.t) vector * (C_Fd.t) vector * (C_Fd.t) vector * (C_Int.t) array * (C_Int.t) array * (C_Int.t) array -> (C_Int.t) C_Errno.t;
val sendArr = _import "Socket_sendArr" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t -> (C_SSize.t) C_Errno.t;
val sendArrTo = _import "Socket_sendArrTo" : C_Sock.t * (Word8.t) array * C_Int.t * C_Size.t * C_Int.t * (Word8.t) vector * C_Socklen.t -> (C_SSize.t) C_Errno.t;
val sendVec = _import "Socket_sendVec" : C_Sock.t * (Word8.t) vector * C_Int.t * C_Size.t * C_Int.t -> (C_SSize.t) C_Errno.t;
val sendVecTo = _import "Socket_sendVecTo" : C_Sock.t * (Word8.t) vector * C_Int.t * C_Size.t * C_Int.t * (Word8.t) vector * C_Socklen.t -> (C_SSize.t) C_Errno.t;
+val setTimeout = _import "Socket_setTimeout" : C_Time.t * C_SUSeconds.t -> unit;
+val setTimeoutNull = _import "Socket_setTimeoutNull" : unit -> unit;
val SHUT_RD = _const "Socket_SHUT_RD" : C_Int.t;
val SHUT_RDWR = _const "Socket_SHUT_RDWR" : C_Int.t;
val SHUT_WR = _const "Socket_SHUT_WR" : C_Int.t;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h 2007-04-10 16:31:54 UTC (rev 5501)
@@ -35,22 +35,24 @@
/* This should not conflict with existing flags. */
#define MSG_DONTWAIT 0x1000000
-#define PF_INET6 0
+/* Cygwin does not handle IPv6. */
+#ifndef AF_INET6
+
+#define AF_INET6 23 /* Internet Protocol, Version 6 */
+#define PF_INET6 AF_INET6
+
struct sockaddr_in6 {
int dummy; // quell gcc warnings about "struct has no members"
};
+/* Cygwin does provide sockaddr_storage. */
+
+#endif
+
typedef unsigned int nfds_t;
typedef long suseconds_t; // type of timeval.tv_usec in sys/time.h
-// /usr/include/cygwin/socket.h has this ifdef'd out for now.
-#define AF_INET6 23
-
// Unimplemented on Cygwin
#define MSG_WAITALL 0
#define MSG_EOR 0
-
-
-
-
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/hpux.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/hpux.h 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/hpux.h 2007-04-10 16:31:54 UTC (rev 5501)
@@ -41,15 +41,25 @@
/* This should not conflict with existing flags. */
#define MSG_DONTWAIT 0x1000000
-#ifndef PF_INET6
-/* Old versions of HP-UX don't have IPv6 support. */
-struct sockaddr_in6 { char dummy; };
-#define sockaddr_storage sockaddr_in
-#define PF_INET6 0
-#define AF_INET6 0
+/* Old versions of HP-UX do not handle IPv6. */
+#ifndef AF_INET6
+
+#define AF_INET6 22 /* Internet Protocol, Version 6 */
+#define PF_INET6 AF_INET6
+
+struct sockaddr_in6 {
+ int dummy; // quell gcc warnings about "struct has no members"
+};
+struct sockaddr_storage {
+ union {
+ struct sockaddr_in sa_in;
+ struct sockaddr_un sa_un;
+ } sa;
+}
+
#endif
-typedef long suseconds_t;
+typedef long suseconds_t; // type of timeval.tv_usec in sys/time.h
/* These GCC builtins aren't defined in the system headers. */
float modff(float x, float *iptr);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2007-04-10 16:23:58 UTC (rev 5500)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2007-04-10 16:31:54 UTC (rev 5501)
@@ -57,3 +57,27 @@
#endif
extern char **environ; /* for Posix_ProcEnv_environ */
+
+/* Solaris 7 does not define MAP_ANON. */
+
+#ifndef MAP_ANON
+#define MAP_ANON 0x100 /* map anonymous pages directly */
+#endif
+
+/* Solaris 7 does not handle IPv6. */
+#ifndef AF_INET6
+
+#define AF_INET6 26 /* Internet Protocol, Version 6 */
+#define PF_INET6 AF_INET6
+
+struct sockaddr_in6 {
+ int dummy; // quell gcc warnings about "struct has no members"
+};
+struct sockaddr_storage {
+ union {
+ struct sockaddr_in sa_in;
+ struct sockaddr_un sa_un;
+ } sa;
+}
+
+#endif
More information about the MLton-commit
mailing list