[MLton-commit] r4422
Matthew Fluet
MLton@mlton.org
Tue, 25 Apr 2006 19:25:32 -0700
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