[MLton-commit] r4326
Matthew Fluet
MLton@mlton.org
Sat, 28 Jan 2006 11:14:02 -0800
Checkpointing move to generated basis imports
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/call-stack.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/itimer.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-prot-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-serv-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/platform/cygwin.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.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/process.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/posix/sys-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/IEEE-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/command-line.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sig 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sig 2006-01-28 19:13:54 UTC (rev 4326)
@@ -6,7 +6,7 @@
* See the file MLton-LICENSE for details.
*)
-signature C =
+signature C_OLD =
sig
(* C char* *)
structure CS :
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/misc/C.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -6,7 +6,7 @@
* See the file MLton-LICENSE for details.
*)
-structure C: C =
+structure COld: C_OLD =
struct
open Int
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/call-stack.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/call-stack.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/call-stack.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -44,7 +44,7 @@
if j > max
then ac
else loop (j + 1,
- C.CS.toString (sourceName
+ COld.CS.toString (sourceName
(gcState, Pointer.getInt32 (p, j)))
:: ac)
in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/itimer.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/itimer.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/itimer.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -8,7 +8,7 @@
structure MLtonItimer =
struct
- structure Prim = Primitive.Itimer
+ structure Prim = PrimitiveFFI.MLton.Itimer
datatype t = Prof | Real | Virtual
@@ -18,9 +18,9 @@
| Virtual => PosixPrimitive.Signal.vtalrm
val toInt =
- fn Prof => Prim.prof
- | Real => Prim.real
- | Virtual => Prim.virtual
+ fn Prof => Prim.PROF
+ | Real => Prim.REAL
+ | Virtual => Prim.VIRTUAL
fun set' (t, {interval, value}) =
let
@@ -33,7 +33,7 @@
val (s1, u1) = split interval
val (s2, u2) = split value
in
- Prim.set (toInt t, s1, u1, s2, u2)
+ ignore (Prim.set (toInt t, s1, u1, s2, u2))
end
fun set (z as (t, _)) =
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 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -322,8 +322,8 @@
then
let
val path = NullString.nullTerm path
- val args = C.CSS.fromList args
- val env = C.CSS.fromList env
+ val args = COld.CSS.fromList args
+ val env = COld.CSS.fromList env
in
SysCall.syscall
(fn () =>
@@ -346,7 +346,7 @@
then
let
val file = NullString.nullTerm file
- val args = C.CSS.fromList args
+ val args = COld.CSS.fromList args
in
SysCall.syscall
(fn () =>
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sig 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sig 2006-01-28 19:13:54 UTC (rev 4326)
@@ -6,11 +6,9 @@
* See the file MLton-LICENSE for details.
*)
-type word = Word.word
-
signature MLTON_RLIMIT =
sig
- type rlim = word
+ type rlim = Word64.word
val infinity: rlim
@@ -20,12 +18,14 @@
val cpuTime: t (* CPU CPU time in seconds *)
val dataSize: t (* DATA max data size *)
val fileSize: t (* FSIZE Maximum filesize *)
+ val numFiles: t (* NOFILE max number of open files *)
+ val stackSize: t (* STACK max stack size *)
+ val virtualMemorySize: t (* AS virtual memory limit *)
+(*
val lockedInMemorySize: t (* MEMLOCK max locked address space *)
- val numFiles: t (* NOFILE max number of open files *)
val numProcesses: t (* NPROC max number of processes *)
val residentSetSize: t (* RSS max resident set size *)
- val stackSize: t (* STACK max stack size *)
- val virtualMemorySize: t (* AS virtual memory limit *)
+ *)
val get: t -> {hard: rlim, soft: rlim}
val set: t * {hard: rlim, soft: rlim} -> unit
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -8,7 +8,9 @@
structure MLtonRlimit: MLTON_RLIMIT =
struct
- open Primitive.MLton.Rlimit
+ open PrimitiveFFI.MLton.Rlimit
+ type rlim = C.RLim.t
+ type t = C.Int.t
val get =
fn (r: t) =>
@@ -22,4 +24,21 @@
fn (r: t, {hard, soft}) =>
PosixError.SysCall.simple
(fn () => set (r, hard, soft))
+
+ val infinity = INFINITY
+
+ val coreFileSize = CORE
+ val cpuTime = CPU
+ val dataSize = DATA
+ val fileSize = FSIZE
+ val numFiles = NOFILE
+ val stackSize = STACK
+ val virtualMemorySize = AS
+
+(*
+ val lockedInMemorySize = MEMLOCK
+ val numProcesses = NPROC
+ val residentSetSize = RSS
+*)
+
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -8,7 +8,7 @@
structure MLtonRusage: MLTON_RUSAGE =
struct
- structure Prim = Primitive.MLton.Rusage
+ structure Prim = PrimitiveFFI.MLton.Rusage
type t = {utime: Time.time, stime: Time.time}
@@ -36,7 +36,7 @@
in
fn () =>
let
- val () = Prim.ru ()
+ val () = Prim.getrusage ()
open Prim
in
{children = collect (children_utime_sec, children_utime_usec,
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sig 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sig 2006-01-28 19:13:54 UTC (rev 4326)
@@ -20,7 +20,11 @@
val CONS : openflag
val NDELAY : openflag
+ val NOWAIT : openflag
+ val ODELAY : openflag
+(*
val PERROR : openflag
+*)
val PID : openflag
type facility
@@ -40,7 +44,9 @@
val LPR : facility
val MAIL : facility
val NEWS : facility
+(*
val SYSLOG : facility
+*)
val USER : facility
val UUCP : facility
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -14,33 +14,76 @@
structure MLtonSyslog :> MLTON_SYSLOG =
struct
-open Primitive.MLton.Syslog
+open PrimitiveFFI.MLton.Syslog
+type openflag = C.Int.t
+
+local
+ open Logopt
+in
+ val CONS = LOG_CONS
+ val NDELAY = LOG_NDELAY
+ val NOWAIT = LOG_NOWAIT
+ val ODELAY = LOG_ODELAY
+ val PID = LOG_PID
+end
+
+type facility = C.Int.t
+
+local
+ open Facility
+in
+ val AUTHPRIV = LOG_AUTH
+ val CRON = LOG_CRON
+ val DAEMON = LOG_DAEMON
+ val KERN = LOG_KERN
+ val LOCAL0 = LOG_LOCAL0
+ val LOCAL1 = LOG_LOCAL1
+ val LOCAL2 = LOG_LOCAL2
+ val LOCAL3 = LOG_LOCAL3
+ val LOCAL4 = LOG_LOCAL4
+ val LOCAL5 = LOG_LOCAL5
+ val LOCAL6 = LOG_LOCAL6
+ val LOCAL7 = LOG_LOCAL7
+ val LPR = LOG_LPR
+ val MAIL = LOG_MAIL
+ val NEWS = LOG_NEWS
+(*
+ val SYSLOG = LOG_SYSLOG
+*)
+ val USER = LOG_USER
+ val UUCP = LOG_UUCP
+end
+
+type loglevel = C.Int.t
+
+local
+ open Severity
+in
+ val ALERT = LOG_ALERT
+ val CRIT = LOG_CRIT
+ val DEBUG = LOG_DEBUG
+ val EMERG = LOG_EMERG
+ val ERR = LOG_ERR
+ val INFO = LOG_INFO
+ val NOTICE = LOG_NOTICE
+ val WARNING = LOG_WARNING
+end
+
fun zt s = s ^ "\000"
-(* openlog seems to rely on the string being around forever,
- * so I use strdup to make a copy.
- * This is a little dirty, sorry. (Personally I think it is
- * openlog's fault.)
- *)
-fun openlog (s, opt, fac) =
+val openlog = fn (s, opt, fac) =>
let
val optf =
Word32.toInt (foldl Word32.orb 0w0 (map Word32.fromInt opt))
- val sys_strdup = _import "strdup" : string -> word ;
- val sys_openlog = _import "openlog" : word * int * int -> unit ;
in
- sys_openlog (sys_strdup (zt s), optf, fac)
+ openlog (NullString.fromString (zt s), optf, fac)
end
-fun closelog () =
- let val sys_closelog = _import "closelog" : unit -> unit ;
- in sys_closelog ()
- end
+val closelog = fn () =>
+ closelog ()
-fun log (lev, msg) =
- let val sys_syslog = _import "syslog" : int * string * string -> unit ;
- in sys_syslog (lev, "%s\000", zt msg)
- end
+val log = fn (lev, msg) =>
+ syslog (lev, NullString.fromString (zt msg))
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -58,13 +58,13 @@
fun get (b: bool): entry option =
if b
then let
- val name = C.CS.toString (Prim.entryName ())
+ val name = COld.CS.toString (Prim.entryName ())
val numAliases = Prim.entryNumAliases ()
fun fill (n, aliases) =
if n < numAliases
then let
val alias =
- C.CS.toString (Prim.entryAliasesN n)
+ COld.CS.toString (Prim.entryAliasesN n)
in
fill (n + 1, alias::aliases)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-prot-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-prot-db.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-prot-db.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -25,13 +25,13 @@
fun get (b: bool): entry option =
if b
then let
- val name = C.CS.toString (Prim.entryName ())
+ val name = COld.CS.toString (Prim.entryName ())
val numAliases = Prim.entryNumAliases ()
fun fill (n, aliases) =
if n < numAliases
then let
val alias =
- C.CS.toString (Prim.entryAliasesN n)
+ COld.CS.toString (Prim.entryAliasesN n)
in
fill (n + 1, alias::aliases)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-serv-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-serv-db.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-serv-db.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -27,20 +27,20 @@
fun get (b: bool): entry option =
if b
then let
- val name = C.CS.toString (Prim.entryName ())
+ val name = COld.CS.toString (Prim.entryName ())
val numAliases = Prim.entryNumAliases ()
fun fill (n, aliases) =
if n < numAliases
then let
val alias =
- C.CS.toString (Prim.entryAliasesN n)
+ COld.CS.toString (Prim.entryAliasesN n)
in
fill (n + 1, alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
val port = Net.ntohs (Prim.entryPort ())
- val protocol = C.CS.toString (Prim.entryProtocol ())
+ val protocol = COld.CS.toString (Prim.entryProtocol ())
in
SOME (T {name = name,
aliases = aliases,
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/platform/cygwin.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/platform/cygwin.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/platform/cygwin.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -10,7 +10,7 @@
structure Prim = Primitive.Cygwin
fun toFullWindowsPath p =
- C.CS.toString (Prim.toFullWindowsPath (NullString.nullTerm p))
+ COld.CS.toString (Prim.toFullWindowsPath (NullString.nullTerm p))
fun toExe cmd =
let
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 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -45,7 +45,7 @@
in
if cs = Primitive.Pointer.null
then "Unknown error"
- else C.CS.toString cs
+ else COld.CS.toString cs
end
fun raiseSys n = raise SysErr (errorMsg n, SOME n)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -95,7 +95,7 @@
NONE => NONE
| SOME cs =>
let
- val s = C.CS.toString cs
+ val s = COld.CS.toString cs
in
if s = "." orelse s = ".."
then loop ()
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 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -11,7 +11,7 @@
structure Prim = PosixPrimitive.ProcEnv
structure Error = PosixError
structure SysCall = Error.SysCall
- structure CS = C.CS
+ structure CS = COld.CS
type pid = Pid.t
@@ -119,7 +119,7 @@
end)
end
- fun environ () = C.CSS.toList Prim.environ
+ fun environ () = COld.CSS.toList Prim.environ
fun getenv name =
let
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -34,7 +34,7 @@
else fn () => Error.raiseSys Error.nosys
val conv = NullString.nullTerm
- val convs = C.CSS.fromList
+ val convs = COld.CSS.fromList
fun exece (path, args, env): 'a =
let
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 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -110,13 +110,6 @@
struct
open Primitive
- structure Itimer =
- struct
- open Itimer
-
- val set = stub ("set", set)
- end
-
structure OS =
struct
open OS
@@ -142,4 +135,20 @@
end
end
end
+ structure PrimitiveFFI =
+ struct
+ open PrimitiveFFI
+
+ structure MLton =
+ struct
+ open MLton
+
+ structure Itimer =
+ struct
+ open Itimer
+
+ val set = stub ("set", set)
+ end
+ end
+ end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -8,7 +8,7 @@
structure PosixSysDB: POSIX_SYS_DB =
struct
- structure CS = C.CS
+ structure CS = COld.CS
structure Prim = PosixPrimitive.SysDB
structure Error = PosixError
structure SysCall = Error.SysCall
@@ -66,7 +66,7 @@
(if f () then 0 else ~1,
fn () => {name = CS.toString(Group.name()),
gid = Group.gid(),
- members = C.CSS.toList(Group.mem())}))
+ members = COld.CSS.toList(Group.mem())}))
val name: group -> string = #name
val gid: group -> gid = #gid
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -8,7 +8,7 @@
structure PosixTTY: POSIX_TTY =
struct
- structure Cstring = C.CS
+ structure Cstring = COld.CS
structure Prim = PosixPrimitive.TTY
open Prim
structure Error = PosixError
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-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -128,10 +128,6 @@
struct
type t = Pointer.t
end
- structure CStringArray =
- struct
- type t = Pointer.t
- end
structure GCState =
struct
@@ -204,13 +200,6 @@
(* val fromWord32 = _prim "WordU32_toWord32": Word32.word -> char; *)
end
- structure CommandLine =
- struct
- val argc = #1 _symbol "CommandLine_argc": int GetSet.t;
- val argv = #1 _symbol "CommandLine_argv": CStringArray.t GetSet.t;
- val commandName = #1 _symbol "CommandLine_commandName": CString.t GetSet.t;
- end
-
structure Exn =
struct
(* The polymorphism with extra and setInitExtra is because primitives
@@ -264,25 +253,6 @@
_import "GC_unpack": GCState.t -> unit;
end
- structure IEEEReal =
- struct
- structure RoundingMode =
- struct
- type t = int
-
- val toNearest = _const "FE_TONEAREST": t;
- val downward = _const "FE_DOWNWARD": t;
- val noSupport = _const "FE_NOSUPPORT": t;
- val upward = _const "FE_UPWARD": t;
- val towardZero = _const "FE_TOWARDZERO": t;
- end
-
- val getRoundingMode =
- _import "IEEEReal_getRoundingMode": unit -> int;
- val setRoundingMode =
- _import "IEEEReal_setRoundingMode": int -> unit;
- end
-
structure Int1 =
struct
open Int1
@@ -761,17 +731,6 @@
val xorb = _prim "IntInf_xorb": int * int * word -> int;
end
- structure Itimer =
- struct
- type which = int
-
- val prof = _const "Itimer_prof": which;
- val real = _const "Itimer_real": which;
- val set =
- _import "Itimer_set": which * int * int * int * int -> unit;
- val virtual = _const "Itimer_virtual": which;
- end
-
structure MLton =
struct
structure Codegen =
@@ -914,94 +873,7 @@
_import "GC_setProfileCurrent"
: GCState.t * Data.t -> unit;
end
-
- structure Rlimit =
- struct
- type rlim = word
-
- val infinity = _const "MLton_Rlimit_infinity": rlim;
- type t = int
-
- val cpuTime = _const "MLton_Rlimit_cpuTime": t;
- val coreFileSize = _const "MLton_Rlimit_coreFileSize": t;
- val dataSize = _const "MLton_Rlimit_dataSize": t;
- val fileSize = _const "MLton_Rlimit_fileSize": t;
- val lockedInMemorySize =
- _const "MLton_Rlimit_lockedInMemorySize": t;
- val numFiles = _const "MLton_Rlimit_numFiles": t;
- val numProcesses = _const "MLton_Rlimit_numProcesses": t;
- val residentSetSize = _const "MLton_Rlimit_residentSetSize": t;
- val stackSize = _const "MLton_Rlimit_stackSize": t;
- val virtualMemorySize =
- _const "MLton_Rlimit_virtualMemorySize": t;
-
- val get = _import "MLton_Rlimit_get": t -> int;
- val getHard = _import "MLton_Rlimit_getHard": unit -> rlim;
- val getSoft = _import "MLton_Rlimit_getSoft": unit -> rlim;
- val set = _import "MLton_Rlimit_set": t * rlim * rlim -> int;
- end
-
- structure Rusage =
- struct
- val ru = _import "MLton_Rusage_ru": unit -> unit;
-
- val self_utime_sec = _import "MLton_Rusage_self_utime_sec": unit -> int;
- val self_utime_usec = _import "MLton_Rusage_self_utime_usec": unit -> int;
- val self_stime_sec = _import "MLton_Rusage_self_stime_sec": unit -> int;
- val self_stime_usec = _import "MLton_Rusage_self_stime_usec": unit -> int;
- val children_utime_sec = _import "MLton_Rusage_children_utime_sec": unit -> int;
- val children_utime_usec = _import "MLton_Rusage_children_utime_usec": unit -> int;
- val children_stime_sec = _import "MLton_Rusage_children_stime_sec": unit -> int;
- val children_stime_usec = _import "MLton_Rusage_children_stime_usec": unit -> int;
- val gc_utime_sec = _import "MLton_Rusage_gc_utime_sec": unit -> int;
- val gc_utime_usec = _import "MLton_Rusage_gc_utime_usec": unit -> int;
- val gc_stime_sec = _import "MLton_Rusage_gc_stime_sec": unit -> int;
- val gc_stime_usec = _import "MLton_Rusage_gc_stime_usec": unit -> int;
- end
-
- structure Syslog =
- struct
- type openflag = int
-
- val CONS = _const "LOG_CONS": openflag;
- val NDELAY = _const "LOG_NDELAY": openflag;
- val PERROR = _const "LOG_PERROR": openflag;
- val PID = _const "LOG_PID": openflag;
-
- type facility = int
-
- val AUTHPRIV = _const "LOG_AUTHPRIV": facility;
- val CRON = _const "LOG_CRON": facility;
- val DAEMON = _const "LOG_DAEMON": facility;
- val KERN = _const "LOG_KERN": facility;
- val LOCAL0 = _const "LOG_LOCAL0": facility;
- val LOCAL1 = _const "LOG_LOCAL1": facility;
- val LOCAL2 = _const "LOG_LOCAL2": facility;
- val LOCAL3 = _const "LOG_LOCAL3": facility;
- val LOCAL4 = _const "LOG_LOCAL4": facility;
- val LOCAL5 = _const "LOG_LOCAL5": facility;
- val LOCAL6 = _const "LOG_LOCAL6": facility;
- val LOCAL7 = _const "LOG_LOCAL7": facility;
- val LPR = _const "LOG_LPR": facility;
- val MAIL = _const "LOG_MAIL": facility;
- val NEWS = _const "LOG_NEWS": facility;
- val SYSLOG = _const "LOG_SYSLOG": facility;
- val USER = _const "LOG_USER": facility;
- val UUCP = _const "LOG_UUCP": facility;
-
- type loglevel = int
-
- val EMERG = _const "LOG_EMERG": loglevel;
- val ALERT = _const "LOG_ALERT": loglevel;
- val CRIT = _const "LOG_CRIT": loglevel;
- val ERR = _const "LOG_ERR": loglevel;
- val WARNING = _const "LOG_WARNING": loglevel;
- val NOTICE = _const "LOG_NOTICE": loglevel;
- val INFO = _const "LOG_INFO": loglevel;
- val DEBUG = _const "LOG_DEBUG": loglevel;
- end
-
structure Weak =
struct
open Weak
@@ -1580,13 +1452,6 @@
val switchTo = _prim "Thread_switchTo": thread -> unit;
end
- structure Time =
- struct
- val gettimeofday = _import "Time_gettimeofday": unit -> int;
- val sec = _import "Time_sec": unit -> int;
- val usec = _import "Time_usec": unit -> int;
- end
-
structure TopLevel =
struct
val setHandler =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/IEEE-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/IEEE-real.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/IEEE-real.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -22,7 +22,7 @@
| SUBNORMAL
| ZERO
- structure Prim = Primitive.IEEEReal
+ structure Prim = PrimitiveFFI.IEEEReal
structure RoundingMode =
struct
@@ -37,10 +37,10 @@
let
open Prim.RoundingMode
in
- [(toNearest, TO_NEAREST),
- (downward, TO_NEGINF),
- (upward, TO_POSINF),
- (towardZero, TO_ZERO)]
+ [(FE_TONEAREST, TO_NEAREST),
+ (FE_DOWNWARD, TO_NEGINF),
+ (FE_UPWARD, TO_POSINF),
+ (FE_TOWARDZERO, TO_ZERO)]
end
in
val fromInt: int -> t =
@@ -55,12 +55,12 @@
open Prim.RoundingMode
val i =
case m of
- TO_NEAREST => toNearest
- | TO_NEGINF => downward
- | TO_POSINF => upward
- | TO_ZERO => towardZero
+ TO_NEAREST => FE_TONEAREST
+ | TO_NEGINF => FE_DOWNWARD
+ | TO_POSINF => FE_UPWARD
+ | TO_ZERO => FE_TOWARDZERO
in
- if i = noSupport
+ if i = FE_NOSUPPORT
then raise Fail "IEEEReal rounding mode not supported"
else i
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun 2006-01-28 19:13:54 UTC (rev 4326)
@@ -432,10 +432,10 @@
if Int.< (i, 0)
then ac
else loop (Int.- (i, 1),
- (Int.- (Char.ord (C.CS.sub (cs, i)),
+ (Int.- (Char.ord (COld.CS.sub (cs, i)),
Char.ord #"0"))
:: ac)
- val digits = loop (Int.- (C.CS.length cs, 1), [])
+ val digits = loop (Int.- (COld.CS.length cs, 1), [])
in
{class = c,
digits = digits,
@@ -448,16 +448,16 @@
fun add1 n = Int.+ (n, 1)
local
- fun fix (sign: string, cs: C.CS.t, decpt: int, ndig: int): string =
+ fun fix (sign: string, cs: COld.CS.t, decpt: int, ndig: int): string =
let
- val length = C.CS.length cs
+ val length = COld.CS.length cs
in
if Int.< (decpt, 0)
then
concat [sign,
"0.",
String.new (Int.~ decpt, #"0"),
- C.CS.toString cs,
+ COld.CS.toString cs,
String.new (Int.+ (Int.- (ndig, length),
decpt),
#"0")]
@@ -469,7 +469,7 @@
else
String.tabulate (decpt, fn i =>
if Int.< (i, length)
- then C.CS.sub (cs, i)
+ then COld.CS.sub (cs, i)
else #"0")
in
if 0 = ndig
@@ -483,7 +483,7 @@
val j = Int.+ (i, decpt)
in
if Int.< (j, length)
- then C.CS.sub (cs, j)
+ then COld.CS.sub (cs, j)
else #"0"
end)
in
@@ -495,8 +495,8 @@
let
val sign = if x < zero then "~" else ""
val (cs, decpt) = gdtoa (x, Sci, add1 ndig)
- val length = C.CS.length cs
- val whole = String.tabulate (1, fn _ => C.CS.sub (cs, 0))
+ val length = COld.CS.length cs
+ val whole = String.tabulate (1, fn _ => COld.CS.sub (cs, 0))
val frac =
if 0 = ndig
then ""
@@ -507,7 +507,7 @@
val j = Int.+ (i, 1)
in
if Int.< (j, length)
- then C.CS.sub (cs, j)
+ then COld.CS.sub (cs, j)
else #"0"
end)]
val exp = Int.- (decpt, 1)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/system/command-line.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/command-line.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/command-line.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -8,10 +8,13 @@
structure CommandLine: COMMAND_LINE =
struct
- structure Prim = Primitive.CommandLine
+ structure Prim = PrimitiveFFI.CommandLine
- fun name () = C.CS.toString (Prim.commandName ())
+ fun name () =
+ COld.CS.toString
+ (Primitive.Pointer.fromWord (Prim.commandNameGet ()))
fun arguments () =
- Array.toList (C.CSS.toArrayOfLength (Prim.argv (), Prim.argc ()))
+ (Array.toList o COld.CSS.toArrayOfLength)
+ (Primitive.Pointer.fromWord (Prim.argvGet ()), Prim.argcGet ())
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2006-01-28 19:13:54 UTC (rev 4326)
@@ -9,7 +9,7 @@
structure Time: TIME_EXTRA =
struct
-structure Prim = Primitive.Time
+structure Prim = PrimitiveFFI.Time
(* A time is represented as a number of nanoseconds. *)
val ticksPerSecond: LargeInt.int = 1000000000
@@ -68,7 +68,7 @@
*)
local
fun getNow (): time =
- (if ~1 = Prim.gettimeofday ()
+ (if ~1 = Prim.getTimeOfDay ()
then raise Fail "Time.now"
else ()
; timeAdd(fromSeconds (LargeInt.fromInt (Prim.sec ())),
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog.c 2006-01-28 19:12:47 UTC (rev 4325)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog.c 2006-01-28 19:13:54 UTC (rev 4326)
@@ -13,5 +13,5 @@
}
void MLton_Syslog_syslog(C_Int_t p, NullString8_t s) {
- syslog(p, (const char*)s);
+ syslog(p, "%s", (const char*)s);
}