Menu
▾
▴
mlton-commit — [MLton-commit] Code commits
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(56) |
Sep
(40) |
Oct
(30) |
Nov
(144) |
Dec
(23) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(41) |
Feb
(29) |
Mar
(31) |
Apr
(39) |
May
(193) |
Jun
(45) |
Jul
(19) |
Aug
(3) |
Sep
(23) |
Oct
(83) |
Nov
(92) |
Dec
(123) |
| 2007 |
Jan
(90) |
Feb
(267) |
Mar
(120) |
Apr
(51) |
May
(40) |
Jun
(121) |
Jul
(109) |
Aug
(173) |
Sep
(77) |
Oct
(52) |
Nov
(121) |
Dec
(62) |
| 2008 |
Jan
(76) |
Feb
(53) |
Mar
(98) |
Apr
(87) |
May
(26) |
Jun
(27) |
Jul
(23) |
Aug
(136) |
Sep
(79) |
Oct
(68) |
Nov
(29) |
Dec
(14) |
| 2009 |
Jan
(7) |
Feb
(2) |
Mar
(11) |
Apr
(75) |
May
(1) |
Jun
(95) |
Jul
(19) |
Aug
(4) |
Sep
(8) |
Oct
(93) |
Nov
(43) |
Dec
(21) |
| 2010 |
Jan
(20) |
Feb
(23) |
Mar
(18) |
Apr
(6) |
May
(20) |
Jun
(23) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
(2) |
Feb
(6) |
Mar
(15) |
Apr
(5) |
May
(9) |
Jun
(14) |
Jul
(9) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(17) |
Jul
(37) |
Aug
|
Sep
(1) |
Oct
(6) |
Nov
|
Dec
|
| 2013 |
Jan
|
Feb
|
Mar
(5) |
Apr
(2) |
May
(7) |
Jun
(11) |
Jul
(8) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
(2) |
Mar
(1) |
Apr
|
May
(1) |
Jun
(1) |
Jul
(7) |
Aug
(2) |
Sep
|
Oct
(5) |
Nov
(2) |
Dec
(4) |
| 2015 |
Jan
|
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(9) |
Jul
(1) |
Aug
|
Sep
|
Oct
(4) |
Nov
(1) |
Dec
|
| 2016 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(5) |
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
(3) |
Mar
(3) |
Apr
(7) |
May
(2) |
Jun
(2) |
Jul
(5) |
Aug
(1) |
Sep
(2) |
Oct
(17) |
Nov
(4) |
Dec
(7) |
| 2018 |
Jan
(5) |
Feb
(14) |
Mar
(2) |
Apr
(5) |
May
(2) |
Jun
(5) |
Jul
|
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(5) |
Dec
|
| 2019 |
Jan
(4) |
Feb
(2) |
Mar
(3) |
Apr
(1) |
May
(8) |
Jun
(14) |
Jul
(2) |
Aug
|
Sep
(2) |
Oct
(2) |
Nov
(15) |
Dec
(2) |
| 2020 |
Jan
(10) |
Feb
(3) |
Mar
(1) |
Apr
|
May
(9) |
Jun
(4) |
Jul
(16) |
Aug
(10) |
Sep
(4) |
Oct
(3) |
Nov
|
Dec
|
| 2021 |
Jan
(11) |
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
|
Oct
(6) |
Nov
(4) |
Dec
(4) |
| 2022 |
Jan
(4) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(6) |
Jun
(3) |
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
(2) |
May
(5) |
Jun
(1) |
Jul
(4) |
Aug
(1) |
Sep
|
Oct
(1) |
Nov
(13) |
Dec
|
| 2024 |
Jan
(1) |
Feb
|
Mar
(5) |
Apr
|
May
(10) |
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
(1) |
Dec
(14) |
| 2025 |
Jan
(3) |
Feb
|
Mar
(1) |
Apr
|
May
(2) |
Jun
(3) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Matthew F. <fl...@ml...> - 2006-01-30 18:01:37
|
A temporary "fix" for the echo.sml regression failure.
The real bug runs much deeper, and is a consequence of the fact that
in HEAD, we are using ntohs and htons to handle network/host endian
conversions, which is completely wrong, as they have the signatures:
uint16_t ntohs(uint16_t);
uint16_t htons(uint16_t);
but we wrap/import them as
Int Net_htons (Int i) { return htons (i); }
Int Net_ntohs (Int i) { return ntohs (i); }
val htons = _import "Net_htons": int -> int;
val ntohs = _import "Net_ntohs": int -> int;
As a consequence, we are only endian converting the two lower bytes.
It's a wonder any of the networking works at all.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml
----------------------------------------------------------------------
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 2006-01-31 01:50:54 UTC (rev 4332)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml 2006-01-31 02:01:34 UTC (rev 4333)
@@ -18,16 +18,19 @@
val inetAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.INET
fun toAddr (in_addr, port) =
+ let val port = Net.htonl port
+ in
if port < 0 orelse port >= 0x10000
then PosixError.raiseSys PosixError.inval
else
let
val (sa, salen, finish) = Socket.new_sock_addr ()
val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
- Net.htonl port, sa, salen)
+ port, sa, salen)
in
finish ()
end
+ end
fun any port = toAddr (NetHostDB.any (), port)
|
|
From: Matthew F. <fl...@ml...> - 2006-01-30 17:50:55
|
Add x86-linux config ---------------------------------------------------------------------- A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/ A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml ---------------------------------------------------------------------- Added: mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml 2006-01-31 01:46:18 UTC (rev 4331) +++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml 2006-01-31 01:50:54 UTC (rev 4332) @@ -0,0 +1,78 @@ +(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh + * Jagannathan, and Stephen Weeks. + * + * MLton is released under a BSD-style license. + * See the file MLton-LICENSE for details. + *) + +structure C = struct + + +(* C *) +structure Char = struct open Int8 type t = int end +structure SChar = struct open Int8 type t = int end +structure UChar = struct open Word8 type t = word end +structure Short = struct open Int16 type t = int end +structure SShort = struct open Int16 type t = int end +structure UShort = struct open Word16 type t = word end +structure Int = struct open Int32 type t = int end +structure SInt = struct open Int32 type t = int end +structure UInt = struct open Word32 type t = word end +structure Long = struct open Int32 type t = int end +structure SLong = struct open Int32 type t = int end +structure ULong = struct open Word32 type t = word end +structure LongLong = struct open Int64 type t = int end +structure SLongLong = struct open Int64 type t = int end +structure ULongLong = struct open Word64 type t = word end +structure Float = struct open Real32 type t = real end +structure Double = struct open Real64 type t = real end +structure Size = struct open Word32 type t = word end + +structure String = Pointer +structure StringArray = Pointer + +(* Generic integers *) +structure Fd = Int +structure Signal = Int +structure Status = Int +structure Sock = Int + +(* from <dirent.h> *) +structure DirP = struct open Word32 type t = word end + +(* from <poll.h> *) +structure NFds = struct open Word32 type t = word end + +(* from <resource.h> *) +structure RLim = struct open Word64 type t = word end + +(* from <sys/types.h> *) +structure Clock = struct open Int32 type t = int end +structure Dev = struct open Word64 type t = word end +structure GId = struct open Word32 type t = word end +structure Id = struct open Word32 type t = word end +structure INo = struct open Word64 type t = word end +structure Mode = struct open Word32 type t = word end +structure NLink = struct open Word32 type t = word end +structure Off = struct open Int64 type t = int end +structure PId = struct open Int32 type t = int end +structure SSize = struct open Int32 type t = int end +structure SUSeconds = struct open Int32 type t = int end +structure Time = struct open Int32 type t = int end +structure UId = struct open Word32 type t = word end +structure USeconds = struct open Word32 type t = word end + +(* from <sys/socket.h> *) +structure Socklen = struct open Word32 type t = word end + +(* from <termios.h> *) +structure CC = struct open Word8 type t = word end +structure Speed = struct open Word32 type t = word end +structure TCFlag = struct open Word32 type t = word end + +(* from "gmp.h" *) +structure MPLimb = struct open Word32 type t = word end + + +structure Errno = struct type 'a t = 'a end +end |
|
From: Matthew F. <fl...@ml...> - 2006-01-30 17:46:20
|
A 'small' IntInf has absolute value in [0,2^(CHAR_BIT * OBJPTR_SIZE) - 2]:
one bit for the non-pointer tag and one bit for the twos-complement sign.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-01-30 00:44:07 UTC (rev 4330)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-01-31 01:46:18 UTC (rev 4331)
@@ -53,7 +53,7 @@
uint32_t i, j;
bool neg;
GC_intInf bp;
- unsigned char* cp;
+ unsigned char *cp;
assert (isFrontierAligned (s, s->frontier));
frontier = s->frontier;
@@ -66,12 +66,11 @@
str++;
slen = strlen (str);
assert (slen > 0);
+ bp = (GC_intInf)frontier;
cp = (unsigned char*)(s->heap.start + (s->heap.size - slen));
- bp = (GC_intInf)frontier;
-
for (j = 0; j != slen; j++) {
- assert('0' <= str[j] && str[j] <= '9');
+ assert ('0' <= str[j] && str[j] <= '9');
cp[j] = str[j] - '0' + 0;
}
alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, 10);
@@ -84,16 +83,16 @@
val = bp->limbs[0];
if (neg) {
/*
- * We only fit if val in [1, 2^(8 * OBJPTR_SIZE - 1)].
+ * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
*/
ans = - val;
val = val - 1;
} else
/*
- * We only fit if val in [0, 2^(8 * OBJPTR_SIZE - 1) - 1].
+ * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
*/
ans = val;
- if (val < (uintmax_t)1<<(8 * OBJPTR_SIZE - 1)) {
+ if (val < (uintmax_t)1<<(CHAR_BIT * OBJPTR_SIZE - 2)) {
s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
continue;
}
|
|
From: Matthew F. <fl...@ml...> - 2006-01-29 16:44:17
|
Mostly complete reintegration of generated basis library FFI. Almost
all regressions pass; something busted with sockets and with IntInf.
MLton MLTONVERSION (built Sun Jan 29 19:07:18 2006 on localhost.localdomain)
flags = -type-check true
testing 10
testing 11
testing 12
testing 13
testing 14
testing 15
testing 16
testing 17
testing 18
testing 19
testing 1
testing 20
testing 21
testing 22
testing 23
testing 2
testing 3
testing 4
testing 5
testing 6
testing 7
testing 8
testing 9
testing abcde
testing abstype
testing all-overloads
testing array2
testing array3
testing array4
testing array5
testing array6
testing array7
testing array
testing asterisk
testing basis-sharing
testing big-array
testing binio
testing bool-triple
testing bytechar
testing callcc2
testing callcc3
testing callcc
testing cases
testing char0
testing char.scan
testing check_arrays
testing circular
testing cmdline
testing cobol
testing command-line
testing comment-end
testing constraint
testing conv2
0a1,6
> FailRead, base = BIN, str = |1000000000000000000000000000000|
> FailRead, base = BIN, str = |1000000000000000000000000000001|
> FailRead, base = BIN, str = |~1000000000000000000000000000001|
> FailRead, base = BIN, str = |1000000000000000000000000000010|
> FailRead, base = BIN, str = |~1000000000000000000000000000010|
> FailRead, base = BIN, str = |~10000000000000000000000000000000|
difference with -type-check true
testing conv
1c1,44495308
< All ok
---
> Fail 3: ~1
difference with -type-check true
testing cycle
testing datatype-with-free-tyvars
testing date
testing dead
testing deep-flatten
testing default-overloads
testing down
testing echo
1c1,3
< server processed 1900 bytes
---
> unhandled exception: SysErr: Invalid argument [inval]
> ./bin/regression: line 112: 30636 Terminated ./$f
> Nonzero exit status.
difference with -type-check true
testing eq
testing eqtype
testing exhaustive
testing exn2
testing exnHistory3
testing exnHistory
testing exn
testing expansive-valbind
testing exponential
testing ex
testing fact
testing fast2
testing fast
testing ffi-opaque
testing ffi
testing fft
testing filesys
testing finalize.2
testing finalize.3
testing finalize.4
testing finalize.5
testing finalize
testing fixed-integer
13a14,17
> Int31: abs ~1073741824 = Overflow <> ~1073741824
> Int31: ~ ~1073741824 = Overflow <> ~1073741824
> Int31: ~1073741824 div ~1 = Overflow <> ~1073741824
> Int31: ~1073741824 quot ~1 = Overflow <> ~1073741824
difference with -type-check true
testing flat-array.2
testing flat-array.3
testing flat-array
testing flat-vector
testing flexrecord
testing format
testing ftruncate
testing FuhMishra
testing functor
testing gc-collect
testing general
testing grow-raise
testing harmonic
testing hello-world
testing id
testing int-inf.0
testing int-inf.1
testing int-inf.2
difference with -type-check true
testing int-inf.3
1c1
< true12345
---
> true~9129
difference with -type-check true
testing int-inf.4
testing int-inf.5
testing int-inf.bitops
testing int-inf.compare
difference with -type-check true
testing int-inf.log2
6,12c6,7
< 30
< 31
< 32
< 32
< 33
< 33
< OK
---
> unhandled exception: Domain
> Nonzero exit status.
difference with -type-check true
testing int-overflow
testing int
testing jump
testing kitdangle3
testing kitdangle
testing kitfib35
testing kitkbjul9
testing kitlife35u
testing kitloop2
testing kitmandelbrot
testing kitqsort
testing kitreynolds2
testing kitreynolds3
testing kitsimple
testing kittmergesort
testing kkb36c
testing kkb_eq
testing klife_eq
testing known-case0
testing known-case1
testing lambda-list-ref
testing layout
testing lex
testing lib
testing life
testing listpair
testing list
testing llv
testing local-ref
testing math
testing mlton.overload
testing mlton.share
testing mlton.word
testing modules
testing msort
testing mutex
testing nested-loop
testing nonexhaustive
testing once
testing only-one-exception
testing opaque2
testing opaque
testing open
testing os-exit
testing overloading
testing pack-real
testing pack
testing pack-word
testing parse
testing pat
testing poly-equal.2
testing poly-equal
testing polymorphic-recursion
testing posix-exit
testing posix-procenv
testing print-self
testing prodcons
testing pseudokit
testing real
testing ref-flatten.2
testing ref-flatten.3
testing ref-flatten.4
testing ref-flatten.5
testing ref-flatten.6
testing ref-flatten
testing ring
testing rlimit
Error: rlimit.sml 5.48.
Undefined variable lockedInMemorySize.
Error: rlimit.sml 6.5.
Undefined variable numProcesses.
Error: rlimit.sml 6.19.
Undefined variable residentSetSize.
compilation aborted: parseAndElaborate reported errors
compilation of rlimit failed with -type-check true
testing same-fringe
testing scon
testing semicolon
testing sharing
testing signals2
testing signals
testing sigs
testing size
testing slow2
testing slower
testing slow
testing smith-normal-form
testing socket
testing string2
testing stringcvt
testing string.fromString
testing string
testing substring-overflow
testing substring
testing suspend
testing tak
testing taut
testing testdyn1
testing testMatrix
testing textio.2
testing textio
testing thread0
testing thread1
testing thread2
testing thread-switch
testing time2
testing time3
testing time4
testing timeout
testing time
testing tststrcmp
testing type-check
testing typespec
testing unary.2
testing unary
testing undetermined
testing unixpath
testing useless-string
testing valrec
testing vector2
testing vector3
testing vector4
testing vector-loop
testing vector
testing weak
testing where-and
testing where
testing withtype
testing word8array
testing word8vector
testing word-all
testing wordn-array
testing word
testing world1
testing world2
testing world3
testing world4
testing world5
testing world6
testing barnes-hut
testing boyer
testing checksum
testing count-graphs
testing DLXSimulator
testing fft
testing fib
testing flat-array
skipping fxp
skipping hamlet
testing imp-for
testing knuth-bendix
testing lexgen
testing life
testing logic
testing mandelbrot
testing matrix-multiply
testing md5
testing merge
testing mlyacc
testing model-elimination
testing mpuz
testing nucleic
testing output1
testing peek
testing psdes-random
testing ratio-regions
testing ray
testing raytrace
testing simple
testing smith-normal-form
testing tailfib
testing tak
testing tensor
testing tsp
testing tyan
testing vector-concat
testing vector-rev
testing vliw
testing wc-input1
testing wc-scanStream
testing zebra
testing zern
testing mllex
testing mlyacc
testing mlprof
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/generic-sock.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/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/pointer-tycon.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/FLock-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/Socket-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Socket/UnixSock.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-01-30 00:44:07 UTC (rev 4330)
@@ -9,7 +9,7 @@
"deadCode true"
"sequenceNonUnit warn"
"nonexhaustiveMatch warn" "redundantMatch warn"
- "warnUnused true" "forceUsed"
+ "warnUnused false" "forceUsed"
in
local
../../primitive/primitive.mlb
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-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -7,7 +7,7 @@
structure MLtonProcess =
struct
- structure Prim = Primitive.MLton.Process
+ structure Prim = PrimitiveFFI.MLton.Process
structure MLton = Primitive.MLton
local
open Posix
@@ -219,7 +219,7 @@
then
SysCall.simple
(fn () =>
- Primitive.Windows.Process.terminate (pid, signal))
+ PrimitiveFFI.Windows.Process.terminate (pid, signal))
else Process.kill (Process.K_PROC pid, signal)
in
ignore (reap p)
@@ -267,7 +267,7 @@
| _ => raise Fail "create"
end
val p =
- Primitive.Windows.Process.create
+ PrimitiveFFI.Windows.Process.create
(NullString.nullTerm cmd, args, env, stdin, stdout, stderr)
val p' = Pid.toInt p
in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/generic-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/generic-sock.sml 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/generic-sock.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -7,7 +7,7 @@
structure GenericSock : GENERIC_SOCK =
struct
- structure Prim = Primitive.Socket.GenericSock
+ structure Prim = PrimitiveFFI.Socket.GenericSock
structure PE = Posix.Error
structure PESC = PE.SysCall
@@ -22,13 +22,13 @@
fun socketPair' (af, st, p) =
let
- val s1 = ref 0
- val s2 = ref 0
+ val a = Array.array (2, 0)
in
PESC.syscall
(fn () =>
- let val n = Prim.socketPair (NetHostDB.addrFamilyToInt af, st, p, s1, s2)
- in (n, fn () => (intToSock (!s1), intToSock (!s2)))
+ let val n = Prim.socketPair (NetHostDB.addrFamilyToInt af, st, p, a)
+ in (n, fn () => (intToSock (Array.sub (a, 0)),
+ intToSock (Array.sub (a, 1))))
end)
end
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 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -7,7 +7,7 @@
structure INetSock:> INET_SOCK =
struct
- structure Prim = Primitive.Socket.INetSock
+ structure Prim = PrimitiveFFI.Socket.INetSock
datatype inet = INET (* a phantom type*)
type 'sock_type sock = (inet, 'sock_type) Socket.sock
@@ -15,7 +15,7 @@
type dgram_sock = Socket.dgram sock
type sock_addr = inet Socket.sock_addr
- val inetAF = NetHostDB.intToAddrFamily Primitive.Socket.AF.INET
+ val inetAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.INET
fun toAddr (in_addr, port) =
if port < 0 orelse port >= 0x10000
@@ -51,7 +51,7 @@
structure TCP =
struct
- structure Prim = Prim.TCP
+ structure Prim = Prim.Ctl
fun socket' prot =
GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
@@ -60,10 +60,10 @@
fun getNODELAY sock =
Socket.CtlExtra.getSockOptBool
- (Prim.TCP, Prim.NODELAY) sock
+ (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) sock
fun setNODELAY (sock,optval) =
Socket.CtlExtra.setSockOptBool
- (Prim.TCP, Prim.NODELAY) (sock,optval)
+ (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) (sock,optval)
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig 2006-01-30 00:44:07 UTC (rev 4330)
@@ -171,7 +171,7 @@
val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) sock
type pre_sock_addr
val unpackSockAddr: 'af sock_addr -> Word8Vector.vector
- val new_sock_addr: unit -> (pre_sock_addr * int ref * (unit -> 'af sock_addr))
+ val new_sock_addr: unit -> (pre_sock_addr * C.Socklen.t ref * (unit -> 'af sock_addr))
structure CtlExtra:
sig
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 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -6,33 +6,35 @@
*)
structure Socket:> SOCKET_EXTRA
- where type SOCK.sock_type = Primitive.Socket.SOCK.sock_type
+ where type SOCK.sock_type = C.Int.t
where type pre_sock_addr = Word8.word array
=
struct
-structure Prim = Primitive.Socket
+structure Prim = PrimitiveFFI.Socket
structure Error = Posix.Error
structure Syscall = Error.SysCall
structure FileSys = Posix.FileSys
-type sock = Prim.sock
-val sockToWord = SysWord.fromInt o Prim.toInt
-val wordToSock = Prim.fromInt o SysWord.toInt
+type sock = C.Sock.t
+val sockToWord = SysWord.fromInt o C.Sock.toInt
+val wordToSock = C.Sock.fromInt o SysWord.toInt
fun sockToFD sock = FileSys.wordToFD (sockToWord sock)
fun fdToSock fd = wordToSock (FileSys.fdToWord fd)
-type pre_sock_addr = Prim.pre_sock_addr
-datatype sock_addr = SA of Prim.sock_addr
+type pre_sock_addr = Word8.word array
+datatype sock_addr = SA of Word8.word vector
fun unpackSockAddr (SA sa) = Word8Vector.fromPoly sa
-fun new_sock_addr (): (pre_sock_addr * int ref * (unit -> sock_addr)) =
+fun new_sock_addr (): (pre_sock_addr * C.Socklen.t ref * (unit -> sock_addr)) =
let
- val sa = Array.array (Prim.sockAddrLenMax, 0wx0)
- val salen = ref (Array.length sa)
+ val salen = C.Size.toInt Prim.sockAddrStorageLen
+ val sa = Array.array (salen, 0wx0)
+ val salenRef = ref (C.Socklen.fromInt salen)
fun finish () =
- SA (ArraySlice.vector (ArraySlice.slice (sa, 0, SOME (!salen))))
+ SA (ArraySlice.vector (ArraySlice.slice
+ (sa, 0, SOME (C.Socklen.toInt (!salenRef)))))
in
- (sa, salen, finish)
+ (sa, salenRef, finish)
end
datatype dgram = DGRAM (* phantom *)
datatype stream = MODE (* phantom *)
@@ -62,7 +64,7 @@
structure SOCK =
struct
- type sock_type = Prim.SOCK.sock_type
+ type sock_type = C.Int.t
val stream = Prim.SOCK.STREAM
val dgram = Prim.SOCK.DGRAM
val names = [
@@ -82,9 +84,9 @@
structure CtlExtra =
struct
- type level = Prim.Ctl.level
- type optname = Prim.Ctl.optname
- type request = Prim.Ctl.request
+ type level = C.Int.t
+ type optname = C.Int.t
+ type request = C.Int.t
(* host byte order *)
structure PW = PackWord32Host
@@ -140,14 +142,14 @@
fun getSockOpt (level: level, optname: optname) s =
let
val optval = Word8Array.array (optlen, 0wx0)
- val optlen = ref optlen
+ val optlen = ref (C.Socklen.fromInt optlen)
in
Syscall.simple
(fn () =>
Prim.Ctl.getSockOpt (s, level, optname,
Word8Array.toPoly optval,
optlen))
- ; unmarshal (optval, !optlen, 0)
+ ; unmarshal (optval, C.Socklen.toInt (!optlen), 0)
end
fun setSockOpt (level: level, optname: optname) (s, optval) =
let
@@ -158,7 +160,7 @@
(fn () =>
Prim.Ctl.setSockOpt (s, level, optname,
Word8Vector.toPoly optval,
- optlen))
+ C.Socklen.fromInt optlen))
end
fun getIOCtl (request: request) s : 'a =
let
@@ -191,36 +193,35 @@
make (timeOptLen, marshalTimeOpt, unmarshalTimeOpt)
end
- val getDEBUG = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG)
- val setDEBUG = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG)
- val getREUSEADDR = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.REUSEADDR)
- val setREUSEADDR = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.REUSEADDR)
- val getKEEPALIVE = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.KEEPALIVE)
- val setKEEPALIVE = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.KEEPALIVE)
- val getDONTROUTE = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DONTROUTE)
- val setDONTROUTE = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DONTROUTE)
- val getBROADCAST = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.BROADCAST)
- val getLINGER = getSockOptTimeOpt (Prim.Ctl.SOCKET, Prim.Ctl.LINGER)
- val setLINGER = setSockOptTimeOpt (Prim.Ctl.SOCKET, Prim.Ctl.LINGER)
- val setBROADCAST = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.BROADCAST)
- val getOOBINLINE = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.OOBINLINE)
- val setOOBINLINE = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.OOBINLINE)
- val getSNDBUF = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.SNDBUF)
- val setSNDBUF = setSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.SNDBUF)
- val getRCVBUF = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF)
- val setRCVBUF = setSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF)
- fun getTYPE s =
- Prim.SOCK.fromInt (getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.TYPE) s)
+ val getDEBUG = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DEBUG)
+ val setDEBUG = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DEBUG)
+ val getREUSEADDR = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_REUSEADDR)
+ val setREUSEADDR = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_REUSEADDR)
+ val getKEEPALIVE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_KEEPALIVE)
+ val setKEEPALIVE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_KEEPALIVE)
+ val getDONTROUTE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
+ val setDONTROUTE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
+ val getBROADCAST = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
+ val getLINGER = getSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
+ val setLINGER = setSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
+ val setBROADCAST = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
+ val getOOBINLINE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
+ val setOOBINLINE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
+ val getSNDBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
+ val setSNDBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
+ val getRCVBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
+ val setRCVBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
+ fun getTYPE s = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_TYPE) s
fun getERROR s =
let
- val se = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.ERROR) s
+ val se = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_ERROR) s
in
if 0 = se
then NONE
else SOME (Posix.Error.errorMsg se, SOME se)
end handle Error.SysErr z => SOME z
local
- fun getName (s, f: Prim.sock * pre_sock_addr * int ref -> int) =
+ fun getName (s, f: sock * pre_sock_addr * C.Socklen.t ref -> int) =
let
val (sa, salen, finish) = new_sock_addr ()
val () = Syscall.simple (fn () => f (s, sa, salen))
@@ -231,8 +232,8 @@
fun getPeerName s = getName (s, Prim.Ctl.getPeerName)
fun getSockName s = getName (s, Prim.Ctl.getSockName)
end
- val getNREAD = getIOCtlInt Prim.Ctl.NREAD
- val getATMARK = getIOCtlBool Prim.Ctl.ATMARK
+ val getNREAD = getIOCtlInt Prim.Ctl.FIONREAD
+ val getATMARK = getIOCtlBool Prim.Ctl.SIOCATMARK
end
structure Ctl =
@@ -247,7 +248,7 @@
fun familyOfAddr (SA sa) = NetHostDB.intToAddrFamily (Prim.familyOfAddr sa)
fun bind (s, SA sa) =
- Syscall.simple (fn () => Prim.bind (s, sa, Vector.length sa))
+ Syscall.simple (fn () => Prim.bind (s, sa, C.Socklen.fromInt (Vector.length sa)))
fun listen (s, n) =
Syscall.simple (fn () => Prim.listen (s, n))
@@ -271,7 +272,7 @@
in
fun withNonBlock (s, f: unit -> 'a) =
let
- val fd = Primitive.FileDesc.fromInt (Prim.toInt s)
+ val fd = s
val flags =
Syscall.simpleResultRestart (fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
val _ =
@@ -289,12 +290,12 @@
end
fun connect (s, SA sa) =
- Syscall.simple (fn () => Prim.connect (s, sa, Vector.length sa))
+ Syscall.simple (fn () => Prim.connect (s, sa, C.Socklen.fromInt (Vector.length sa)))
fun connectNB (s, SA sa) =
nonBlock'
({restart = false}, fn () =>
- withNonBlock (s, fn () => Prim.connect (s, sa, Vector.length sa)),
+ withNonBlock (s, fn () => Prim.connect (s, sa, C.Socklen.fromInt (Vector.length sa))),
fn _ => true,
Error.inprogress, false)
@@ -303,7 +304,7 @@
val (sa, salen, finish) = new_sock_addr ()
val s = Syscall.simpleResultRestart (fn () => Prim.accept (s, sa, salen))
in
- (Prim.fromInt s, finish ())
+ (s, finish ())
end
fun acceptNB s =
@@ -312,7 +313,7 @@
in
nonBlock
(fn () => withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
- fn s => SOME (Prim.fromInt s, finish ()),
+ fn s => SOME (s, finish ()),
NONE)
end
@@ -380,8 +381,8 @@
type out_flags = {don't_route: bool, oob: bool}
fun mk_out_flags {don't_route, oob} =
- Word.orb (if don't_route then Prim.MSG_DONTROUTE else 0wx0,
- Word.orb (if oob then Prim.MSG_OOB else 0wx0,
+ Word.orb (if don't_route then Word.fromInt Prim.MSG_DONTROUTE else 0wx0,
+ Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
0wx0))
val no_out_flags = {don't_route = false, oob = false}
@@ -396,7 +397,8 @@
val (buf, i, sz) = base sl
in
Syscall.simpleResultRestart
- (fn () => primSend (s, buf, i, sz, mk_out_flags out_flags))
+ (fn () => primSend (s, buf, i, C.Size.fromInt sz,
+ Word.toInt (mk_out_flags out_flags)))
end
fun send (sock, buf) = send' (sock, buf, no_out_flags)
fun sendNB' (s, sl, out_flags) =
@@ -405,8 +407,10 @@
in
nonBlock
(fn () =>
- primSend (s, buf, i, sz,
- Word.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags)),
+ primSend (s, buf, i, C.Size.fromInt sz,
+ Word.toInt (
+ Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
+ mk_out_flags out_flags))),
SOME,
NONE)
end
@@ -417,8 +421,9 @@
in
Syscall.simpleRestart
(fn () =>
- primSendTo (s, buf, i, sz,
- mk_out_flags out_flags, sa, Vector.length sa))
+ primSendTo (s, buf, i, C.Size.fromInt sz,
+ Word.toInt (mk_out_flags out_flags),
+ sa, C.Socklen.fromInt (Vector.length sa)))
end
fun sendTo (sock, sock_addr, sl) =
sendTo' (sock, sock_addr, sl, no_out_flags)
@@ -428,10 +433,11 @@
in
nonBlock
(fn () =>
- primSendTo (s, buf, i, sz,
- Word.orb (Prim.MSG_DONTWAIT,
- mk_out_flags out_flags),
- sa, Vector.length sa),
+ primSendTo (s, buf, i, C.Size.fromInt sz,
+ Word.toInt (
+ Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
+ mk_out_flags out_flags)),
+ sa, C.Socklen.fromInt (Vector.length sa)),
fn _ => true,
false)
end
@@ -444,11 +450,11 @@
val (sendArr, sendArr', sendArrNB, sendArrNB',
sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') =
make (Word8ArraySlice.base, Word8Array.toPoly,
- Prim.sendArr, Prim.sendToArr)
+ Prim.sendArr, Prim.sendArrTo)
val (sendVec, sendVec', sendVecNB, sendVecNB',
sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') =
make (Word8VectorSlice.base, Word8Vector.toPoly,
- Prim.sendVec, Prim.sendToVec)
+ Prim.sendVec, Prim.sendVecTo)
end
type in_flags = {peek: bool, oob: bool}
@@ -456,8 +462,8 @@
val no_in_flags = {peek = false, oob = false}
fun mk_in_flags {peek, oob} =
- Word.orb (if peek then Prim.MSG_PEEK else 0wx0,
- Word.orb (if oob then Prim.MSG_OOB else 0wx0,
+ Word.orb (if peek then Word.fromInt Prim.MSG_PEEK else 0wx0,
+ Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
0wx0))
fun recvArr' (s, sl, in_flags) =
@@ -465,7 +471,8 @@
val (buf, i, sz) = Word8ArraySlice.base sl
in
Syscall.simpleResultRestart
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, sz, mk_in_flags in_flags))
+ (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ Word.toInt (mk_in_flags in_flags)))
end
fun getVec (a, n, bytesRead) =
@@ -492,8 +499,9 @@
val (sa, salen, finish) = new_sock_addr ()
val n =
Syscall.simpleResultRestart
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, sz,
- mk_in_flags in_flags, sa, salen))
+ (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ Word.toInt (mk_in_flags in_flags),
+ sa, salen))
in
(n, finish ())
end
@@ -511,15 +519,15 @@
fun recvVecFrom (sock, n) = recvVecFrom' (sock, n, no_in_flags)
-fun mk_in_flagsNB z = Word.orb (mk_in_flags z, Prim.MSG_DONTWAIT)
+fun mk_in_flagsNB z = Word.orb (mk_in_flags z, Word.fromInt Prim.MSG_DONTWAIT)
fun recvArrNB' (s, sl, in_flags) =
let
val (buf, i, sz) = Word8ArraySlice.base sl
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, sz,
- mk_in_flagsNB in_flags),
+ (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ Word.toInt (mk_in_flagsNB in_flags)),
SOME,
NONE)
end
@@ -529,8 +537,8 @@
val a = Word8Array.rawArray n
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly a, 0, n,
- mk_in_flagsNB in_flags),
+ (fn () => Prim.recv (s, Word8Array.toPoly a, 0, C.Size.fromInt n,
+ Word.toInt (mk_in_flagsNB in_flags)),
fn bytesRead => SOME (getVec (a, n, bytesRead)),
NONE)
end
@@ -545,8 +553,8 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, sz,
- mk_in_flagsNB in_flags, sa, salen),
+ (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ Word.toInt (mk_in_flagsNB in_flags), sa, salen),
fn n => SOME (n, finish ()),
NONE)
end
@@ -557,8 +565,8 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, n,
- mk_in_flagsNB in_flags, sa, salen),
+ (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C.Size.fromInt n,
+ Word.toInt (mk_in_flagsNB in_flags), sa, salen),
fn bytesRead => SOME (getVec (a, n, bytesRead), finish ()),
NONE)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -7,19 +7,21 @@
structure UnixSock : UNIX_SOCK =
struct
- structure Prim = Primitive.Socket.UnixSock
+ structure Prim = PrimitiveFFI.Socket.UnixSock
datatype unix = UNIX
type 'sock_type sock = (unix, 'sock_type) Socket.sock
type 'mode stream_sock = 'mode Socket.stream sock
type dgram_sock = Socket.dgram sock
type sock_addr = unix Socket.sock_addr
- val unixAF = NetHostDB.intToAddrFamily Primitive.Socket.AF.UNIX
+ val unixAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.UNIX
fun toAddr s =
let
val (sa, salen, finish) = Socket.new_sock_addr ()
- val _ = Prim.toAddr (NullString.nullTerm s, String.size s, sa, salen)
+ val _ = Prim.toAddr (NullString.nullTerm s,
+ C.Size.fromInt (String.size s),
+ sa, salen)
in
finish ()
end
@@ -29,10 +31,10 @@
val sa = Socket.unpackSockAddr sa
val sa = Word8Vector.toPoly sa
val len = Prim.pathLen sa
- val a = CharArray.array (len, #"\000")
+ val a = CharArray.array (C.Size.toInt len, #"\000")
val _ = Prim.fromAddr (sa, CharArray.toPoly a, len)
in
- CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME len))
+ CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME (C.Size.toInt len)))
end
structure Strm =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -80,15 +80,6 @@
fn SEEK_SET => Prim.SEEK_SET
| SEEK_CUR => Prim.SEEK_CUR
| SEEK_END => Prim.SEEK_END
-
-fun intToWhence n =
- if n = Prim.SEEK_SET
- then SEEK_SET
- else if n = Prim.SEEK_CUR
- then SEEK_CUR
- else if n = Prim.SEEK_END
- then SEEK_END
- else raise Fail "Posix.IO.intToWhence"
fun lseek (fd, n: Position.int, w: whence): Position.int =
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 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -19,23 +19,6 @@
; Error.raiseSys Error.nosys)
else f
in
- structure Primitive =
- struct
- open Primitive
-
- structure Socket =
- struct
- open Socket
-
- structure UnixSock =
- struct
- open UnixSock
-
- val toAddr = stub ("toAddr", toAddr)
- val fromAddr = stub ("fromAddr", fromAddr)
- end
- end
- end
structure PrimitiveFFI =
struct
open PrimitiveFFI
@@ -155,5 +138,18 @@
end
end
end
+
+ structure Socket =
+ struct
+ open Socket
+
+ structure UnixSock =
+ struct
+ open UnixSock
+
+ val toAddr = stub ("toAddr", toAddr)
+ val fromAddr = stub ("fromAddr", fromAddr)
+ end
+ end
end
end
Added: 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 2006-01-29 21:18:38 UTC (rev 4329)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-01-30 00:44:07 UTC (rev 4330)
@@ -0,0 +1,1000 @@
+(* This file is automatically generated. Do not edit. *)
+
+structure PrimitiveFFI =
+struct
+structure CommandLine =
+struct
+val (argcGet, argcSet) = _symbol "CommandLine_argc": (unit -> (C.Int.t)) * ((C.Int.t) -> unit);
+val (argvGet, argvSet) = _symbol "CommandLine_argv": (unit -> (C.StringArray.t)) * ((C.StringArray.t) -> unit);
+val (commandNameGet, commandNameSet) = _symbol "CommandLine_commandName": (unit -> (C.String.t)) * ((C.String.t) -> unit);
+end
+structure Date =
+struct
+val gmTime = _import "Date_gmTime" : (C.Time.t) ref -> (C.Int.t) C.Errno.t;
+val localOffset = _import "Date_localOffset" : unit -> C.Double.t;
+val localTime = _import "Date_localTime" : (C.Time.t) ref -> (C.Int.t) C.Errno.t;
+val mkTime = _import "Date_mkTime" : unit -> (C.Time.t) C.Errno.t;
+val strfTime = _import "Date_strfTime" : (Char8.t) array * C.Size.t * NullString8.t -> C.Size.t;
+structure Tm =
+struct
+val getHour = _import "Date_Tm_getHour" : unit -> C.Int.t;
+val getIsDst = _import "Date_Tm_getIsDst" : unit -> C.Int.t;
+val getMDay = _import "Date_Tm_getMDay" : unit -> C.Int.t;
+val getMin = _import "Date_Tm_getMin" : unit -> C.Int.t;
+val getMon = _import "Date_Tm_getMon" : unit -> C.Int.t;
+val getSec = _import "Date_Tm_getSec" : unit -> C.Int.t;
+val getWDay = _import "Date_Tm_getWDay" : unit -> C.Int.t;
+val getYDay = _import "Date_Tm_getYDay" : unit -> C.Int.t;
+val getYear = _import "Date_Tm_getYear" : unit -> C.Int.t;
+val setHour = _import "Date_Tm_setHour" : C.Int.t -> unit;
+val setIsDst = _import "Date_Tm_setIsDst" : C.Int.t -> unit;
+val setMDay = _import "Date_Tm_setMDay" : C.Int.t -> unit;
+val setMin = _import "Date_Tm_setMin" : C.Int.t -> unit;
+val setMon = _import "Date_Tm_setMon" : C.Int.t -> unit;
+val setSec = _import "Date_Tm_setSec" : C.Int.t -> unit;
+val setWDay = _import "Date_Tm_setWDay" : C.Int.t -> unit;
+val setYDay = _import "Date_Tm_setYDay" : C.Int.t -> unit;
+val setYear = _import "Date_Tm_setYear" : C.Int.t -> unit;
+end
+end
+structure IEEEReal =
+struct
+val getRoundingMode = _import "IEEEReal_getRoundingMode" : unit -> C.Int.t;
+structure RoundingMode =
+struct
+val FE_DOWNWARD = _const "IEEEReal_RoundingMode_FE_DOWNWARD" : C.Int.t;
+val FE_NOSUPPORT = _const "IEEEReal_RoundingMode_FE_NOSUPPORT" : C.Int.t;
+val FE_TONEAREST = _const "IEEEReal_RoundingMode_FE_TONEAREST" : C.Int.t;
+val FE_TOWARDZERO = _const "IEEEReal_RoundingMode_FE_TOWARDZERO" : C.Int.t;
+val FE_UPWARD = _const "IEEEReal_RoundingMode_FE_UPWARD" : C.Int.t;
+end
+val setRoundingMode = _import "IEEEReal_setRoundingMode" : C.Int.t -> unit;
+end
+structure MLton =
+struct
+structure Itimer =
+struct
+val PROF = _const "MLton_Itimer_PROF" : C.Int.t;
+val REAL = _const "MLton_Itimer_REAL" : C.Int.t;
+val set = _import "MLton_Itimer_set" : C.Int.t * C.Time.t * C.SUSeconds.t * C.Time.t * C.SUSeconds.t -> (C.Int.t) C.Errno.t;
+val VIRTUAL = _const "MLton_Itimer_VIRTUAL" : C.Int.t;
+end
+structure Process =
+struct
+val cwait = _import "MLton_Process_cwait" : C.PId.t * (C.Status.t) ref -> (C.PId.t) C.Errno.t;
+val spawne = _import "MLton_Process_spawne" : NullString8.t * NullString8Array.t * NullString8Array.t -> (C.Int.t) C.Errno.t;
+val spawnp = _import "MLton_Process_spawnp" : NullString8.t * NullString8Array.t -> (C.Int.t) C.Errno.t;
+end
+structure Rlimit =
+struct
+val AS = _const "MLton_Rlimit_AS" : C.Int.t;
+val CORE = _const "MLton_Rlimit_CORE" : C.Int.t;
+val CPU = _const "MLton_Rlimit_CPU" : C.Int.t;
+val DATA = _const "MLton_Rlimit_DATA" : C.Int.t;
+val FSIZE = _const "MLton_Rlimit_FSIZE" : C.Int.t;
+val get = _import "MLton_Rlimit_get" : C.Int.t -> (C.Int.t) C.Errno.t;
+val getHard = _import "MLton_Rlimit_getHard" : unit -> C.RLim.t;
+val getSoft = _import "MLton_Rlimit_getSoft" : unit -> C.RLim.t;
+val INFINITY = _const "MLton_Rlimit_INFINITY" : C.RLim.t;
+val NOFILE = _const "MLton_Rlimit_NOFILE" : C.Int.t;
+val set = _import "MLton_Rlimit_set" : C.Int.t * C.RLim.t * C.RLim.t -> (C.Int.t) C.Errno.t;
+val STACK = _const "MLton_Rlimit_STACK" : C.Int.t;
+end
+structure Rusage =
+struct
+val children_stime_sec = _import "MLton_Rusage_children_stime_sec" : unit -> C.Time.t;
+val children_stime_usec = _import "MLton_Rusage_children_stime_usec" : unit -> C.SUSeconds.t;
+val children_utime_sec = _import "MLton_Rusage_children_utime_sec" : unit -> C.Time.t;
+val children_utime_usec = _import "MLton_Rusage_children_utime_usec" : unit -> C.SUSeconds.t;
+val gc_stime_sec = _import "MLton_Rusage_gc_stime_sec" : unit -> C.Time.t;
+val gc_stime_usec = _import "MLton_Rusage_gc_stime_usec" : unit -> C.SUSeconds.t;
+val gc_utime_sec = _import "MLton_Rusage_gc_utime_sec" : unit -> C.Time.t;
+val gc_utime_usec = _import "MLton_Rusage_gc_utime_usec" : unit -> C.SUSeconds.t;
+val getrusage = _import "MLton_Rusage_getrusage" : unit -> unit;
+val self_stime_sec = _import "MLton_Rusage_self_stime_sec" : unit -> C.Time.t;
+val self_stime_usec = _import "MLton_Rusage_self_stime_usec" : unit -> C.SUSeconds.t;
+val self_utime_sec = _import "MLton_Rusage_self_utime_sec" : unit -> C.Time.t;
+val self_utime_usec = _import "MLton_Rusage_self_utime_usec" : unit -> C.SUSeconds.t;
+end
+structure Syslog =
+struct
+val closelog = _import "MLton_Syslog_closelog" : unit -> unit;
+structure Facility =
+struct
+val LOG_AUTH = _const "MLton_Syslog_Facility_LOG_AUTH" : C.Int.t;
+val LOG_CRON = _const "MLton_Syslog_Facility_LOG_CRON" : C.Int.t;
+val LOG_DAEMON = _const "MLton_Syslog_Facility_LOG_DAEMON" : C.Int.t;
+val LOG_KERN = _const "MLton_Syslog_Facility_LOG_KERN" : C.Int.t;
+val LOG_LOCAL0 = _const "MLton_Syslog_Facility_LOG_LOCAL0" : C.Int.t;
+val LOG_LOCAL1 = _const "MLton_Syslog_Facility_LOG_LOCAL1" : C.Int.t;
+val LOG_LOCAL2 = _const "MLton_Syslog_Facility_LOG_LOCAL2" : C.Int.t;
+val LOG_LOCAL3 = _const "MLton_Syslog_Facility_LOG_LOCAL3" : C.Int.t;
+val LOG_LOCAL4 = _const "MLton_Syslog_Facility_LOG_LOCAL4" : C.Int.t;
+val LOG_LOCAL5 = _const "MLton_Syslog_Facility_LOG_LOCAL5" : C.Int.t;
+val LOG_LOCAL6 = _const "MLton_Syslog_Facility_LOG_LOCAL6" : C.Int.t;
+val LOG_LOCAL7 = _const "MLton_Syslog_Facility_LOG_LOCAL7" : C.Int.t;
+val LOG_LPR = _const "MLton_Syslog_Facility_LOG_LPR" : C.Int.t;
+val LOG_MAIL = _const "MLton_Syslog_Facility_LOG_MAIL" : C.Int.t;
+val LOG_NEWS = _const "MLton_Syslog_Facility_LOG_NEWS" : C.Int.t;
+val LOG_USER = _const "MLton_Syslog_Facility_LOG_USER" : C.Int.t;
+val LOG_UUCP = _const "MLton_Syslog_Facility_LOG_UUCP" : C.Int.t;
+end
+structure Logopt =
+struct
+val LOG_CONS = _const "MLton_Syslog_Logopt_LOG_CONS" : C.Int.t;
+val LOG_NDELAY = _const "MLton_Syslog_Logopt_LOG_NDELAY" : C.Int.t;
+val LOG_NOWAIT = _const "MLton_Syslog_Logopt_LOG_NOWAIT" : C.Int.t;
+val LOG_ODELAY = _const "MLton_Syslog_Logopt_LOG_ODELAY" : C.Int.t;
+val LOG_PID = _const "MLton_Syslog_Logopt_LOG_PID" : C.Int.t;
+end
+val openlog = _import "MLton_Syslog_openlog" : NullString8.t * C.Int.t * C.Int.t -> unit;
+structure Severity =
+struct
+val LOG_ALERT = _const "MLton_Syslog_Severity_LOG_ALERT" : C.Int.t;
+val LOG_CRIT = _const "MLton_Syslog_Severity_LOG_CRIT" : C.Int.t;
+val LOG_DEBUG = _const "MLton_Syslog_Severity_LOG_DEBUG" : C.Int.t;
+val LOG_EMERG = _const "MLton_Syslog_Severity_LOG_EMERG" : C.Int.t;
+val LOG_ERR = _const "MLton_Syslog_Severity_LOG_ERR" : C.Int.t;
+val LOG_INFO = _const "MLton_Syslog_Severity_LOG_INFO" : C.Int.t;
+val LOG_NOTICE = _const "MLton_Syslog_Severity_LOG_NOTICE" : C.Int.t;
+val LOG_WARNING = _const "MLton_Syslog_Severity_LOG_WARNING" : C.Int.t;
+end
+val syslog = _import "MLton_Syslog_syslog" : C.Int.t * NullString8.t -> unit;
+end
+end
+structure Net =
+struct
+val htonl = _import "Net_htonl" : Word32.t -> Word32.t;
+val htons = _import "Net_htons" : Word16.t -> Word16.t;
+val ntohl = _import "Net_ntohl" : Word32.t -> Word32.t;
+val ntohs = _import "Net_ntohs" : Word16.t -> Word16.t;
+end
+structure NetHostDB =
+struct
+val getByAddress = _import "NetHostDB_getByAddress" : (Word8.t) vector * C.Socklen.t -> Bool.t;
+val getByName = _import "NetHostDB_getByName" : NullString8.t -> Bool.t;
+val getEntryAddrsN = _import "NetHostDB_getEntryAddrsN" : C.Int.t * (Word8.t) array -> unit;
+val getEntryAddrsNum = _import "NetHostDB_getEntryAddrsNum" : unit -> C.Int.t;
+val getEntryAddrType = _import "NetHostDB_getEntryAddrType" : unit -> C.Int.t;
+val getEntryAliasesN = _import "NetHostDB_getEntryAliasesN" : C.Int.t -> C.String.t;
+val getEntryAliasesNum = _import "NetHostDB_getEntryAliasesNum" : unit -> C.Int.t;
+val getEntryLength = _import "NetHostDB_getEntryLength" : unit -> C.Int.t;
+val getEntryName = _import "NetHostDB_getEntryName" : unit -> C.String.t;
+val getHostName = _import "NetHostDB_getHostName" : (Char8.t) array * C.Size.t -> (C.Int.t) C.Errno.t;
+val INADDR_ANY = _const "NetHostDB_INADDR_ANY" : C.Int.t;
+val inAddrSize = _const "NetHostDB_inAddrSize" : C.Size.t;
+end
+structure NetProtDB =
+struct
+val getByName = _import "NetProtDB_getByName" : NullString8.t -> Bool.t;
+val getByNumber = _import "NetProtDB_getByNumber" : C.Int.t -> Bool.t;
+val getEntryAliasesN = _import "NetProtDB_getEntryAliasesN" : C.Int.t -> C.String.t;
+val getEntryAliasesNum = _import "NetProtDB_getEntryAliasesNum" : unit -> C.Int.t;
+val getEntryName = _import "NetProtDB_getEntryName" : unit -> C.String.t;
+val getEntryProto = _import "NetProtDB_getEntryProto" : unit -> C.Int.t;
+end
+structure NetServDB =
+struct
+val getByName = _import "NetServDB_getByName" : NullString8.t * NullString8.t -> Bool.t;
+val getByNameNull = _import "NetServDB_getByNameNull" : NullString8.t -> Bool.t;
+val getByPort = _import "NetServDB_getByPort" : C.Int.t * NullString8.t -> Bool.t;
+val getByPortNull = _import "NetServDB_getByPortNull" : C.Int.t -> Bool.t;
+val getEntryAliasesN = _import "NetServDB_getEntryAliasesN" : C.Int.t -> C.String.t;
+val getEntryAliasesNum = _import "NetServDB_getEntryAliasesNum" : unit -> C.Int.t;
+val getEntryName = _import "NetServDB_getEntryName" : unit -> C.String.t;
+val getEntryPort = _import "NetServDB_getEntryPort" : unit -> C.Int.t;
+val getEntryProto = _import "NetServDB_getEntryProto" : unit -> C.String.t;
+end
+structure OS =
+struct
+structure IO =
+struct
+val poll = _import "OS_IO_poll" : (C.Fd.t) vector * (C.Short.t) vector * C.NFds.t * C.Int.t * (C.Short.t) array -> (C.Int.t) C.Errno.t;
+val POLLIN = _const "OS_IO_POLLIN" : C.Short.t;
+val POLLOUT = _const "OS_IO_POLLOUT" : C.Short.t;
+val POLLPRI = _const "OS_IO_POLLPRI" : C.Short.t;
+end
+end
+structure Posix =
+struct
+structure Error =
+struct
+val clearErrno = _import "Posix_Error_clearErrno" : unit -> unit;
+val E2BIG = _const "Posix_Error_E2BIG" : C.Int.t;
+val EACCES = _const "Posix_Error_EACCES" : C.Int.t;
+val EADDRINUSE = _const "Posix_Error_EADDRINUSE" : C.Int.t;
+val EADDRNOTAVAIL = _const "Posix_Error_EADDRNOTAVAIL" : C.Int.t;
+val EAFNOSUPPORT = _const "Posix_Error_EAFNOSUPPORT" : C.Int.t;
+val EAGAIN = _const "Posix_Error_EAGAIN" : C.Int.t;
+val EALREADY = _const "Posix_Error_EALREADY" : C.Int.t;
+val EBADF = _const "Posix_Error_EBADF" : C.Int.t;
+val EBADMSG = _const "Posix_Error_EBADMSG" : C.Int.t;
+val EBUSY = _const "Posix_Error_EBUSY" : C.Int.t;
+val ECANCELED = _const "Posix_Error_ECANCELED" : C.Int.t;
+val ECHILD = _const "Posix_Error_ECHILD" : C.Int.t;
+val ECONNABORTED = _const "Posix_Error_ECONNABORTED" : C.Int.t;
+val ECONNREFUSED = _const "Posix_Error_ECONNREFUSED" : C.Int.t;
+val ECONNRESET = _const "Posix_Error_ECONNRESET" : C.Int.t;
+val EDEADLK = _const "Posix_Error_EDEADLK" : C.Int.t;
+val EDESTADDRREQ = _const "Posix_Error_EDESTADDRREQ" : C.Int.t;
+val EDOM = _const "Posix_Error_EDOM" : C.Int.t;
+val EDQUOT = _const "Posix_Error_EDQUOT" : C.Int.t;
+val EEXIST = _const "Posix_Error_EEXIST" : C.Int.t;
+val EFAULT = _const "Posix_Error_EFAULT" : C.Int.t;
+val EFBIG = _const "Posix_Error_EFBIG" : C.Int.t;
+val EHOSTUNREACH = _const "Posix_Error_EHOSTUNREACH" : C.Int.t;
+val EIDRM = _const "Posix_Error_EIDRM" : C.Int.t;
+val EILSEQ = _const "Posix_Error_EILSEQ" : C.Int.t;
+val EINPROGRESS = _const "Posix_Error_EINPROGRESS" : C.Int.t;
+val EINTR = _const "Posix_Error_EINTR" : C.Int.t;
+val EINVAL = _const "Posix_Error_EINVAL" : C.Int.t;
+val EIO = _const "Posix_Error_EIO" : C.Int.t;
+val EISCONN = _const "Posix_Error_EISCONN" : C.Int.t;
+val EISDIR = _const "Posix_Error_EISDIR" : C.Int.t;
+val ELOOP = _const "Posix_Error_ELOOP" : C.Int.t;
+val EMFILE = _const "Posix_Error_EMFILE" : C.Int.t;
+val EMLINK = _const "Posix_Error_EMLINK" : C.Int.t;
+val EMSGSIZE = _const "Posix_Error_EMSGSIZE" : C.Int.t;
+val EMULTIHOP = _const "Posix_Error_EMULTIHOP" : C.Int.t;
+val ENAMETOOLONG = _const "Posix_Error_ENAMETOOLONG" : C.Int.t;
+val ENETDOWN = _const "Posix_Error_ENETDOWN" : C.Int.t;
+val ENETRESET = _const "Posix_Error_ENETRESET" : C.Int.t;
+val ENETUNREACH = _const "Posix_Error_ENETUNREACH" : C.Int.t;
+val ENFILE = _const "Posix_Error_ENFILE" : C.Int.t;
+val ENOBUFS = _const "Posix_Error_ENOBUFS" : C.Int.t;
+val ENODATA = _const "Posix_Error_ENODATA" : C.Int.t;
+val ENODEV = _const "Posix_Error_ENODEV" : C.Int.t;
+val ENOENT = _const "Posix_Error_ENOENT" : C.Int.t;
+val ENOEXEC = _const "Posix_Error_ENOEXEC" : C.Int.t;
+val ENOLCK = _const "Posix_Error_ENOLCK" : C.Int.t;
+val ENOLINK = _const "Posix_Error_ENOLINK" : C.Int.t;
+val ENOMEM = _const "Posix_Error_ENOMEM" : C.Int.t;
+val ENOMSG = _const "Posix_Error_ENOMSG" : C.Int.t;
+val ENOPROTOOPT = _const "Posix_Error_ENOPROTOOPT" : C.Int.t;
+val ENOSPC = _const "Posix_Error_ENOSPC" : C.Int.t;
+val ENOSR = _const "Posix_Error_ENOSR" : C.Int.t;
+val ENOSTR = _const "Posix_Error_ENOSTR" : C.Int.t;
+val ENOSYS = _const "Posix_Error_ENOSYS" : C.Int.t;
+val ENOTCONN = _const "Posix_Error_ENOTCONN" : C.Int.t;
+val ENOTDIR = _const "Posix_Error_ENOTDIR" : C.Int.t;
+val ENOTEMPTY = _const "Posix_Error_ENOTEMPTY" : C.Int.t;
+val ENOTSOCK = _const "Posix_Error_ENOTSOCK" : C.Int.t;
+val ENOTSUP = _const "Posix_Error_ENOTSUP" : C.Int.t;
+val ENOTTY = _const "Posix_Error_ENOTTY" : C.Int.t;
+val ENXIO = _const "Posix_Error_ENXIO" : C.Int.t;
+val EOPNOTSUPP = _const "Posix_Error_EOPNOTSUPP" : C.Int.t;
+val EOVERFLOW = _const "Posix_Error_EOVERFLOW" : C.Int.t;
+val EPERM = _const "Posix_Error_EPERM" : C.Int.t;
+val EPIPE = _const "Posix_Error_EPIPE" : C.Int.t;
+val EPROTO = _const "Posix_Error_EPROTO" : C.Int.t;
+val EPROTONOSUPPORT = _const "Posix_Error_EPROTONOSUPPORT" : C.Int.t;
+val EPROTOTYPE = _const "Posix_Error_EPROTOTYPE" : C.Int.t;
+val ERANGE = _const "Posix_Error_ERANGE" : C.Int.t;
+val EROFS = _const "Posix_Error_EROFS" : C.Int.t;
+val ESPIPE = _const "Posix_Error_ESPIPE" : C.Int.t;
+val ESRCH = _const "Posix_Error_ESRCH" : C.Int.t;
+val ESTALE = _const "Posix_Error_ESTALE" : C.Int.t;
+val ETIME = _const "Posix_Error_ETIME" : C.Int.t;
+val ETIMEDOUT = _const "Posix_Error_ETIMEDOUT" : C.Int.t;
+val ETXTBSY = _const "Posix_Error_ETXTBSY" : C.Int.t;
+val EWOULDBLOCK = _const "Posix_Error_EWOULDBLOCK" : C.Int.t;
+val EXDEV = _const "Posix_Error_EXDEV" : C.Int.t;
+val getErrno = _import "Posix_Error_getErrno" : unit -> C.Int.t;
+val strError = _import "Posix_Error_strError" : C.Int.t -> C.String.t;
+end
+structure FileSys =
+struct
+structure A =
+struct
+val F_OK = _const "Posix_FileSys_A_F_OK" : C.Int.t;
+val R_OK = _const "Posix_FileSys_A_R_OK" : C.Int.t;
+val W_OK = _const "Posix_FileSys_A_W_OK" : C.Int.t;
+val X_OK = _const "Posix_FileSys_A_X_OK" : C.Int.t;
+end
+val access = _import "Posix_FileSys_access" : NullString8.t * C.Int.t -> (C.Int.t) C.Errno.t;
+val chdir = _import "Posix_FileSys_chdir" : NullString8.t -> (C.Int.t) C.Errno.t;
+val chmod = _import "Posix_FileSys_chmod" : NullString8.t * C.Mode.t -> (C.Int.t) C.Errno.t;
+val chown = _import "Posix_FileSys_chown" : NullString8.t * C.UId.t * C.GId.t -> (C.Int.t) C.Errno.t;
+structure Dirstream =
+struct
+val closeDir = _import "Posix_FileSys_Dirstream_closeDir" : C.DirP.t -> (C.Int.t) C.Errno.t;
+val openDir = _import "Posix_FileSys_Dirstream_openDir" : NullString8.t -> (C.DirP.t) C.Errno.t;
+val readDir = _import "Posix_FileSys_Dirstream_readDir" : C.DirP.t -> (C.String.t) C.Errno.t;
+val rewindDir = _import "Posix_FileSys_Dirstream_rewindDir" : C.DirP.t -> unit;
+end
+val fchdir = _import "Posix_FileSys_fchdir" : C.Fd.t -> (C.Int.t) C.Errno.t;
+val fchmod = _import "Posix_FileSys_fchmod" : C.Fd.t * C.Mode.t -> (C.Int.t) C.Errno.t;
+val fchown = _import "Posix_FileSys_fchown" : C.Fd.t * C.UId.t * C.GId.t -> (C.Int.t) C.Errno.t;
+val fpathconf = _import "Posix_FileSys_fpathconf" : C.Fd.t * C.Int.t -> (C.Long.t) C.Errno.t;
+val ftruncate = _import "Posix_FileSys_ftruncate" : C.Fd.t * C.Off.t -> (C.Int.t) C.Errno.t;
+val getcwd = _import "Posix_FileSys_getcwd" : (Char8.t) array * C.Size.t -> (C.String.t) C.Errno.t;
+val link = _import "Posix_FileSys_link" : NullString8.t * NullString8.t -> (C.Int.t) C.Errno.t;
+val mkdir = _import "Posix_FileSys_mkdir" : NullString8.t * C.Mode.t -> (C.Int.t) C.Errno.t;
+val mkfifo = _import "Posix_FileSys_mkfifo" : NullString8.t * C.Mode.t -> (C.Int.t) C.Errno.t;
+structure O =
+struct
+val APPEND = _const "Posix_FileSys_O_APPEND" : C.Int.t;
+val BINARY = _const "Posix_FileSys_O_BINARY" : C.Int.t;
+val CREAT = _const "Posix_FileSys_O_CREAT" : C.Int.t;
+val DSYNC = _const "Posix_FileSys_O_DSYNC" : C.Int.t;
+val EXCL = _const "Posix_FileSys_O_EXCL" : C.Int.t;
+val NOCTTY = _const "Posix_FileSys_O_NOCTTY" : C.Int.t;
+val NONBLOCK = _const "Posix_FileSys_O_NONBLOCK" : C.Int.t;
+val RDONLY = _const "Posix_FileSys_O_RDONLY" : C.Int.t;
+val RDWR = _const "Posix_FileSys_O_RDWR" : C.Int.t;
+val RSYNC = _const "Posix_FileSys_O_RSYNC" : C.Int.t;
+val SYNC = _const "Posix_FileSys_O_SYNC" : C.Int.t;
+val TEXT = _const "Posix_FileSys_O_TEXT" : C.Int.t;
+val TRUNC = _const "Posix_FileSys_O_TRUNC" : C.Int.t;
+val WRONLY = _const "Posix_FileSys_O_WRONLY" : C.Int.t;
+end
+val open2 = _import "Posix_FileSys_open2" : NullString8.t * C.Int.t -> (C.Fd.t) C.Errno.t;
+val open3 = _import "Posix_FileSys_open3" : NullString8.t * C.Int.t * C.Mode.t -> (C.Fd.t) C.Errno.t;
+val pathconf = _import "Posix_FileSys_pathconf" : NullString8.t * C.Int.t -> (C.Long.t) C.Errno.t;
+structure PC =
+struct
+val ALLOC_SIZE_MIN = _const "Posix_FileSys_PC_ALLOC_SIZE_MIN" : C.Int.t;
+val ASYNC_IO = _const "Posix_FileSys_PC_ASYNC_IO" : C.Int.t;
+val CHOWN_RESTRICTED = _const "Posix_FileSys_PC_CHOWN_RESTRICTED" : C.Int.t;
+val FILESIZEBITS = _const "Posix_FileSys_PC_FILESIZEBITS" : C.Int.t;
+val LINK_MAX = _const "Posix_FileSys_PC_LINK_MAX" : C.Int.t;
+val MAX_CANON = _const "Posix_FileSys_PC_MAX_CANON" : C.Int.t;
+val MAX_INPUT = _const "Posix_FileSys_PC_MAX_INPUT" : C.Int.t;
+val NAME_MAX = _const "Posix_FileSys_PC_NAME_MAX" : C.Int.t;
+val NO_TRUNC = _const "Posix_FileSys_PC_NO_TRUNC" : C.Int.t;
+val PATH_MAX = _const "Posix_FileSys_PC_PATH_MAX" : C.Int.t;
+val PIPE_BUF = _const "Posix_FileSys_PC_PIPE_BUF" : C.Int.t;
+val PRIO_IO = _const "Posix_FileSys_PC_PRIO_IO" : C.Int.t;
+val REC_INCR_XFER_SIZE = _const "Posix_FileSys_PC_REC_INCR_XFER_SIZE" : C.Int.t;
+val REC_MAX_XFER_SIZE = _const "Posix_FileSys_PC_REC_MAX_XFER_SIZE" : C.Int.t;
+val REC_MIN_XFER_SIZE = _const "Posix_FileSys_PC_REC_MIN_XFER_SIZE" : C.Int.t;
+val REC_XFER_ALIGN = _const "Posix_FileSys_PC_REC_XFER_ALIGN" : C.Int.t;
+val SYMLINK_MAX = _const "Posix_FileSys_PC_SYMLINK_MAX" : C.Int.t;
+val SYNC_IO = _const "Posix_FileSys_PC_SYNC_IO" : C.Int.t;
+val VDISABLE = _const "Posix_FileSys_PC_VDISABLE" : C.Int.t;
+end
+val readlink = _import "Posix_FileSys_readlink" : NullString8.t * (Char8.t) array * C.Size.t -> (C.SSize.t) C.Errno.t;
+val rename = _import "Posix_FileSys_rename" : NullString8.t * NullString8.t -> (C.Int.t) C.Errno.t;
+val rmdir = _import "Posix_FileSys_rmdir" : NullString8.t -> (C.Int.t) C.Errno.t;
+structure S =
+struct
+val IFBLK = _const "Posix_FileSys_S_IFBLK" : C.Mode.t;
+val IFCHR = _const "Posix_FileSys_S_IFCHR" : C.Mode.t;
+val IFDIR = _const "Posix_FileSys_S_IFDIR" : C.Mode.t;
+val IFIFO = _const "Posix_FileSys_S_IFIFO" : C.Mode.t;
+val IFLNK = _const "Posix_FileSys_S_IFLNK" : C.Mode.t;
+val IFMT = _const "Posix_FileSys_S_IFMT" : C.Mode.t;
+val IFREG = _const "Posix_FileSys_S_IFREG" : C.Mode.t;
+val IFSOCK = _const "Posix_FileSys_S_IFSOCK" : C.Mode.t;
+val IRGRP = _const "Posix_FileSys_S_IRGRP" : C.Mode.t;
+val IROTH = _const "Posix_FileSys_S_IROTH" : C.Mode.t;
+val IRUSR = _const "Posix_FileSys_S_IRUSR" : C.Mode.t;
+val IRWXG = _const "Posix_FileSys_S_IRWXG" : C.Mode.t;
+val IRWXO = _const "Posix_FileSys_S_IRWXO" : C.Mode.t;
+val IRWXU = _const "Posix_FileSys_S_IRWXU" : C.Mode.t;
+val ISGID = _const "Posix_FileSys_S_ISGID" : C.Mode.t;
+val ISUID = _const "Posix_FileSys_S_ISUID" : C.Mode.t;
+val ISVTX = _const "Posix_FileSys_S_ISVTX" : C.Mode.t;
+val IWGRP = _const "Posix_FileSys_S_IWGRP" : C.Mode.t;
+val IWOTH = _const "Posix_FileSys_S_IWOTH" : C.Mode.t;
+val IWUSR = _const "Posix_FileSys_S_IWUSR" : C.Mode.t;
+val IXGRP = _const "Posix_FileSys_S_IXGRP" : C.Mode.t;
+val IXOTH = _const "Posix_FileSys_S_IXOTH" : C.Mode.t;
+val IXUSR = _const "Posix_FileSys_S_IXUSR" : C.Mode.t;
+end
+structure ST =
+struct
+val isBlk = _import "Posix_FileSys_ST_isBlk" : C.Mode.t -> Bool.t;
+val isChr = _import "Posix_FileSys_ST_isChr" : C.Mode.t -> Bool.t;
+val isDir = _import "Posix_FileSys_ST_isDir" : C.Mode.t -> Bool.t;
+val isFIFO = _import "Posix_FileSys_ST_isFIFO" : C.Mode.t -> Bool.t;
+val isLink = _import "Posix_FileSys_ST_isLink" : C.Mode.t -> Bool.t;
+val isReg = _import "Posix_FileSys_ST_isReg" : C.Mode.t -> Bool.t;
+val isSock = _import "Posix_FileSys_ST_isSock" : C.Mode.t -> Bool.t;
+end
+structure Stat =
+struct
+val fstat = _import "Posix_FileSys_Stat_fstat" : C.Fd.t -> (C.Int.t) C.Errno.t;
+val getATime = _import "Posix_FileSys_Stat_getATime" : unit -> C.Time.t;
+val getCTime = _import "Posix_FileSys_Stat_getCTime" : unit -> C.Time.t;
+val getDev = _import "Posix_FileSys_Stat_getDev" : unit -> C.Dev.t;
+val getGId = _import "Posix_FileSys_Stat_getGId" : unit -> C.GId.t;
+val getINo = _import "Posix_FileSys_Stat_getINo" : unit -> C.INo.t;
+val getMode = _import "Posix_FileSys_Stat_getMode" : unit -> C.Mode.t;
+val getMTime = _import "Posix_FileSys_Stat_getMTime" : unit -> C.Time.t;
+val getNLink = _import "Posix_FileSys_Stat_getNLink" : unit -> C.NLink.t;
+val getRDev = _import "Posix_FileSys_Stat_getRDev" : unit -> C.Dev.t;
+val getSize = _import "Posix_FileSys_Stat_getSize" : unit -> C.Off.t;
+val getUId = _import "Posix_FileSys_Stat_getUId" : unit -> C.UId.t;
+val lstat = _import "Posix_FileSys_Stat_lstat" : NullString8.t -> (C.Int.t) C.Errno.t;
+val stat = _import "Posix_FileSys_Stat_stat" : NullString8.t -> (C.Int.t) C.Errno.t;
+end
+val symlink = _import "Posix_FileSys_symlink" : NullString8.t * NullString8.t -> (C.Int.t) C.Errno.t;
+val truncate = _import "Posix_FileSys_truncate" : NullString8.t * C.Off.t -> (C.Int.t) C.Errno.t;
+val umask = _import "Posix_FileSys_umask" : C.Mode.t -> C.Mode.t;
+val unlink = _import "Posix_FileSys_unlink" : NullString8.t -> (C.Int.t) C.Errno.t;
+structure Utimbuf =
+struct
+val setAcTime = _import "Posix_FileSys_Utimbuf_setAcTime" : C.Time.t -> unit;
+val setModTime = _import "Posix_FileSys_Utimbuf_setModTime" : C.Time.t -> unit;
+val utime = _import "Posix_FileSys_Utimbuf_utime" : NullString8.t -> (C.Int.t) C.Errno.t;
+end
+end
+structure IO =
+struct
+val close = _import "Posix_IO_close" : C.Fd.t -> (C.Int.t) C.Errno.t;
+val dup = _import "Posix_IO_dup" : C.Fd.t -> (C.Fd.t) C.Errno.t;
+val dup2 = _import "Posix_IO_dup2" : C.Fd.t * C.Fd.t -> (C.Fd.t) C.Errno.t;
+val F_DUPFD = _const "Posix_IO_F_DUPFD" : C.Int.t;
+val F_GETFD = _const "Posix_IO_F_GETFD" : C.Int.t;
+val F_GETFL = _const "Posix_IO_F_GETFL" : C.Int.t;
+val F_GETOWN = _const "Posix_IO_F_GETOWN" : C.Int.t;
+val F_SETFD = _const "Posix_IO_F_SETFD" : C.Int.t;
+val F_SETFL = _const "Posix_IO_F_SETFL" : C.Int.t;
+val F_SETOWN = _const "Posix_IO_F_SETOWN" : C.Int.t;
+val fcntl2 = _import "Posix_IO_fcntl2" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
+val fcntl3 = _import "Posix_IO_fcntl3" : C.Fd.t * C.Int.t * C.Int.t -> (C.Int.t) C.Errno.t;
+structure FD =
+struct
+val CLOEXEC = _const "Posix_IO_FD_CLOEXEC" : C.Fd.t;
+end
+structure FLock =
+struct
+val F_GETLK = _const "Posix_IO_FLock_F_GETLK" : C.Int.t;
+val F_RDLCK = _const "Posix_IO_FLock_F_RDLCK" : C.Short.t;
+val F_SETLK = _const "Posix_IO_FLock_F_SETLK" : C.Int.t;
+val F_SETLKW = _const "Posix_IO_FLock_F_SETLKW" : C.Int.t;
+val F_UNLCK = _const "Posix_IO_FLock_F_UNLCK" : C.Short.t;
+val F_WRLCK = _const "Posix_IO_FLock_F_WRLCK" : C.Short.t;
+val fcntl = _import "Posix_IO_FLock_fcntl" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
+val getLen = _import "Posix_IO_FLock_getLen" : unit -> C.Off.t;
+val getPId = _import "Posix_IO_FLock_getPId" : unit -> C.PId.t;
+val getStart = _import "Posix_IO_FLock_getStart" : unit -> C.Off.t;
+val getType = _import "Posix_IO_FLock_getType" : unit -> C.Short.t;
+val getWhence = _import "Posix_IO_FLock_getWhence" : unit -> C.Short.t;
+val SEEK_CUR = _const "Posix_IO_FLock_SEEK_CUR" : C.Short.t;
+val SEEK_END = _const "Posix_IO_FLock_SEEK_END" : C.Short.t;
+val SEEK_SET = _const "Posix_IO_FLock_SEEK_SET" : C.Short.t;
+val setLen = _import "Posix_IO_FLock_setLen" : C.Off.t -> unit;
+val setPId = _import "Posix_IO_FLock_setPId" : C.PId.t -> unit;
+val setStart = _import "Posix_IO_FLock_setStart" : C.Off.t -> unit;
+val setType = _import "Posix_IO_FLock_setType" : C.Short.t -> unit;
+val setWhence = _import "Posix_IO_FLock_setWhence" : C.Short.t -> unit;
+end
+val fsync = _import "Posix_IO_fsync" : C.Fd.t -> (C.Int.t) C.Errno.t;
+val lseek = _import "Posix_IO_lseek" : C.Fd.t * C.Off.t * C.Int.t -> (C.Off.t) C.Errno.t;
+val O_ACCMODE = _const "Posix_IO_O_ACCMODE" : C.Int.t;
+val pipe = _import "Posix_IO_pipe" : (C.Fd.t) array -> (C.Int.t) C.Errno.t;
+val readChar8 = _import "Posix_IO_readChar8" : C.Fd.t * (Char8.t) array * C.Int.t * C.Size.t -> (C.SSize.t) C.Errno.t;
+val readWord8 = _import "Posix_IO_readWord8" : C.Fd.t * (Word8.t) array * C.Int.t * C.Size.t -> ...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-01-29 13:18:40
|
Catching up with changes to basis-ffi.def
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/ProcEnv.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/getgroups.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/ProcEnv.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/ProcEnv.c 2006-01-29 21:06:37 UTC (rev 4328)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/ProcEnv.c 2006-01-29 21:18:38 UTC (rev 4329)
@@ -37,7 +37,7 @@
return setgid (g);
}
-C_Errno_t(C_Int_t) Posix_ProcEnv_setpgid (C_PId_t p, C_GId_t g) {
+C_Errno_t(C_Int_t) Posix_ProcEnv_setpgid (C_PId_t p, C_PId_t g) {
return setpgid (p, g);
}
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-01-29 21:06:37 UTC (rev 4328)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/getgroups.c 2006-01-29 21:18:38 UTC (rev 4329)
@@ -1,6 +1,6 @@
#include "platform.h"
-C_Errno_t(C_Int_t) Posix_ProcEnv_getgroupsN (unit) {
+C_Errno_t(C_Int_t) Posix_ProcEnv_getgroupsN (void) {
return getgroups (0, (gid_t*)NULL);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY.c 2006-01-29 21:06:37 UTC (rev 4328)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY.c 2006-01-29 21:18:38 UTC (rev 4329)
@@ -20,7 +20,7 @@
void Posix_TTY_Termios_getCC (Array(C_CC_t) a) {
for (int i = 0; i < NCCS; i++)
- ((cc_t*)a)[i] = termios.c_cc[n];
+ ((cc_t*)a)[i] = termios.c_cc[i];
}
C_Speed_t Posix_TTY_Termios_cfGetOSpeed (void) {
@@ -49,7 +49,7 @@
void Posix_TTY_Termios_setCC (Array(C_CC_t) a) {
for (int i = 0; i < NCCS; i++)
- termios.c_cc[n] = ((cc_t*)a)[i];
+ termios.c_cc[i] = ((cc_t*)a)[i];
}
C_Errno_t(C_Int_t) Posix_TTY_Termios_cfSetOSpeed (C_Speed_t s) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-01-29 21:06:37 UTC (rev 4328)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-01-29 21:18:38 UTC (rev 4329)
@@ -11,10 +11,6 @@
#include "platform.h"
typedef unsigned int uint;
-enum {
- DEBUG_INT_INF = FALSE,
-};
-
/* Import the global gcState so we can get and set the frontier. */
extern struct GC_state gcState;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2006-01-29 21:06:37 UTC (rev 4328)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2006-01-29 21:18:38 UTC (rev 4329)
@@ -49,5 +49,5 @@
}
C_Errno_t(C_Int_t) NetHostDB_getHostName(Array(Char8_t) buf, C_Size_t len) {
- gethostname ((char*)buf, len);
+ return gethostname ((char*)buf, len);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-29 21:06:37 UTC (rev 4328)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-29 21:18:38 UTC (rev 4329)
@@ -187,7 +187,7 @@
writeString (cTypesHFd, "/* "); \
writeString (cTypesHFd, #t); \
writeString (cTypesHFd, " */ "); \
- writeString (cTypesHFd, "Pointer_t "); \
+ writeString (cTypesHFd, "Pointer "); \
writeString (cTypesHFd, "C_"); \
writeString (cTypesHFd, name); \
writeString (cTypesHFd, "_t;"); \
|
|
From: Matthew F. <fl...@ml...> - 2006-01-29 13:06:48
|
Continue re-integration of generated ML-side basis library imports. Eliminated PosixPrimitive.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/bin-io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/text-io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/misc/basic.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.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/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/mlton/world.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.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/io.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
D mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/posix-primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/pre-os.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/process.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/FLock-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/fcntl-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/IO/pipe.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/getgroups.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/linux.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/io/bin-io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/io/bin-io.sml 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/io/bin-io.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -13,7 +13,7 @@
structure Vector = Word8Vector
structure VectorSlice = Word8VectorSlice
val chunkSize = Primitive.TextIO.bufSize
- val fileTypeFlags = [PosixPrimitive.FileSys.O.binary]
+ val fileTypeFlags = [SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.BINARY]
val line = NONE
val mkReader = Posix.IO.mkBinReader
val mkWriter = Posix.IO.mkBinWriter
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/io/text-io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/io/text-io.sml 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/io/text-io.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -16,7 +16,7 @@
structure Vector = CharVector
structure VectorSlice = CharVectorSlice
val chunkSize = Primitive.TextIO.bufSize
- val fileTypeFlags = [PosixPrimitive.FileSys.O.text]
+ val fileTypeFlags = [SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.TEXT]
val line = SOME {isLine = fn c => c = #"\n",
lineElem = #"\n"}
val mkReader = Posix.IO.mkTextReader
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/misc/basic.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/misc/basic.sml 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/misc/basic.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -20,7 +20,7 @@
fun die (s: string): 'a =
(Primitive.Stdio.print s
- ; PosixPrimitive.Process.exit 1
+ ; PrimitiveFFI.Posix.Process.exit 1
; let exception DieFailed
in raise DieFailed
end)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -7,7 +7,14 @@
structure Exit =
struct
- structure Status = PosixPrimitive.Process.Status
+ structure Status =
+ struct
+ type t = C.Status.t
+ val fromInt =C.Status.fromInt
+ val toInt = C.Status.toInt
+ val failure = fromInt 1
+ val success = fromInt 0
+ end
val exiting = ref false
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -8,7 +8,7 @@
structure MLtonProcEnv: MLTON_PROC_ENV =
struct
- type gid = PosixPrimitive.ProcEnv.gid
+ type gid = C.GId.t
fun setenv {name, value} =
let
@@ -16,10 +16,15 @@
val value = NullString.nullTerm value
in
PosixError.SysCall.simple
- (fn () => PosixPrimitive.ProcEnv.setenv (name, value))
+ (fn () => PrimitiveFFI.Posix.ProcEnv.setenv (name, value))
end
fun setgroups gs =
- PosixError.SysCall.simple
- (fn () => PosixPrimitive.ProcEnv.setgroups (Array.fromList gs))
+ let
+ val v = Vector.fromList gs
+ val n = Vector.length v
+ in
+ PosixError.SysCall.simple
+ (fn () => PrimitiveFFI.Posix.ProcEnv.setgroups (n, v))
+ end
end
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sig 2006-01-29 21:06:37 UTC (rev 4328)
@@ -21,7 +21,8 @@
val numFiles: t (* NOFILE max number of open files *)
val stackSize: t (* STACK max stack size *)
val virtualMemorySize: t (* AS virtual memory limit *)
-(*
+
+(* NOT STANDARD
val lockedInMemorySize: t (* MEMLOCK max locked address space *)
val numProcesses: t (* NPROC max number of processes *)
val residentSetSize: t (* RSS max resident set size *)
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -35,7 +35,7 @@
val stackSize = STACK
val virtualMemorySize = AS
-(*
+(* NOT STANDARD
val lockedInMemorySize = MEMLOCK
val numProcesses = NPROC
val residentSetSize = RSS
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sig 2006-01-29 21:06:37 UTC (rev 4328)
@@ -22,7 +22,7 @@
val NDELAY : openflag
val NOWAIT : openflag
val ODELAY : openflag
-(*
+(* NOT STANDARD
val PERROR : openflag
*)
val PID : openflag
@@ -44,7 +44,7 @@
val LPR : facility
val MAIL : facility
val NEWS : facility
-(*
+(* NOT STANDARD
val SYSLOG : facility
*)
val USER : 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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -48,7 +48,7 @@
val LPR = LOG_LPR
val MAIL = LOG_MAIL
val NEWS = LOG_NEWS
-(*
+(* NOT STANDARD
val SYSLOG = LOG_SYSLOG
*)
val USER = LOG_USER
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -25,7 +25,7 @@
open Posix.FileSys
val flags =
O.flags [O.trunc,
- PosixPrimitive.FileSys.O.binary]
+ SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.BINARY]
val mode =
let
open S
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 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -267,11 +267,11 @@
nonBlock' ({restart = true}, f, post, Error.again, no)
local
- structure PIO = PosixPrimitive.IO
+ structure PIO = PrimitiveFFI.Posix.IO
in
fun withNonBlock (s, f: unit -> 'a) =
let
- val fd = PosixPrimitive.FileDesc.fromInt (Prim.toInt s)
+ val fd = Primitive.FileDesc.fromInt (Prim.toInt s)
val flags =
Syscall.simpleResultRestart (fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
val _ =
@@ -280,7 +280,7 @@
PIO.fcntl3 (fd, PIO.F_SETFL,
Word.toIntX
(Word.orb (Word.fromInt flags,
- PosixPrimitive.FileSys.O.nonblock))))
+ SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.NONBLOCK))))
in
DynamicWind.wind
(f, fn () =>
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -25,17 +25,17 @@
end
structure SysCall = Error.SysCall
- structure Prim = PosixPrimitive.FileSys
+ structure Prim = PrimitiveFFI.Posix.FileSys
open Prim
structure Stat = Prim.Stat
structure Flags = BitFlags
- type file_desc = Prim.file_desc
- type uid = Prim.uid
- type gid = Prim.gid
+ type file_desc = C.Fd.t
+ type uid = C.UId.t
+ type gid = C.GId.t
- val fdToWord = PosixPrimitive.FileDesc.toWord
- val wordToFD = PosixPrimitive.FileDesc.fromWord
+ val fdToWord = Primitive.FileDesc.toWord
+ val wordToFD = Primitive.FileDesc.fromWord
val fdToIOD = OS.IO.fromFD
val iodToFD = SOME o OS.IO.toFD
@@ -45,7 +45,7 @@
local
structure Prim = Prim.Dirstream
- datatype dirstream = DS of Prim.dirstream option ref
+ datatype dirstream = DS of C.DirP.t option ref
fun get (DS r) =
case !r of
@@ -61,9 +61,10 @@
SysCall.syscall
(fn () =>
let
- val d = Prim.opendir s
+ val d = Prim.openDir s
+ val p = Primitive.Pointer.fromWord d
in
- (if Primitive.Pointer.isNull d then ~1 else 0,
+ (if Primitive.Pointer.isNull p then ~1 else 0,
fn () => DS (ref (SOME d)))
end)
end
@@ -78,7 +79,7 @@
({clear = true, restart = false},
fn () =>
let
- val cs = Prim.readdir d
+ val cs = Prim.readDir d
in
{return = if Primitive.Pointer.isNull cs
then ~1
@@ -111,7 +112,7 @@
SysCall.syscallErr
({clear = true, restart = false},
fn () =>
- let val () = Prim.rewinddir d
+ let val () = Prim.rewindDir d
in
{return = ~1,
post = fn () => (),
@@ -122,7 +123,7 @@
fun closedir (DS r) =
case !r of
NONE => ()
- | SOME d => (SysCall.simple (fn () => Prim.closedir d); r := NONE)
+ | SOME d => (SysCall.simple (fn () => Prim.closeDir d); r := NONE)
end
fun chdir s =
@@ -150,14 +151,14 @@
fun extract a = extractToChar (a, #"\000")
in
fun getcwd () =
- if Primitive.Pointer.isNull (Prim.getcwd (!buffer, !size))
+ if Primitive.Pointer.isNull (Prim.getcwd (!buffer, C.Size.fromInt (!size)))
then (size := 2 * !size
; buffer := make ()
; getcwd ())
else extract (!buffer)
end
- val FD = PosixPrimitive.FileDesc.fromInt
+ val FD = Primitive.FileDesc.fromInt
val stdin = FD 0
val stdout = FD 1
@@ -166,25 +167,63 @@
structure S =
struct
open S Flags
+ type mode = C.Mode.t
+ val ifblk = IFBLK
+ val ifchr = IFCHR
+ val ifdir = IFDIR
+ val ififo = IFIFO
+ val iflnk = IFLNK
+ val ifmt = IFMT
+ val ifreg = IFREG
+ val ifsock = IFSOCK
+ val irgrp = IRGRP
+ val iroth = IROTH
+ val irusr = IRUSR
+ val irwxg = IRWXG
+ val irwxo = IRWXO
+ val irwxu = IRWXU
+ val isgid = ISGID
+ val isuid = ISUID
+ val isvtx = ISVTX
+ val iwgrp = IWGRP
+ val iwoth = IWOTH
+ val iwusr = IWUSR
+ val ixgrp = IXGRP
+ val ixoth = IXOTH
+ val ixusr = IXUSR
end
structure O =
struct
open O Flags
+ val append = SysWord.fromInt APPEND
+ val binary = SysWord.fromInt BINARY
+ val creat = SysWord.fromInt CREAT
+ val dsync = SysWord.fromInt DSYNC
+ val excl = SysWord.fromInt EXCL
+ val noctty = SysWord.fromInt NOCTTY
+ val nonblock = SysWord.fromInt NONBLOCK
+ val rdonly = SysWord.fromInt RDONLY
+ val rdwr = SysWord.fromInt RDWR
+ val rsync = SysWord.fromInt RSYNC
+ val sync = SysWord.fromInt SYNC
+ val text = SysWord.fromInt TEXT
+ val trunc = SysWord.fromInt TRUNC
+ val wronly = SysWord.fromInt WRONLY
end
datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
fun wordToOpenMode w =
- if w = o_rdonly then O_RDONLY
- else if w = o_wronly then O_WRONLY
- else if w = o_rdwr then O_RDWR
+ if w = O.rdonly then O_RDONLY
+ else if w = O.wronly then O_WRONLY
+ else if w = O.rdwr then O_RDWR
else raise Fail "wordToOpenMode: unknown word"
val openModeToWord =
- fn O_RDONLY => o_rdonly
- | O_WRONLY => o_wronly
- | O_RDWR => o_rdwr
+ fn O_RDONLY => O.rdonly
+ | O_WRONLY => O.wronly
+ | O_RDWR => O.rdwr
fun createf (pathname, openMode, flags, mode) =
let
@@ -194,7 +233,7 @@
O.creat]
val fd =
SysCall.simpleResult
- (fn () => Prim.openn (pathname, flags, mode))
+ (fn () => Prim.open3 (pathname, SysWord.toInt flags, mode))
in
FD fd
end
@@ -205,7 +244,7 @@
val flags = Flags.flags [openModeToWord openMode, flags]
val fd =
SysCall.simpleResult
- (fn () => Prim.openn (pathname, flags, Flags.empty))
+ (fn () => Prim.open3 (pathname, SysWord.toInt flags, Flags.empty))
in FD fd
end
@@ -238,7 +277,7 @@
local
val size: int = 1024
- val buf = Word8Array.array (size, 0w0)
+ val buf : char array = Array.array (size, #"\000")
in
fun readlink (path: string): string =
let
@@ -246,22 +285,21 @@
in
SysCall.syscall
(fn () =>
- let val len = Prim.readlink (path, Word8Array.toPoly buf, size)
+ let val len = Prim.readlink (path, buf, C.Size.fromInt size)
in
(len, fn () =>
- Byte.unpackString (Word8ArraySlice.slice (buf, 0, SOME len)))
+ ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len)))
end)
end
end
- type dev = Prim.dev
- val id = fn x => x
- val wordToDev = id
- val devToWord = id
+ type dev = C.Dev.t
+ val wordToDev = C.Dev.fromLargeWord o SysWord.toLargeWord
+ val devToWord = SysWord.fromLargeWord o C.Dev.toLargeWord
- type ino = Prim.ino
- val wordToIno = SysWord.toInt
- val inoToWord = SysWord.fromInt
+ type ino = C.INo.t
+ val wordToIno = C.INo.fromLargeWord o SysWord.toLargeWord
+ val inoToWord = SysWord.fromLargeWord o C.INo.toLargeWord
structure ST =
struct
@@ -278,16 +316,16 @@
ctime: Time.time}
fun fromC (): stat =
- T {dev = Stat.dev (),
- ino = Stat.ino (),
- mode = Stat.mode (),
- nlink = Stat.nlink (),
- uid = Stat.uid (),
- gid = Stat.gid (),
- size = Stat.size (),
- atime = Time.fromSeconds (Stat.atime ()),
- mtime = Time.fromSeconds (Stat.mtime ()),
- ctime = Time.fromSeconds (Stat.ctime ())}
+ T {dev = Stat.getDev (),
+ ino = Stat.getINo (),
+ mode = Stat.getMode (),
+ nlink = C.NLink.toInt (Stat.getNLink ()),
+ uid = Stat.getUId (),
+ gid = Stat.getGId (),
+ size = Stat.getSize (),
+ atime = Time.fromSeconds (Stat.getATime ()),
+ mtime = Time.fromSeconds (Stat.getMTime ()),
+ ctime = Time.fromSeconds (Stat.getCTime ())}
local
fun make sel (T r) = sel r
@@ -329,13 +367,13 @@
datatype access_mode = A_READ | A_WRITE | A_EXEC
val conv_access_mode =
- fn A_READ => R_OK
- | A_WRITE => W_OK
- | A_EXEC => X_OK
+ fn A_READ => A.R_OK
+ | A_WRITE => A.W_OK
+ | A_EXEC => A.X_OK
fun access (path: string, mode: access_mode list): bool =
let
- val mode = Flags.flags (F_OK :: (map conv_access_mode mode))
+ val mode = SysWord.toInt (Flags.flags (map SysWord.fromInt (A.F_OK :: (map conv_access_mode mode))))
val path = NullString.nullTerm path
in
SysCall.syscallErr
@@ -372,14 +410,41 @@
in
SysCall.syscallRestart
(fn () =>
- (U.setActime a
- ; U.setModtime m
+ (U.setAcTime a
+ ; U.setModTime m
; (U.utime f, fn () =>
())))
end
end
local
+ local
+ open Prim.PC
+ in
+ val properties =
+ [
+ (ALLOC_SIZE_MIN,"ALLOC_SIZE_MIN"),
+ (ASYNC_IO,"ASYNC_IO"),
+ (CHOWN_RESTRICTED,"CHOWN_RESTRICTED"),
+ (FILESIZEBITS,"FILESIZEBITS"),
+ (LINK_MAX,"LINK_MAX"),
+ (MAX_CANON,"MAX_CANON"),
+ (MAX_INPUT,"MAX_INPUT"),
+ (NAME_MAX,"NAME_MAX"),
+ (NO_TRUNC,"NO_TRUNC"),
+ (PATH_MAX,"PATH_MAX"),
+ (PIPE_BUF,"PIPE_BUF"),
+ (PRIO_IO,"PRIO_IO"),
+ (REC_INCR_XFER_SIZE,"REC_INCR_XFER_SIZE"),
+ (REC_MAX_XFER_SIZE,"REC_MAX_XFER_SIZE"),
+ (REC_MIN_XFER_SIZE,"REC_MIN_XFER_SIZE"),
+ (REC_XFER_ALIGN,"REC_XFER_ALIGN"),
+ (SYMLINK_MAX,"SYMLINK_MAX"),
+ (SYNC_IO,"SYNC_IO"),
+ (VDISABLE,"VDISABLE")
+ ]
+ end
+
fun convertProperty s =
case List.find (fn (_, s') => s = s') properties of
NONE => Error.raiseSys Error.inval
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml 2006-01-28 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -9,17 +9,17 @@
structure PosixIO: POSIX_IO =
struct
-structure Prim = PosixPrimitive.IO
+structure Prim = PrimitiveFFI.Posix.IO
open Prim
structure Error = PosixError
structure SysCall = Error.SysCall
structure FS = PosixFileSys
-type file_desc = Prim.file_desc
-type pid = Pid.t
+type file_desc = C.Fd.t
+type pid = C.PId.t
-val FD = PosixPrimitive.FileDesc.fromInt
-val unFD = PosixPrimitive.FileDesc.toInt
+val FD = C.Fd.fromInt
+val unFD = C.Fd.toInt
local
val a: file_desc array = Array.array (2, FD 0)
@@ -41,6 +41,7 @@
structure FD =
struct
open FD BitFlags
+ val cloexec = SysWord.fromInt CLOEXEC
end
structure O = PosixFileSys.O
@@ -64,8 +65,8 @@
val n =
SysCall.simpleResultRestart (fn () => Prim.fcntl2 (fd, F_GETFL))
val w = Word.fromInt n
- val flags = Word.andb (w, Word.notb O_ACCMODE)
- val mode = Word.andb (w, O_ACCMODE)
+ val flags = Word.andb (w, Word.notb (Word.fromInt O_ACCMODE))
+ val mode = Word.andb (w, (Word.fromInt O_ACCMODE))
in (flags, PosixFileSys.wordToOpenMode mode)
end
@@ -98,27 +99,43 @@
fun fsync fd : unit = SysCall.simple (fn () => Prim.fsync fd)
+val whenceToInt =
+ fn SEEK_SET => Prim.FLock.SEEK_SET
+ | SEEK_CUR => Prim.FLock.SEEK_CUR
+ | SEEK_END => Prim.FLock.SEEK_END
+
+fun intToWhence n =
+ if n = Prim.FLock.SEEK_SET
+ then SEEK_SET
+ else if n = Prim.FLock.SEEK_CUR
+ then SEEK_CUR
+ else if n = Prim.FLock.SEEK_END
+ then SEEK_END
+ else raise Fail "Posix.IO.intToWhence"
+
datatype lock_type =
F_RDLCK
| F_WRLCK
| F_UNLCK
val lockTypeToInt =
- fn F_RDLCK => Prim.F_RDLCK
- | F_WRLCK => Prim.F_WRLCK
- | F_UNLCK => Prim.F_UNLCK
+ fn F_RDLCK => Prim.FLock.F_RDLCK
+ | F_WRLCK => Prim.FLock.F_WRLCK
+ | F_UNLCK => Prim.FLock.F_UNLCK
fun intToLockType n =
- if n = Prim.F_RDLCK
+ if n = Prim.FLock.F_RDLCK
then F_RDLCK
- else if n = Prim.F_WRLCK
+ else if n = Prim.FLock.F_WRLCK
then F_WRLCK
- else if n = Prim.F_UNLCK
+ else if n = Prim.FLock.F_UNLCK
then F_UNLCK
else raise Fail "Posix.IO.intToLockType"
structure FLock =
struct
+ open FLock
+
type flock = {ltype: lock_type,
whence: whence,
start: Position.int,
@@ -146,15 +163,15 @@
; P.setStart start
; P.setLen len
; P.fcntl (fd, cmd)), fn () =>
- {ltype = intToLockType (P.typ ()),
- whence = intToWhence (P.whence ()),
- start = P.start (),
- len = P.len (),
- pid = if usepid then SOME (P.pid ()) else NONE}))
+ {ltype = intToLockType (P.getType ()),
+ whence = intToWhence (P.getWhence ()),
+ start = P.getStart (),
+ len = P.getLen (),
+ pid = if usepid then SOME (P.getPId ()) else NONE}))
in
- val getlk = make (F_GETLK, true)
- val setlk = make (F_SETLK, false)
- val setlkw = make (F_SETLKW, false)
+ val getlk = make (FLock.F_GETLK, true)
+ val setlk = make (FLock.F_SETLK, false)
+ val setlkw = make (FLock.F_SETLKW, false)
end
(* Adapted from SML/NJ sources. *)
@@ -220,13 +237,13 @@
let
val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
in
- SysCall.simpleResultRestart (fn () => read (fd, buf, i, sz))
+ SysCall.simpleResultRestart (fn () => read (fd, buf, i, C.Size.fromInt sz))
end
fun readVec (fd, n) =
let
val a = Primitive.Array.array n
val bytesRead =
- SysCall.simpleResultRestart (fn () => read (fd, a, 0, n))
+ SysCall.simpleResultRestart (fn () => read (fd, a, 0, C.Size.fromInt n))
in
fromVector
(if n = bytesRead
@@ -239,7 +256,7 @@
val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
in
SysCall.simpleResultRestart
- (fn () => write (fd, buf, i, sz))
+ (fn () => write (fd, buf, i, C.Size.fromInt sz))
end
val writeVec =
fn (fd, sl) =>
@@ -247,7 +264,7 @@
val (buf, i, sz) = VectorSlice.base (toVectorSlice sl)
in
SysCall.simpleResultRestart
- (fn () => writeVec (fd, buf, i, sz))
+ (fn () => writeVec (fd, buf, i, C.Size.fromInt sz))
end
fun mkReader {fd, name, initBlkMode} =
let
@@ -375,19 +392,19 @@
toArraySlice = Word8ArraySlice.toPoly,
toVectorSlice = Word8VectorSlice.toPoly,
vectorLength = Word8Vector.length,
- write = writeWord8,
+ write = writeWord8Arr,
writeVec = writeWord8Vec}
val {mkReader = mkTextReader, mkWriter = mkTextWriter, ...} =
make {RD = TextPrimIO.RD,
WR = TextPrimIO.WR,
fromVector = fn v => v,
- read = readChar,
+ read = readChar8,
setMode = Prim.settext,
toArraySlice = CharArraySlice.toPoly,
toVectorSlice = CharVectorSlice.toPoly,
vectorLength = CharVector.length,
- write = writeChar,
- writeVec = writeCharVec}
+ write = writeChar8Arr,
+ writeVec = writeChar8Vec}
end
end
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -8,19 +8,19 @@
structure PosixProcEnv: POSIX_PROC_ENV =
struct
- structure Prim = PosixPrimitive.ProcEnv
+ structure Prim = PrimitiveFFI.Posix.ProcEnv
structure Error = PosixError
structure SysCall = Error.SysCall
structure CS = COld.CS
- type pid = Pid.t
+ type pid = C.PId.t
+ type uid = C.UId.t
+ type gid = C.GId.t
+ type file_desc = C.Fd.t
local
open Prim
in
- type uid = uid
- type gid = gid
- datatype file_desc = datatype file_desc
val getpgrp = getpgrp (* No error checking required *)
val getegid = getegid (* No error checking required *)
val geteuid = geteuid (* No error checking required *)
@@ -32,8 +32,7 @@
val setuid = fn uid => SysCall.simple (fn () => setuid uid)
end
- fun setsid () =
- Pid.fromInt (SysCall.simpleResult (Pid.toInt o Prim.setsid))
+ fun setsid () = SysCall.simpleResult (Prim.setsid)
fun id x = x
val uidToWord = id
@@ -42,12 +41,13 @@
val wordToGid = id
local
- val a: word array = Primitive.Array.array Prim.numgroups
+ val n = Prim.getgroupsN ()
+ val a: word array = Primitive.Array.array n
in
fun getgroups () =
SysCall.syscall
(fn () =>
- let val n = Prim.getgroups a
+ let val n = Prim.getgroups (n, a)
in (n, fn () =>
ArraySlice.toList (ArraySlice.slice (a, 0, SOME n)))
end)
@@ -62,47 +62,169 @@
fun setpgid {pid, pgid} =
let
- val f =
- fn NONE => Pid.fromInt 0
- | SOME pid => pid
- val pid = f pid
- val pgid = f pgid
+ val pid = case pid of NONE => 0 | SOME pid => pid
+ val pgid = case pgid of NONE => 0 | SOME pgid => pgid
in
SysCall.simple
(fn () => Prim.setpgid (pid, pgid))
end
+ fun uname () =
+ SysCall.syscall
+ (fn () =>
+ (Prim.uname (), fn () =>
+ [("sysname", CS.toString (Prim.Uname.getSysName ())),
+ ("nodename", CS.toString (Prim.Uname.getNodeName ())),
+ ("release", CS.toString (Prim.Uname.getRelease ())),
+ ("version", CS.toString (Prim.Uname.getVersion ())),
+ ("machine", CS.toString (Prim.Uname.getMachine ()))]))
+
+ val time = Time.now
+
local
- structure Uname = Prim.Uname
+ val sysconfNames =
+ [
+ (Prim.SC_2_CHAR_TERM,"2_CHAR_TERM"),
+ (Prim.SC_2_C_BIND,"2_C_BIND"),
+ (Prim.SC_2_C_DEV,"2_C_DEV"),
+ (Prim.SC_2_FORT_DEV,"2_FORT_DEV"),
+ (Prim.SC_2_FORT_RUN,"2_FORT_RUN"),
+ (Prim.SC_2_LOCALEDEF,"2_LOCALEDEF"),
+ (Prim.SC_2_PBS,"2_PBS"),
+ (Prim.SC_2_PBS_ACCOUNTING,"2_PBS_ACCOUNTING"),
+ (Prim.SC_2_PBS_CHECKPOINT,"2_PBS_CHECKPOINT"),
+ (Prim.SC_2_PBS_LOCATE,"2_PBS_LOCATE"),
+ (Prim.SC_2_PBS_MESSAGE,"2_PBS_MESSAGE"),
+ (Prim.SC_2_PBS_TRACK,"2_PBS_TRACK"),
+ (Prim.SC_2_SW_DEV,"2_SW_DEV"),
+ (Prim.SC_2_UPE,"2_UPE"),
+ (Prim.SC_2_VERSION,"2_VERSION"),
+ (Prim.SC_ADVISORY_INFO,"ADVISORY_INFO"),
+ (Prim.SC_AIO_LISTIO_MAX,"AIO_LISTIO_MAX"),
+ (Prim.SC_AIO_MAX,"AIO_MAX"),
+ (Prim.SC_AIO_PRIO_DELTA_MAX,"AIO_PRIO_DELTA_MAX"),
+ (Prim.SC_ARG_MAX,"ARG_MAX"),
+ (Prim.SC_ASYNCHRONOUS_IO,"ASYNCHRONOUS_IO"),
+ (Prim.SC_ATEXIT_MAX,"ATEXIT_MAX"),
+ (Prim.SC_BARRIERS,"BARRIERS"),
+ (Prim.SC_BC_BASE_MAX,"BC_BASE_MAX"),
+ (Prim.SC_BC_DIM_MAX,"BC_DIM_MAX"),
+ (Prim.SC_BC_SCALE_MAX,"BC_SCALE_MAX"),
+ (Prim.SC_BC_STRING_MAX,"BC_STRING_MAX"),
+ (Prim.SC_CHILD_MAX,"CHILD_MAX"),
+ (Prim.SC_CLK_TCK,"CLK_TCK"),
+ (Prim.SC_CLOCK_SELECTION,"CLOCK_SELECTION"),
+ (Prim.SC_COLL_WEIGHTS_MAX,"COLL_WEIGHTS_MAX"),
+ (Prim.SC_CPUTIME,"CPUTIME"),
+ (Prim.SC_DELAYTIMER_MAX,"DELAYTIMER_MAX"),
+ (Prim.SC_EXPR_NEST_MAX,"EXPR_NEST_MAX"),
+ (Prim.SC_FSYNC,"FSYNC"),
+ (Prim.SC_GETGR_R_SIZE_MAX,"GETGR_R_SIZE_MAX"),
+ (Prim.SC_GETPW_R_SIZE_MAX,"GETPW_R_SIZE_MAX"),
+ (Prim.SC_HOST_NAME_MAX,"HOST_NAME_MAX"),
+ (Prim.SC_IOV_MAX,"IOV_MAX"),
+ (Prim.SC_IPV6,"IPV6"),
+ (Prim.SC_JOB_CONTROL,"JOB_CONTROL"),
+ (Prim.SC_LINE_MAX,"LINE_MAX"),
+ (Prim.SC_LOGIN_NAME_MAX,"LOGIN_NAME_MAX"),
+ (Prim.SC_MAPPED_FILES,"MAPPED_FILES"),
+ (Prim.SC_MEMLOCK,"MEMLOCK"),
+ (Prim.SC_MEMLOCK_RANGE,"MEMLOCK_RANGE"),
+ (Prim.SC_MEMORY_PROTECTION,"MEMORY_PROTECTION"),
+ (Prim.SC_MESSAGE_PASSING,"MESSAGE_PASSING"),
+ (Prim.SC_MONOTONIC_CLOCK,"MONOTONIC_CLOCK"),
+ (Prim.SC_MQ_OPEN_MAX,"MQ_OPEN_MAX"),
+ (Prim.SC_MQ_PRIO_MAX,"MQ_PRIO_MAX"),
+ (Prim.SC_NGROUPS_MAX,"NGROUPS_MAX"),
+ (Prim.SC_OPEN_MAX,"OPEN_MAX"),
+ (Prim.SC_PAGESIZE,"PAGESIZE"),
+ (Prim.SC_PAGE_SIZE,"PAGE_SIZE"),
+ (Prim.SC_PRIORITIZED_IO,"PRIORITIZED_IO"),
+ (Prim.SC_PRIORITY_SCHEDULING,"PRIORITY_SCHEDULING"),
+ (Prim.SC_RAW_SOCKETS,"RAW_SOCKETS"),
+ (Prim.SC_READER_WRITER_LOCKS,"READER_WRITER_LOCKS"),
+ (Prim.SC_REALTIME_SIGNALS,"REALTIME_SIGNALS"),
+ (Prim.SC_REGEXP,"REGEXP"),
+ (Prim.SC_RE_DUP_MAX,"RE_DUP_MAX"),
+ (Prim.SC_RTSIG_MAX,"RTSIG_MAX"),
+ (Prim.SC_SAVED_IDS,"SAVED_IDS"),
+ (Prim.SC_SEMAPHORES,"SEMAPHORES"),
+ (Prim.SC_SEM_NSEMS_MAX,"SEM_NSEMS_MAX"),
+ (Prim.SC_SEM_VALUE_MAX,"SEM_VALUE_MAX"),
+ (Prim.SC_SHARED_MEMORY_OBJECTS,"SHARED_MEMORY_OBJECTS"),
+ (Prim.SC_SHELL,"SHELL"),
+ (Prim.SC_SIGQUEUE_MAX,"SIGQUEUE_MAX"),
+ (Prim.SC_SPAWN,"SPAWN"),
+ (Prim.SC_SPIN_LOCKS,"SPIN_LOCKS"),
+ (Prim.SC_SPORADIC_SERVER,"SPORADIC_SERVER"),
+ (Prim.SC_SS_REPL_MAX,"SS_REPL_MAX"),
+ (Prim.SC_STREAM_MAX,"STREAM_MAX"),
+ (Prim.SC_SYMLOOP_MAX,"SYMLOOP_MAX"),
+ (Prim.SC_SYNCHRONIZED_IO,"SYNCHRONIZED_IO"),
+ (Prim.SC_THREADS,"THREADS"),
+ (Prim.SC_THREAD_ATTR_STACKADDR,"THREAD_ATTR_STACKADDR"),
+ (Prim.SC_THREAD_ATTR_STACKSIZE,"THREAD_ATTR_STACKSIZE"),
+ (Prim.SC_THREAD_CPUTIME,"THREAD_CPUTIME"),
+ (Prim.SC_THREAD_DESTRUCTOR_ITERATIONS,"THREAD_DESTRUCTOR_ITERATIONS"),
+ (Prim.SC_THREAD_KEYS_MAX,"THREAD_KEYS_MAX"),
+ (Prim.SC_THREAD_PRIORITY_SCHEDULING,"THREAD_PRIORITY_SCHEDULING"),
+ (Prim.SC_THREAD_PRIO_INHERIT,"THREAD_PRIO_INHERIT"),
+ (Prim.SC_THREAD_PRIO_PROTECT,"THREAD_PRIO_PROTECT"),
+ (Prim.SC_THREAD_PROCESS_SHARED,"THREAD_PROCESS_SHARED"),
+ (Prim.SC_THREAD_SAFE_FUNCTIONS,"THREAD_SAFE_FUNCTIONS"),
+ (Prim.SC_THREAD_SPORADIC_SERVER,"THREAD_SPORADIC_SERVER"),
+ (Prim.SC_THREAD_STACK_MIN,"THREAD_STACK_MIN"),
+ (Prim.SC_THREAD_THREADS_MAX,"THREAD_THREADS_MAX"),
+ (Prim.SC_TIMEOUTS,"TIMEOUTS"),
+ (Prim.SC_TIMERS,"TIMERS"),
+ (Prim.SC_TIMER_MAX,"TIMER_MAX"),
+ (Prim.SC_TRACE,"TRACE"),
+ (Prim.SC_TRACE_EVENT_FILTER,"TRACE_EVENT_FILTER"),
+ (Prim.SC_TRACE_EVENT_NAME_MAX,"TRACE_EVENT_NAME_MAX"),
+ (Prim.SC_TRACE_INHERIT,"TRACE_INHERIT"),
+ (Prim.SC_TRACE_LOG,"TRACE_LOG"),
+ (Prim.SC_TRACE_NAME_MAX,"TRACE_NAME_MAX"),
+ (Prim.SC_TRACE_SYS_MAX,"TRACE_SYS_MAX"),
+ (Prim.SC_TRACE_USER_EVENT_MAX,"TRACE_USER_EVENT_MAX"),
+ (Prim.SC_TTY_NAME_MAX,"TTY_NAME_MAX"),
+ (Prim.SC_TYPED_MEMORY_OBJECTS,"TYPED_MEMORY_OBJECTS"),
+ (Prim.SC_TZNAME_MAX,"TZNAME_MAX"),
+ (Prim.SC_V6_ILP32_OFF32,"V6_ILP32_OFF32"),
+ (Prim.SC_V6_ILP32_OFFBIG,"V6_ILP32_OFFBIG"),
+ (Prim.SC_V6_LP64_OFF64,"V6_LP64_OFF64"),
+ (Prim.SC_V6_LPBIG_OFFBIG,"V6_LPBIG_OFFBIG"),
+ (Prim.SC_VERSION,"VERSION"),
+ (Prim.SC_XBS5_ILP32_OFF32,"XBS5_ILP32_OFF32"),
+ (Prim.SC_XBS5_ILP32_OFFBIG,"XBS5_ILP32_OFFBIG"),
+ (Prim.SC_XBS5_LP64_OFF64,"XBS5_LP64_OFF64"),
+ (Prim.SC_XBS5_LPBIG_OFFBIG,"XBS5_LPBIG_OFFBIG"),
+ (Prim.SC_XOPEN_CRYPT,"XOPEN_CRYPT"),
+ (Prim.SC_XOPEN_ENH_I18N,"XOPEN_ENH_I18N"),
+ (Prim.SC_XOPEN_LEGACY,"XOPEN_LEGACY"),
+ (Prim.SC_XOPEN_REALTIME,"XOPEN_REALTIME"),
+ (Prim.SC_XOPEN_REALTIME_THREADS,"XOPEN_REALTIME_THREADS"),
+ (Prim.SC_XOPEN_SHM,"XOPEN_SHM"),
+ (Prim.SC_XOPEN_STREAMS,"XOPEN_STREAMS"),
+ (Prim.SC_XOPEN_UNIX,"XOPEN_UNIX"),
+ (Prim.SC_XOPEN_VERSION,"XOPEN_VERSION")
+ ]
in
- fun uname () =
- SysCall.syscall
- (fn () =>
- (Uname.uname (), fn () =>
- [("sysname", CS.toString (Uname.sysname ())),
- ("nodename", CS.toString (Uname.nodename ())),
- ("release", CS.toString (Uname.release ())),
- ("version", CS.toString (Uname.version ())),
- ("machine", CS.toString (Uname.machine ()))]))
+ fun sysconf s =
+ 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)
end
-
- val time = Time.now
-
- fun sysconf s =
- case List.find (fn (_, s') => s = s') Prim.sysconfNames of
- NONE => Error.raiseSys Error.inval
- | SOME (n, _) =>
- (SysWord.fromInt o SysCall.simpleResult)
- (fn () => Prim.sysconf n)
local
- structure Tms = Prim.Tms
+ structure Times = Prim.Times
val ticksPerSec = Int.toLarge (SysWord.toIntX (sysconf "CLK_TCK"))
- fun cvt (ticks: word) =
+ fun cvt (ticks: C.Clock.t) =
Time.fromTicks (LargeInt.quot
- (LargeInt.* (Word.toLargeIntX ticks,
+ (LargeInt.* (C.Clock.toLarge ticks,
Time.ticksPerSecond),
ticksPerSec))
in
@@ -112,14 +234,14 @@
let val elapsed = Prim.times ()
in (0, fn () =>
{elapsed = cvt elapsed,
- utime = cvt (Tms.utime ()),
- stime = cvt (Tms.stime ()),
- cutime = cvt (Tms.cutime ()),
- cstime = cvt (Tms.cstime ())})
+ utime = cvt (Times.getUTime ()),
+ stime = cvt (Times.getSTime ()),
+ cutime = cvt (Times.getCUTime ()),
+ cstime = cvt (Times.getCSTime ())})
end)
end
- fun environ () = COld.CSS.toList Prim.environ
+ fun environ () = COld.CSS.toList (Prim.environGet ())
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -8,7 +8,7 @@
structure PosixProcess: POSIX_PROCESS_EXTRA =
struct
- structure Prim = PosixPrimitive.Process
+ structure Prim = PrimitiveFFI.Posix.Process
open Prim
structure Error = PosixError
structure SysCall = Error.SysCall
@@ -86,10 +86,13 @@
structure W =
struct
open W BitFlags
+ val continued = SysWord.fromInt CONTINUED
+ val nohang = SysWord.fromInt NOHANG
+ val untraced = SysWord.fromInt UNTRACED
end
local
- val status: Status.t ref = ref (Status.fromInt 0)
+ val status: C.Status.t ref = ref (C.Status.fromInt 0)
fun wait (wa, status, flags) =
let
val useCwait =
@@ -108,7 +111,7 @@
let
val pid =
if useCwait
- then Prim.cwait (Pid.fromInt p, status)
+ then PrimitiveFFI.MLton.Process.cwait (Pid.fromInt p, status)
else Prim.waitpid (Pid.fromInt p, status,
SysWord.toInt flags)
in
@@ -126,7 +129,7 @@
fun waitpid_nh (wa, flags) =
let
- val pid = wait (wa, status, wnohang :: flags)
+ val pid = wait (wa, status, W.nohang :: flags)
in
if 0 = Pid.toInt pid
then NONE
@@ -162,10 +165,12 @@
local
fun wrap prim (t: Time.time): Time.time =
Time.fromSeconds
- (LargeInt.fromInt
- (prim
- (LargeInt.toInt (Time.toSeconds t)
- handle Overflow => Error.raiseSys Error.inval)))
+ (LargeInt.fromInt
+ (C.UInt.toInt
+ (prim
+ (C.UInt.fromInt
+ (LargeInt.toInt (Time.toSeconds t)
+ handle Overflow => Error.raiseSys Error.inval)))))
in
val alarm = wrap Prim.alarm
(* val sleep = wrap Prim.sleep *)
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -19,93 +19,6 @@
; Error.raiseSys Error.nosys)
else f
in
- structure PosixPrimitive =
- struct
- open PosixPrimitive
-
- structure FileSys =
- struct
- open FileSys
-
- val chown = stub ("chown", chown)
- val fchown = stub ("fchown", fchown)
- val fpathconf = stub ("fpathconf", fpathconf)
- val link = stub ("link", link)
- val mkfifo = stub ("mkfifo", mkfifo)
- val pathconf = stub ("pathconf", pathconf)
- val readlink = stub ("readlink", readlink)
- val symlink = stub ("symlink", symlink)
- end
-
- structure IO =
- struct
- open IO
-
- val fcntl2 = stub ("fcntl2", fcntl2)
- val fcntl3 = stub ("fcntl3", fcntl3)
- end
-
- structure Process =
- struct
- open Process
-
- val exece = stub ("exece", exece)
- val execp = stub ("execp", execp)
- val exit = stub ("exit", exit)
- val fork = stub ("fork", fork)
- val kill = stub ("kill", kill)
- val pause = stub ("pause", pause)
- val waitpid = stub ("waitpid", waitpid)
- end
-
- structure ProcEnv =
- struct
- open ProcEnv
-
- val ctermid = stub ("ctermid", ctermid)
- val getegid = stub ("getegid", getegid)
- val geteuid = stub ("geteuid", geteuid)
- val getgid = stub ("getgid", getgid)
- 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)
- val setgroups = stub ("stegroups", setgroups)
- val setpgid = stub ("setpgid", setpgid)
- val setsid = stub ("setsid", setsid)
- val setuid = stub ("setuid", setuid)
- val sysconf = stub ("sysconf", sysconf)
- val times = stub ("times", times)
- val ttyname = stub ("ttyname", ttyname)
- end
-
- structure SysDB =
- struct
- open SysDB
-
- val getgrgid = stub ("getgrgid", getgrgid)
- val getgrnam = stub ("getgrnam", getgrnam)
- val getpwuid = stub ("getpwuid", getpwuid)
- end
-
- structure TTY =
- struct
- open TTY
-
- val drain = stub ("drain", drain)
- val flow = stub ("flow", flow)
- val flush = stub ("flush", flush)
- val getattr = stub ("getattr", getattr)
- val getpgrp = stub ("getpgrp", getpgrp)
- val sendbreak = stub ("sendbreak", sendbreak)
- val setattr = stub ("setattr", setattr)
- val setpgrp = stub ("setpgrp", setpgrp)
- end
- end
-
structure Primitive =
struct
open Primitive
@@ -150,5 +63,97 @@
val poll = stub ("poll", poll)
end
end
+
+ structure Posix =
+ struct
+ open Posix
+
+ structure FileSys =
+ struct
+ open FileSys
+
+ val chown = stub ("chown", chown)
+ val fchown = stub ("fchown", fchown)
+ val fpathconf = stub ("fpathconf", fpathconf)
+ val link = stub ("link", link)
+ val mkfifo = stub ("mkfifo", mkfifo)
+ val pathconf = stub ("pathconf", pathconf)
+ val readlink = stub ("readlink", readlink)
+ val symlink = stub ("symlink", symlink)
+ end
+
+ structure IO =
+ struct
+ open IO
+
+ val fcntl2 = stub ("fcntl2", fcntl2)
+ val fcntl3 = stub ("fcntl3", fcntl3)
+ end
+
+ structure ProcEnv =
+ struct
+ open ProcEnv
+
+ val ctermid = stub ("ctermid", ctermid)
+ val getegid = stub ("getegid", getegid)
+ val geteuid = stub ("geteuid", geteuid)
+ val getgid = stub ("getgid", getgid)
+ 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)
+ val setgroups = stub ("stegroups", setgroups)
+ val setpgid = stub ("setpgid", setpgid)
+ val setsid = stub ("setsid", setsid)
+ val setuid = stub ("setuid", setuid)
+ val sysconf = stub ("sysconf", sysconf)
+ val times = stub ("times", times)
+ val ttyname = stub ("ttyname", ttyname)
+ end
+
+ structure Process =
+ struct
+ open Process
+
+ val exece = stub ("exece", exece)
+ val execp = stub ("execp", execp)
+ val exit = stub ("exit", exit)
+ val fork = stub ("fork", fork)
+ val kill = stub ("kill", kill)
+ val pause = stub ("pause", pause)
+ val waitpid = stub ("waitpid", waitpid)
+ end
+
+ structure SysDB =
+ struct
+ open SysDB
+
+ val getgrgid = stub ("getgrgid", getgrgid)
+ val getgrnam = stub ("getgrnam", getgrnam)
+ val getpwuid = stub ("getpwuid", getpwuid)
+ end
+
+ structure TTY =
+ struct
+ open TTY
+
+ structure TC =
+ struct
+ open TC
+
+ val drain = stub ("drain", drain)
+ val flow = stub ("flow", flow)
+ val flush = stub ("flush", flush)
+ val getattr = stub ("getattr", getattr)
+ val getpgrp = stub ("getpgrp", getpgrp)
+ val sendbreak = stub ("sendbreak", sendbreak)
+ val setattr = stub ("setattr", setattr)
+ val setpgrp = stub ("setpgrp", setpgrp)
+ end
+ 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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -9,12 +9,12 @@
structure PosixSysDB: POSIX_SYS_DB =
struct
structure CS = COld.CS
- structure Prim = PosixPrimitive.SysDB
+ structure Prim = PrimitiveFFI.Posix.SysDB
structure Error = PosixError
structure SysCall = Error.SysCall
- type uid = Prim.uid
- type gid = Prim.gid
+ type uid = C.UId.t
+ type gid = C.GId.t
structure Passwd =
struct
@@ -24,20 +24,18 @@
home: string,
shell: string}
- local
- structure C = Prim.Passwd
- in
- fun fromC (f: unit -> bool): passwd =
- SysCall.syscall
- (fn () =>
- (if f () then 0 else ~1,
- fn () => {name = CS.toString(C.name()),
- uid = C.uid(),
- gid = C.gid(),
- home = CS.toString(C.dir()),
- shell = CS.toString(C.shell())}))
- end
+ structure Passwd = Prim.Passwd
+ fun fromC (f: unit -> bool): passwd =
+ SysCall.syscall
+ (fn () =>
+ (if f () then 0 else ~1,
+ fn () => {name = CS.toString(Passwd.getName ()),
+ uid = Passwd.getUId (),
+ gid = Passwd.getGId (),
+ home = CS.toString(Passwd.getDir ()),
+ shell = CS.toString(Passwd.getShell ())}))
+
val name: passwd -> string = #name
val uid: passwd -> uid = #uid
val gid: passwd -> gid = #gid
@@ -64,9 +62,9 @@
SysCall.syscall
(fn () =>
(if f () then 0 else ~1,
- fn () => {name = CS.toString(Group.name()),
- gid = Group.gid(),
- members = COld.CSS.toList(Group.mem())}))
+ fn () => {name = CS.toString(Group.getName ()),
+ gid = Group.getGId (),
+ members = COld.CSS.toList(Group.getMem ())}))
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 21:30:43 UTC (rev 4327)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml 2006-01-29 21:06:37 UTC (rev 4328)
@@ -9,26 +9,39 @@
structure PosixTTY: POSIX_TTY =
struct
structure Cstring = COld.CS
- structure Prim = PosixPrimitive.TTY
+ structure Prim = PrimitiveFFI.Posix.TTY
open Prim
structure Error = PosixError
structure SysCall = Error.SysCall
- type pid = Pid.t
+ type pid = C.PId.t
- datatype file_desc = datatype Prim.file_desc
+ type file_desc = C.Fd.t
structure V =
struct
open V
+ val nccs = NCCS
+ val eof = VEOF
+ val eol = VEOL
+ val erase = VERASE
+ val intr = VINTR
+ val kill = VKILL
+ val min = VMIN
+ val quit = VQUIT
+ val susp = VSUSP
+ val time = VTIME
+ val start = VSTART
+ val stop = VSTOP
- type cc = char array
+ type cc = C.CC.t array
- val default = #"\000"
+ val default = Byte.charToByte #"\000"
- fun new () = Array.array (nccs, default)
+ fun new () = Array.array (NCCS, default)
- fun updates (a, l) = List.app (fn (i, c) => Array.update (a, i, c)) l
+ fun updates (a, l) =
+ List.app (fn (i, cc) => Array.update (a, i, Byte.charToByte cc)) l
fun cc l = let val a = new ()
in updates (a, l)
@@ -42,40 +55,117 @@
; a'
end
- val sub = Array.sub
+ val sub = Byte.byteToChar o Array.sub
end
- structure I =
+ structure IFlags =
struct
- open I BitFlags
+ open IFlags BitFlags
+ val brkint = BRKINT
+ val icrnl = ICRNL
+ val ignbrk = IGNBRK
+ val igncr = IGNCR
+ val ignpar = IGNPAR
+ val inlcr = INLCR
+ val inpck = INPCK
+ val istrip = ISTRIP
+ val ixany = IXANY
+ val ixoff = IXOFF
+ val ixon = IXON
+ val parmrk = PARMRK
end
- structure O =
+ structure OFlags =
struct
- open O BitFlags
+ open OFlags BitFlags
+ val bs0 = BS0
+ val bs1 = BS1
+ val bsdly = BSDLY
+ val cr0 = CR0
+ val cr1 = CR1
+ val cr2 = CR2
+ val cr3 = CR3
+ val crdly = CRDLY
+ val ff0 = FF0
+ val ff1 = FF1
+ val ffdly = FFDLY
+ val nl0 = NL0
+ val nl1 = NL1
+ val onldly = NLDLY
+ val ocrnl = OCRNL
+ val ofill = OFILL
+ val onlcr = ONLCR
+ val onlret = ONLRET
+ val onocr = ONOCR
+ val opost = OPOST
+ val tab0 = TAB0
+ val tab1 = TAB1
+ val tab2 = TAB2
+ val tab3 = TAB3
+ val tabdly = TABDLY
+ val vt0 = VT0
+ val vt1 = VT1
+ val vtdly = VTDLY
end
- structure C =
+ structure CFlags =
struct
- open C BitFlags
+ open CFlags BitFlags
+ val clocal = CLOCAL
+ val cread = CREAD
+ val cs5 = CS5
+ val cs6 = CS6
+ val cs7 = CS7
+ val cs8 = CS8
+ val csize = CSIZE
+ val cstopb = CSTOPB
+ val hupcl = HUPCL
+ val parenb = PARENB
+ val parodd = PARODD
end
- structure L =
+ structure LFlags =
struct
- open L BitFlags
+ open LFlags BitFlags
+ val echo = ECHO
+ val echoe = ECHOE
+ val echok = ECHOK
+ val echonl = ECHONL
+ val icanon = ICANON
+ val iexten = IEXTEN
+ val isig = ISIG
+ val noflsh = NOFLSH
+ val tostop = TOSTOP
end
- type speed = Prim.speed
+ type speed = C.Speed.t
+ val b0 = B0
+ val b110 = B110
+ val b1200 = B1200
+ val b134 = B134
+ val b150 = B150
+ val b1800 = B1800
+ val b19200 = B19200
+ val b200 = B200
+ val b2400 = B2400
+ val b300 = B300
+ val b38400 = B38400
+ val b4800 = B4800
+ val b50 = B50
+ val b600 = B600
+ val b75 = B75
+ val b9600 = B9600
+
val compareSpeed = SysWord.compare
fun id x = x
val speedToWord = id
val wordToSpeed = id
- type termios = {iflag: I.flags,
- oflag: O.flags,
- cflag: C.flags,
- lflag: L.flags,
+ type termios = {iflag: IFlags.flags,
+ oflag: OFlags.flags,
+ cflag: CFlags.flags,
+ lflag: LFlags.flags,
cc: V.cc,
ispeed: speed,
ospeed: speed}
@@ -83,10 +173,10 @@
val termios = id
val fieldsOf = id
- val getiflag: termios -> I.flags = #iflag
- val getoflag: termios -> O.flags = #oflag
- val getcflag: termios -> C.flags = #cflag
- val getlflag: termios -> L.flags = #oflag
+ val getiflag: termios -> IFlags.flags = #iflag
+ val getoflag: termios -> OFlags.flags = #oflag
+ val getcflag: termios -> CFlags.flags = #cflag
+ val getlflag: termios -> LFlags.flags = #oflag
val getcc: termios -> V.cc = #cc
structure CF =
@@ -121,53 +211,73 @@
struct
open Prim.TC
+ type set_action = C.Int.t
+ val sadrain = TCSADRAIN
+ val saflush = TCSAFLUSH
+ val sanow = TCSANOW
+
+ type flow_action = C.Int.t
+ val ioff = TCIOFF
+ val ion = TCION
+ val ooff = TCOOFF
+ val oon = TCOON
+
+ type queue_sel = C.Int.t
+ val iflush = TCIFLUSH
+ val oflush = TCOFLUSH
+ val ioflush = TCIOFLUSH
+
fun getattr fd =
SysCall.syscallRestart
(fn () =>
- (Prim.getattr fd, fn () =>
- {iflag = Termios.iflag (),
- oflag = Termios.oflag (),
- cflag = Termios.cflag (),
- lflag = Termios.lflag (),
- cc = Cstring.toCharArrayOfLength (Termios.cc (), V.nccs),
- ispeed = Termios.ispeed (),
- ospeed = Termios.ospeed ()}))
+ (Prim.TC.getattr fd, fn () =>
+ {iflag = Termios.getIFlag (),
+ oflag = Termios.getOFlag (),
+ cflag = Termios.getCFlag (),
+ lflag = Termios.getLFlag (),
+ cc = let val a = V.new ()
+ in Termios.getCC (a); a
+ end,
+ ispeed = Termios.cfGetISpeed (),
+ ospeed = Termios.cfGetOSpeed ()}))
fun setattr (fd, a,
{iflag, oflag, cflag, lflag, cc, ispeed, ospeed}) =
Sys...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-01-28 13:30:51
|
More re-integration of generated ML-side basis library imports.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/itimer.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.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-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/net/net.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.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/signal.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.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/posix-primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
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/io.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -9,27 +9,27 @@
(* C *)
-structure Char = Int8
-structure SChar = Int8
-structure UChar = Word8
-structure Short = Int16
-structure SShort = Int16
-structure UShort = Word16
-structure Int = Int32
-structure SInt = Int32
-structure UInt = Word32
-structure Long = Int32
-structure SLong = Int32
-structure ULong = Word32
-structure LongLong = Int64
-structure SLongLong = Int64
-structure ULongLong = Word64
-structure Float = Real32
-structure Double = Real64
-structure Size = Word32
+structure Char = struct open Int8 type t = int end
+structure SChar = struct open Int8 type t = int end
+structure UChar = struct open Word8 type t = word end
+structure Short = struct open Int16 type t = int end
+structure SShort = struct open Int16 type t = int end
+structure UShort = struct open Word16 type t = word end
+structure Int = struct open Int32 type t = int end
+structure SInt = struct open Int32 type t = int end
+structure UInt = struct open Word32 type t = word end
+structure Long = struct open Int32 type t = int end
+structure SLong = struct open Int32 type t = int end
+structure ULong = struct open Word32 type t = word end
+structure LongLong = struct open Int64 type t = int end
+structure SLongLong = struct open Int64 type t = int end
+structure ULongLong = struct open Word64 type t = word end
+structure Float = struct open Real32 type t = real end
+structure Double = struct open Real64 type t = real end
+structure Size = struct open Word32 type t = word end
-structure String = Word32
-structure StringArray = Word32
+structure String = Pointer
+structure StringArray = Pointer
(* Generic integers *)
structure Fd = Int
@@ -38,40 +38,40 @@
structure Sock = Int
(* from <dirent.h> *)
-structure DirP = Word32
+structure DirP = struct open Word32 type t = word end
(* from <poll.h> *)
-structure NFds = Word32
+structure NFds = struct open Word32 type t = word end
(* from <resource.h> *)
-structure RLim = Word64
+structure RLim = struct open Word64 type t = word end
(* from <sys/types.h> *)
-structure Clock = Int32
-structure Dev = Word64
-structure GId = Word32
-structure Id = Word32
-structure INo = Word64
-structure Mode = Word32
-structure NLink = Word32
-structure Off = Int64
-structure PId = Int32
-structure SSize = Int32
-structure SUSeconds = Int32
-structure Time = Int32
-structure UId = Word32
-structure USeconds = Word32
+structure Clock = struct open Int32 type t = int end
+structure Dev = struct open Word64 type t = word end
+structure GId = struct open Word32 type t = word end
+structure Id = struct open Word32 type t = word end
+structure INo = struct open Word64 type t = word end
+structure Mode = struct open Word32 type t = word end
+structure NLink = struct open Word32 type t = word end
+structure Off = struct open Int64 type t = int end
+structure PId = struct open Int32 type t = int end
+structure SSize = struct open Int32 type t = int end
+structure SUSeconds = struct open Int32 type t = int end
+structure Time = struct open Int32 type t = int end
+structure UId = struct open Word32 type t = word end
+structure USeconds = struct open Word32 type t = word end
(* from <sys/socket.h> *)
-structure Socklen = Word32
+structure Socklen = struct open Word32 type t = word end
(* from <termios.h> *)
-structure CC = Word8
-structure Speed = Word32
-structure TCFlag = Word32
+structure CC = struct open Word8 type t = word end
+structure Speed = struct open Word32 type t = word end
+structure TCFlag = struct open Word32 type t = word end
(* from "gmp.h" *)
-structure MPLimb = Word32
+structure MPLimb = struct open Word32 type t = word end
structure Errno = struct type 'a t = 'a end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-01-28 21:30:43 UTC (rev 4327)
@@ -87,6 +87,9 @@
../../integer/patch.sml
../../integer/embed-int.sml
../../integer/embed-word.sml
+ ann "forceUsed" in
+ ../../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
+ end
../../top-level/arithmetic.sml
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:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/itimer.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -13,9 +13,9 @@
datatype t = Prof | Real | Virtual
val signal =
- fn Prof => PosixPrimitive.Signal.prof
- | Real => PosixPrimitive.Signal.alrm
- | Virtual => PosixPrimitive.Signal.vtalrm
+ fn Prof => PosixSignal.prof
+ | Real => PosixSignal.alrm
+ | Virtual => PosixSignal.vtalrm
val toInt =
fn Prof => Prim.PROF
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -10,18 +10,15 @@
struct
open Posix.Signal
-structure Prim = PosixPrimitive.Signal
+structure Prim = PrimitiveFFI.Posix.Signal
structure Error = PosixError
structure SysCall = Error.SysCall
val restart = SysCall.restartFlag
type t = signal
-val prof = Prim.prof
-val vtalrm = Prim.vtalrm
+type how = C.Int.t
-type how = Prim.how
-
(* val toString = SysWord.toString o toWord *)
fun raiseInval () =
@@ -33,7 +30,7 @@
val validSignals =
Array.tabulate
- (Prim.numSignals, fn i =>
+ (Prim.NSIG, fn i =>
Prim.sigismember(fromInt i) <> ~1)
structure Mask =
@@ -73,10 +70,10 @@
fun make (how: how) (m: t) =
(write m; SysCall.simpleRestart (fn () => Prim.sigprocmask how))
in
- val block = make Prim.block
- val unblock = make Prim.unblock
- val setBlocked = make Prim.setmask
- fun getBlocked () = (make Prim.block none; read ())
+ val block = make Prim.SIG_BLOCK
+ val unblock = make Prim.SIG_UNBLOCK
+ val setBlocked = make Prim.SIG_SETMASK
+ fun getBlocked () = (make Prim.SIG_BLOCK none; read ())
end
local
@@ -115,7 +112,7 @@
val (getHandler, setHandler, handlers) =
let
- val handlers = Array.tabulate (Prim.numSignals, initHandler o fromInt)
+ val handlers = Array.tabulate (Prim.NSIG, initHandler o fromInt)
val _ =
Cleaner.addNew
(Cleaner.atLoadWorld, fn () =>
@@ -179,7 +176,7 @@
val () = Mask.block (handled ())
val fs =
case !gcHandler of
- Handler f => if Prim.isGCPending () then [f] else []
+ Handler f => if Prim.isPendingGC () then [f] else []
| _ => []
val fs =
Array.foldri
@@ -220,7 +217,7 @@
fun suspend m =
(Mask.write m
- ; Prim.suspend ()
+ ; Prim.sigsuspend ()
; MLtonThread.switchToSignalHandler ())
fun handleGC f =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -39,7 +39,7 @@
file, " due to ",
General.exnMessage e])
end
- val _ = Prim.save (Posix.FileSys.fdToWord fd)
+ val _ = Prim.save fd
in
if Prim.getAmOriginal gcState
then (Posix.IO.close fd; Original)
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 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -24,7 +24,7 @@
let
val (sa, salen, finish) = Socket.new_sock_addr ()
val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
- Net.htons port, sa, salen)
+ Net.htonl port, sa, salen)
in
finish ()
end
@@ -34,7 +34,7 @@
fun fromAddr sa =
let
val _ = Prim.fromAddr (Word8Vector.toPoly (Socket.unpackSockAddr sa))
- val port = Net.ntohs (Prim.getPort ())
+ val port = Net.ntohl (Prim.getPort ())
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-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -7,11 +7,11 @@
structure NetHostDB:> NET_HOST_DB_EXTRA =
struct
- structure Prim = Primitive.NetHostDB
+ structure Prim = PrimitiveFFI.NetHostDB
(* network byte order (MSB) *)
- type pre_in_addr = Prim.pre_in_addr
- type in_addr = Prim.in_addr
+ type pre_in_addr = Word8.word array
+ type in_addr = Word8.word vector
val preInAddrToWord8Array = fn a => a
val inAddrToWord8Vector = fn v => v
@@ -19,7 +19,8 @@
structure PW = PackWord32Big
fun new_in_addr () =
let
- val ia: pre_in_addr = Array.array (Prim.inAddrLen, 0wx0: Word8.word)
+ val inAddrLen = Word32.toIntX Prim.inAddrSize
+ val ia: pre_in_addr = Array.array (inAddrLen, 0wx0: Word8.word)
fun finish () = Array.vector ia
in
(ia, finish)
@@ -34,7 +35,7 @@
finish ()
end
fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
- type addr_family = Prim.addr_family
+ type addr_family = C.Int.t
val intToAddrFamily = fn z => z
val addrFamilyToInt = fn z => z
@@ -58,27 +59,27 @@
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.entryName ())
- val numAliases = Prim.entryNumAliases ()
+ val name = COld.CS.toString (Prim.getEntryName ())
+ val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
if n < numAliases
then let
val alias =
- COld.CS.toString (Prim.entryAliasesN n)
+ COld.CS.toString (Prim.getEntryAliasesN n)
in
fill (n + 1, alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
- val addrType = Prim.entryAddrType ()
- val length = Prim.entryLength ()
- val numAddrs = Prim.entryNumAddrs ()
+ val addrType = Prim.getEntryAddrType ()
+ val length = Prim.getEntryLength ()
+ val numAddrs = Prim.getEntryAddrsNum ()
fun fill (n, addrs) =
if n < numAddrs
then let
val addr = Word8Array.array (length, 0wx0)
val _ =
- Prim.entryAddrsN (n, Word8Array.toPoly addr)
+ Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
val addr =
Word8Vector.toPoly (Word8Array.vector addr)
in
@@ -95,7 +96,7 @@
else NONE
in
fun getByAddr in_addr =
- get (Prim.getByAddress (in_addr, Vector.length in_addr))
+ get (Prim.getByAddress (in_addr, C.Socklen.fromInt (Vector.length in_addr)))
fun getByName name =
get (Prim.getByName (NullString.nullTerm name))
end
@@ -106,7 +107,7 @@
val buf = CharArray.array (n, #"\000")
val () =
Posix.Error.SysCall.simple
- (fn () => Prim.getHostName (CharArray.toPoly buf, n))
+ (fn () => Prim.getHostName (CharArray.toPoly buf, C.Size.fromInt n))
in
case CharArray.findi (fn (_, c) => c = #"\000") buf of
NONE => CharArray.vector buf
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:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-prot-db.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -7,7 +7,7 @@
structure NetProtDB: NET_PROT_DB =
struct
- structure Prim = Primitive.NetProtDB
+ structure Prim = PrimitiveFFI.NetProtDB
datatype entry = T of {name: string,
aliases: string list,
@@ -25,19 +25,19 @@
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.entryName ())
- val numAliases = Prim.entryNumAliases ()
+ val name = COld.CS.toString (Prim.getEntryName ())
+ val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
if n < numAliases
then let
val alias =
- COld.CS.toString (Prim.entryAliasesN n)
+ COld.CS.toString (Prim.getEntryAliasesN n)
in
fill (n + 1, alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
- val protocol = Prim.entryProtocol ()
+ val protocol = Prim.getEntryProto ()
in
SOME (T {name = name,
aliases = aliases,
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:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-serv-db.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -7,7 +7,7 @@
structure NetServDB: NET_SERV_DB =
struct
- structure Prim = Primitive.NetServDB
+ structure Prim = PrimitiveFFI.NetServDB
datatype entry = T of {name: string,
aliases: string list,
@@ -27,20 +27,20 @@
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.entryName ())
- val numAliases = Prim.entryNumAliases ()
+ val name = COld.CS.toString (Prim.getEntryName ())
+ val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
if n < numAliases
then let
val alias =
- COld.CS.toString (Prim.entryAliasesN n)
+ COld.CS.toString (Prim.getEntryAliasesN n)
in
fill (n + 1, alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
- val port = Net.ntohs (Prim.entryPort ())
- val protocol = COld.CS.toString (Prim.entryProtocol ())
+ val port = Net.ntohl (Prim.getEntryPort ())
+ val protocol = COld.CS.toString (Prim.getEntryProto ())
in
SOME (T {name = name,
aliases = aliases,
@@ -56,7 +56,7 @@
| NONE => get (Prim.getByNameNull (NullString.nullTerm name))
fun getByPort (port, proto) =
let
- val port = Net.htons port
+ val port = Net.htonl port
in
case proto of
NONE => get (Prim.getByPortNull port)
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 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sig 2006-01-28 21:30:43 UTC (rev 4327)
@@ -1,7 +1,7 @@
signature NET =
sig
-(* val htonl: int -> int *)
-(* val ntohl: int -> int *)
- val htons: int -> int
- val ntohs: int -> int
+ val htonl: Int32.int -> Int32.int
+ val ntohl: Int32.int -> Int32.int
+ val htons: Int16.int -> Int16.int
+ val ntohs: Int16.int -> Int16.int
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sml 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -7,10 +7,10 @@
structure Net : NET =
struct
- structure Prim = Primitive.Net
+ structure Prim = PrimitiveFFI.Net
-(* val htonl = Prim.htonl *)
-(* val ntohl = Prim.ntohl *)
- val htons = Prim.htons
- val ntohs = Prim.ntohs
+ val htonl = Primitive.Word32.toInt32 o Prim.htonl o Primitive.Word32.fromInt32
+ val ntohl = Primitive.Word32.toInt32 o Prim.ntohl o Primitive.Word32.fromInt32
+ val htons = Primitive.Word16.toInt16 o Prim.htons o Primitive.Word16.fromInt16
+ val ntohs = Primitive.Word16.toInt16 o Prim.ntohs o Primitive.Word16.fromInt16
end
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:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -8,9 +8,174 @@
structure PosixError: POSIX_ERROR_EXTRA =
struct
- structure Prim = PosixPrimitive.Error
+ structure Prim = PrimitiveFFI.Posix.Error
open Prim
-
+
+ type syserror = C.Int.t
+
+ val acces = EACCES
+ val addrinuse = EADDRINUSE
+ val addrnotavail = EADDRNOTAVAIL
+ val afnosupport = EAFNOSUPPORT
+ val again = EAGAIN
+ val already = EALREADY
+ val badf = EBADF
+ val badmsg = EBADMSG
+ val busy = EBUSY
+ val canceled = ECANCELED
+ val child = ECHILD
+ val connaborted = ECONNABORTED
+ val connrefused = ECONNREFUSED
+ val connreset = ECONNRESET
+ val deadlk = EDEADLK
+ val destaddrreq = EDESTADDRREQ
+ val dom = EDOM
+ val dquot = EDQUOT
+ val exist = EEXIST
+ val fault = EFAULT
+ val fbig = EFBIG
+ val hostunreach = EHOSTUNREACH
+ val idrm = EIDRM
+ val ilseq = EILSEQ
+ val inprogress = EINPROGRESS
+ val intr = EINTR
+ val inval = EINVAL
+ val io = EIO
+ val isconn = EISCONN
+ val isdir = EISDIR
+ val loop = ELOOP
+ val mfile = EMFILE
+ val mlink = EMLINK
+ val msgsize = EMSGSIZE
+ val multihop = EMULTIHOP
+ val nametoolong = ENAMETOOLONG
+ val netdown = ENETDOWN
+ val netreset = ENETRESET
+ val netunreach = ENETUNREACH
+ val nfile = ENFILE
+ val nobufs = ENOBUFS
+ val nodata = ENODATA
+ val nodev = ENODEV
+ val noent = ENOENT
+ val noexec = ENOEXEC
+ val nolck = ENOLCK
+ val nolink = ENOLINK
+ val nomem = ENOMEM
+ val nomsg = ENOMSG
+ val noprotoopt = ENOPROTOOPT
+ val nospc = ENOSPC
+ val nosr = ENOSR
+ val nostr = ENOSTR
+ val nosys = ENOSYS
+ val notconn = ENOTCONN
+ val notdir = ENOTDIR
+ val notempty = ENOTEMPTY
+ val notsock = ENOTSOCK
+ val notsup = ENOTSUP
+ val notty = ENOTTY
+ val nxio = ENXIO
+ val opnotsupp = EOPNOTSUPP
+ val overflow = EOVERFLOW
+ val perm = EPERM
+ val pipe = EPIPE
+ val proto = EPROTO
+ val protonosupport = EPROTONOSUPPORT
+ val prototype = EPROTOTYPE
+ val range = ERANGE
+ val rofs = EROFS
+ val spipe = ESPIPE
+ val srch = ESRCH
+ val stale = ESTALE
+ val time = ETIME
+ val timedout = ETIMEDOUT
+ val toobig = E2BIG
+ val txtbsy = ETXTBSY
+ val wouldblock = EWOULDBLOCK
+ val xdev = EXDEV
+
+ val errorNames =
+ [
+ (acces,"acces"),
+ (addrinuse,"addrinuse"),
+ (addrnotavail,"addrnotavail"),
+ (afnosupport,"afnosupport"),
+ (again,"again"),
+ (already,"already"),
+ (badf,"badf"),
+ (badmsg,"badmsg"),
+ (busy,"busy"),
+ (canceled,"canceled"),
+ (child,"child"),
+ (connaborted,"connaborted"),
+ (connrefused,"connrefused"),
+ (connreset,"connreset"),
+ (deadlk,"deadlk"),
+ (destaddrreq,"destaddrreq"),
+ (dom,"dom"),
+ (dquot,"dquot"),
+ (exist,"exist"),
+ (fault,"fault"),
+ (fbig,"fbig"),
+ (hostunreach,"hostunreach"),
+ (idrm,"idrm"),
+ (ilseq,"ilseq"),
+ (inprogress,"inprogress"),
+ (intr,"intr"),
+ (inval,"inval"),
+ (io,"io"),
+ (isconn,"isconn"),
+ (isdir,"isdir"),
+ (loop,"loop"),
+ (mfile,"mfile"),
+ (mlink,"mlink"),
+ (msgsize,"msgsize"),
+ (multihop,"multihop"),
+ (nametoolong,"nametoolong"),
+ (netdown,"netdown"),
+ (netreset,"netreset"),
+ (netunreach,"netunreach"),
+ (nfile,"nfile"),
+ (nobufs,"nobufs"),
+ (nodata,"nodata"),
+ (nodev,"nodev"),
+ (noent,"noent"),
+ (noexec,"noexec"),
+ (nolck,"nolck"),
+ (nolink,"nolink"),
+ (nomem,"nomem"),
+ (nomsg,"nomsg"),
+ (noprotoopt,"noprotoopt"),
+ (nospc,"nospc"),
+ (nosr,"nosr"),
+ (nostr,"nostr"),
+ (nosys,"nosys"),
+ (notconn,"notconn"),
+ (notdir,"notdir"),
+ (notempty,"notempty"),
+ (notsock,"notsock"),
+ (notsup,"notsup"),
+ (notty,"notty"),
+ (nxio,"nxio"),
+ (opnotsupp,"opnotsupp"),
+ (overflow,"overflow"),
+ (perm,"perm"),
+ (pipe,"pipe"),
+ (proto,"proto"),
+ (protonosupport,"protonosupport"),
+ (prototype,"prototype"),
+ (range,"range"),
+ (rofs,"rofs"),
+ (spipe,"spipe"),
+ (srch,"srch"),
+ (stale,"stale"),
+ (time,"time"),
+ (timedout,"timedout"),
+ (toobig,"toobig"),
+ (txtbsy,"txtbsy"),
+ (wouldblock,"wouldblock"),
+ (xdev,"xdev")
+ ]
+
exception SysErr of string * syserror option
val toWord = SysWord.fromInt
@@ -41,7 +206,7 @@
fun errorMsg (n: int) =
let
- val cs = strerror n
+ val cs = strError n
in
if cs = Primitive.Pointer.null
then "Unknown error"
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sig 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sig 2006-01-28 21:30:43 UTC (rev 4327)
@@ -31,6 +31,9 @@
sig
include POSIX_SIGNAL
+ val prof: signal
+ val vtalrm: signal
+
val fromInt: int -> signal
val toInt: signal -> int
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -8,10 +8,42 @@
structure PosixSignal: POSIX_SIGNAL_EXTRA =
struct
- open PosixPrimitive.Signal
+ open PrimitiveFFI.Posix.Signal
- type signal = t
+ type signal = C.Int.t
+
+ val abrt = SIGABRT
+ val alrm = SIGALRM
+ val bus = SIGBUS
+ val chld = SIGCHLD
+ val cont = SIGCONT
+ val fpe = SIGFPE
+ val hup = SIGHUP
+ val ill = SIGILL
+ val int = SIGINT
+ val kill = SIGKILL
+ val pipe = SIGPIPE
+ val poll = SIGPOLL
+ val prof = SIGPROF
+ val quit = SIGQUIT
+ val segv = SIGSEGV
+ val stop = SIGSTOP
+ val sys = SIGSYS
+ val term = SIGTERM
+ val trap = SIGTRAP
+ val tstp = SIGTSTP
+ val ttin = SIGTTIN
+ val ttou = SIGTTOU
+ val urg = SIGURG
+ val usr1 = SIGUSR1
+ val usr2 = SIGUSR2
+ val vtalrm = SIGVTALRM
+ val xcpu = SIGXCPU
+ val xfsz = SIGXFSZ
+ val toInt = C.Int.toInt
+ val fromInt = C.Int.fromInt
+
+ val toWord = SysWord.fromInt o toInt
val fromWord = fromInt o SysWord.toInt
- val toWord = SysWord.fromInt o toInt
end
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:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -110,18 +110,6 @@
struct
open Primitive
- structure OS =
- struct
- open OS
-
- structure IO =
- struct
- open IO
-
- val poll = stub ("poll", poll)
- end
- end
-
structure Socket =
struct
open Socket
@@ -150,5 +138,17 @@
val set = stub ("set", set)
end
end
+
+ structure OS =
+ struct
+ open OS
+
+ structure IO =
+ struct
+ open IO
+
+ val poll = stub ("poll", poll)
+ end
+ end
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/posix-primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/posix-primitive.sml 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/posix-primitive.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -22,153 +22,9 @@
type file_desc = FileDesc.t
type fd = file_desc
- structure Error =
- struct
- type syserror = int
-
- val getErrno = _import "Posix_Error_getErrno": unit -> int;
- val clearErrno = _import "Posix_Error_clearErrno": unit -> unit;
- val strerror = _import "Posix_Error_strerror": syserror -> cstring;
-
- val acces = _const "Posix_Error_acces": syserror;
- val again = _const "Posix_Error_again": syserror;
- val badf = _const "Posix_Error_badf": syserror;
- val badmsg = _const "Posix_Error_badmsg": syserror;
- val busy = _const "Posix_Error_busy": syserror;
- val canceled = _const "Posix_Error_canceled": syserror;
- val child = _const "Posix_Error_child": syserror;
- val deadlk = _const "Posix_Error_deadlk": syserror;
- val dom = _const "Posix_Error_dom": syserror;
- val exist = _const "Posix_Error_exist": syserror;
- val fault = _const "Posix_Error_fault": syserror;
- val fbig = _const "Posix_Error_fbig": syserror;
- val inprogress = _const "Posix_Error_inprogress": syserror;
- val intr = _const "Posix_Error_intr": syserror;
- val inval = _const "Posix_Error_inval": syserror;
- val io = _const "Posix_Error_io": syserror;
- val isdir = _const "Posix_Error_isdir": syserror;
- val loop = _const "Posix_Error_loop": syserror;
- val mfile = _const "Posix_Error_mfile": syserror;
- val mlink = _const "Posix_Error_mlink": syserror;
- val msgsize = _const "Posix_Error_msgsize": syserror;
- val nametoolong = _const "Posix_Error_nametoolong": syserror;
- val nfile = _const "Posix_Error_nfile": syserror;
- val nodev = _const "Posix_Error_nodev": syserror;
- val noent = _const "Posix_Error_noent": syserror;
- val noexec = _const "Posix_Error_noexec": syserror;
- val nolck = _const "Posix_Error_nolck": syserror;
- val nomem = _const "Posix_Error_nomem": syserror;
- val nospc = _const "Posix_Error_nospc": syserror;
- val nosys = _const "Posix_Error_nosys": syserror;
- val notdir = _const "Posix_Error_notdir": syserror;
- val notempty = _const "Posix_Error_notempty": syserror;
- val notsup = _const "Posix_Error_notsup": syserror;
- val notty = _const "Posix_Error_notty": syserror;
- val nxio = _const "Posix_Error_nxio": syserror;
- val perm = _const "Posix_Error_perm": syserror;
- val pipe = _const "Posix_Error_pipe": syserror;
- val range = _const "Posix_Error_range": syserror;
- val rofs = _const "Posix_Error_rofs": syserror;
- val spipe = _const "Posix_Error_spipe": syserror;
- val srch = _const "Posix_Error_srch": syserror;
- val toobig = _const "Posix_Error_toobig": syserror;
- val xdev = _const "Posix_Error_xdev": syserror;
-
- val errorNames =
- [
- (acces, "acces"),
- (again, "again"),
- (badf, "badf"),
- (badmsg, "badmsg"),
- (busy, "busy"),
- (canceled, "canceled"),
- (child, "child"),
- (deadlk, "deadlk"),
- (dom, "dom"),
- (exist, "exist"),
- (fault, "fault"),
- (fbig, "fbig"),
- (inprogress, "inprogress"),
- (intr, "intr"),
- (inval, "inval"),
- (io, "io"),
- (isdir, "isdir"),
- (loop, "loop"),
- (mfile, "mfile"),
- (mlink, "mlink"),
- (msgsize, "msgsize"),
- (nametoolong, "nametoolong"),
- (nfile, "nfile"),
- (nodev, "nodev"),
- (noent, "noent"),
- (noexec, "noexec"),
- (nolck, "nolck"),
- (nomem, "nomem"),
- (nospc, "nospc"),
- (nosys, "nosys"),
- (notdir, "notdir"),
- (notempty, "notempty"),
- (notsup, "notsup"),
- (notty, "notty"),
- (nxio, "nxio"),
- (perm, "perm"),
- (pipe, "pipe"),
- (range, "range"),
- (rofs, "rofs"),
- (spipe, "spipe"),
- (srch, "srch"),
- (toobig, "toobig"),
- (xdev, "xdev")
- ]
- end
-
structure Signal =
struct
open Primitive.Signal
-
- val abrt = _const "Posix_Signal_abrt": t;
- val alrm = _const "Posix_Signal_alrm": t;
- val bus = _const "Posix_Signal_bus": t;
- val chld = _const "Posix_Signal_chld": t;
- val cont = _const "Posix_Signal_cont": t;
- val fpe = _const "Posix_Signal_fpe": t;
- val hup = _const "Posix_Signal_hup": t;
- val ill = _const "Posix_Signal_ill": t;
- val int = _const "Posix_Signal_int": t;
- val kill = _const "Posix_Signal_kill": t;
- val pipe = _const "Posix_Signal_pipe": t;
- val prof = _const "Posix_Signal_prof": t;
- val quit = _const "Posix_Signal_quit": t;
- val segv = _const "Posix_Signal_segv": t;
- val stop = _const "Posix_Signal_stop": t;
- val term = _const "Posix_Signal_term": t;
- val tstp = _const "Posix_Signal_tstp": t;
- val ttin = _const "Posix_Signal_ttin": t;
- val ttou = _const "Posix_Signal_ttou": t;
- val usr1 = _const "Posix_Signal_usr1": t;
- val usr2 = _const "Posix_Signal_usr2": t;
- val vtalrm = _const "Posix_Signal_vtalrm": t;
-
- val block = _const "Posix_Signal_block": how;
- val default = _import "Posix_Signal_default": t -> int;
- val handleGC = _import "Posix_Signal_handleGC": unit -> unit;
- val handlee = _import "Posix_Signal_handle": t -> int;
- val ignore = _import "Posix_Signal_ignore": t -> int;
- val isDefault =
- _import "Posix_Signal_isDefault": t * bool ref -> int;
- val isGCPending = _import "Posix_Signal_isGCPending": unit -> bool;
- val isPending = _import "Posix_Signal_isPending": t -> bool;
- val numSignals = _const "Posix_Signal_numSignals": int;
- val resetPending = _import "Posix_Signal_resetPending": unit -> unit;
- val setmask = _const "Posix_Signal_setmask": how;
- val sigaddset = _import "Posix_Signal_sigaddset": t -> int;
- val sigdelset = _import "Posix_Signal_sigdelset": t -> int;
- val sigemptyset = _import "Posix_Signal_sigemptyset": unit -> int;
- val sigfillset = _import "Posix_Signal_sigfillset": unit -> int;
- val sigismember = _import "Posix_Signal_sigismember": t -> int;
- val sigprocmask = _import "Posix_Signal_sigprocmask": how -> int;
- val suspend = _import "Posix_Signal_suspend": unit -> unit;
- val unblock = _const "Posix_Signal_unblock": how;
end
structure Process =
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:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -52,7 +52,7 @@
type 'a t = (unit -> 'a) * ('a -> unit)
end
-structure Pid :> sig
+structure Pid : sig
eqtype t
val fromInt: int -> t
@@ -884,72 +884,13 @@
end
end
- structure Net =
- struct
- (* val htonl = _import "Net_htonl": int -> int; *)
- (* val ntohl = _import "Net_ntohl": int -> int; *)
- val htons = _import "Net_htons": int -> int;
- val ntohs = _import "Net_ntohs": int -> int;
- end
-
structure NetHostDB =
struct
(* network byte order (MSB) *)
type pre_in_addr = Word8.word array
type in_addr = Word8.word vector
- val inAddrLen = _const "NetHostDB_inAddrLen": int;
- val INADDR_ANY = _const "NetHostDB_INADDR_ANY": int;
- type addr_family = int
- val entryName = _import "NetHostDB_Entry_name": unit -> CString.t;
- val entryNumAliases = _import "NetHostDB_Entry_numAliases": unit -> int;
- val entryAliasesN = _import "NetHostDB_Entry_aliasesN": int -> CString.t;
- val entryAddrType = _import "NetHostDB_Entry_addrType": unit -> int;
- val entryLength = _import "NetHostDB_Entry_length": unit -> int;
- val entryNumAddrs = _import "NetHostDB_Entry_numAddrs": unit -> int;
- val entryAddrsN =
- _import "NetHostDB_Entry_addrsN": int * pre_in_addr -> unit;
- val getByAddress =
- _import "NetHostDB_getByAddress": in_addr * int -> bool;
- val getByName = _import "NetHostDB_getByName": NullString.t -> bool;
- val getHostName =
- _import "NetHostDB_getHostName": char array * int -> int;
end
- structure NetProtDB =
- struct
- val entryName = _import "NetProtDB_Entry_name": unit -> CString.t;
- val entryNumAliases = _import "NetProtDB_Entry_numAliases": unit -> int;
- val entryAliasesN = _import "NetProtDB_Entry_aliasesN": int -> CString.t;
- val entryProtocol = _import "NetProtDB_Entry_protocol": unit -> int;
- val getByName = _import "NetProtDB_getByName": NullString.t -> bool;
- val getByNumber = _import "NetProtDB_getByNumber": int -> bool;
- end
-
- structure NetServDB =
- struct
- val entryName = _import "NetServDB_Entry_name": unit -> CString.t;
- val entryNumAliases = _import "NetServDB_Entry_numAliases": unit -> int;
- val entryAliasesN = _import "NetServDB_Entry_aliasesN": int -> CString.t;
- val entryPort = _import "NetServDB_Entry_port": unit -> int;
- val entryProtocol = _import "NetServDB_Entry_protocol": unit -> CString.t;
- val getByName = _import "NetServDB_getByName": NullString.t * NullString.t -> bool;
- val getByNameNull = _import "NetServDB_getByNameNull": NullString.t -> bool;
- val getByPort = _import "NetServDB_getByPort": int * NullString.t -> bool;
- val getByPortNull = _import "NetServDB_getByPortNull": int -> bool;
- end
-
- structure OS =
- struct
- structure IO =
- struct
- val POLLIN = _const "OS_IO_POLLIN": word;
- val POLLPRI = _const "OS_IO_POLLPRI": word;
- val POLLOUT = _const "OS_IO_POLLOUT": word;
- val poll = _import "OS_IO_poll": int vector * word vector *
- int * int * word array -> int;
- end
- end
-
structure PackReal32 =
struct
type real = Real32.real
@@ -1190,23 +1131,21 @@
val assign = _prim "Ref_assign": 'a ref * 'a -> unit;
end
- structure Signal:>
+ structure Signal:
sig
eqtype t
- type how
val fromInt: int -> t
val toInt: t -> int
end =
struct
type t = int
- type how = int
val fromInt = fn s => s
val toInt = fn s => s
end
- structure Socket:>
+ structure Socket:
sig
type sock
@@ -1235,7 +1174,7 @@
val INET6 = _const "Socket_AF_INET6": addr_family;
val UNSPEC = _const "Socket_AF_UNSPEC": addr_family;
end
- structure SOCK:>
+ structure SOCK:
sig
eqtype sock_type
@@ -1380,7 +1319,7 @@
end
end
- structure Status:>
+ structure Status:
sig
eqtype t
@@ -1665,6 +1604,9 @@
val toLarge = _prim "WordU16_toWord64": word -> LargeWord.word;
val toLargeX = _prim "WordS16_toWord64": word -> LargeWord.word;
val xorb = _prim "Word16_xorb": word * word -> word;
+
+ val toInt16 = _prim "WordU16_toWord16": word -> Int16.int;
+ val fromInt16 = _prim "WordU16_toWord16": Int16.int -> word;
end
structure Word16 =
struct
@@ -1823,6 +1765,9 @@
val toLarge = _prim "WordU32_toWord64": word -> LargeWord.word;
val toLargeX = _prim "WordS32_toWord64": word -> LargeWord.word;
val xorb = _prim "Word32_xorb": word * word -> word;
+
+ val toInt32 = _prim "WordU32_toWord32": word -> Int32.int;
+ val fromInt32 = _prim "WordU32_toWord32": Int32.int -> word;
end
structure Word32 =
struct
@@ -1877,7 +1822,7 @@
_import "Cygwin_toFullWindowsPath": NullString.t -> CString.t;
end
- structure FileDesc:>
+ structure FileDesc:
sig
eqtype t
@@ -1912,7 +1857,7 @@
struct
val getAmOriginal = _import "GC_getAmOriginal": GCState.t -> bool;
val setAmOriginal = _import "GC_setAmOriginal": GCState.t * bool -> unit;
- val save = _prim "World_save": word (* filedes *) -> unit;
+ val save = _prim "World_save": FileDesc.t -> unit;
end
end
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:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/command-line.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -11,10 +11,9 @@
structure Prim = PrimitiveFFI.CommandLine
fun name () =
- COld.CS.toString
- (Primitive.Pointer.fromWord (Prim.commandNameGet ()))
+ COld.CS.toString (Prim.commandNameGet ())
fun arguments () =
(Array.toList o COld.CSS.toArrayOfLength)
- (Primitive.Pointer.fromWord (Prim.argvGet ()), Prim.argcGet ())
+ (Prim.argvGet (), Prim.argcGet ())
end
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 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml 2006-01-28 21:30:43 UTC (rev 4327)
@@ -94,24 +94,28 @@
(* polling function *)
local
- structure Prim = Primitive.OS.IO
+ structure Prim = PrimitiveFFI.OS.IO
fun join (false, _, w) = w
- | join (true, b, w) = Word.orb(w, b)
- fun test (w, b) = (Word.andb(w, b) <> 0w0)
- val rdBit : Word.word = Primitive.OS.IO.POLLIN
- and wrBit : Word.word = Primitive.OS.IO.POLLOUT
- and priBit : Word.word = Primitive.OS.IO.POLLPRI
+ | join (true, b, w) = Word16.orb(w, b)
+ fun test (w, b) = (Word16.andb(w, b) <> 0w0)
+ val rdBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLIN
+ and wrBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLOUT
+ and priBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLPRI
fun fromPollDesc (PollDesc (iod, {rd, wr, pri})) =
( toInt iod,
+ Primitive.Word16.toInt16 (
join (rd, rdBit,
join (wr, wrBit,
- join (pri, priBit, 0w0)))
+ join (pri, priBit, 0w0))))
)
- fun toPollInfo (fd, w) = PollInfo (fromInt fd, {
+ fun toPollInfo (fd, i) =
+ let val w = Primitive.Word16.fromInt16 i
+ in PollInfo (fromInt fd, {
rd = test(w, rdBit),
wr = test(w, wrBit),
pri = test(w, priBit)
})
+ end
in
fun poll (pds, timeOut) = let
val (fds, eventss) = ListPair.unzip (List.map fromPollDesc pds)
@@ -126,13 +130,13 @@
then let open PosixError in raiseSys inval end
else (Int.fromLarge (Time.toMilliseconds t)
handle Overflow => Error.raiseSys Error.inval)
- val reventss = Array.array (n, 0w0)
+ val reventss = Array.array (n, 0)
val _ = Posix.Error.SysCall.simpleRestart
- (fn () => Prim.poll (fds, eventss, n, timeOut, reventss))
+ (fn () => Prim.poll (fds, eventss, C.NFds.fromInt n, timeOut, reventss))
in
Array.foldri
(fn (i, w, l) =>
- if w <> 0w0
+ if w <> 0
then (toPollInfo (Vector.sub (fds, i), w))::l
else l)
[]
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB-consts.c 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB-consts.c 2006-01-28 21:30:43 UTC (rev 4327)
@@ -1,4 +1,4 @@
#include "platform.h"
-const C_Size_t NetHostDB_inAddrLen = sizeof (struct in_addr);
+const C_Size_t NetHostDB_inAddrSize = sizeof (struct in_addr);
const C_Int_t NetHostDB_INADDR_ANY = INADDR_ANY;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2006-01-28 21:30:43 UTC (rev 4327)
@@ -48,6 +48,6 @@
return (hostent != NULL and hostent->h_name != NULL);
}
-Bool NetHostDB_getHostName(Array(Char8_t) buf, C_Size_t len) {
- return (gethostname ((char*)buf, len) == 0);
+C_Errno_t(C_Int_t) NetHostDB_getHostName(Array(Char8_t) buf, C_Size_t len) {
+ gethostname ((char*)buf, len);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-01-28 21:30:43 UTC (rev 4327)
@@ -24,7 +24,7 @@
/* C99 headers */
// #include <assert.h>
// #include <complex.h>
-// #include <ctype.h>
+#include <ctype.h>
#include <errno.h>
// #include <fenv.h>
#include <float.h>
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-01-28 21:30:43 UTC (rev 4327)
@@ -110,8 +110,8 @@
NetHostDB.getEntryAliasesNum = _import : unit -> C.Int.t
NetHostDB.getEntryLength = _import : unit -> C.Int.t
NetHostDB.getEntryName = _import : unit -> C.String.t
-NetHostDB.getHostName = _import : Char8.t array * C.Size.t -> Bool.t
-NetHostDB.inAddrLen = _const : C.Size.t
+NetHostDB.getHostName = _import : Char8.t array * C.Size.t -> C.Int.t C.Errno.t
+NetHostDB.inAddrSize = _const : C.Size.t
NetProtDB.getByName = _import : NullString8.t -> Bool.t
NetProtDB.getByNumber = _import : C.Int.t -> Bool.t
NetProtDB.getEntryAliasesN = _import : C.Int.t -> C.String.t
@@ -573,6 +573,9 @@
Posix.Signal.SIGVTALRM = _const : C.Signal.t
Posix.Signal.SIGXCPU = _const : C.Signal.t
Posix.Signal.SIGXFSZ = _const : C.Signal.t
+Posix.Signal.SIG_BLOCK = _const : C.Int.t
+Posix.Signal.SIG_SETMASK = _const : C.Int.t
+Posix.Signal.SIG_UNBLOCK = _const : C.Int.t
Posix.Signal.default = _import : C.Signal.t -> C.Int.t C.Errno.t
Posix.Signal.handleGC = _import : unit -> unit
Posix.Signal.handlee = _import : C.Signal.t -> C.Int.t C.Errno.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-28 19:13:54 UTC (rev 4326)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-28 21:30:43 UTC (rev 4327)
@@ -148,6 +148,8 @@
#define systype(t, bt, name) \
do { \
+ char *btLower = strdup(bt); \
+ btLower[0] = tolower(bt[0]); \
writeString (cTypesHFd, "typedef "); \
writeString (cTypesHFd, "/* "); \
writeString (cTypesHFd, #t); \
@@ -161,10 +163,14 @@
writeNewline (cTypesHFd); \
writeString (cTypesSMLFd, "structure "); \
writeString (cTypesSMLFd, name); \
- writeString (cTypesSMLFd, " = "); \
+ writeString (cTypesSMLFd, " = struct open "); \
writeString (cTypesSMLFd, bt); \
writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
+ writeString (cTypesSMLFd, " type t = "); \
+ writeString (cTypesSMLFd, btLower); \
+ writeString (cTypesSMLFd, " end"); \
writeNewline (cTypesSMLFd); \
+ free (btLower); \
} while (0)
#define chksystype(t, name) \
do { \
@@ -175,6 +181,23 @@
else \
systype(t, "Int", name); \
} while (0)
+#define ptrtype(t, name) \
+ do { \
+ writeString (cTypesHFd, "typedef "); \
+ writeString (cTypesHFd, "/* "); \
+ writeString (cTypesHFd, #t); \
+ writeString (cTypesHFd, " */ "); \
+ writeString (cTypesHFd, "Pointer_t "); \
+ writeString (cTypesHFd, "C_"); \
+ writeString (cTypesHFd, name); \
+ writeString (cTypesHFd, "_t;"); \
+ writeNewline (cTypesHFd); \
+ writeString (cTypesSMLFd, "structure "); \
+ writeString (cTypesSMLFd, name); \
+ writeString (cTypesSMLFd, " = Pointer"); \
+ writeNewline (cTypesSMLFd); \
+ } while (0)
+
#define aliastype(name1, name2) \
do { \
writeString (cTypesHFd, "typedef "); \
@@ -256,8 +279,8 @@
chksystype(size_t, "Size");
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
// systype(void*, "Word", "Pointer");
- systype(char*, "Word", "String");
- systype(char**, "Word", "StringArray");
+ ptrtype(char*, "String");
+ ptrtype(char**, "StringArray");
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
writeStringWithNewline (cTypesHFd, "/* Generic integers */");
@@ -270,6 +293,7 @@
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
writeStringWithNewline (cTypesHFd, "/* from <dirent.h> */");
writeStringWithNewline (cTypesSMLFd, "(* from <dirent.h> *)");
+ // ptrtype(DIR*, "DirP");
systype(DIR*, "Word", "DirP");
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 11:14:05
|
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);
}
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 11:12:49
|
Move IntInf operations into gc runtime, where it has access to objptr
representation.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h 2006-01-28 17:54:57 UTC (rev 4324)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h 2006-01-28 19:12:47 UTC (rev 4325)
@@ -18,6 +18,7 @@
DEBUG_DFS_MARK = FALSE,
DEBUG_ENTER_LEAVE = FALSE,
DEBUG_GENERATIONAL = FALSE,
+ DEBUG_INT_INF = FALSE,
DEBUG_MARK_COMPACT = FALSE,
DEBUG_MEM = FALSE,
DEBUG_PROFILE = FALSE,
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c (from rev 4312, mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-01-27 01:55:39 UTC (rev 4312)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-01-28 19:12:47 UTC (rev 4325)
@@ -0,0 +1,560 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+typedef unsigned int uint;
+
+COMPILE_TIME_ASSERT(sizeof_mp_limb_t__compat__sizeof_objptr,
+ (sizeof(mp_limb_t) >= sizeof(objptr)) ||
+ (sizeof(objptr) % sizeof(mp_limb_t) == 0));
+#define LIMBS_PER_OBJPTR ( \
+ sizeof(mp_limb_t) >= sizeof(objptr) ? \
+ 1 : sizeof(objptr) / sizeof(mp_limb_t))
+
+/* Import the global gcState so we can get and set the frontier. */
+extern struct GC_state gcState;
+
+/*
+ * Test if a intInf is a fixnum.
+ */
+static inline bool isSmall (objptr arg) {
+ return (arg & 1);
+}
+
+static inline bool eitherIsSmall (objptr arg1, objptr arg2) {
+ return ((arg1 | arg2) & 1);
+}
+
+static inline bool areSmall (objptr arg1, objptr arg2) {
+ return (arg1 & arg2 & 1);
+}
+
+/*
+ * Convert a bignum intInf to a bignum pointer.
+ */
+static inline GC_intInf toBignum (objptr arg) {
+ GC_intInf bp;
+
+ assert(not isSmall(arg));
+ bp = (GC_intInf)(objptrToPointer(arg, gcState.heap.start)
+ - offsetof(struct GC_intInf, isneg));
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
+ assert (bp->header == GC_INTINF_HEADER);
+ return bp;
+}
+
+/*
+ * Given an intInf, a pointer to an __mpz_struct and space large
+ * enough to contain 2 * LIMBS_PER_OBJPTR limbs, fill in the
+ * __mpz_struct.
+ */
+static inline void fill (objptr arg, __mpz_struct *res,
+ mp_limb_t space[2 * LIMBS_PER_OBJPTR]) {
+ GC_intInf bp;
+
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "fill ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
+ arg, (uintptr_t)res, (uintptr_t)space);
+ if (isSmall(arg)) {
+ res->_mp_alloc = 2 * LIMBS_PER_OBJPTR;
+ res->_mp_d = space;
+ if (arg == 0) {
+ res->_mp_size = 0;
+ } else {
+ objptr highBit = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
+ bool neg = (arg & highBit) != (objptr)0;
+ if (neg) {
+ res->_mp_size = - LIMBS_PER_OBJPTR;
+ arg = -((arg >> 1) | highBit);
+ } else {
+ res->_mp_size = LIMBS_PER_OBJPTR;
+ arg = (arg >> 1);
+ }
+ for (unsigned int i = 0; i < LIMBS_PER_OBJPTR; i++) {
+ space[i] = (mp_limb_t)arg;
+ arg = arg >> (CHAR_BIT * sizeof(mp_limb_t));
+ }
+ }
+ } else {
+ bp = toBignum(arg);
+ res->_mp_alloc = bp->length - 1;
+ res->_mp_d = (mp_limb_t*)(bp->limbs);
+ res->_mp_size = bp->isneg ? - res->_mp_alloc : res->_mp_alloc;
+ }
+}
+
+/* /\* */
+/* * Initialize an __mpz_struct to use the space provided by an ML array. */
+/* *\/ */
+/* static inline void initRes (__mpz_struct *mpzp, size_t bytes) { */
+/* GC_intInf bp; */
+
+/* assert (bytes <= (size_t)(gcState.limitPlusSlop - gcState.frontier)); */
+/* bp = (GC_intInf)gcState.frontier; */
+/* /\* We have as much space for the limbs as there is to the end */
+/* * of the heap. Divide by (sizeof(mp_limb_t)) to get number */
+/* * of limbs. */
+/* *\/ */
+/* mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t)); */
+/* mpzp->_mp_size = 0; /\* is this necessary? *\/ */
+/* mpzp->_mp_d = (mp_limb_t*)(bp->limbs); */
+/* } */
+
+/* /\* */
+/* * Count number of leading zeros. The argument will not be zero. */
+/* * This MUST be replaced with assembler. */
+/* *\/ */
+/* static inline uint leadingZeros (mp_limb_t word) { */
+/* uint res; */
+
+/* assert(word != 0); */
+/* res = 0; */
+/* while ((int)word > 0) { */
+/* ++res; */
+/* word <<= 1; */
+/* } */
+/* return (res); */
+/* } */
+
+/* static inline void setFrontier (pointer p, size_t bytes) { */
+/* p = GC_alignFrontier (&gcState, p); */
+/* assert ((size_t)(p - gcState.frontier) <= bytes); */
+/* GC_profileAllocInc (&gcState, p - gcState.frontier); */
+/* gcState.frontier = p; */
+/* assert (gcState.frontier <= gcState.limitPlusSlop); */
+/* } */
+
+/* /\* */
+/* * Given an __mpz_struct pointer which reflects the answer, set gcState.frontier */
+/* * and return the answer. */
+/* * If the answer fits in a fixnum, we return that, with the frontier */
+/* * rolled back. */
+/* * If the answer doesn't need all of the space allocated, we adjust */
+/* * the array size and roll the frontier slightly back. */
+/* *\/ */
+/* static pointer answer (__mpz_struct *ans, size_t bytes) { */
+/* GC_intInf bp; */
+/* int size; */
+
+/* bp = (GC_intInf)((pointer)ans->_mp_d - offsetof(struct GC_intInf, limbs)); */
+/* assert(ans->_mp_d == (mp_limb_t*)(bp->limbs)); */
+/* size = ans->_mp_size; */
+/* if (size < 0) { */
+/* bp->isneg = TRUE; */
+/* size = - size; */
+/* } else */
+/* bp->isneg = FALSE; */
+/* if (size <= 1) { */
+/* uint val, */
+/* ans; */
+
+/* if (size == 0) */
+/* val = 0; */
+/* else */
+/* val = bp->limbs[0]; */
+/* if (bp->isneg) { */
+/* /\* */
+/* * We only fit if val in [1, 2^30]. */
+/* *\/ */
+/* ans = - val; */
+/* val = val - 1; */
+/* } else */
+/* /\* */
+/* * We only fit if val in [0, 2^30 - 1]. */
+/* *\/ */
+/* ans = val; */
+/* if (val < (uint)1<<30) { */
+/* return (pointer)(ans<<1 | 1); */
+/* } */
+/* } */
+/* setFrontier ((pointer)(&bp->limbs[size]), bytes); */
+/* bp->counter = 0; */
+/* bp->length = size + 1; /\* +1 for isNeg word *\/ */
+/* bp->header = GC_intInfHeader (); */
+/* return (pointer)&bp->isneg; */
+/* } */
+
+/* static inline pointer binary (pointer lhs, pointer rhs, size_t bytes, */
+/* void(*binop)(__mpz_struct *resmpz, */
+/* __gmp_const __mpz_struct *lhsspace, */
+/* __gmp_const __mpz_struct *rhsspace)) { */
+/* __mpz_struct lhsmpz, */
+/* rhsmpz, */
+/* resmpz; */
+/* mp_limb_t lhsspace[2], */
+/* rhsspace[2]; */
+
+/* initRes (&resmpz, bytes); */
+/* fill (lhs, &lhsmpz, lhsspace); */
+/* fill (rhs, &rhsmpz, rhsspace); */
+/* binop (&resmpz, &lhsmpz, &rhsmpz); */
+/* return answer (&resmpz, bytes); */
+/* } */
+
+/* pointer IntInf_add (pointer lhs, pointer rhs, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_add ("FMTPTR", "FMTPTR", %zu)\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
+/* return binary (lhs, rhs, bytes, &mpz_add); */
+/* } */
+
+/* pointer IntInf_gcd (pointer lhs, pointer rhs, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_gcd ("FMTPTR", "FMTPTR", %zu)\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
+/* return binary (lhs, rhs, bytes, &mpz_gcd); */
+/* } */
+
+/* pointer IntInf_mul (pointer lhs, pointer rhs, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_mul ("FMTPTR", "FMTPTR", %zu)\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
+/* return binary (lhs, rhs, bytes, &mpz_mul); */
+/* } */
+
+/* pointer IntInf_sub (pointer lhs, pointer rhs, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_sub ("FMTPTR", "FMTPTR", %zu)\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
+/* return binary (lhs, rhs, bytes, &mpz_sub); */
+/* } */
+
+/* pointer IntInf_andb(pointer lhs, pointer rhs, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_andb ("FMTPTR", "FMTPTR", %zu)\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
+/* return binary(lhs, rhs, bytes, &mpz_and); */
+/* } */
+
+/* pointer IntInf_orb(pointer lhs, pointer rhs, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_orb ("FMTPTR", "FMTPTR", %zu)\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
+/* return binary(lhs, rhs, bytes, &mpz_ior); */
+/* } */
+
+/* pointer IntInf_xorb(pointer lhs, pointer rhs, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_xorb ("FMTPTR", "FMTPTR", %zu)\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
+/* return binary(lhs, rhs, bytes, &mpz_xor); */
+/* } */
+
+/* static pointer */
+/* unary(pointer arg, size_t bytes, */
+/* void(*unop)(__mpz_struct *resmpz, */
+/* __gmp_const __mpz_struct *argspace)) */
+/* { */
+/* __mpz_struct argmpz, */
+/* resmpz; */
+/* mp_limb_t argspace[2]; */
+
+/* initRes(&resmpz, bytes); */
+/* fill(arg, &argmpz, argspace); */
+/* unop(&resmpz, &argmpz); */
+/* return answer (&resmpz, bytes); */
+/* } */
+
+/* pointer IntInf_neg(pointer arg, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_neg ("FMTPTR", %zu)\n", */
+/* (uintptr_t)arg, bytes); */
+/* return unary(arg, bytes, &mpz_neg); */
+/* } */
+
+/* pointer IntInf_notb(pointer arg, size_t bytes) { */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_notb ("FMTPTR", %zu)\n", */
+/* (uintptr_t)arg, bytes); */
+/* return unary(arg, bytes, &mpz_com); */
+/* } */
+
+/* static pointer */
+/* shary(pointer arg, uint shift, size_t bytes, */
+/* void(*shop)(__mpz_struct *resmpz, */
+/* __gmp_const __mpz_struct *argspace, */
+/* unsigned long shift)) */
+/* { */
+/* __mpz_struct argmpz, */
+/* resmpz; */
+/* mp_limb_t argspace[2]; */
+
+/* initRes(&resmpz, bytes); */
+/* fill(arg, &argmpz, argspace); */
+/* shop(&resmpz, &argmpz, (unsigned long)shift); */
+/* return answer (&resmpz, bytes); */
+/* } */
+
+/* pointer IntInf_arshift(pointer arg, Word shift_w, size_t bytes) { */
+/* uint shift = (uint)shift_w; */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_arshift ("FMTPTR", %u, %zu)\n", */
+/* (uintptr_t)arg, shift, bytes); */
+/* return shary(arg, shift, bytes, &mpz_fdiv_q_2exp); */
+/* } */
+
+/* pointer IntInf_lshift(pointer arg, Word shift_w, size_t bytes) { */
+/* uint shift = (uint)shift_w; */
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_lshift ("FMTPTR", %u, %zu)\n", */
+/* (uintptr_t)arg, shift, bytes); */
+/* return shary(arg, shift, bytes, &mpz_mul_2exp); */
+/* } */
+
+/* Word */
+/* IntInf_smallMul(Word lhs, Word rhs, pointer carry) */
+/* { */
+/* intmax_t prod; */
+
+/* prod = (intmax_t)(int)lhs * (int)rhs; */
+/* *(uint *)carry = (uintmax_t)prod >> 32; */
+/* return ((uint)(uintmax_t)prod); */
+/* } */
+
+/* /\* */
+/* * Return an integer which compares to 0 as the two intInf args compare */
+/* * to each other. */
+/* *\/ */
+/* Int IntInf_compare (pointer lhs, pointer rhs) { */
+/* __mpz_struct lhsmpz, */
+/* rhsmpz; */
+/* mp_limb_t lhsspace[2], */
+/* rhsspace[2]; */
+
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_compare ("FMTPTR", "FMTPTR")\n", */
+/* (uintptr_t)lhs, (uintptr_t)rhs); */
+/* fill (lhs, &lhsmpz, lhsspace); */
+/* fill (rhs, &rhsmpz, rhsspace); */
+/* return mpz_cmp (&lhsmpz, &rhsmpz); */
+/* } */
+
+/* /\* */
+/* * Check if two IntInf.int's are equal. */
+/* *\/ */
+/* Bool IntInf_equal (pointer lhs, pointer rhs) { */
+/* if (lhs == rhs) */
+/* return TRUE; */
+/* if (eitherIsSmall (lhs, rhs)) */
+/* return FALSE; */
+/* else */
+/* return 0 == IntInf_compare (lhs, rhs); */
+/* } */
+
+/* /\* */
+/* * Convert an intInf to a string. */
+/* * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and space is a */
+/* * string (mutable) which is large enough. */
+/* *\/ */
+/* pointer IntInf_toString (pointer arg, int base, size_t bytes) { */
+/* GC_string sp; */
+/* __mpz_struct argmpz; */
+/* mp_limb_t argspace[2]; */
+/* char *str; */
+/* uint size; */
+/* uint i; */
+/* char c; */
+
+/* if (DEBUG_INT_INF) */
+/* fprintf (stderr, "IntInf_toString ("FMTPTR", %d, %zu)\n", */
+/* (uintptr_t)arg, base, bytes); */
+/* assert (base == 2 || base == 8 || base == 10 || base == 16); */
+/* fill (arg, &argmpz, argspace); */
+/* sp = (GC_string)gcState.frontier; */
+/* str = mpz_get_str(sp->chars, base, &argmpz); */
+/* assert(str == sp->chars); */
+/* size = strlen(str); */
+/* if (*sp->chars == '-') */
+/* *sp->chars = '~'; */
+/* if (base > 0) */
+/* for (i = 0; i < size; i++) { */
+/* c = sp->chars[i]; */
+/* if (('a' <= c) && (c <= 'z')) */
+/* sp->chars[i] = c + ('A' - 'a'); */
+/* } */
+/* sp->counter = 0; */
+/* sp->length = size; */
+/* sp->header = GC_stringHeader (); */
+/* setFrontier ((pointer)(&sp->chars[align(size, 4)]), bytes); */
+/* return (pointer)str; */
+/* } */
+
+/* /\* */
+/* * Quotient (round towards 0, remainder is returned by IntInf_rem). */
+/* * space is a word array with enough space for the quotient */
+/* * num limbs + 1 - den limbs */
+/* * shifted numerator */
+/* * num limbs + 1 */
+/* * and shifted denominator */
+/* * den limbs */
+/* * and the isNeg word. */
+/* * It must be the last thing allocated. */
+/* * num is the numerator bignum, den is the denominator and frontier is */
+/* * the current frontier. */
+/* *\/ */
+/* pointer IntInf_quot (pointer num, pointer den, size_t bytes) { */
+/* __mpz_struct resmpz, */
+/* nmpz, */
+/* dmpz; */
+/* mp_limb_t nss[2], */
+/* dss[2], */
+/* carry, */
+/* *np, */
+/* *dp; */
+/* int nsize, */
+/* dsize, */
+/* qsize; */
+/* bool resIsNeg; */
+/* uint shift; */
+
+/* initRes(&resmpz, bytes); */
+/* fill(num, &nmpz, nss); */
+/* resIsNeg = FALSE; */
+/* nsize = nmpz._mp_size; */
+/* if (nsize < 0) { */
+/* nsize = - nsize; */
+/* resIsNeg = TRUE; */
+/* } */
+/* fill(den, &dmpz, dss); */
+/* dsize = dmpz._mp_size; */
+/* if (dsize < 0) { */
+/* dsize = - dsize; */
+/* resIsNeg = not resIsNeg; */
+/* } */
+/* assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0); */
+/* assert((nsize == 0 && dsize == 1) */
+/* or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0)); */
+/* qsize = 1 + nsize - dsize; */
+/* if (dsize == 1) { */
+/* if (nsize == 0) */
+/* return (pointer)1; /\* tagged 0 *\/ */
+/* mpn_divrem_1(resmpz._mp_d, */
+/* (mp_size_t)0, */
+/* nmpz._mp_d, */
+/* nsize, */
+/* dmpz._mp_d[0]); */
+/* if (resmpz._mp_d[qsize - 1] == 0) */
+/* --qsize; */
+/* } else { */
+/* np = &resmpz._mp_d[qsize]; */
+/* shift = leadingZeros(dmpz._mp_d[dsize - 1]); */
+/* if (shift == 0) { */
+/* dp = dmpz._mp_d; */
+/* memcpy((void *)np, */
+/* nmpz._mp_d, */
+/* nsize * sizeof(*nmpz._mp_d)); */
+/* } else { */
+/* carry = mpn_lshift(np, nmpz._mp_d, nsize, shift); */
+/* unless (carry == 0) */
+/* np[nsize++] = carry; */
+/* dp = &np[nsize]; */
+/* mpn_lshift(dp, dmpz._mp_d, dsize, shift); */
+/* } */
+/* carry = mpn_divrem(resmpz._mp_d, */
+/* (mp_size_t)0, */
+/* np, */
+/* nsize, */
+/* dp, */
+/* dsize); */
+/* qsize = nsize - dsize; */
+/* if (carry != 0) */
+/* resmpz._mp_d[qsize++] = carry; */
+/* } */
+/* resmpz._mp_size = resIsNeg ? - qsize : qsize; */
+/* return answer (&resmpz, bytes); */
+/* } */
+
+
+/* /\* */
+/* * Remainder (sign taken from numerator, quotient is returned by IntInf_quot). */
+/* * space is a word array with enough space for the remainder */
+/* * den limbs */
+/* * shifted numerator */
+/* * num limbs + 1 */
+/* * and shifted denominator */
+/* * den limbs */
+/* * and the isNeg word. */
+/* * It must be the last thing allocated. */
+/* * num is the numerator bignum, den is the denominator and frontier is */
+/* * the current frontier. */
+/* *\/ */
+/* pointer IntInf_rem (pointer num, pointer den, size_t bytes) { */
+/* __mpz_struct resmpz, */
+/* nmpz, */
+/* dmpz; */
+/* mp_limb_t nss[2], */
+/* dss[2], */
+/* carry, */
+/* *dp; */
+/* int nsize, */
+/* dsize; */
+/* bool resIsNeg; */
+/* uint shift; */
+
+/* initRes(&resmpz, bytes); */
+/* fill(num, &nmpz, nss); */
+/* nsize = nmpz._mp_size; */
+/* resIsNeg = nsize < 0; */
+/* if (resIsNeg) */
+/* nsize = - nsize; */
+/* fill(den, &dmpz, dss); */
+/* dsize = dmpz._mp_size; */
+/* if (dsize < 0) */
+/* dsize = - dsize; */
+/* assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0); */
+/* assert((nsize == 0 && dsize == 1) */
+/* or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0)); */
+/* if (dsize == 1) { */
+/* if (nsize == 0) */
+/* resmpz._mp_size = 0; */
+/* else { */
+/* carry = mpn_mod_1(nmpz._mp_d, nsize, dmpz._mp_d[0]); */
+/* if (carry == 0) */
+/* nsize = 0; */
+/* else { */
+/* resmpz._mp_d[0] = carry; */
+/* nsize = 1; */
+/* } */
+/* } */
+/* } else { */
+/* shift = leadingZeros(dmpz._mp_d[dsize - 1]); */
+/* if (shift == 0) { */
+/* dp = dmpz._mp_d; */
+/* memcpy((void *)resmpz._mp_d, */
+/* (void *)nmpz._mp_d, */
+/* nsize * sizeof(*nmpz._mp_d)); */
+/* } else { */
+/* carry = mpn_lshift(resmpz._mp_d, */
+/* nmpz._mp_d, */
+/* nsize, */
+/* shift); */
+/* unless (carry == 0) */
+/* resmpz._mp_d[nsize++] = carry; */
+/* dp = &resmpz._mp_d[nsize]; */
+/* mpn_lshift(dp, dmpz._mp_d, dsize, shift); */
+/* } */
+/* mpn_divrem(&resmpz._mp_d[dsize], */
+/* (mp_size_t)0, */
+/* resmpz._mp_d, */
+/* nsize, */
+/* dp, */
+/* dsize); */
+/* nsize = dsize; */
+/* assert(nsize > 0); */
+/* while (resmpz._mp_d[nsize - 1] == 0) */
+/* if (--nsize == 0) */
+/* break; */
+/* unless (nsize == 0 || shift == 0) { */
+/* mpn_rshift(resmpz._mp_d, resmpz._mp_d, nsize, shift); */
+/* if (resmpz._mp_d[nsize - 1] == 0) */
+/* --nsize; */
+/* } */
+/* } */
+/* resmpz._mp_size = resIsNeg ? - nsize : nsize; */
+/* return answer (&resmpz, bytes); */
+/* } */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h 2006-01-28 17:54:57 UTC (rev 4324)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h 2006-01-28 19:12:47 UTC (rev 4325)
@@ -16,7 +16,7 @@
GC_arrayLength length;
GC_header header;
mp_limb_t isneg;
- mp_limb_t limbs[1];
+ mp_limb_t limbs[];
} *GC_intInf;
#endif /* (defined (MLTON_GC_INTERNAL_TYPES)) */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2006-01-28 17:54:57 UTC (rev 4324)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2006-01-28 19:12:47 UTC (rev 4325)
@@ -62,3 +62,4 @@
#include "gc/translate.c"
#include "gc/weak.c"
#include "gc/world.c"
+// #include "gc/int-inf-ops.c"
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:55:06
|
Starting re-integration of generated ML-side basis library imports.
----------------------------------------------------------------------
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/integer.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
D mlton/branches/on-20050822-x86_64-branch/basis-library/libs/primitive.mlb
D mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/ffi.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library/posix/primitive.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/posix-primitive.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-basis.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-basis.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/pack-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/date.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Rusage/rusage.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
----------------------------------------------------------------------
Added: mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-01-28 17:09:17 UTC (rev 4323)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-01-28 17:54:57 UTC (rev 4324)
@@ -0,0 +1,78 @@
+(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure C = struct
+
+
+(* C *)
+structure Char = Int8
+structure SChar = Int8
+structure UChar = Word8
+structure Short = Int16
+structure SShort = Int16
+structure UShort = Word16
+structure Int = Int32
+structure SInt = Int32
+structure UInt = Word32
+structure Long = Int32
+structure SLong = Int32
+structure ULong = Word32
+structure LongLong = Int64
+structure SLongLong = Int64
+structure ULongLong = Word64
+structure Float = Real32
+structure Double = Real64
+structure Size = Word32
+
+structure String = Word32
+structure StringArray = Word32
+
+(* Generic integers *)
+structure Fd = Int
+structure Signal = Int
+structure Status = Int
+structure Sock = Int
+
+(* from <dirent.h> *)
+structure DirP = Word32
+
+(* from <poll.h> *)
+structure NFds = Word32
+
+(* from <resource.h> *)
+structure RLim = Word64
+
+(* from <sys/types.h> *)
+structure Clock = Int32
+structure Dev = Word64
+structure GId = Word32
+structure Id = Word32
+structure INo = Word64
+structure Mode = Word32
+structure NLink = Word32
+structure Off = Int64
+structure PId = Int32
+structure SSize = Int32
+structure SUSeconds = Int32
+structure Time = Int32
+structure UId = Word32
+structure USeconds = Word32
+
+(* from <sys/socket.h> *)
+structure Socklen = Word32
+
+(* from <termios.h> *)
+structure CC = Word8
+structure Speed = Word32
+structure TCFlag = Word32
+
+(* from "gmp.h" *)
+structure MPLimb = Word32
+
+
+structure Errno = struct type 'a t = 'a end
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/integer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/integer.sig 2006-01-28 17:09:17 UTC (rev 4323)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/integer.sig 2006-01-28 17:54:57 UTC (rev 4324)
@@ -5,7 +5,7 @@
structure LargeInt =
struct
- type int = intInf
+ type int = Primitive.IntInf.int
end
signature INTEGER_GLOBAL =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sig 2006-01-28 17:09:17 UTC (rev 4323)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sig 2006-01-28 17:54:57 UTC (rev 4324)
@@ -5,7 +5,7 @@
structure LargeWord =
struct
- type word = word64
+ type word = Primitive.Word64.word
end
signature WORD_GLOBAL =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-01-28 17:09:17 UTC (rev 4323)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-01-28 17:54:57 UTC (rev 4324)
@@ -12,7 +12,7 @@
"warnUnused true" "forceUsed"
in
local
- ../primitive.mlb
+ ../../primitive/primitive.mlb
(* Common basis implementation. *)
../../top-level/infixes.sml
../../misc/basic.sml
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/primitive.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/primitive.mlb 2006-01-28 17:09:17 UTC (rev 4323)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/primitive.mlb 2006-01-28 17:54:57 UTC (rev 4324)
@@ -1,22 +0,0 @@
-(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-ann
- "allowConstant true"
- "allowFFI true"
- "allowPrim true"
- "allowRebindEquals true"
- "deadCode true"
- "nonexhaustiveMatch warn"
- "redundantMatch warn"
- "sequenceNonUnit warn"
- "warnUnused true"
-in
- _prim
- ../misc/primitive.sml
- ../posix/primitive.sml
-end
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml 2006-01-28 17:09:17 UTC (rev 4323)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml 2006-01-28 17:54:57 UTC (rev 4324)
@@ -1,2271 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-(* Primitive names are special -- see atoms/prim.fun. *)
-
-infix 4 = (* <> > >= < <= *)
-
-val op = = fn z => _prim "MLton_equal": ''a * ''a -> bool; z
-
-structure Array =
- struct
- type 'a array = 'a array
- end
-
-type 'a array = 'a Array.array
-
-structure Bool =
- struct
- datatype bool = datatype bool
- type t = bool
- end
-
-structure Char =
- struct
- type t = char8
- type char = t
- end
-type char = Char.char
-structure Char2 =
- struct
- type t = char16
- type char = t
- end
-structure Char4 =
- struct
- type t = char32
- type char = t
- end
-
-type exn = exn
-
-structure Int8 =
- struct
- type t = int8
- type int = t
- end
-structure Int16 =
- struct
- type t = int16
- type int = t
- end
-structure Int32 =
- struct
- type t = int32
- type int = t
- end
-structure Int = Int32
-type int = Int.int
-structure Int64 =
- struct
- type t = int64
- type int = t
- end
-structure Position = Int64
-structure IntInf =
- struct
- type t = intInf
- type int = t
- end
-(*structure LargeInt = IntInf*)
-
-structure Real32 =
- struct
- type t = real32
- type real = t
- end
-structure Real64 =
- struct
- type t = real64
- type real = t
- end
-structure Real = Real64
-type real = Real.real
-
-structure String =
- struct
- type t = char vector
- type string = t
- end
-type string = String.string
-structure String2 =
- struct
- type t = Char2.t vector
- type string = t
- end
-structure String4 =
- struct
- type t = Char4.t vector
- type string = t
- end
-
-structure PreThread :> sig type t end = struct type t = thread end
-structure Thread :> sig type t end = struct type t = thread end
-
-structure Word8 =
- struct
- type t = word8
- type word = t
- end
-structure Word16 =
- struct
- type t = word16
- type word = t
- end
-structure Word32 =
- struct
- type t = word32
- type word = t
- end
-structure Word = Word32
-type word = Word.word
-structure Word64 =
- struct
- type t = word64
- type word = t
- end
-structure LargeWord = Word64
-
-type 'a vector = 'a vector
-type 'a weak = 'a weak
-
-(* NullString is used for strings that must be passed to C and hence must be
- * null terminated. After the Primitive structure is defined,
- * NullString.fromString is replaced by a version that checks that the string
- * is indeed null terminated. See the bottom of this file.
- *)
-structure NullString :>
- sig
- type t
-
- val fromString: string -> t
- end =
- struct
- type t = string
-
- val fromString = fn s => s
- end
-
-structure Pointer =
- struct
- type t = pointer
- end
-
-structure GetSet =
- struct
- type 'a t = (unit -> 'a) * ('a -> unit)
- end
-
-structure Pid :> sig
- eqtype t
-
- val fromInt: int -> t
- val toInt: t -> int
- end =
- struct
- type t = int
-
- val fromInt = fn i => i
- val toInt = fn i => i
- val _ = fromInt
- end
-
-exception Fail of string
-exception Match = Match
-exception PrimitiveOverflow = Overflow
-exception Overflow
-exception Size
-
-val wrapOverflow: ('a -> 'b) -> ('a -> 'b) =
- fn f => fn a => f a handle PrimitiveOverflow => raise Overflow
-
-datatype 'a option = NONE | SOME of 'a
-
-fun not b = if b then false else true
-
-functor Comparisons (type t
- val < : t * t -> bool) =
- struct
- fun <= (a, b) = not (< (b, a))
- fun > (a, b) = < (b, a)
- fun >= (a, b) = <= (b, a)
- end
-
-functor RealComparisons (type t
- val < : t * t -> bool
- val <= : t * t -> bool) =
- struct
- fun > (a, b) = < (b, a)
- fun >= (a, b) = <= (b, a)
- end
-
-structure Primitive =
- struct
- val bug = _import "MLton_bug": NullString.t -> unit;
- val debug = _command_line_const "MLton.debug": bool = false;
- val detectOverflow =
- _command_line_const "MLton.detectOverflow": bool = true;
- val eq = _prim "MLton_eq": 'a * 'a -> bool;
- val installSignalHandler =
- _prim "MLton_installSignalHandler": unit -> unit;
- val safe = _command_line_const "MLton.safe": bool = true;
- val touch = _prim "MLton_touch": 'a -> unit;
- val usesCallcc: bool ref = ref false;
-
- structure Stdio =
- struct
- val print = _import "Stdio_print": string -> unit;
- end
-
- structure Array =
- struct
- val array0Const = _prim "Array_array0Const": unit -> 'a array;
- val length = _prim "Array_length": 'a array -> int;
- (* There is no maximum length on arrays, so maxLen = maxInt. *)
- val maxLen: int = 0x7FFFFFFF
- val sub = _prim "Array_sub": 'a array * int -> 'a;
- val update = _prim "Array_update": 'a array * int * 'a -> unit;
- end
-
- structure CString =
- struct
- type t = Pointer.t
- end
- structure CStringArray =
- struct
- type t = Pointer.t
- end
-
- structure GCState =
- struct
- type t = Pointer.t
-
- val gcState = #1 _symbol "gcStateAddress": t GetSet.t; ()
- end
-
- structure CallStack =
- struct
- (* The most recent caller is at index 0 in the array. *)
- datatype t = T of int array
-
- val callStack =
- _import "GC_callStack": GCState.t * int array -> unit;
- val frameIndexSourceSeq =
- _import "GC_frameIndexSourceSeq": GCState.t * int -> Pointer.t;
- val keep = _command_line_const "CallStack.keep": bool = false;
- val numStackFrames =
- _import "GC_numStackFrames": GCState.t -> int;
- val sourceName = _import "GC_sourceName": GCState.t * int -> CString.t;
- end
-
- structure Char =
- struct
- open Char
-
- val op < = _prim "WordU8_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord8": int -> char;
- val ord = _prim "WordU8_toWord32": char -> int;
- val toInt8 = _prim "WordS8_toWord8": char -> Int8.int;
- val fromInt8 = _prim "WordS8_toWord8": Int8.int -> char;
- val toWord8 = _prim "WordU8_toWord8": char -> Word8.word;
- val fromWord8 = _prim "WordU8_toWord8": Word8.word -> char;
- end
-
- structure Char =
- struct
- open Char
- local
- structure S = Comparisons (Char)
- in
- open S
- end
- end
-
- structure Char2 =
- struct
- open Char2
-
- val op < = _prim "WordU16_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord16": int -> char;
- val ord = _prim "WordU16_toWord32": char -> int;
- val toInt16 = _prim "WordS16_toWord16": char -> Int16.int;
- val fromInt16 = _prim "WordS16_toWord16": Int16.int -> char;
- (* val toWord16 = _prim "WordU16_toWord16": char -> Word16.word; *)
- (* val fromWord16 = _prim "WordU16_toWord16": Word16.word -> char; *)
- end
-
- structure Char4 =
- struct
- open Char4
-
- val op < = _prim "WordU32_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord32": int -> char;
- val ord = _prim "WordU32_toWord32": char -> int;
- val toInt32 = _prim "WordS32_toWord32": char -> Int32.int;
- val fromInt32 = _prim "WordS32_toWord32": Int32.int -> char;
- (* val toWord32 = _prim "WordU32_toWord32": char -> Word32.word; *)
- (* 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 Date =
- struct
- type time = int
- type size = int
-
- structure Tm =
- struct
- val sec = _import "Date_Tm_sec": unit -> int;
- val min = _import "Date_Tm_min": unit -> int;
- val hour = _import "Date_Tm_hour": unit -> int;
- val mday = _import "Date_Tm_mday": unit -> int;
- val mon = _import "Date_Tm_mon": unit -> int;
- val year = _import "Date_Tm_year": unit -> int;
- val wday = _import "Date_Tm_wday": unit -> int;
- val yday = _import "Date_Tm_yday": unit -> int;
- val isdst = _import "Date_Tm_isdst": unit -> int;
-
- val setSec = _import "Date_Tm_setSec": int -> unit;
- val setMin = _import "Date_Tm_setMin": int -> unit;
- val setHour = _import "Date_Tm_setHour": int -> unit;
- val setMday = _import "Date_Tm_setMday": int -> unit;
- val setMon = _import "Date_Tm_setMon": int -> unit;
- val setYear = _import "Date_Tm_setYear": int -> unit;
- val setWday = _import "Date_Tm_setWday": int -> unit;
- val setYday = _import "Date_Tm_setYday": int -> unit;
- val setIsdst = _import "Date_Tm_setIsdst": int -> unit;
- end
-
- val gmTime = _import "Date_gmTime": time ref -> unit;
- val localOffset = _import "Date_localOffset": unit -> int;
- val localTime = _import "Date_localTime": time ref -> unit;
- val mkTime = _import "Date_mkTime": unit -> time;
- val strfTime =
- _import "Date_strfTime": char array * size * NullString.t -> size;
- end
-
- structure Exn =
- struct
- (* The polymorphism with extra and setInitExtra is because primitives
- * are only supposed to deal with basic types. The polymorphism
- * allows the various passes like monomorphisation to translate
- * the types appropriately.
- *)
- type extra = CallStack.t option
-
- val extra = _prim "Exn_extra": exn -> 'a;
- val extra: exn -> extra = extra
- val name = _prim "Exn_name": exn -> string;
- val keepHistory =
- _command_line_const "Exn.keepHistory": bool = false;
- val setExtendExtra = _prim "Exn_setExtendExtra": ('a -> 'a) -> unit;
- val setExtendExtra: (extra -> extra) -> unit = setExtendExtra
- val setInitExtra = _prim "Exn_setInitExtra": 'a -> unit;
- val setInitExtra: extra -> unit = setInitExtra
- end
-
- structure FFI =
- struct
- val getOp = #1 _symbol "MLton_FFI_op": int GetSet.t;
- val int8Array = #1 _symbol "MLton_FFI_Int8": Pointer.t GetSet.t; ()
- val int16Array = #1 _symbol "MLton_FFI_Int16": Pointer.t GetSet.t; ()
- val int32Array = #1 _symbol "MLton_FFI_Int32": Pointer.t GetSet.t; ()
- val int64Array = #1 _symbol "MLton_FFI_Int64": Pointer.t GetSet.t; ()
- val numExports = _build_const "MLton_FFI_numExports": int;
- val pointerArray = #1 _symbol "MLton_FFI_Pointer": Pointer.t GetSet.t; ()
- val real32Array = #1 _symbol "MLton_FFI_Real32": Pointer.t GetSet.t; ()
- val real64Array = #1 _symbol "MLton_FFI_Real64": Pointer.t GetSet.t; ()
- val word8Array = #1 _symbol "MLton_FFI_Word8": Pointer.t GetSet.t; ()
- val word16Array = #1 _symbol "MLton_FFI_Word16": Pointer.t GetSet.t; ()
- val word32Array = #1 _symbol "MLton_FFI_Word32": Pointer.t GetSet.t; ()
- val word64Array = #1 _symbol "MLton_FFI_Word64": Pointer.t GetSet.t; ()
- end
-
- structure GC =
- struct
- val collect = _prim "GC_collect": unit -> unit;
- val pack = _import "GC_pack": GCState.t -> unit;
- val setHashConsDuringGC =
- _import "GC_setHashConsDuringGC": GCState.t * bool -> unit;
- val setMessages =
- _import "GC_setMessages": GCState.t * bool -> unit;
- val setRusageMeasureGC =
- _import "GC_setRusageMeasureGC": GCState.t * bool -> unit;
- val setSummary =
- _import "GC_setSummary": GCState.t * bool -> unit;
- val unpack =
- _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
- type big = Int8.int
- type int = int1
- val fromBigUnsafe = _prim "WordU8_toWord1": big -> int;
- val precision' = 1
- val toBig = _prim "WordU1_toWord8": int -> big;
- end
- structure Int2 =
- struct
- type big = Int8.int
- type int = int2
- val fromBigUnsafe = _prim "WordU8_toWord2": big -> int;
- val precision' = 2
- val toBig = _prim "WordU2_toWord8": int -> big;
- end
- structure Int3 =
- struct
- type big = Int8.int
- type int = int3
- val fromBigUnsafe = _prim "WordU8_toWord3": big -> int;
- val precision' = 3
- val toBig = _prim "WordU3_toWord8": int -> big;
- end
- structure Int4 =
- struct
- type big = Int8.int
- type int = int4
- val fromBigUnsafe = _prim "WordU8_toWord4": big -> int;
- val precision' = 4
- val toBig = _prim "WordU4_toWord8": int -> big;
- end
- structure Int5 =
- struct
- type big = Int8.int
- type int = int5
- val fromBigUnsafe = _prim "WordU8_toWord5": big -> int;
- val precision' = 5
- val toBig = _prim "WordU5_toWord8": int -> big;
- end
- structure Int6 =
- struct
- type big = Int8.int
- type int = int6
- val fromBigUnsafe = _prim "WordU8_toWord6": big -> int;
- val precision' = 6
- val toBig = _prim "WordU6_toWord8": int -> big;
- end
- structure Int7 =
- struct
- type big = Int8.int
- type int = int7
- val fromBigUnsafe = _prim "WordU8_toWord7": big -> int;
- val precision' = 7
- val toBig = _prim "WordU7_toWord8": int -> big;
- end
- structure Int8 =
- struct
- type t = Int8.int
- type int = t
-
- val precision' : Int.int = 8
- val maxInt' : int = 0x7f
- val minInt' : int = ~0x80
-
- val *? = _prim "WordS8_mul": int * int -> int;
- val * =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_mulCheck": int * int -> int;)
- else *?
- val +? = _prim "Word8_add": int * int -> int;
- val + =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_addCheck": int * int -> int;)
- else +?
- val -? = _prim "Word8_sub": int * int -> int;
- val - =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_subCheck": int * int -> int;)
- else -?
- val op < = _prim "WordS8_lt": int * int -> bool;
- val quot = _prim "WordS8_quot": int * int -> int;
- val rem = _prim "WordS8_rem": int * int -> int;
- val << = _prim "Word8_lshift": int * Word.word -> int;
- val >> = _prim "WordU8_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS8_rshift": int * Word.word -> int;
- val ~? = _prim "Word8_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word8_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word8_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord8": Int.int -> int;
- val toInt = _prim "WordS8_toWord32": int -> Int.int;
- end
- structure Int8 =
- struct
- open Int8
- local
- structure S = Comparisons (Int8)
- in
- open S
- end
- end
- structure Int9 =
- struct
- type big = Int16.int
- type int = int9
- val fromBigUnsafe = _prim "WordU16_toWord9": big -> int;
- val precision' = 9
- val toBig = _prim "WordU9_toWord16": int -> big;
- end
- structure Int10 =
- struct
- type big = Int16.int
- type int = int10
- val fromBigUnsafe = _prim "WordU16_toWord10": big -> int;
- val precision' = 10
- val toBig = _prim "WordU10_toWord16": int -> big;
- end
- structure Int11 =
- struct
- type big = Int16.int
- type int = int11
- val fromBigUnsafe = _prim "WordU16_toWord11": big -> int;
- val precision' = 11
- val toBig = _prim "WordU11_toWord16": int -> big;
- end
- structure Int12 =
- struct
- type big = Int16.int
- type int = int12
- val fromBigUnsafe = _prim "WordU16_toWord12": big -> int;
- val precision' = 12
- val toBig = _prim "WordU12_toWord16": int -> big;
- end
- structure Int13 =
- struct
- type big = Int16.int
- type int = int13
- val fromBigUnsafe = _prim "WordU16_toWord13": big -> int;
- val precision' = 13
- val toBig = _prim "WordU13_toWord16": int -> big;
- end
- structure Int14 =
- struct
- type big = Int16.int
- type int = int14
- val fromBigUnsafe = _prim "WordU16_toWord14": big -> int;
- val precision' = 14
- val toBig = _prim "WordU14_toWord16": int -> big;
- end
- structure Int15 =
- struct
- type big = Int16.int
- type int = int15
- val fromBigUnsafe = _prim "WordU16_toWord15": big -> int;
- val precision' = 15
- val toBig = _prim "WordU15_toWord16": int -> big;
- end
- structure Int16 =
- struct
- type t = Int16.int
- type int = t
-
- val precision' : Int.int = 16
- val maxInt' : int = 0x7fff
- val minInt' : int = ~0x8000
-
- val *? = _prim "WordS16_mul": int * int -> int;
- val * =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_mulCheck": int * int -> int;))
- else *?
- val +? = _prim "Word16_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word16_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS16_lt": int * int -> bool;
- val quot = _prim "WordS16_quot": int * int -> int;
- val rem = _prim "WordS16_rem": int * int -> int;
- val << = _prim "Word16_lshift": int * Word.word -> int;
- val >> = _prim "WordU16_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS16_rshift": int * Word.word -> int;
- val ~? = _prim "Word16_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word16_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word16_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord16": Int.int -> int;
- val toInt = _prim "WordS16_toWord32": int -> Int.int;
- end
- structure Int16 =
- struct
- open Int16
- local
- structure S = Comparisons (Int16)
- in
- open S
- end
- end
- structure Int17 =
- struct
- type big = Int32.int
- type int = int17
- val fromBigUnsafe = _prim "WordU32_toWord17": big -> int;
- val precision' = 17
- val toBig = _prim "WordU17_toWord32": int -> big;
- end
- structure Int18 =
- struct
- type big = Int32.int
- type int = int18
- val fromBigUnsafe = _prim "WordU32_toWord18": big -> int;
- val precision' = 18
- val toBig = _prim "WordU18_toWord32": int -> big;
- end
- structure Int19 =
- struct
- type big = Int32.int
- type int = int19
- val fromBigUnsafe = _prim "WordU32_toWord19": big -> int;
- val precision' = 19
- val toBig = _prim "WordU19_toWord32": int -> big;
- end
- structure Int20 =
- struct
- type big = Int32.int
- type int = int20
- val fromBigUnsafe = _prim "WordU32_toWord20": big -> int;
- val precision' = 20
- val toBig = _prim "WordU20_toWord32": int -> big;
- end
- structure Int21 =
- struct
- type big = Int32.int
- type int = int21
- val fromBigUnsafe = _prim "WordU32_toWord21": big -> int;
- val precision' = 21
- val toBig = _prim "WordU21_toWord32": int -> big;
- end
- structure Int22 =
- struct
- type big = Int32.int
- type int = int22
- val fromBigUnsafe = _prim "WordU32_toWord22": big -> int;
- val precision' = 22
- val toBig = _prim "WordU22_toWord32": int -> big;
- end
- structure Int23 =
- struct
- type big = Int32.int
- type int = int23
- val fromBigUnsafe = _prim "WordU32_toWord23": big -> int;
- val precision' = 23
- val toBig = _prim "WordU23_toWord32": int -> big;
- end
- structure Int24 =
- struct
- type big = Int32.int
- type int = int24
- val fromBigUnsafe = _prim "WordU32_toWord24": big -> int;
- val precision' = 24
- val toBig = _prim "WordU24_toWord32": int -> big;
- end
- structure Int25 =
- struct
- type big = Int32.int
- type int = int25
- val fromBigUnsafe = _prim "WordU32_toWord25": big -> int;
- val precision' = 25
- val toBig = _prim "WordU25_toWord32": int -> big;
- end
- structure Int26 =
- struct
- type big = Int32.int
- type int = int26
- val fromBigUnsafe = _prim "WordU32_toWord26": big -> int;
- val precision' = 26
- val toBig = _prim "WordU26_toWord32": int -> big;
- end
- structure Int27 =
- struct
- type big = Int32.int
- type int = int27
- val fromBigUnsafe = _prim "WordU32_toWord27": big -> int;
- val precision' = 27
- val toBig = _prim "WordU27_toWord32": int -> big;
- end
- structure Int28 =
- struct
- type big = Int32.int
- type int = int28
- val fromBigUnsafe = _prim "WordU32_toWord28": big -> int;
- val precision' = 28
- val toBig = _prim "WordU28_toWord32": int -> big;
- end
- structure Int29 =
- struct
- type big = Int32.int
- type int = int29
- val fromBigUnsafe = _prim "WordU32_toWord29": big -> int;
- val precision' = 29
- val toBig = _prim "WordU29_toWord32": int -> big;
- end
- structure Int30 =
- struct
- type big = Int32.int
- type int = int30
- val fromBigUnsafe = _prim "WordU32_toWord30": big -> int;
- val precision' = 30
- val toBig = _prim "WordU30_toWord32": int -> big;
- end
- structure Int31 =
- struct
- type big = Int32.int
- type int = int31
- val fromBigUnsafe = _prim "WordU32_toWord31": big -> int;
- val precision' = 31
- val toBig = _prim "WordU31_toWord32": int -> big;
- end
- structure Int32 =
- struct
- type t = Int32.int
- type int = t
-
- val precision' : Int.int = 32
- val maxInt' : int = 0x7fffffff
- val minInt' : int = ~0x80000000
-
- val *? = _prim "WordS32_mul": int * int -> int;
- val * =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_mulCheck": int * int -> int;))
- else *?
- val +? = _prim "Word32_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word32_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS32_lt": int * int -> bool;
- val quot = _prim "WordS32_quot": int * int -> int;
- val rem = _prim "WordS32_rem": int * int -> int;
- val << = _prim "Word32_lshift": int * Word.word -> int;
- val >> = _prim "WordU32_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS32_rshift": int * Word.word -> int;
- val ~? = _prim "Word32_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word32_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word32_andb": int * int -> int;
- val fromInt : int -> int = fn x => x
- val toInt : int -> int = fn x => x
- end
- structure Int32 =
- struct
- open Int32
- local
- structure S = Comparisons (Int32)
- in
- open S
- end
- end
- structure Int = Int32
- structure Int64 =
- struct
- type t = Int64.int
- type int = t
-
- val precision' : Int.int = 64
- val maxInt' : int = 0x7FFFFFFFFFFFFFFF
- val minInt' : int = ~0x8000000000000000
-
- val *? = _prim "WordS64_mul": int * int -> int;
- val * = fn _ => raise Fail "Int64.* unimplemented"
-(*
- val * =
- if detectOverflow
- then _prim "WordS64_mulCheck": int * int -> int;
- else *?
-*)
- val +? = _prim "Word64_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS64_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word64_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS64_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS64_lt": int * int -> bool;
- val << = _prim "Word64_lshift": int * Word.word -> int;
- val >> = _prim "WordU64_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS64_rshift": int * Word.word -> int;
- val quot = _prim "WordS64_quot": int * int -> int;
- val rem = _prim "WordS64_rem": int * int -> int;
- val ~? = _prim "Word64_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word64_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word64_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord64": Int.int -> int;
- val fromWord = _prim "WordU32_toWord64": word -> int;
- val toInt = _prim "WordU64_toWord32": int -> Int.int;
- val toWord = _prim "WordU64_toWord32": int -> word;
- end
- structure Int64 =
- struct
- open Int64
- local
- structure S = Comparisons (Int64)
- in
- open S
- end
- end
-
- structure Array =
- struct
- open Array
-
- val array = _prim "Array_array": int -> 'a array;
- val array =
- fn n => if safe andalso Int.< (n, 0)
- then raise Size
- else array n
- end
-
- structure IntInf =
- struct
- open IntInf
-
- val + = _prim "IntInf_add": int * int * word -> int;
- val andb = _prim "IntInf_andb": int * int * word -> int;
- val ~>> = _prim "IntInf_arshift": int * word * word -> int;
- val compare = _prim "IntInf_compare": int * int -> Int.int;
- val fromVector = _prim "WordVector_toIntInf": word vector -> int;
- val fromWord = _prim "Word_toIntInf": word -> int;
- val gcd = _prim "IntInf_gcd": int * int * word -> int;
- val << = _prim "IntInf_lshift": int * word * word -> int;
- val * = _prim "IntInf_mul": int * int * word -> int;
- val ~ = _prim "IntInf_neg": int * word -> int;
- val notb = _prim "IntInf_notb": int * word -> int;
- val orb = _prim "IntInf_orb": int * int * word -> int;
- val quot = _prim "IntInf_quot": int * int * word -> int;
- val rem = _prim "IntInf_rem": int * int * word -> int;
- val smallMul =
- _import "IntInf_smallMul": word * word * word ref -> word;
- val - = _prim "IntInf_sub": int * int * word -> int;
- val toString
- = _prim "IntInf_toString": int * Int.int * word -> string;
- val toVector = _prim "IntInf_toVector": int -> word vector;
- val toWord = _prim "IntInf_toWord": int -> word;
- 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 =
- struct
- datatype t = Bytecode | C | Native
-
- val codegen =
- case _build_const "MLton_Codegen_codegen": int; of
- 0 => Bytecode
- | 1 => C
- | 2 => Native
- | _ => raise Fail "MLton_Codegen_codegen"
-
- val isBytecode = codegen = Bytecode
- (* val isC = codegen = C *)
- val isNative = codegen = Native
- end
-
- (* val deserialize = _prim "MLton_deserialize": Word8Vector.vector -> 'a ref; *)
- (* val serialize = _prim "MLton_serialize": 'a ref -> Word8Vector.vector; *)
- val share = _prim "MLton_share": 'a -> unit;
- val size = _prim "MLton_size": 'a ref -> int;
-
- structure Platform =
- struct
- structure Arch =
- struct
- datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
- MIPS | PowerPC | S390 | Sparc | X86
-
- val host: t =
- case _const "MLton_Platform_Arch_host": string; of
- "alpha" => Alpha
- | "amd64" => AMD64
- | "arm" => ARM
- | "hppa" => HPPA
- | "ia64" => IA64
- | "m68k" => m68k
- | "mips" => MIPS
- | "powerpc" => PowerPC
- | "s390" => S390
- | "sparc" => Sparc
- | "x86" => X86
- | _ => raise Fail "strange MLton_Platform_Arch_host"
-
- val hostIsBigEndian =
- _const "MLton_Platform_Arch_bigendian": bool;
- end
-
- structure OS =
- struct
- datatype t =
- Cygwin
- | Darwin
- | FreeBSD
- | Linux
- | MinGW
- | NetBSD
- | OpenBSD
- | Solaris
-
- val host: t =
- case _const "MLton_Platform_OS_host": string; of
- "cygwin" => Cygwin
- | "darwin" => Darwin
- | "freebsd" => FreeBSD
- | "linux" => Linux
- | "mingw" => MinGW
- | "netbsd" => NetBSD
- | "openbsd" => OpenBSD
- | "solaris" => Solaris
- | _ => raise Fail "strange MLton_Platform_OS_host"
-
- val forkIsEnabled =
- case host of
- Cygwin =>
- #1 _symbol "MLton_Platform_CygwinUseMmap": bool GetSet.t; ()
- | MinGW => false
- | _ => true
-
- val useWindowsProcess = not forkIsEnabled
- end
- end
-
- structure Process =
- struct
- val spawne =
- if let
- open Platform.OS
- in
- case host of
- Cygwin => true
- | MinGW => true
- | _ => false
- end
- then
- _import "MLton_Process_spawne"
- : (NullString.t
- * NullString.t array
- * NullString.t array
- -> Pid.t);
- else fn _ => raise Fail "spawne not defined"
- val spawnp =
- if let
- open Platform.OS
- in
- case host of
- Cygwin => true
- | MinGW => true
- | _ => false
- end
- then
- _import "MLton_Process_spawnp"
- : (NullString.t
- * NullString.t array
- -> Pid.t);
- else fn _ => raise Fail "spawnp not defined"
- end
-
- structure Profile =
- struct
- val isOn = _build_const "MLton_Profile_isOn": bool;
- structure Data =
- struct
- type t = word
-
- val dummy:t = 0w0
- val free =
- _import "GC_profileFree": GCState.t * t -> unit;
- val malloc =
- _import "GC_profileMalloc": GCState.t -> t;
- val write =
- _import "GC_profileWrite"
- : GCState.t * t * word (* fd *) -> unit;
- end
- val done = _import "GC_profileDone": GCState.t -> unit;
- val getCurrent =
- _import "GC_getProfileCurrent": GCState.t -> Data.t;
- val setCurrent =
- _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": GCState.t -> 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
- type 'a t = 'a weak
-
- val canGet = _prim "Weak_canGet": 'a t -> bool;
- val get = _prim "Weak_get": 'a t -> 'a;
- val new = _prim "Weak_new": 'a -> 'a t;
- end
- end
-
- structure Net =
- struct
- (* val htonl = _import "Net_htonl": int -> int; *)
- (* val ntohl = _import "Net_ntohl": int -> int; *)
- val htons = _import "Net_htons": int -> int;
- val ntohs = _import "Net_ntohs": int -> int;
- end
-
- structure NetHostDB =
- struct
- (* network byte order (MSB) *)
- type pre_in_addr = word8 array
- type in_addr = word8 vector
- val inAddrLen = _const "NetHostDB_inAddrLen": int;
- val INADDR_ANY = _const "NetHostDB_INADDR_ANY": int;
- type addr_family = int
- val entryName = _import "NetHostDB_Entry_name": unit -> CString.t;
- val entryNumAliases = _import "NetHostDB_Entry_numAliases": unit -> int;
- val entryAliasesN = _import "NetHostDB_Entry_aliasesN": int -> CString.t;
- val entryAddrType = _import "NetHostDB_Entry_addrType": unit -> int;
- val entryLength = _import "NetHostDB_Entry_length": unit -> int;
- val entryNumAddrs = _import "NetHostDB_Entry_numAddrs": unit -> int;
- val entryAddrsN =
- _import "NetHostDB_Entry_addrsN": int * pre_in_addr -> unit;
- val getByAddress =
- _import "NetHostDB_getByAddress": in_addr * int -> bool;
- val getByName = _import "NetHostDB_getByName": NullString.t -> bool;
- val getHostName =
- _import "NetHostDB_getHostName": char array * int -> int;
- end
-
- structure NetProtDB =
- struct
- val entryName = _import "NetProtDB_Entry_name": unit -> CString.t;
- val entryNumAliases = _import "NetProtDB_Entry_numAliases": unit -> int;
- val entryAliasesN = _import "NetProtDB_Entry_aliasesN": int -> CString.t;
- val entryProtocol = _import "NetProtDB_Entry_protocol": unit -> int;
- val getByName = _import "NetProtDB_getByName": NullString.t -> bool;
- val getByNumber = _import "NetProtDB_getByNumber": int -> bool;
- end
-
- structure NetServDB =
- struct
- val entryName = _import "NetServDB_Entry_name": unit -> CString.t;
- val entryNumAliases = _import "NetServDB_Entry_numAliases": unit -> int;
- val entryAliasesN = _import "NetServDB_Entry_aliasesN": int -> CString.t;
- val entryPort = _import "NetServDB_Entry_port": unit -> int;
- val entryProtocol = _import "NetServDB_Entry_protocol": unit -> CString.t;
- val getByName = _import "NetServDB_getByName": NullString.t * NullString.t -> bool;
- val getByNameNull = _import "NetServDB_getByNameNull": NullString.t -> bool;
- val getByPort = _import "NetServDB_getByPort": int * NullString.t -> bool;
- val getByPortNull = _import "NetServDB_getByPortNull": int -> bool;
- end
-
- structure OS =
- struct
- structure IO =
- struct
- val POLLIN = _const "OS_IO_POLLIN": word;
- val POLLPRI = _const "OS_IO_POLLPRI": word;
- val POLLOUT = _const "OS_IO_POLLOUT": word;
- val poll = _import "OS_IO_poll": int vector * word vector *
- int * int * word array -> int;
- end
- end
-
- structure PackReal32 =
- struct
- type real = Real32.real
-
- val subVec = _import "PackReal32_subVec": word8 vector * int -> real;
- val subVecRev =
- _import "PackReal32_subVecRev": word8 vector * int -> real;
- val update =
- _import "PackReal32_update": word8 array * int * real -> unit;
- val updateRev =
- _import "PackReal32_updateRev": word8 array * int * real -> unit;
- end
-
- structure PackReal64 =
- struct
- type real = Real64.real
-
- val subVec = _import "PackReal64_subVec": word8 vector * int -> real;
- val subVecRev =
- _import "PackReal64_subVecRev": word8 vector * int -> real;
- val update =
- _import "PackReal64_update": word8 array * int * real -> unit;
- val updateRev =
- _import "PackReal64_updateRev": word8 array * int * real -> unit;
- end
-
- structure Pointer =
- struct
- open Pointer
-
- val fromWord = _prim "WordU32_toWord32": word -> t;
- val toWord = _prim "WordU32_toWord32": t -> word;
-
- val null: t = fromWord 0w0
-
- fun isNull p = p = null
-
- (* val + = _prim "Pointer_add": t * t -> t; *)
- (* val op < = _prim "Pointer_lt": t * t -> bool; *)
- (* val - = _prim "Pointer_sub": t * t -> t; *)
-(* val free = _import "free": t -> unit; *)
- val getInt8 = _prim "Pointer_getWord8": t * int -> Int8.int;
- val getInt16 = _prim "Pointer_getWord16": t * int -> Int16.int;
- val getInt32 = _prim "Pointer_getWord32": t * int -> Int32.int;
- val getInt64 = _prim "Pointer_getWord64": t * int -> Int64.int;
- val getPointer = _prim "Pointer_getPointer": t * int -> 'a;
- val getReal32 = _prim "Pointer_getReal32": t * int -> Real32.real;
- val getReal64 = _prim "Pointer_getReal64": t * int -> Real64.real;
- val getWord8 = _prim "Pointer_getWord8": t * int -> Word8.word;
- val getWord16 = _prim "Pointer_getWord16": t * int -> Word16.word;
- val getWord32 = _prim "Pointer_getWord32": t * int -> Word32.word;
- val getWord64 = _prim "Pointer_getWord64": t * int -> Word64.word;
- val setInt8 = _prim "Pointer_setWord8": t * int * Int8.int -> unit;
- val setInt16 =
- _prim "Pointer_setWord16": t * int * Int16.int -> unit;
- val setInt32 =
- _prim "Pointer_setWord32": t * int * Int32.int -> unit;
- val setInt64 =
- _prim "Pointer_setWord64": t * int * Int64.int -> unit;
- val setPointer = _prim "Pointer_setPointer": t * int * 'a -> unit;
- val setReal32 =
- _prim "Pointer_setReal32": t * int * Real32.real -> unit;
- val setReal64 =
- _prim "Pointer_setReal64": t * int * Real64.real -> unit;
- val setWord8 =
- _prim "Pointer_setWord8": t * int * Word8.word -> unit;
- val setWord16 =
- _prim "Pointer_setWord16": t * int * Word16.word -> unit;
- val setWord32 =
- _prim "Pointer_setWord32": t * int * Word32.word -> unit;
- val setWord64 =
- _prim "Pointer_setWord64": t * int * Word64.word -> unit;
- end
-
- structure Real64 =
- struct
- open Real64
-
- structure Class =
- struct
- type t = int
-
- val inf = _const "FP_INFINITE": t;
- val nan = _const "FP_NAN": t;
- val normal = _const "FP_NORMAL": t;
- val subnormal = _const "FP_SUBNORMAL": t;
- val zero = _const "FP_ZERO": t;
- end
-
- structure Math =
- struct
- type real = real
-
- val acos = _prim "Real64_Math_acos": real -> real;
- val asin = _prim "Real64_Math_asin": real -> real;
- val atan = _prim "Real64_Math_atan": real -> real;
- val atan2 = _prim "Real64_Math_atan2": real * real -> real;
- val cos = _prim "Real64_Math_cos": real -> real;
- val cosh = _import "cosh": real -> real;
- val e = #1 _symbol "Real64_Math_e": real GetSet.t; ()
- val exp = _prim "Real64_Math_exp": real -> real;
- val ln = _prim "Real64_Math_ln": real -> real;
- val log10 = _prim "Real64_Math_log10": real -> real;
- val pi = #1 _symbol "Real64_Math_pi": real GetSet.t; ()
- val pow = _import "pow": real * real -> real;
- val sin = _prim "Real64_Math_sin": real -> real;
- val sinh = _import "sinh": real -> real;
- val sqrt = _prim "Real64_Math_sqrt": real -> real;
- val tan = _prim "Real64_Math_tan": real -> real;
- val tanh = _import "tanh": real -> real;
- end
-
- val * = _prim "Real64_mul": real * real -> real;
- val *+ = _prim "Real64_muladd": real * real * real -> real;
- val *- = _prim "Real64_mulsub": real * real * real -> real;
- val + = _prim "Real64_add": real * real -> real;
- val - = _prim "Real64_sub": real * real -> real;
- val / = _prim "Real64_div": real * real -> real;
- val op < = _prim "Real64_lt": real * real -> bool;
- val op <= = _prim "Real64_le": real * real -> bool;
- val == = _prim "Real64_equal": real * real -> bool;
- val ?= = _prim "Real64_qequal": real * real -> bool;
- val abs = _prim "Real64_abs": real -> real;
- val class = _import "Real64_class": real -> int;
- val frexp = _import "Real64_frexp": real * int ref -> real;
- val gdtoa =
- _import "Real64_gdtoa": real * int * int * int ref -> CString.t;
- val fromInt = _prim "WordS32_toReal64": int -> real;
- val ldexp = _prim "Real64_ldexp": real * int -> real;
- val maxFinite = #1 _symbol "Real64_maxFinite": real GetSet.t; ()
- val minNormalPos = #1 _symbol "Real64_minNormalPos": real GetSet.t; ()
- val minPos = #1 _symbol "Real64_minPos": real GetSet.t; ()
- val m...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:09:20
|
Generate C-type bindings for SML; separately generate ML-type and C-type bindings for C
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.h
U mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
U mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.h 2006-01-28 17:02:57 UTC (rev 4322)
+++ mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.h 2006-01-28 17:09:17 UTC (rev 4323)
@@ -9,7 +9,7 @@
#define _INTERPRET_H_
#include <stdio.h>
-#include "types.h"
+#include "ml-types.h"
#include "assert.h"
#define regs(ty) \
Modified: mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2006-01-28 17:02:57 UTC (rev 4322)
+++ mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2006-01-28 17:09:17 UTC (rev 4323)
@@ -13,7 +13,7 @@
#include "assert.h"
#include "c-common.h"
-#include "types.h"
+#include "ml-types.h"
#ifndef TRUE
#define TRUE 1
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun 2006-01-28 17:02:57 UTC (rev 4322)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun 2006-01-28 17:09:17 UTC (rev 4323)
@@ -414,7 +414,7 @@
let
val _ =
File.outputContents
- (concat [!Control.libDir, "/include/types.h"], out)
+ (concat [!Control.libDir, "/include/ml-types.h"], out)
fun print s = Out.output (out, s)
val _ = print "\n"
val _ = Ffi.declareHeaders {print = print}
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:02:59
|
Generate C-type bindings for SML; separately generate ML-type and C-type bindings for C ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-01-28 17:02:39 UTC (rev 4321) +++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-01-28 17:02:57 UTC (rev 4322) @@ -97,7 +97,8 @@ util.h \ $(GCHFILES) \ gc.h \ - types.h \ + ml-types.h \ + c-types.h \ basis-ffi.h \ platform.h \ platform/$(TARGET_OS).h @@ -169,11 +170,12 @@ util/%.o: util/%.c util.h $(UTILHFILES) $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) -c -o $@ $< -types.h: gen/gen-types.c util.h $(UTILOFILES) - rm -f types.h +c-types.h ml-types.h: gen/gen-types.c util.h $(UTILOFILES) + rm -f c-types.h ml-types.h $(CC) $(OPTCFLAGS) $(WARNFLAGS) -o gen/gen-types gen/gen-types.c $(UTILOFILES) cd gen && ./gen-types - cp gen/types.h types.h + cp gen/c-types.h c-types.h + cp gen/ml-types.h ml-types.h rm -f gen/gen-types basis-ffi.h: gen/gen-basis-ffi.sml gen/basis-ffi.def |
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:02:42
|
Generate C-type bindings for SML; separately generate ML-type and C-type bindings for C ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-01-28 17:02:20 UTC (rev 4320) +++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-01-28 17:02:39 UTC (rev 4321) @@ -99,7 +99,8 @@ #define SPAWN_MODE 0 #endif -#include "types.h" +#include "ml-types.h" +#include "c-types.h" #include "basis-ffi.h" /* ---------------------------------------------------------------- */ |
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:02:22
|
Generate C-type bindings for SML; separately generate ML-type and C-type bindings for C
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
U mlton/branches/on-20050822-x86_64-branch/runtime/util/read_write.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-28 17:01:23 UTC (rev 4319)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-28 17:02:20 UTC (rev 4320)
@@ -8,21 +8,17 @@
#include "cenv.h"
#include "util.h"
-static char* prefix[] = {
- "/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh",
+static char* mlTypesHPrefix[] = {
+ "/* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh",
" * Jagannathan, and Stephen Weeks.",
" *",
" * MLton is released under a BSD-style license.",
" * See the file MLton-LICENSE for details.",
" */",
"",
- "/* Can't use _TYPES_H_ because MSVCRT uses it.",
- " * So, we use _MLTON_TYPES_H_.",
- " */",
+ "#ifndef _MLTON_MLTYPES_H_",
+ "#define _MLTON_MLTYPES_H_",
"",
- "#ifndef _MLTON_TYPES_H_",
- "#define _MLTON_TYPES_H_",
- "",
"/* We need these because in header files for exported SML functions, ",
" * types.h is included without cenv.h.",
" */",
@@ -40,7 +36,34 @@
NULL
};
-static char* stdtypes[] = {
+static char* cTypesHPrefix[] = {
+ "/* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh",
+ " * Jagannathan, and Stephen Weeks.",
+ " *",
+ " * MLton is released under a BSD-style license.",
+ " * See the file MLton-LICENSE for details.",
+ " */",
+ "",
+ "#ifndef _MLTON_CTYPES_H_",
+ "#define _MLTON_CTYPES_H_",
+ "",
+ NULL
+};
+
+static char* cTypesSMLPrefix[] = {
+ "(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh",
+ " * Jagannathan, and Stephen Weeks.",
+ " *",
+ " * MLton is released under a BSD-style license.",
+ " * See the file MLton-LICENSE for details.",
+ " *)",
+ "",
+ "structure C = struct",
+ "",
+ NULL
+};
+
+static char* mlTypesHStd[] = {
"/* ML types */",
"typedef unsigned char* /* uintptr_t */ Pointer;",
"#define Array(t) Pointer",
@@ -119,143 +142,188 @@
"typedef String8_t NullString8;",
"typedef Array(NullString8_t) NullString8Array_t;",
"typedef Array(NullString8_t) NullString8Array;",
+ "",
NULL
};
-#define systype(t, bt, name) \
- do { \
- writeString (fd, "typedef "); \
- writeString (fd, "/* "); \
- writeString (fd, #t); \
- writeString (fd, " */ "); \
- writeString (fd, bt); \
- writeUintmaxU (fd, CHAR_BIT * sizeof(t));\
- writeString (fd, "_t "); \
- writeString (fd, name); \
- writeString (fd, ";"); \
- writeNewline (fd); \
+#define systype(t, bt, name) \
+ do { \
+ writeString (cTypesHFd, "typedef "); \
+ writeString (cTypesHFd, "/* "); \
+ writeString (cTypesHFd, #t); \
+ writeString (cTypesHFd, " */ "); \
+ writeString (cTypesHFd, bt); \
+ writeUintmaxU (cTypesHFd, CHAR_BIT * sizeof(t)); \
+ writeString (cTypesHFd, "_t "); \
+ writeString (cTypesHFd, "C_"); \
+ writeString (cTypesHFd, name); \
+ writeString (cTypesHFd, "_t;"); \
+ writeNewline (cTypesHFd); \
+ writeString (cTypesSMLFd, "structure "); \
+ writeString (cTypesSMLFd, name); \
+ writeString (cTypesSMLFd, " = "); \
+ writeString (cTypesSMLFd, bt); \
+ writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
+ writeNewline (cTypesSMLFd); \
} while (0)
-#define chkintsystype(t, name) \
+#define chksystype(t, name) \
do { \
- if ((double)((t)(-1)) > 0) \
+ if ((double)((t)(0.25)) > 0) \
+ systype(t, "Real", name); \
+ else if ((double)((t)(-1)) > 0) \
systype(t, "Word", name); \
else \
systype(t, "Int", name); \
} while (0)
-#define chknumsystype(t, name) \
- do { \
- if ((double)((t)(0.25)) > 0) \
- systype(t, "Real", name); \
- else \
- chkintsystype(t, name); \
+#define aliastype(name1, name2) \
+ do { \
+ writeString (cTypesHFd, "typedef "); \
+ writeString (cTypesHFd, "C_"); \
+ writeString (cTypesHFd, name1); \
+ writeString (cTypesHFd, "_t "); \
+ writeString (cTypesHFd, "C_"); \
+ writeString (cTypesHFd, name2); \
+ writeString (cTypesHFd, "_t;"); \
+ writeNewline (cTypesHFd); \
+ writeString (cTypesSMLFd, "structure "); \
+ writeString (cTypesSMLFd, name2); \
+ writeString (cTypesSMLFd, " = "); \
+ writeString (cTypesSMLFd, name1); \
+ writeNewline (cTypesSMLFd); \
} while (0)
-static char* suffix[] = {
+static char* mlTypesHSuffix[] = {
+ "",
+ "#endif /* _MLTON_MLTYPES_H_ */",
+ NULL
+};
+
+static char* cTypesHSuffix[] = {
+ "",
"#define C_Errno_t(t) t",
"",
- "#endif /* _MLTON_TYPES_H_ */",
+ "#endif /* _MLTON_CTYPES_H_ */",
NULL
};
+static char* cTypesSMLSuffix[] = {
+ "",
+ "structure Errno = struct type 'a t = 'a end",
+ "end",
+ NULL
+};
+
int main (int argc, char* argv[]) {
- int fd;
+ int mlTypesHFd, cTypesHFd, cTypesSMLFd;
- unlink_safe ("types.h");
- fd = open_safe ("types.h", O_RDWR | O_CREAT, S_IRUSR | S_IWUSR);
- for (int i = 0; prefix[i] != NULL; i++) {
- writeString (fd, prefix[i]);
- writeNewline (fd);
- }
- for (int i = 0; stdtypes[i] != NULL; i++) {
- writeString (fd, stdtypes[i]);
- writeNewline (fd);
- }
- writeNewline (fd);
- writeString (fd, "/* C */");
- writeNewline (fd);
- chkintsystype(char, "C_Char_t");
- systype(signed char, "Int", "C_SChar_t");
- systype(unsigned char, "Word", "C_UChar_t");
- systype(short, "Int", "C_Short_t");
- systype(unsigned short, "Word", "C_UShort_t");
- systype(int, "Int", "C_Int_t");
- systype(unsigned int, "Word", "C_UInt_t");
- systype(long, "Int", "C_Long_t");
- systype(unsigned long, "Word", "C_ULong_t");
- systype(long long, "Int", "C_LongLong_t");
- systype(unsigned long long, "Word", "C_ULongLong_t");
- systype(float, "Real", "C_Float_t");
- systype(double, "Real", "C_Double_t");
- // systype(long double, "Real", "C_LongDouble");
- systype(size_t, "Word", "C_Size_t");
- writeNewline (fd);
- systype(void*, "Word", "C_Pointer_t");
- systype(char*, "Word", "C_String_t");
- systype(char**, "Word", "C_StringArray_t");
- writeNewline (fd);
- writeString (fd, "/* C99 */");
- writeNewline (fd);
- systype(_Bool, "Word", "C_Bool_t");
- systype(intmax_t, "Int", "C_Intmax_t");
- systype(uintmax_t, "Word", "C_UIntmax_t");
- systype(intptr_t, "Int", "C_Intptr_t");
- systype(uintptr_t, "Word", "C_UIntptr_t");
- writeNewline (fd);
- writeString (fd, "/* Generic integers */");
- writeNewline (fd);
- systype(int, "Int", "C_Fd_t");
- systype(int, "Int", "C_Signal_t");
- systype(int, "Int", "C_Status_t");
- systype(int, "Int", "C_Sock_t");
- writeNewline (fd);
- writeString (fd, "/* from <dirent.h> */");
- writeNewline (fd);
- systype(DIR*, "Word", "C_DirP_t");
- writeNewline (fd);
- writeString (fd, "/* from <poll.h> */");
- writeNewline (fd);
- systype(nfds_t, "Word", "C_NFds_t");
- writeNewline (fd);
- writeString (fd, "/* from <sys/resource.h> */");
- writeNewline (fd);
- systype(rlim_t, "Word", "C_RLim_t");
- writeNewline (fd);
- writeString (fd, "/* from <sys/types.h> */");
- writeNewline (fd);
- // systype(blkcnt_t, "Int", "C_BlkCnt_t");
- // systype(blksize_t, "Int", "C_BlkSize_t");
- chknumsystype(clock_t, "C_Clock_t");
- chknumsystype(dev_t, "C_Dev_t");
- chkintsystype(gid_t, "C_GId_t");
- chkintsystype(id_t, "C_Id_t");
- systype(ino_t, "Word", "C_INo_t");
- chkintsystype(mode_t, "C_Mode_t");
- chkintsystype(nlink_t, "C_NLink_t");
- systype(off_t, "Int", "C_Off_t");
- systype(pid_t, "Int", "C_PId_t");
- systype(ssize_t, "Int", "C_SSize_t");
- systype(suseconds_t, "Int", "C_SUSeconds_t");
- chknumsystype(time_t, "C_Time_t");
- chkintsystype(uid_t, "C_UId_t");
- systype(useconds_t, "Word", "C_USeconds_t");
- writeNewline (fd);
- writeString (fd, "/* from <sys/socket.h> */");
- writeNewline (fd);
- chkintsystype(socklen_t, "C_Socklen_t");
- writeNewline (fd);
- writeString (fd, "/* from <termios.h> */");
- writeNewline (fd);
- systype(cc_t, "Word", "C_CC_t");
- systype(speed_t, "Word", "C_Speed_t");
- systype(tcflag_t, "Word", "C_TCFlag_t");
- writeNewline (fd);
- writeString (fd, "/* from \"gmp.h\" */");
- writeNewline (fd);
- systype(mp_limb_t, "Word", "C_MPLimb_t");
- writeNewline (fd);
- for (int i = 0; suffix[i] != NULL; i++) {
- writeString (fd, suffix[i]);
- writeNewline (fd);
- }
+ mlTypesHFd = open_safe ("ml-types.h", O_RDWR | O_CREAT | O_TRUNC, S_IRUSR | S_IWUSR);
+ for (int i = 0; mlTypesHPrefix[i] != NULL; i++)
+ writeStringWithNewline (mlTypesHFd, mlTypesHPrefix[i]);
+ for (int i = 0; mlTypesHStd[i] != NULL; i++)
+ writeStringWithNewline (mlTypesHFd, mlTypesHStd[i]);
+ for (int i = 0; mlTypesHSuffix[i] != NULL; i++)
+ writeStringWithNewline (mlTypesHFd, mlTypesHSuffix[i]);
+
+ cTypesHFd= open_safe ("c-types.h", O_RDWR | O_CREAT | O_TRUNC, S_IRUSR | S_IWUSR);
+ cTypesSMLFd = open_safe ("c-types.sml", O_RDWR | O_CREAT | O_TRUNC, S_IRUSR | S_IWUSR);
+
+ for (int i = 0; cTypesHPrefix[i] != NULL; i++)
+ writeStringWithNewline (cTypesHFd, cTypesHPrefix[i]);
+ for (int i = 0; cTypesSMLPrefix[i] != NULL; i++)
+ writeStringWithNewline (cTypesSMLFd, cTypesSMLPrefix[i]);
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* C */");
+ writeStringWithNewline (cTypesSMLFd, "(* C *)");
+ chksystype(char, "Char");
+ chksystype(signed char, "SChar");
+ chksystype(unsigned char, "UChar");
+ chksystype(short, "Short");
+ chksystype(signed short, "SShort");
+ chksystype(unsigned short, "UShort");
+ chksystype(int, "Int");
+ chksystype(signed int, "SInt");
+ chksystype(unsigned int, "UInt");
+ chksystype(long, "Long");
+ chksystype(signed long, "SLong");
+ chksystype(unsigned long, "ULong");
+ chksystype(long long, "LongLong");
+ chksystype(signed long long, "SLongLong");
+ chksystype(unsigned long long, "ULongLong");
+ chksystype(float, "Float");
+ chksystype(double, "Double");
+ // chksystype(long double, "LongDouble");
+ chksystype(size_t, "Size");
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ // systype(void*, "Word", "Pointer");
+ systype(char*, "Word", "String");
+ systype(char**, "Word", "StringArray");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* Generic integers */");
+ writeStringWithNewline (cTypesSMLFd, "(* Generic integers *)");
+ aliastype("Int", "Fd");
+ aliastype("Int", "Signal");
+ aliastype("Int", "Status");
+ aliastype("Int", "Sock");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* from <dirent.h> */");
+ writeStringWithNewline (cTypesSMLFd, "(* from <dirent.h> *)");
+ systype(DIR*, "Word", "DirP");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* from <poll.h> */");
+ writeStringWithNewline (cTypesSMLFd, "(* from <poll.h> *)");
+ chksystype(nfds_t, "NFds");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* from <resource.h> */");
+ writeStringWithNewline (cTypesSMLFd, "(* from <resource.h> *)");
+ chksystype(rlim_t, "RLim");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* from <sys/types.h> */");
+ writeStringWithNewline (cTypesSMLFd, "(* from <sys/types.h> *)");
+ // chksystype(blkcnt_t, "BlkCnt");
+ // chksystype(blksize_t, "BlkSize");
+ chksystype(clock_t, "Clock");
+ chksystype(dev_t, "Dev");
+ chksystype(gid_t, "GId");
+ chksystype(id_t, "Id");
+ chksystype(ino_t, "INo");
+ chksystype(mode_t, "Mode");
+ chksystype(nlink_t, "NLink");
+ chksystype(off_t, "Off");
+ chksystype(pid_t, "PId");
+ chksystype(ssize_t, "SSize");
+ chksystype(suseconds_t, "SUSeconds");
+ chksystype(time_t, "Time");
+ chksystype(uid_t, "UId");
+ chksystype(useconds_t, "USeconds");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* from <sys/socket.h> */");
+ writeStringWithNewline (cTypesSMLFd, "(* from <sys/socket.h> *)");
+ chksystype(socklen_t, "Socklen");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* from <termios.h> */");
+ writeStringWithNewline (cTypesSMLFd, "(* from <termios.h> *)");
+ chksystype(cc_t, "CC");
+ chksystype(speed_t, "Speed");
+ chksystype(tcflag_t, "TCFlag");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* from \"gmp.h\" */");
+ writeStringWithNewline (cTypesSMLFd, "(* from \"gmp.h\" *)");
+ chksystype(mp_limb_t, "MPLimb");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ for (int i = 0; cTypesHSuffix[i] != NULL; i++)
+ writeStringWithNewline (cTypesHFd, cTypesHSuffix[i]);
+ for (int i = 0; cTypesSMLSuffix[i] != NULL; i++)
+ writeStringWithNewline (cTypesSMLFd, cTypesSMLSuffix[i]);
+
return 0;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/util/read_write.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/util/read_write.h 2006-01-28 17:01:23 UTC (rev 4319)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/read_write.h 2006-01-28 17:02:20 UTC (rev 4320)
@@ -88,4 +88,9 @@
static inline void writeNewline (int fd) {
writeString (fd, "\n");
}
+
+static inline void writeStringWithNewline (int fd, char* s) {
+ writeString (fd, s);
+ writeNewline (fd);
+}
#undef BUF_SIZE
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:01:25
|
Expand _symbol type annotation
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-01-28 17:00:37 UTC (rev 4318)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-01-28 17:01:23 UTC (rev 4319)
@@ -230,9 +230,11 @@
Name.last name,
"Set) = _symbol \"",
Name.toC name,
- "\": (",
+ "\": (unit -> (",
Type.toML ty,
- ") GetSet.t;"]
+ ")) * ((",
+ Type.toML ty,
+ ") -> unit);"]
fun parseConst (s, name) =
let
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:00:40
|
Adding MLton.Syslog
----------------------------------------------------------------------
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog-consts.c
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog.c
----------------------------------------------------------------------
Added: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog-consts.c 2006-01-28 17:00:16 UTC (rev 4317)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog-consts.c 2006-01-28 17:00:37 UTC (rev 4318)
@@ -0,0 +1,34 @@
+#include "platform.h"
+
+const C_Int_t MLton_Syslog_Logopt_LOG_CONS = LOG_CONS;
+const C_Int_t MLton_Syslog_Logopt_LOG_NDELAY = LOG_NDELAY;
+const C_Int_t MLton_Syslog_Logopt_LOG_NOWAIT = LOG_NOWAIT;
+const C_Int_t MLton_Syslog_Logopt_LOG_ODELAY = LOG_ODELAY;
+const C_Int_t MLton_Syslog_Logopt_LOG_PID = LOG_PID;
+
+const C_Int_t MLton_Syslog_Facility_LOG_AUTH = LOG_AUTH;
+const C_Int_t MLton_Syslog_Facility_LOG_CRON = LOG_CRON;
+const C_Int_t MLton_Syslog_Facility_LOG_DAEMON = LOG_DAEMON;
+const C_Int_t MLton_Syslog_Facility_LOG_KERN = LOG_KERN;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL0 = LOG_LOCAL0;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL1 = LOG_LOCAL1;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL2 = LOG_LOCAL2;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL3 = LOG_LOCAL3;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL4 = LOG_LOCAL4;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL5 = LOG_LOCAL5;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL6 = LOG_LOCAL6;
+const C_Int_t MLton_Syslog_Facility_LOG_LOCAL7 = LOG_LOCAL7;
+const C_Int_t MLton_Syslog_Facility_LOG_LPR = LOG_LPR;
+const C_Int_t MLton_Syslog_Facility_LOG_MAIL = LOG_MAIL;
+const C_Int_t MLton_Syslog_Facility_LOG_NEWS = LOG_NEWS;
+const C_Int_t MLton_Syslog_Facility_LOG_USER = LOG_USER;
+const C_Int_t MLton_Syslog_Facility_LOG_UUCP = LOG_UUCP;
+
+const C_Int_t MLton_Syslog_Severity_LOG_ALERT = LOG_ALERT;
+const C_Int_t MLton_Syslog_Severity_LOG_CRIT = LOG_CRIT;
+const C_Int_t MLton_Syslog_Severity_LOG_DEBUG = LOG_DEBUG;
+const C_Int_t MLton_Syslog_Severity_LOG_EMERG = LOG_EMERG;
+const C_Int_t MLton_Syslog_Severity_LOG_ERR = LOG_ERR;
+const C_Int_t MLton_Syslog_Severity_LOG_INFO = LOG_INFO;
+const C_Int_t MLton_Syslog_Severity_LOG_NOTICE = LOG_NOTICE;
+const C_Int_t MLton_Syslog_Severity_LOG_WARNING = LOG_WARNING;
Added: 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 17:00:16 UTC (rev 4317)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Syslog/Syslog.c 2006-01-28 17:00:37 UTC (rev 4318)
@@ -0,0 +1,17 @@
+#include "platform.h"
+
+void MLton_Syslog_closelog(void) {
+ closelog();
+}
+
+/* openlog relies on the string being around forever. */
+void MLton_Syslog_openlog(NullString8_t s, C_Int_t o, C_Int_t f) {
+ char *s_ = strdup ((const char*)s);
+ if (s_ == NULL)
+ s_ = "";
+ openlog (s_, o, f);
+}
+
+void MLton_Syslog_syslog(C_Int_t p, NullString8_t s) {
+ syslog(p, (const char*)s);
+}
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 09:00:21
|
Avoiding keyword and name clashes
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY-consts.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c 2006-01-28 16:59:30 UTC (rev 4316)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c 2006-01-28 17:00:16 UTC (rev 4317)
@@ -36,7 +36,7 @@
const C_Int_t Posix_FileSys_PC_NAME_MAX = _PC_NAME_MAX;
const C_Int_t Posix_FileSys_PC_PATH_MAX = _PC_PATH_MAX;
const C_Int_t Posix_FileSys_PC_PIPE_BUF = _PC_PIPE_BUF;
-const C_Int_t Posix_FileSys_PC_2_SYMLINKS = _PC_2_SYMLINKS;
+// const C_Int_t Posix_FileSys_PC_2_SYMLINKS = _PC_2_SYMLINKS;
const C_Int_t Posix_FileSys_PC_ALLOC_SIZE_MIN = _PC_ALLOC_SIZE_MIN;
const C_Int_t Posix_FileSys_PC_REC_INCR_XFER_SIZE = _PC_REC_INCR_XFER_SIZE;
const C_Int_t Posix_FileSys_PC_REC_MAX_XFER_SIZE = _PC_REC_MAX_XFER_SIZE;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c 2006-01-28 16:59:30 UTC (rev 4316)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/Signal.c 2006-01-28 17:00:16 UTC (rev 4317)
@@ -54,7 +54,7 @@
return res;
}
-C_Errno_t(C_Int_t) Posix_Signal_handle (C_Int_t signum) {
+C_Errno_t(C_Int_t) Posix_Signal_handlee (C_Int_t signum) {
static struct sigaction sa;
sigaddset (GC_getSignalsHandledAddr (&gcState), signum);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY-consts.c 2006-01-28 16:59:30 UTC (rev 4316)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY-consts.c 2006-01-28 17:00:16 UTC (rev 4317)
@@ -14,69 +14,69 @@
const C_Int_t Posix_TTY_V_VSUSP = VSUSP;
const C_Int_t Posix_TTY_V_VTIME = VTIME;
-const C_TCFlag_t Posix_TTY_I_BRKINT = BRKINT;
-const C_TCFlag_t Posix_TTY_I_ICRNL = ICRNL;
-const C_TCFlag_t Posix_TTY_I_IGNBRK = IGNBRK;
-const C_TCFlag_t Posix_TTY_I_IGNCR = IGNCR;
-const C_TCFlag_t Posix_TTY_I_IGNPAR = IGNPAR;
-const C_TCFlag_t Posix_TTY_I_INLCR = INLCR;
-const C_TCFlag_t Posix_TTY_I_INPCK = INPCK;
-const C_TCFlag_t Posix_TTY_I_ISTRIP = ISTRIP;
-const C_TCFlag_t Posix_TTY_I_IXANY = IXANY;
-const C_TCFlag_t Posix_TTY_I_IXOFF = IXOFF;
-const C_TCFlag_t Posix_TTY_I_IXON = IXON;
-const C_TCFlag_t Posix_TTY_I_PARMRK = PARMRK;
+const C_TCFlag_t Posix_TTY_IFlags_BRKINT = BRKINT;
+const C_TCFlag_t Posix_TTY_IFlags_ICRNL = ICRNL;
+const C_TCFlag_t Posix_TTY_IFlags_IGNBRK = IGNBRK;
+const C_TCFlag_t Posix_TTY_IFlags_IGNCR = IGNCR;
+const C_TCFlag_t Posix_TTY_IFlags_IGNPAR = IGNPAR;
+const C_TCFlag_t Posix_TTY_IFlags_INLCR = INLCR;
+const C_TCFlag_t Posix_TTY_IFlags_INPCK = INPCK;
+const C_TCFlag_t Posix_TTY_IFlags_ISTRIP = ISTRIP;
+const C_TCFlag_t Posix_TTY_IFlags_IXANY = IXANY;
+const C_TCFlag_t Posix_TTY_IFlags_IXOFF = IXOFF;
+const C_TCFlag_t Posix_TTY_IFlags_IXON = IXON;
+const C_TCFlag_t Posix_TTY_IFlags_PARMRK = PARMRK;
-const C_TCFlag_t Posix_TTY_O_OPOST = OPOST;
-const C_TCFlag_t Posix_TTY_O_ONLCR = ONLCR;
-const C_TCFlag_t Posix_TTY_O_OCRNL = OCRNL;
-const C_TCFlag_t Posix_TTY_O_ONOCR = ONOCR;
-const C_TCFlag_t Posix_TTY_O_ONLRET = ONLRET;
-const C_TCFlag_t Posix_TTY_O_OFILL = OFILL;
-const C_TCFlag_t Posix_TTY_O_NLDLY = NLDLY;
-const C_TCFlag_t Posix_TTY_O_NL0 = NL0;
-const C_TCFlag_t Posix_TTY_O_NL1 = NL1;
-const C_TCFlag_t Posix_TTY_O_CRDLY = CRDLY;
-const C_TCFlag_t Posix_TTY_O_CR0 = CR0;
-const C_TCFlag_t Posix_TTY_O_CR1 = CR1;
-const C_TCFlag_t Posix_TTY_O_CR2 = CR2;
-const C_TCFlag_t Posix_TTY_O_CR3 = CR3;
-const C_TCFlag_t Posix_TTY_O_TABDLY = TABDLY;
-const C_TCFlag_t Posix_TTY_O_TAB0 = TAB0;
-const C_TCFlag_t Posix_TTY_O_TAB1 = TAB1;
-const C_TCFlag_t Posix_TTY_O_TAB2 = TAB2;
-const C_TCFlag_t Posix_TTY_O_TAB3 = TAB3;
-const C_TCFlag_t Posix_TTY_O_BSDLY = BSDLY;
-const C_TCFlag_t Posix_TTY_O_BS0 = BS0;
-const C_TCFlag_t Posix_TTY_O_BS1 = BS1;
-const C_TCFlag_t Posix_TTY_O_VTDLY = VTDLY;
-const C_TCFlag_t Posix_TTY_O_VT0 = VT0;
-const C_TCFlag_t Posix_TTY_O_VT1 = VT1;
-const C_TCFlag_t Posix_TTY_O_FFDLY = FFDLY;
-const C_TCFlag_t Posix_TTY_O_FF0 = FF0;
-const C_TCFlag_t Posix_TTY_O_FF1 = FF1;
+const C_TCFlag_t Posix_TTY_OFlags_OPOST = OPOST;
+const C_TCFlag_t Posix_TTY_OFlags_ONLCR = ONLCR;
+const C_TCFlag_t Posix_TTY_OFlags_OCRNL = OCRNL;
+const C_TCFlag_t Posix_TTY_OFlags_ONOCR = ONOCR;
+const C_TCFlag_t Posix_TTY_OFlags_ONLRET = ONLRET;
+const C_TCFlag_t Posix_TTY_OFlags_OFILL = OFILL;
+const C_TCFlag_t Posix_TTY_OFlags_NLDLY = NLDLY;
+const C_TCFlag_t Posix_TTY_OFlags_NL0 = NL0;
+const C_TCFlag_t Posix_TTY_OFlags_NL1 = NL1;
+const C_TCFlag_t Posix_TTY_OFlags_CRDLY = CRDLY;
+const C_TCFlag_t Posix_TTY_OFlags_CR0 = CR0;
+const C_TCFlag_t Posix_TTY_OFlags_CR1 = CR1;
+const C_TCFlag_t Posix_TTY_OFlags_CR2 = CR2;
+const C_TCFlag_t Posix_TTY_OFlags_CR3 = CR3;
+const C_TCFlag_t Posix_TTY_OFlags_TABDLY = TABDLY;
+const C_TCFlag_t Posix_TTY_OFlags_TAB0 = TAB0;
+const C_TCFlag_t Posix_TTY_OFlags_TAB1 = TAB1;
+const C_TCFlag_t Posix_TTY_OFlags_TAB2 = TAB2;
+const C_TCFlag_t Posix_TTY_OFlags_TAB3 = TAB3;
+const C_TCFlag_t Posix_TTY_OFlags_BSDLY = BSDLY;
+const C_TCFlag_t Posix_TTY_OFlags_BS0 = BS0;
+const C_TCFlag_t Posix_TTY_OFlags_BS1 = BS1;
+const C_TCFlag_t Posix_TTY_OFlags_VTDLY = VTDLY;
+const C_TCFlag_t Posix_TTY_OFlags_VT0 = VT0;
+const C_TCFlag_t Posix_TTY_OFlags_VT1 = VT1;
+const C_TCFlag_t Posix_TTY_OFlags_FFDLY = FFDLY;
+const C_TCFlag_t Posix_TTY_OFlags_FF0 = FF0;
+const C_TCFlag_t Posix_TTY_OFlags_FF1 = FF1;
-const C_TCFlag_t Posix_TTY_C_CSIZE = CSIZE;
-const C_TCFlag_t Posix_TTY_C_CS5 = CS5;
-const C_TCFlag_t Posix_TTY_C_CS6 = CS6;
-const C_TCFlag_t Posix_TTY_C_CS7 = CS7;
-const C_TCFlag_t Posix_TTY_C_CS8 = CS8;
-const C_TCFlag_t Posix_TTY_C_CSTOPB = CSTOPB;
-const C_TCFlag_t Posix_TTY_C_CREAD = CREAD;
-const C_TCFlag_t Posix_TTY_C_PARENB = PARENB;
-const C_TCFlag_t Posix_TTY_C_PARODD = PARODD;
-const C_TCFlag_t Posix_TTY_C_HUPCL = HUPCL;
-const C_TCFlag_t Posix_TTY_C_CLOCAL = CLOCAL;
+const C_TCFlag_t Posix_TTY_CFlags_CSIZE = CSIZE;
+const C_TCFlag_t Posix_TTY_CFlags_CS5 = CS5;
+const C_TCFlag_t Posix_TTY_CFlags_CS6 = CS6;
+const C_TCFlag_t Posix_TTY_CFlags_CS7 = CS7;
+const C_TCFlag_t Posix_TTY_CFlags_CS8 = CS8;
+const C_TCFlag_t Posix_TTY_CFlags_CSTOPB = CSTOPB;
+const C_TCFlag_t Posix_TTY_CFlags_CREAD = CREAD;
+const C_TCFlag_t Posix_TTY_CFlags_PARENB = PARENB;
+const C_TCFlag_t Posix_TTY_CFlags_PARODD = PARODD;
+const C_TCFlag_t Posix_TTY_CFlags_HUPCL = HUPCL;
+const C_TCFlag_t Posix_TTY_CFlags_CLOCAL = CLOCAL;
-const C_TCFlag_t Posix_TTY_L_ECHO = ECHO;
-const C_TCFlag_t Posix_TTY_L_ECHOE = ECHOE;
-const C_TCFlag_t Posix_TTY_L_ECHOK = ECHOK;
-const C_TCFlag_t Posix_TTY_L_ECHONL = ECHONL;
-const C_TCFlag_t Posix_TTY_L_ICANON = ICANON;
-const C_TCFlag_t Posix_TTY_L_IEXTEN = IEXTEN;
-const C_TCFlag_t Posix_TTY_L_ISIG = ISIG;
-const C_TCFlag_t Posix_TTY_L_NOFLSH = NOFLSH;
-const C_TCFlag_t Posix_TTY_L_TOSTOP = TOSTOP;
+const C_TCFlag_t Posix_TTY_LFlags_ECHO = ECHO;
+const C_TCFlag_t Posix_TTY_LFlags_ECHOE = ECHOE;
+const C_TCFlag_t Posix_TTY_LFlags_ECHOK = ECHOK;
+const C_TCFlag_t Posix_TTY_LFlags_ECHONL = ECHONL;
+const C_TCFlag_t Posix_TTY_LFlags_ICANON = ICANON;
+const C_TCFlag_t Posix_TTY_LFlags_IEXTEN = IEXTEN;
+const C_TCFlag_t Posix_TTY_LFlags_ISIG = ISIG;
+const C_TCFlag_t Posix_TTY_LFlags_NOFLSH = NOFLSH;
+const C_TCFlag_t Posix_TTY_LFlags_TOSTOP = TOSTOP;
const C_Speed_t Posix_TTY_B0 = B0;
const C_Speed_t Posix_TTY_B50 = B50;
|
|
From: Matthew F. <fl...@ml...> - 2006-01-28 08:59:32
|
Avoiding keyword and name clashes ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-01-27 02:03:34 UTC (rev 4315) +++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-01-28 16:59:30 UTC (rev 4316) @@ -63,6 +63,39 @@ MLton.Rusage.self_stime_usec = _import : unit -> C.SUSeconds.t MLton.Rusage.self_utime_sec = _import : unit -> C.Time.t MLton.Rusage.self_utime_usec = _import : unit -> C.SUSeconds.t +MLton.Syslog.Facility.LOG_AUTH = _const : C.Int.t +MLton.Syslog.Facility.LOG_CRON = _const : C.Int.t +MLton.Syslog.Facility.LOG_DAEMON = _const : C.Int.t +MLton.Syslog.Facility.LOG_KERN = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL0 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL1 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL2 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL3 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL4 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL5 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL6 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LOCAL7 = _const : C.Int.t +MLton.Syslog.Facility.LOG_LPR = _const : C.Int.t +MLton.Syslog.Facility.LOG_MAIL = _const : C.Int.t +MLton.Syslog.Facility.LOG_NEWS = _const : C.Int.t +MLton.Syslog.Facility.LOG_USER = _const : C.Int.t +MLton.Syslog.Facility.LOG_UUCP = _const : C.Int.t +MLton.Syslog.Logopt.LOG_CONS = _const : C.Int.t +MLton.Syslog.Logopt.LOG_NDELAY = _const : C.Int.t +MLton.Syslog.Logopt.LOG_NOWAIT = _const : C.Int.t +MLton.Syslog.Logopt.LOG_ODELAY = _const : C.Int.t +MLton.Syslog.Logopt.LOG_PID = _const : C.Int.t +MLton.Syslog.Severity.LOG_ALERT = _const : C.Int.t +MLton.Syslog.Severity.LOG_CRIT = _const : C.Int.t +MLton.Syslog.Severity.LOG_DEBUG = _const : C.Int.t +MLton.Syslog.Severity.LOG_EMERG = _const : C.Int.t +MLton.Syslog.Severity.LOG_ERR = _const : C.Int.t +MLton.Syslog.Severity.LOG_INFO = _const : C.Int.t +MLton.Syslog.Severity.LOG_NOTICE = _const : C.Int.t +MLton.Syslog.Severity.LOG_WARNING = _const : C.Int.t +MLton.Syslog.closelog = _import : unit -> unit +MLton.Syslog.openlog = _import : NullString8.t * C.Int.t * C.Int.t -> unit +MLton.Syslog.syslog = _import : C.Int.t * NullString8.t -> unit Net.htonl = _import : Word32.t -> Word32.t Net.htons = _import : Word16.t -> Word16.t Net.ntohl = _import : Word32.t -> Word32.t @@ -202,7 +235,7 @@ Posix.FileSys.O.TEXT = _const : C.Int.t Posix.FileSys.O.TRUNC = _const : C.Int.t Posix.FileSys.O.WRONLY = _const : C.Int.t -Posix.FileSys.PC.2_SYMLINKS = _const : C.Int.t +# Posix.FileSys.PC.2_SYMLINKS = _const : C.Int.t Posix.FileSys.PC.ALLOC_SIZE_MIN = _const : C.Int.t Posix.FileSys.PC.ASYNC_IO = _const : C.Int.t Posix.FileSys.PC.CHOWN_RESTRICTED = _const : C.Int.t @@ -541,8 +574,8 @@ Posix.Signal.SIGXCPU = _const : C.Signal.t Posix.Signal.SIGXFSZ = _const : C.Signal.t Posix.Signal.default = _import : C.Signal.t -> C.Int.t C.Errno.t -Posix.Signal.handle = _import : C.Signal.t -> C.Int.t C.Errno.t Posix.Signal.handleGC = _import : unit -> unit +Posix.Signal.handlee = _import : C.Signal.t -> C.Int.t C.Errno.t Posix.Signal.ignore = _import : C.Signal.t -> C.Int.t C.Errno.t Posix.Signal.isDefault = _import : C.Signal.t * Bool.t ref -> C.Int.t C.Errno.t Posix.Signal.isIgnore = _import : C.Signal.t * Bool.t ref -> C.Int.t C.Errno.t @@ -584,66 +617,66 @@ Posix.TTY.B600 = _const : C.Speed.t Posix.TTY.B75 = _const : C.Speed.t Posix.TTY.B9600 = _const : C.Speed.t -Posix.TTY.C.CLOCAL = _const : C.TCFlag.t -Posix.TTY.C.CREAD = _const : C.TCFlag.t -Posix.TTY.C.CS5 = _const : C.TCFlag.t -Posix.TTY.C.CS6 = _const : C.TCFlag.t -Posix.TTY.C.CS7 = _const : C.TCFlag.t -Posix.TTY.C.CS8 = _const : C.TCFlag.t -Posix.TTY.C.CSIZE = _const : C.TCFlag.t -Posix.TTY.C.CSTOPB = _const : C.TCFlag.t -Posix.TTY.C.HUPCL = _const : C.TCFlag.t -Posix.TTY.C.PARENB = _const : C.TCFlag.t -Posix.TTY.C.PARODD = _const : C.TCFlag.t -Posix.TTY.I.BRKINT = _const : C.TCFlag.t -Posix.TTY.I.ICRNL = _const : C.TCFlag.t -Posix.TTY.I.IGNBRK = _const : C.TCFlag.t -Posix.TTY.I.IGNCR = _const : C.TCFlag.t -Posix.TTY.I.IGNPAR = _const : C.TCFlag.t -Posix.TTY.I.INLCR = _const : C.TCFlag.t -Posix.TTY.I.INPCK = _const : C.TCFlag.t -Posix.TTY.I.ISTRIP = _const : C.TCFlag.t -Posix.TTY.I.IXANY = _const : C.TCFlag.t -Posix.TTY.I.IXOFF = _const : C.TCFlag.t -Posix.TTY.I.IXON = _const : C.TCFlag.t -Posix.TTY.I.PARMRK = _const : C.TCFlag.t -Posix.TTY.L.ECHO = _const : C.TCFlag.t -Posix.TTY.L.ECHOE = _const : C.TCFlag.t -Posix.TTY.L.ECHOK = _const : C.TCFlag.t -Posix.TTY.L.ECHONL = _const : C.TCFlag.t -Posix.TTY.L.ICANON = _const : C.TCFlag.t -Posix.TTY.L.IEXTEN = _const : C.TCFlag.t -Posix.TTY.L.ISIG = _const : C.TCFlag.t -Posix.TTY.L.NOFLSH = _const : C.TCFlag.t -Posix.TTY.L.TOSTOP = _const : C.TCFlag.t -Posix.TTY.O.BS0 = _const : C.TCFlag.t -Posix.TTY.O.BS1 = _const : C.TCFlag.t -Posix.TTY.O.BSDLY = _const : C.TCFlag.t -Posix.TTY.O.CR0 = _const : C.TCFlag.t -Posix.TTY.O.CR1 = _const : C.TCFlag.t -Posix.TTY.O.CR2 = _const : C.TCFlag.t -Posix.TTY.O.CR3 = _const : C.TCFlag.t -Posix.TTY.O.CRDLY = _const : C.TCFlag.t -Posix.TTY.O.FF0 = _const : C.TCFlag.t -Posix.TTY.O.FF1 = _const : C.TCFlag.t -Posix.TTY.O.FFDLY = _const : C.TCFlag.t -Posix.TTY.O.NL0 = _const : C.TCFlag.t -Posix.TTY.O.NL1 = _const : C.TCFlag.t -Posix.TTY.O.NLDLY = _const : C.TCFlag.t -Posix.TTY.O.OCRNL = _const : C.TCFlag.t -Posix.TTY.O.OFILL = _const : C.TCFlag.t -Posix.TTY.O.ONLCR = _const : C.TCFlag.t -Posix.TTY.O.ONLRET = _const : C.TCFlag.t -Posix.TTY.O.ONOCR = _const : C.TCFlag.t -Posix.TTY.O.OPOST = _const : C.TCFlag.t -Posix.TTY.O.TAB0 = _const : C.TCFlag.t -Posix.TTY.O.TAB1 = _const : C.TCFlag.t -Posix.TTY.O.TAB2 = _const : C.TCFlag.t -Posix.TTY.O.TAB3 = _const : C.TCFlag.t -Posix.TTY.O.TABDLY = _const : C.TCFlag.t -Posix.TTY.O.VT0 = _const : C.TCFlag.t -Posix.TTY.O.VT1 = _const : C.TCFlag.t -Posix.TTY.O.VTDLY = _const : C.TCFlag.t +Posix.TTY.CFlags.CLOCAL = _const : C.TCFlag.t +Posix.TTY.CFlags.CREAD = _const : C.TCFlag.t +Posix.TTY.CFlags.CS5 = _const : C.TCFlag.t +Posix.TTY.CFlags.CS6 = _const : C.TCFlag.t +Posix.TTY.CFlags.CS7 = _const : C.TCFlag.t +Posix.TTY.CFlags.CS8 = _const : C.TCFlag.t +Posix.TTY.CFlags.CSIZE = _const : C.TCFlag.t +Posix.TTY.CFlags.CSTOPB = _const : C.TCFlag.t +Posix.TTY.CFlags.HUPCL = _const : C.TCFlag.t +Posix.TTY.CFlags.PARENB = _const : C.TCFlag.t +Posix.TTY.CFlags.PARODD = _const : C.TCFlag.t +Posix.TTY.IFlags.BRKINT = _const : C.TCFlag.t +Posix.TTY.IFlags.ICRNL = _const : C.TCFlag.t +Posix.TTY.IFlags.IGNBRK = _const : C.TCFlag.t +Posix.TTY.IFlags.IGNCR = _const : C.TCFlag.t +Posix.TTY.IFlags.IGNPAR = _const : C.TCFlag.t +Posix.TTY.IFlags.INLCR = _const : C.TCFlag.t +Posix.TTY.IFlags.INPCK = _const : C.TCFlag.t +Posix.TTY.IFlags.ISTRIP = _const : C.TCFlag.t +Posix.TTY.IFlags.IXANY = _const : C.TCFlag.t +Posix.TTY.IFlags.IXOFF = _const : C.TCFlag.t +Posix.TTY.IFlags.IXON = _const : C.TCFlag.t +Posix.TTY.IFlags.PARMRK = _const : C.TCFlag.t +Posix.TTY.LFlags.ECHO = _const : C.TCFlag.t +Posix.TTY.LFlags.ECHOE = _const : C.TCFlag.t +Posix.TTY.LFlags.ECHOK = _const : C.TCFlag.t +Posix.TTY.LFlags.ECHONL = _const : C.TCFlag.t +Posix.TTY.LFlags.ICANON = _const : C.TCFlag.t +Posix.TTY.LFlags.IEXTEN = _const : C.TCFlag.t +Posix.TTY.LFlags.ISIG = _const : C.TCFlag.t +Posix.TTY.LFlags.NOFLSH = _const : C.TCFlag.t +Posix.TTY.LFlags.TOSTOP = _const : C.TCFlag.t +Posix.TTY.OFlags.BS0 = _const : C.TCFlag.t +Posix.TTY.OFlags.BS1 = _const : C.TCFlag.t +Posix.TTY.OFlags.BSDLY = _const : C.TCFlag.t +Posix.TTY.OFlags.CR0 = _const : C.TCFlag.t +Posix.TTY.OFlags.CR1 = _const : C.TCFlag.t +Posix.TTY.OFlags.CR2 = _const : C.TCFlag.t +Posix.TTY.OFlags.CR3 = _const : C.TCFlag.t +Posix.TTY.OFlags.CRDLY = _const : C.TCFlag.t +Posix.TTY.OFlags.FF0 = _const : C.TCFlag.t +Posix.TTY.OFlags.FF1 = _const : C.TCFlag.t +Posix.TTY.OFlags.FFDLY = _const : C.TCFlag.t +Posix.TTY.OFlags.NL0 = _const : C.TCFlag.t +Posix.TTY.OFlags.NL1 = _const : C.TCFlag.t +Posix.TTY.OFlags.NLDLY = _const : C.TCFlag.t +Posix.TTY.OFlags.OCRNL = _const : C.TCFlag.t +Posix.TTY.OFlags.OFILL = _const : C.TCFlag.t +Posix.TTY.OFlags.ONLCR = _const : C.TCFlag.t +Posix.TTY.OFlags.ONLRET = _const : C.TCFlag.t +Posix.TTY.OFlags.ONOCR = _const : C.TCFlag.t +Posix.TTY.OFlags.OPOST = _const : C.TCFlag.t +Posix.TTY.OFlags.TAB0 = _const : C.TCFlag.t +Posix.TTY.OFlags.TAB1 = _const : C.TCFlag.t +Posix.TTY.OFlags.TAB2 = _const : C.TCFlag.t +Posix.TTY.OFlags.TAB3 = _const : C.TCFlag.t +Posix.TTY.OFlags.TABDLY = _const : C.TCFlag.t +Posix.TTY.OFlags.VT0 = _const : C.TCFlag.t +Posix.TTY.OFlags.VT1 = _const : C.TCFlag.t +Posix.TTY.OFlags.VTDLY = _const : C.TCFlag.t Posix.TTY.TC.TCIFLUSH = _const : C.Int.t Posix.TTY.TC.TCIOFF = _const : C.Int.t Posix.TTY.TC.TCIOFLUSH = _const : C.Int.t @@ -751,5 +784,5 @@ Time.getTimeOfDay = _import : unit -> C.Int.t Time.sec = _import : unit -> C.Time.t Time.usec = _import : unit -> C.SUSeconds.t -Windows.Process.create = _import : NullString8_t * NullString8_t * NullString8_t * C.Fd.t * C.Fd.t * C.Fd.t -> C.PId.t C.Errno.t +Windows.Process.create = _import : NullString8.t * NullString8.t * NullString8.t * C.Fd.t * C.Fd.t * C.Fd.t -> C.PId.t C.Errno.t Windows.Process.terminate = _import : C.PId.t * C.Signal.t -> C.Int.t C.Errno.t |
|
From: Matthew F. <fl...@ml...> - 2006-01-26 18:03:38
|
Added mp_limb_t
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-27 01:57:43 UTC (rev 4314)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-01-27 02:03:34 UTC (rev 4315)
@@ -151,7 +151,6 @@
} while (0)
static char* suffix[] = {
- "",
"#define C_Errno_t(t) t",
"",
"#endif /* _MLTON_TYPES_H_ */",
@@ -250,6 +249,10 @@
systype(speed_t, "Word", "C_Speed_t");
systype(tcflag_t, "Word", "C_TCFlag_t");
writeNewline (fd);
+ writeString (fd, "/* from \"gmp.h\" */");
+ writeNewline (fd);
+ systype(mp_limb_t, "Word", "C_MPLimb_t");
+ writeNewline (fd);
for (int i = 0; suffix[i] != NULL; i++) {
writeString (fd, suffix[i]);
writeNewline (fd);
|
|
From: Matthew F. <fl...@ml...> - 2006-01-26 17:57:44
|
Todo update
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/TODO
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-01-27 01:56:40 UTC (rev 4313)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-01-27 01:57:43 UTC (rev 4314)
@@ -4,13 +4,14 @@
* Use C99 <assert.h> instead of util/assert.{c,h}
+
+Fix PackWord{16,32,64}_{sub,upadate}{,Rev} to use byte offset;
+This requires fixing the semantics of the primitives as well.
+
basis/Int/Word.c
-basis/Int/Word8Array.c
-basis/Int/Word8Vector.c
basis/IntInf.c
basis/MLton/allocTooLarge.c
basis/MLton/bug.c
-basis/PackReal.c
basis/Real/Math.c
basis/Real/class.c
basis/Real/frexp.c
|
|
From: Matthew F. <fl...@ml...> - 2006-01-26 17:56:41
|
More accurate types
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-01-27 01:55:39 UTC (rev 4312)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-01-27 01:56:40 UTC (rev 4313)
@@ -235,16 +235,47 @@
/* PackReal */
/* ------------------------------------------------- */
-Real32 PackReal32_subVec (Pointer v, Int offset);
-Real32 PackReal32_subVecRev (Pointer v, Int offset);
-Real64 PackReal64_subVec (Pointer v, Int offset);
-Real64 PackReal64_subVecRev (Pointer v, Int offset);
-void PackReal32_update (Pointer a, Int offset, Real32 r);
-void PackReal32_updateRev (Pointer a, Int offset, Real32 r);
-void PackReal64_update (Pointer a, Int offset, Real64 r);
-void PackReal64_updateRev (Pointer a, Int offset, Real64 r);
+Real32_t PackReal32_subArr (Array(Word8_t) v, Int offset);
+Real32_t PackReal32_subArrRev (Array(Word8_t) v, Int offset);
+Real64_t PackReal64_subArr (Array(Word8_t) v, Int offset);
+Real64_t PackReal64_subArrRev (Array(Word8_t) v, Int offset);
+Real32_t PackReal32_subVec (Vector(Word8_t) v, Int offset);
+Real32_t PackReal32_subVecRev (Vector(Word8_t) v, Int offset);
+Real64_t PackReal64_subVec (Vector(Word8_t) v, Int offset);
+Real64_t PackReal64_subVecRev (Vector(Word8_t) v, Int offset);
+void PackReal32_update (Array(Word8_t) a, Int offset, Real32_t r);
+void PackReal32_updateRev (Array(Word8_t) a, Int offset, Real32_t r);
+void PackReal64_update (Array(Word8_t) a, Int offset, Real64_t r);
+void PackReal64_updateRev (Array(Word8_t) a, Int offset, Real64_t r);
/* ------------------------------------------------- */
+/* PackWord */
+/* ------------------------------------------------- */
+
+Word16_t PackWord16_subArr (Array(Word8_t) v, Int offset);
+Word16_t PackWord16_subArrRev (Array(Word8_t) v, Int offset);
+Word32_t PackWord32_subArr (Array(Word8_t) v, Int offset);
+Word32_t PackWord32_subArrRev (Array(Word8_t) v, Int offset);
+Word64_t PackWord64_subArr (Array(Word8_t) v, Int offset);
+Word64_t PackWord64_subArrRev (Array(Word8_t) v, Int offset);
+Word16_t PackWord16_subVec (Vector(Word8_t) v, Int offset);
+Word16_t PackWord16_subVecRev (Vector(Word8_t) v, Int offset);
+Word32_t PackWord32_subVec (Vector(Word8_t) v, Int offset);
+Word32_t PackWord32_subVecRev (Vector(Word8_t) v, Int offset);
+Word64_t PackWord64_subVec (Vector(Word8_t) v, Int offset);
+Word64_t PackWord64_subVecRev (Vector(Word8_t) v, Int offset);
+void PackWord16_update (Array(Word8_t) a, Int offset, Word16_t w);
+void PackWord16_updateRev (Array(Word8_t) a, Int offset, Word16_t w);
+void PackWord32_update (Array(Word8_t) a, Int offset, Word32_t w);
+void PackWord32_updateRev (Array(Word8_t) a, Int offset, Word32_t w);
+void PackWord64_update (Array(Word8_t) a, Int offset, Word64_t w);
+void PackWord64_updateRev (Array(Word8_t) a, Int offset, Word64_t w);
+/* Compat */
+Word32 Word8Array_subWord32Rev (Pointer v, Int offset);
+void Word8Array_updateWord32Rev (Pointer a, Int offset, Word32 w);
+Word32 Word8Vector_subWord32Rev (Pointer v, Int offset);
+
+/* ------------------------------------------------- */
/* Real */
/* ------------------------------------------------- */
@@ -280,11 +311,6 @@
#endif
/* ------------------------------------------------- */
-/* Windows */
-/* ------------------------------------------------- */
-
-
-/* ------------------------------------------------- */
/* Word{8,16,32,64} */
/* ------------------------------------------------- */
@@ -315,17 +341,4 @@
#undef SsubCheckOverflows
#undef all
-/* ------------------------------------------------- */
-/* Word8 Array */
-/* ------------------------------------------------- */
-
-Word32 Word8Array_subWord32Rev (Pointer v, Int offset);
-void Word8Array_updateWord32Rev (Pointer a, Int offset, Word32 w);
-
-/* ------------------------------------------------- */
-/* Word8 Vector */
-/* ------------------------------------------------- */
-
-Word32 Word8Vector_subWord32Rev (Pointer v, Int offset);
-
#endif /* _MLTON_PLATFORM_H_ */
|
|
From: Matthew F. <fl...@ml...> - 2006-01-26 17:55:42
|
Fixing some casts
----------------------------------------------------------------------
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c
----------------------------------------------------------------------
Added: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c 2006-01-27 01:54:17 UTC (rev 4311)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/PackWord.c 2006-01-27 01:55:39 UTC (rev 4312)
@@ -0,0 +1,76 @@
+#include "platform.h"
+
+#define Arr(t) Array(t)
+#define Vec(t) Vector(t)
+
+#define mkSubSeq(kind, Seq) \
+Word##kind##_t PackWord##kind##_sub##Seq (Seq(Word8_t) seq, Int offset) { \
+ Word##kind##_t w; \
+ pointer p = (pointer)&w; \
+ pointer s = (pointer)seq + ((kind / 8) * offset); \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ p[i] = s[i]; \
+ return w; \
+}
+#define mkSubSeqRev(kind, Seq) \
+Word##kind##_t PackWord##kind##_sub##Seq##Rev (Seq(Word8_t) seq, Int offset) { \
+ Word##kind##_t w; \
+ pointer p = (pointer)&w; \
+ pointer s = (pointer)seq + ((kind / 8) * offset); \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ p[i] = s[((kind / 8) - 1) - i]; \
+ return w; \
+}
+
+#define mkUpdate(kind) \
+void PackWord##kind##_update (Arr(Word8_t) a, Int offset, Word##kind##_t w) { \
+ pointer p = (pointer)&w; \
+ pointer s = (pointer)a + ((kind / 8) * offset); \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ s[i] = p[i]; \
+}
+#define mkUpdateRev(kind) \
+void PackWord##kind##_updateRev (Arr(Word8_t) a, Int offset, Word##kind##_t w) { \
+ pointer p = (pointer)&w; \
+ pointer s = (pointer)a + ((kind / 8) * offset); \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ s[i] = p[((kind / 8) - 1) - i]; \
+}
+
+#define all(size) \
+ mkSubSeq(size, Arr) \
+ mkSubSeq(size, Vec) \
+ mkSubSeqRev(size, Arr) \
+ mkSubSeqRev(size, Vec) \
+ mkUpdate(size) \
+ mkUpdateRev(size)
+
+all (16)
+all (32)
+all (64)
+
+#undef mkSubSeq
+#undef mkSubSeqRev
+#undef mkUpdate
+#undef all
+
+
+Word32_t Word8Array_subWord32Rev (Array(Word8_t) a, Int offset) {
+ return PackWord32_subArrRev (a, offset);
+}
+
+void Word8Array_updateWord32Rev (Array(Word32_t) a, Int offset, Word32_t w) {
+ PackWord32_updateRev (a, offset, w);
+}
+
+Word32_t Word8Vector_subWord32Rev (Vector(Word8_t) v, Int offset) {
+ return PackWord32_subArrRev (v, offset);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c 2006-01-27 01:54:17 UTC (rev 4311)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word.c 2006-01-27 01:55:39 UTC (rev 4312)
@@ -24,10 +24,6 @@
* implements / and %.
*/
-#ifndef DEBUG
-#define DEBUG FALSE
-#endif
-
#if ! (defined (__amd64__) || defined (__hppa__) || defined (__i386__) || defined (__ppc__) || defined (__powerpc__) || defined (__sparc__))
#error check that C {/,%} correctly implement {quot,rem} from the basis library
#endif
@@ -42,18 +38,18 @@
coerce (Word##S##from, Word##to) \
coerce (Word##U##from, Word##to)
-#define WordS8_max (WordS8)0x7F
-#define WordS8_min (WordS8)0x80
-#define WordS16_max (WordS16)0x7FFF
-#define WordS16_min (WordS16)0x8000
-#define WordS32_max (WordS32)0x7FFFFFFF
-#define WordS32_min (WordS32)0x80000000
-#define WordS64_max (WordS64)0x7FFFFFFFFFFFFFFFll
-#define WordS64_min (WordS64)0x8000000000000000ll
-#define WordU8_max (WordU8)0xFF
-#define WordU16_max (WordU16)0xFFFF
-#define WordU32_max (WordU32)0xFFFFFFFF
-#define WordU64_max (WordU64)0xFFFFFFFFFFFFFFFFull
+#define WordS8_max (WordS8)INT8_MAX
+#define WordS8_min (WordS8)INT8_MIN
+#define WordS16_max (WordS16)INT16_MAX
+#define WordS16_min (WordS16)INT16_MIN
+#define WordS32_max (WordS32)INT32_MAX
+#define WordS32_min (WordS32)INT32_MIN
+#define WordS64_max (WordS64)INT64_MAX
+#define WordS64_min (WordS64)INT64_MIN
+#define WordU8_max (WordU8)UINT8_MAX
+#define WordU16_max (WordU16)UINT16_MAX
+#define WordU32_max (WordU32)UINT32_MAX
+#define WordU64_max (WordU64)UINT64_MAX
#define binary(kind, name, op) \
Word##kind Word##kind##_##name (Word##kind w1, Word##kind w2); \
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c 2006-01-27 01:54:17 UTC (rev 4311)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Array.c 2006-01-27 01:55:39 UTC (rev 4312)
@@ -1,26 +0,0 @@
-#include "platform.h"
-
-Word32 Word8Array_subWord32Rev (Pointer v, Int offset) {
- Word32 w;
- pointer p;
- pointer s;
- int i;
-
- p = (pointer )&w;
- s = v + (offset * 4);
- for (i = 0; i < 4; ++i)
- p[i] = s[3 - i];
- return w;
-}
-
-void Word8Array_updateWord32Rev (Pointer a, Int offset, Word32 w) {
- pointer p;
- pointer s;
- int i;
-
- p = (pointer)&w;
- s = a + (offset * 4);
- for (i = 0; i < 4; ++i) {
- s[i] = p[3 - i];
- }
-}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c 2006-01-27 01:54:17 UTC (rev 4311)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Int/Word8Vector.c 2006-01-27 01:55:39 UTC (rev 4312)
@@ -1,14 +0,0 @@
-#include "platform.h"
-
-Word32 Word8Vector_subWord32Rev (Pointer v, Int offset) {
- Word32 w;
- pointer p;
- pointer s;
- int i;
-
- p = (pointer)&w;
- s = v + (offset * 4);
- for (i = 0; i < 4; ++i)
- p[i] = s[3 - i];
- return w;
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-01-27 01:54:17 UTC (rev 4311)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-01-27 01:55:39 UTC (rev 4312)
@@ -22,11 +22,11 @@
* Test if a intInf is a fixnum.
*/
static inline bool isSmall (pointer arg) {
- return ((uintptr_t)arg & 1);
+ return ((uintptr_t)arg & 1);
}
static inline bool eitherIsSmall (pointer arg1, pointer arg2) {
- return (((uintptr_t)arg1 | (uintptr_t)arg2) & 1);
+ return (((uintptr_t)arg1 | (uintptr_t)arg2) & 1);
}
static inline bool areSmall (pointer arg1, pointer arg2) {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c 2006-01-27 01:54:17 UTC (rev 4311)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/PackReal.c 2006-01-27 01:55:39 UTC (rev 4312)
@@ -1,85 +1,62 @@
#include "platform.h"
-Real32 PackReal32_subVec (Pointer v, Int offset) {
- Real32 r;
- pointer p = (pointer)&r;
- pointer s = v + offset;
- int i;
+#define Arr(t) Array(t)
+#define Vec(t) Vector(t)
- for (i = 0; i < 4; ++i)
- p[i] = s[i];
- return r;
+#define mkSubSeq(kind, Seq) \
+Real##kind##_t PackReal##kind##_sub##Seq (Seq(Word8_t) seq, Int offset) { \
+ Real##kind##_t r; \
+ pointer p = (pointer)&r; \
+ pointer s = (pointer)seq + offset; \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ p[i] = s[i]; \
+ return r; \
}
-
-Real32 PackReal32_subVecRev (Pointer v, Int offset) {
- Real32 r;
- pointer p = (pointer)&r;
- pointer s = v + offset;
- int i;
-
- for (i = 0; i < 4; ++i)
- p[i] = s[3 - i];
- return r;
+#define mkSubSeqRev(kind, Seq) \
+Real##kind##_t PackReal##kind##_sub##Seq##Rev (Seq(Word8_t) seq, Int offset) { \
+ Real##kind##_t r; \
+ pointer p = (pointer)&r; \
+ pointer s = (pointer)seq + offset; \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ p[i] = s[((kind / 8) - 1) - i]; \
+ return r; \
}
-Real64 PackReal64_subVec (Pointer v, Int offset) {
- Real64 r;
- pointer p = (pointer)&r;
- pointer s = v + offset;
- int i;
-
- for (i = 0; i < 8; ++i)
- p[i] = s[i];
- return r;
+#define mkUpdate(kind) \
+void PackReal##kind##_update (Arr(Word8_t) a, Int offset, Real##kind##_t r) { \
+ pointer p = (pointer)&r; \
+ pointer s = (pointer)a + offset; \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ s[i] = p[i]; \
}
-
-Real64 PackReal64_subVecRev (Pointer v, Int offset) {
- Real64 r;
- pointer p = (pointer)&r;
- pointer s = v + offset;
- int i;
-
- for (i = 0; i < 8; ++i)
- p[i] = s[7 - i];
- return r;
+#define mkUpdateRev(kind) \
+void PackReal##kind##_updateRev (Arr(Word8_t) a, Int offset, Real##kind##_t r) { \
+ pointer p = (pointer)&r; \
+ pointer s = (pointer)a + offset; \
+ int i; \
+ \
+ for (i = 0; i < kind / 8; ++i) \
+ s[i] = p[((kind / 8) - 1) - i]; \
}
-void PackReal32_update (Pointer a, Int offset, Real32 r) {
- pointer p = (pointer)&r;
- pointer s = a + offset;
- int i;
+#define all(size) \
+ mkSubSeq(size, Arr) \
+ mkSubSeq(size, Vec) \
+ mkSubSeqRev(size, Arr) \
+ mkSubSeqRev(size, Vec) \
+ mkUpdate(size) \
+ mkUpdateRev(size)
- for (i = 0; i < 4; ++i) {
- s[i] = p[i];
- }
-}
+all (32)
+all (64)
-void PackReal32_updateRev (Pointer a, Int offset, Real32 r) {
- pointer p = (pointer)&r;
- pointer s = a + offset;
- int i;
-
- for (i = 0; i < 4; ++i) {
- s[i] = p[3 - i];
- }
-}
-
-void PackReal64_update (Pointer a, Int offset, Real64 r) {
- pointer p = (pointer)&r;
- pointer s = a + offset;
- int i;
-
- for (i = 0; i < 8; ++i) {
- s[i] = p[i];
- }
-}
-
-void PackReal64_updateRev (Pointer a, Int offset, Real64 r) {
- pointer p = (pointer)&r;
- pointer s = a + offset;
- int i;
-
- for (i = 0; i < 8; ++i) {
- s[i] = p[7 - i];
- }
-}
+#undef mkSubSeq
+#undef mkSubSeqRev
+#undef mkUpdate
+#undef all
|
|
From: Matthew F. <fl...@ml...> - 2006-01-26 17:54:18
|
Added assert on signedness of char ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-01-27 01:19:15 UTC (rev 4310) +++ mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-01-27 01:54:17 UTC (rev 4311) @@ -52,6 +52,7 @@ COMPILE_TIME_ASSERT(CHAR_BIT__is_eight, CHAR_BIT == 8); COMPILE_TIME_ASSERT(sizeof_float__is_four, sizeof(float) == 4); COMPILE_TIME_ASSERT(sizeof_double__is_eight, sizeof(double) == 8); +COMPILE_TIME_ASSERT(char__is_signed, (double)((char)(-1)) < 0); #include <fcntl.h> #include <unistd.h> |
|
From: Matthew F. <fl...@ml...> - 2006-01-26 17:19:17
|
More accurate calculation of bytes needed for IntInf initialization.
Can't mutate mlstr in place (its static).
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-01-26 23:36:45 UTC (rev 4309)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-01-27 01:19:15 UTC (rev 4310)
@@ -12,19 +12,25 @@
size_t sizeofInitialBytesLive (GC_state s) {
uint32_t i;
+ size_t maxSLen = 0;
size_t numBytes;
size_t total;
total = 0;
for (i = 0; i < s->intInfInitsLength; ++i) {
+ size_t slen = strlen (s->intInfInits[i].mlstr);
+ maxSLen = max (maxSLen, slen);
+ double bytesPerChar = 0.415241011861 /* = ((log(10.0) / log(2.0)) / 8.0) */ ;
+ double bytes = ceil((double)slen * bytesPerChar);
/* A slight overestimate. */
numBytes =
sizeof(mp_limb_t) // for the sign
- + (align(strlen (s->intInfInits[i].mlstr), sizeof(mp_limb_t)));
+ + (align((size_t)bytes, sizeof(mp_limb_t)));
total += align (GC_ARRAY_HEADER_SIZE
+ numBytes,
s->alignment);
}
+ total += maxSLen;
for (i = 0; i < s->vectorInitsLength; ++i) {
numBytes =
s->vectorInits[i].bytesPerElement
@@ -41,12 +47,13 @@
void initIntInfs (GC_state s) {
struct GC_intInfInit *inits;
pointer frontier;
- char *str;
+ const char *str;
size_t slen;
mp_size_t alen;
uint32_t i, j;
bool neg;
GC_intInf bp;
+ unsigned char* cp;
assert (isFrontierAligned (s, s->frontier));
frontier = s->frontier;
@@ -59,15 +66,15 @@
str++;
slen = strlen (str);
assert (slen > 0);
+ cp = (unsigned char*)(s->heap.start + (s->heap.size - slen));
bp = (GC_intInf)frontier;
for (j = 0; j != slen; j++) {
assert('0' <= str[j] && str[j] <= '9');
- unsigned char c = str[j] - '0' + 0;
- str[j] = c;
+ cp[j] = str[j] - '0' + 0;
}
- alen = mpn_set_str ((mp_limb_t*)(bp->limbs), (unsigned char*)str, slen, 10);
+ alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, 10);
if (alen <= 1) {
uintmax_t val, ans;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2006-01-26 23:36:45 UTC (rev 4309)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2006-01-27 01:19:15 UTC (rev 4310)
@@ -21,7 +21,7 @@
*/
struct GC_intInfInit {
uint32_t globalIndex;
- char *mlstr;
+ const char *mlstr;
};
/* GC_init allocates a collection of arrays/vectors in the heap. */
|
|
From: Matthew F. <fl...@ml...> - 2006-01-26 15:36:48
|
Added COMPILE_TIME_ASSERT ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-01-26 23:35:22 UTC (rev 4308) +++ mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-01-26 23:36:45 UTC (rev 4309) @@ -47,8 +47,12 @@ // #include <wchar.h> // #include <wctype.h> +#define COMPILE_TIME_ASSERT(name, x) \ + typedef int _COMPILE_TIME_ASSERT___##name[(x) ? 1 : -1] +COMPILE_TIME_ASSERT(CHAR_BIT__is_eight, CHAR_BIT == 8); +COMPILE_TIME_ASSERT(sizeof_float__is_four, sizeof(float) == 4); +COMPILE_TIME_ASSERT(sizeof_double__is_eight, sizeof(double) == 8); - #include <fcntl.h> #include <unistd.h> |
