[MLton] cvs commit: most MinGW regressions now pass
Stephen Weeks
sweeks@mlton.org
Thu, 26 Aug 2004 17:50:56 -0700
sweeks 04/08/26 17:50:44
Modified: basis-library/libs/basis-extra basis-extra.mlb
basis-library/misc primitive.sml
basis-library/mlton itimer.sml rusage.sml
basis-library/net unix-sock.sml
basis-library/posix error.sig error.sml file-sys.sml io.sml
primitive.sml proc-env.sml process.sml sys-db.sml
tty.sml
basis-library/system io.sml
bin add-cross mlton regression
runtime .cvsignore Makefile gc.c
runtime/Posix/FileSys open.c
runtime/Posix/ProcEnv Uname.c
runtime/basis Date.c Time.c
runtime/basis/Int Word.c
runtime/basis/MLton profile.c
runtime/basis/Net/Socket UnixSock.c
runtime/basis/Real class.c gdtoa.c
runtime/platform mingw.c mingw.h
Added: basis-library/posix stub-mingw.sml
Removed: runtime/basis/MLton gcTime.c
Log:
MAIL most MinGW regressions now pass
I'll go over the failures tomorrow with a fine-tooth comb and figure
out which are OK and which need fixing.
Cleaned up the runtime Makefile's handling of the C files and
eliminated the duplication in OBJS and DEBUG_OBJS. Added the ability
to compile the runtime as one large C file with COMPILE_FAST=yes. The
cross regression script uses this to speed up testing.
Cleaned up how unimplemented system calls are stubbed out in the basis
library code. Now there is a single file, stub-mingw.sml, that
wraps stubs around all the unimplemented calls.
Improved the regression script so that it can cross compile the mingw
tests.
Revision Changes Path
1.3 +1 -0 mlton/basis-library/libs/basis-extra/basis-extra.mlb
Index: basis-extra.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-extra/basis-extra.mlb,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- basis-extra.mlb 5 Aug 2004 00:46:07 -0000 1.2
+++ basis-extra.mlb 27 Aug 2004 00:50:40 -0000 1.3
@@ -109,6 +109,7 @@
../../posix/error.sig
../../posix/error.sml
+ ../../posix/stub-mingw.sml
../../posix/flags.sig
../../posix/flags.sml
../../posix/signal.sig
1.117 +2 -1 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.116
retrieving revision 1.117
diff -u -r1.116 -r1.117
--- primitive.sml 25 Aug 2004 17:51:06 -0000 1.116
+++ primitive.sml 27 Aug 2004 00:50:40 -0000 1.117
@@ -741,7 +741,8 @@
val prof = _const "Itimer_prof": which;
val real = _const "Itimer_real": which;
- val set = _import "Itimer_set": which * int * int * int * int -> unit;
+ val set =
+ _import "Itimer_set": which * int * int * int * int -> unit;
val virtual = _const "Itimer_virtual": which;
end
1.11 +0 -2 mlton/basis-library/mlton/itimer.sml
Index: itimer.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/itimer.sml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- itimer.sml 25 Aug 2004 17:51:06 -0000 1.10
+++ itimer.sml 27 Aug 2004 00:50:41 -0000 1.11
@@ -28,8 +28,6 @@
Prim.set (toInt t, s1, u1, s2, u2)
end
- val set' = PosixError.stubMinGW set'
-
fun set (z as (t, _)) =
if Primitive.MLton.Profile.isOn
andalso t = Prof
1.5 +0 -2 mlton/basis-library/mlton/rusage.sml
Index: rusage.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/rusage.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- rusage.sml 25 Aug 2004 17:51:06 -0000 1.4
+++ rusage.sml 27 Aug 2004 00:50:41 -0000 1.5
@@ -32,6 +32,4 @@
self = collect (self_utime_sec, self_utime_usec,
self_stime_sec, self_stime_usec)}
end
-
- val rusage = PosixError.stubMinGW rusage
end
1.10 +0 -5 mlton/basis-library/net/unix-sock.sml
Index: unix-sock.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/unix-sock.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- unix-sock.sml 25 Aug 2004 17:51:06 -0000 1.9
+++ unix-sock.sml 27 Aug 2004 00:50:41 -0000 1.10
@@ -28,11 +28,6 @@
CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME len))
end
- val stub = PosixError.stubMinGW
-
- val toAddr = stub toAddr
- val fromAddr = stub fromAddr
-
structure Strm =
struct
fun socket () = GenericSock.socket (unixAF, Socket.SOCK.stream)
1.8 +0 -1 mlton/basis-library/posix/error.sig
Index: error.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/error.sig,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- error.sig 25 Aug 2004 17:51:06 -0000 1.7
+++ error.sig 27 Aug 2004 00:50:41 -0000 1.8
@@ -63,7 +63,6 @@
val cleared: syserror
val raiseSys: syserror -> 'a
- val stubMinGW: ('a -> 'b) -> 'a -> 'b
structure SysCall :
sig
1.14 +2 -10 mlton/basis-library/posix/error.sml
Index: error.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/error.sml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- error.sml 25 Aug 2004 17:51:06 -0000 1.13
+++ error.sml 27 Aug 2004 00:50:41 -0000 1.14
@@ -49,14 +49,6 @@
fun raiseSys n = raise SysErr (errorMsg n, SOME n)
- val stubMinGW: ('a -> 'b) -> ('a -> 'b) =
- fn f =>
- if let open Primitive.MLton.Platform.OS
- in MinGW = host
- end
- then fn _ => raiseSys nosys
- else f
-
structure SysCall =
struct
structure Thread = Primitive.Thread
@@ -93,8 +85,8 @@
errno: syserror,
handlers: (syserror * (unit -> 'a)) list}: 'a =
case List.find (fn (e',_) => errno = e') handlers of
- SOME (_, handler) => handler ()
- | NONE => default ()
+ NONE => default ()
+ | SOME (_, handler) => handler ()
fun errBlocked {errno: syserror,
handlers: (syserror * (unit -> 'a)) list}: 'a =
err {default = fn () => raiseSys errno,
1.20 +0 -12 mlton/basis-library/posix/file-sys.sml
Index: file-sys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/file-sys.sml,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- file-sys.sml 25 Aug 2004 17:51:06 -0000 1.19
+++ file-sys.sml 27 Aug 2004 00:50:41 -0000 1.20
@@ -393,16 +393,4 @@
make (fn (path, s) => Prim.pathconf (NullString.nullTerm path, s))
val fpathconf = make (fn (FD n, s) => Prim.fpathconf (n, s))
end
-
- val stub = Error.stubMinGW
-
- val chown = stub chown
- val fchown = stub fchown
- val fpathconf = stub fpathconf
- val ftruncate = stub ftruncate
- val link = stub link
- val mkfifo = stub mkfifo
- val pathconf = stub pathconf
- val readlink = stub readlink
- val symlink = stub symlink
end
1.18 +4 -12 mlton/basis-library/posix/io.sml
Index: io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/io.sml,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- io.sml 25 Aug 2004 17:51:06 -0000 1.17
+++ io.sml 27 Aug 2004 00:50:41 -0000 1.18
@@ -119,7 +119,8 @@
fun getfl (FD fd): O.flags * open_mode =
let
- val n = SysCall.simpleResultRestart (fn () => Prim.fcntl2 (fd, F_GETFL))
+ 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)
@@ -127,7 +128,8 @@
end
fun setfl (FD fd, flags: O.flags): unit =
- SysCall.simpleRestart (fn () => Prim.fcntl3 (fd, F_SETFL, Word.toIntX flags))
+ SysCall.simpleRestart
+ (fn () => Prim.fcntl3 (fd, F_SETFL, Word.toIntX flags))
datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
@@ -374,14 +376,4 @@
val {mkReader = mkTextReader, mkWriter = mkTextWriter} =
make rwChar (TextPrimIO.RD, TextPrimIO.WR)
end
-
- val stub = PosixError.stubMinGW
- val dupfd = stub dupfd
- val fsync = stub fsync
- val getfd = stub getfd
- val getlk = stub getlk
- val pipe = stub pipe
- val setfd = stub setfd
- val setlk = stub setlk
- val setlkw = stub setlkw
end
1.28 +4 -4 mlton/basis-library/posix/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/primitive.sml,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- primitive.sml 29 Apr 2004 02:58:58 -0000 1.27
+++ primitive.sml 27 Aug 2004 00:50:41 -0000 1.28
@@ -723,13 +723,13 @@
_import "Posix_TTY_Termios_setispeed": speed -> int;
end
- val getattr = _import "Posix_TTY_getattr": fd -> int;
- val setattr = _import "Posix_TTY_setattr": fd * TC.set_action -> int;
- val sendbreak = _import "Posix_TTY_sendbreak": fd * int -> int;
val drain = _import "Posix_TTY_drain": fd -> int;
- val flush = _import "Posix_TTY_flush": fd * TC.queue_sel -> int;
val flow = _import "Posix_TTY_flow": fd * TC.flow_action -> int;
+ val flush = _import "Posix_TTY_flush": fd * TC.queue_sel -> int;
+ val getattr = _import "Posix_TTY_getattr": fd -> int;
val getpgrp = _import "Posix_TTY_getpgrp": fd -> Pid.t;
+ val sendbreak = _import "Posix_TTY_sendbreak": fd * int -> int;
+ val setattr = _import "Posix_TTY_setattr": fd * TC.set_action -> int;
val setpgrp = _import "Posix_TTY_setpgrp": fd * Pid.t -> int;
end
end
1.12 +0 -20 mlton/basis-library/posix/proc-env.sml
Index: proc-env.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/proc-env.sml,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- proc-env.sml 25 Aug 2004 17:51:06 -0000 1.11
+++ proc-env.sml 27 Aug 2004 00:50:41 -0000 1.12
@@ -141,24 +141,4 @@
(if Primitive.Pointer.isNull cs then ~1 else 0,
fn () => CS.toString cs)
end)
-
- val stub = Error.stubMinGW
- val ctermid = stub ctermid
- val getegid = stub getegid
- val geteuid = stub geteuid
- val getgid = stub getgid
- val getgroups = stub getgroups
- val getlogin = stub getlogin
- val getpgrp = stub getpgrp
- val getpid = stub getpid
- val getppid = stub getppid
- val getuid = stub getuid
- val setgid = stub setgid
- val setpgid = stub setpgid
- val setsid = stub setsid
- val setuid = stub setuid
- val sysconf = stub sysconf
- val times = stub times
- val ttyname = stub ttyname
- val uname = stub uname
end
1.25 +10 -3 mlton/basis-library/posix/process.sml
Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/process.sml,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- process.sml 17 Aug 2004 05:01:00 -0000 1.24
+++ process.sml 27 Aug 2004 00:50:41 -0000 1.25
@@ -30,9 +30,16 @@
end)
val fork =
- if let open MLton.Platform.OS in host <> Cygwin end
- then fork
- else fn () => Error.raiseSys Error.nosys
+ if let
+ open MLton.Platform.OS
+ in
+ case host of
+ Cygwin => true
+ | MinGW => true
+ | _ => false
+ end
+ then (fn () => Error.raiseSys Error.nosys)
+ else fork
val conv = NullString.nullTerm
val convs = C.CSS.fromList
1.6 +0 -6 mlton/basis-library/posix/sys-db.sml
Index: sys-db.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/sys-db.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- sys-db.sml 25 Aug 2004 17:51:06 -0000 1.5
+++ sys-db.sml 27 Aug 2004 00:50:41 -0000 1.6
@@ -12,8 +12,6 @@
structure Error = PosixError
structure SysCall = Error.SysCall
- val stub = Error.stubMinGW
-
type uid = Prim.uid
type gid = Prim.gid
@@ -80,8 +78,4 @@
end
fun getgrgid gid = Group.fromC (fn () => Prim.getgrgid gid)
-
- val getgrgid = stub getgrgid
- val getgrnam = stub getgrnam
- val getpwuid = stub getpwuid
end
1.9 +0 -10 mlton/basis-library/posix/tty.sml
Index: tty.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/tty.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- tty.sml 25 Aug 2004 17:51:06 -0000 1.8
+++ tty.sml 27 Aug 2004 00:50:41 -0000 1.9
@@ -168,15 +168,5 @@
fun setpgrp (FD fd, pid) =
SysCall.simpleRestart (fn () => Prim.setpgrp (fd, pid))
-
- val stub = Error.stubMinGW
- val drain = stub drain
- val flow = stub flow
- val flush = stub flush
- val getattr = stub getattr
- val getpgrp = stub getpgrp
- val sendbreak = stub sendbreak
- val setattr = stub setattr
- val setpgrp = stub setpgrp
end
end
1.1 mlton/basis-library/posix/stub-mingw.sml
Index: stub-mingw.sml
===================================================================
(* Stub out functions that are not implemented on MinGW. *)
local
structure Error = PosixError
val stub: ('a -> 'b) -> ('a -> 'b) =
fn f =>
if let open Primitive.MLton.Platform.OS
in MinGW = host
end
then fn _ => Error.raiseSys Error.nosys
else f
in
structure PosixPrimitive =
struct
open PosixPrimitive
structure FileSys =
struct
open FileSys
val chown = stub chown
val fchown = stub fchown
val fpathconf = stub fpathconf
val ftruncate = stub ftruncate
val link = stub link
val mkfifo = stub mkfifo
val pathconf = stub pathconf
val readlink = stub readlink
val symlink = stub symlink
end
structure IO =
struct
open IO
val fcntl2 = stub fcntl2
val fcntl3 = stub fcntl3
end
structure ProcEnv =
struct
open ProcEnv
structure Uname =
struct
open Uname
val uname = stub uname
end
val ctermid = stub ctermid
val getegid = stub getegid
val geteuid = stub geteuid
val getgid = stub getgid
val getgroups = stub getgroups
val getlogin = stub getlogin
val getpgrp = stub getpgrp
val getpid = stub getpid
val getppid = stub getppid
val getuid = stub getuid
val setgid = stub setgid
val setpgid = stub setpgid
val setsid = stub setsid
val setuid = stub setuid
val sysconf = stub sysconf
val times = stub times
val ttyname = stub ttyname
end
structure SysDB =
struct
open SysDB
val getgrgid = stub getgrgid
val getgrnam = stub getgrnam
val getpwuid = stub getpwuid
end
structure TTY =
struct
open TTY
val drain = stub drain
val flow = stub flow
val flush = stub flush
val getattr = stub getattr
val getpgrp = stub getpgrp
val sendbreak = stub sendbreak
val setattr = stub setattr
val setpgrp = stub setpgrp
end
end
structure Primitive =
struct
open Primitive
structure Itimer =
struct
open Itimer
val set = stub set
end
structure MLton =
struct
open MLton
structure Rusage =
struct
open Rusage
val ru = stub ru
end
end
structure OS =
struct
open OS
structure IO =
struct
open IO
val poll = stub poll
end
end
structure Socket =
struct
open Socket
structure UnixSock =
struct
open UnixSock
val toAddr = stub toAddr
val fromAddr = stub fromAddr
end
end
end
end
1.11 +0 -2 mlton/basis-library/system/io.sml
Index: io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/io.sml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- io.sml 25 Aug 2004 17:51:07 -0000 1.10
+++ io.sml 27 Aug 2004 00:50:42 -0000 1.11
@@ -137,8 +137,6 @@
end
end (* local *)
- val poll = PosixError.stubMinGW poll
-
(* check for conditions *)
fun isIn (PollInfo(_, flgs)) = #rd flgs
fun isOut (PollInfo(_, flgs)) = #wr flgs
1.19 +2 -2 mlton/bin/add-cross
Index: add-cross
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/add-cross,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- add-cross 26 Aug 2004 03:54:39 -0000 1.18
+++ add-cross 27 Aug 2004 00:50:42 -0000 1.19
@@ -6,7 +6,7 @@
#
# It takes four arguments.
#
-# 1. <crossTarget>, which is waht MLton will pass via the -b flag to the GCC
+# 1. <crossTarget>, which is what MLton would pass via the -b flag to the GCC
# cross-compiler tools. You don't need to have installed these tools in order
# to run this script, since it uses ssh and the native gcc on the target.
# Examples of $crossTarget are i386-pc-cygwin and sparc-sun-solaris.
@@ -80,7 +80,7 @@
echo 'Making runtime.'
( cd $src && tar cf - bin runtime ) |
ssh $machine "cd $tmp && tar xf - && cd runtime &&
- make TARGET_ARCH=$crossArch TARGET_OS=$crossOS clean all"
+ make COMPILE_FAST=yes TARGET_ARCH=$crossArch TARGET_OS=$crossOS clean all"
ssh $machine "cd $tmp/runtime && tar cf - *.a" |
( cd $lib/$crossTarget && tar xf - )
( cd $src &&
1.36 +3 -2 mlton/bin/mlton
Index: mlton
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/mlton,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- mlton 25 Aug 2004 17:51:07 -0000 1.35
+++ mlton 27 Aug 2004 00:50:42 -0000 1.36
@@ -41,7 +41,7 @@
exit 1
}
-# For align-{functions,jumps,loops, we use -m for now instead of
+# For align-{functions,jumps,loops}, we use -m for now instead of
# -f because old gcc's will barf on -f, while newer ones only warn
# about -m. Someday, when we think we won't run into older gcc's,
# these should be changed to -f.
@@ -71,7 +71,8 @@
-mcpu=ultrasparc' \
-target-link-opt cygwin '-lgmp' \
-target-link-opt freebsd '-L/usr/local/lib/ -lgmp' \
- -target-link-opt mingw '-lgmp -lws2_32 -lkernel32' \
+ -target-link-opt mingw \
+ '-lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32' \
-target-link-opt netbsd \
'-Wl,-R/usr/pkg/lib -L/usr/local/lib/ -lgmp' \
-target-link-opt openbsd '-L/usr/local/lib/ -lgmp' \
1.96 +28 -7 mlton/bin/regression
Index: regression
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/regression,v
retrieving revision 1.95
retrieving revision 1.96
diff -u -r1.95 -r1.96
--- regression 23 Aug 2004 15:25:02 -0000 1.95
+++ regression 27 Aug 2004 00:50:42 -0000 1.96
@@ -125,19 +125,23 @@
;;
yes)
case $crossTarget in
+ *mingw)
+ libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
+ ;;
*solaris)
- libs='-lmlton -lgmp -ldl -lnsl -lsocket -lgdtoa -lm'
+ libs='-ldl -lnsl -lsocket'
;;
*)
- libs='-lmlton -lgmp -lgdtoa -lm'
+ libs=''
;;
esac
+ libs="-lmlton -lgmp $libs -lgdtoa -lm"
# Must use $f.[0-9].[cS], not $f.*.[cS], because the
# latter will include other files, e.g. for finalize,
# it will also include finalize.2.
gcc -o $f -w -O1 \
- -I "$src/build/lib/include" \
- -L "$src/build/lib/$crossTarget" \
+ -I "../build/lib/include" \
+ -L "../build/lib/$crossTarget" \
-L /usr/pkg/lib \
-L /usr/local/lib \
$f.[0-9].[cS] \
@@ -145,9 +149,26 @@
;;
esac
if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
- ( ./$f || echo 'Nonzero exit status.' ) >$tmp 2>&1
- if [ -r $f.ok ] && ! diff $f.ok $tmp ; then
- echo "difference with $flags"
+ nonZeroMsg='Nonzero exit status.'
+ case $crossTarget in
+ *mingw)
+ nonZeroMsg="$nonZeroMsg"'\r'
+ ;;
+ esac
+ ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1
+ if [ -r $f.ok ]; then
+ case $crossTarget in
+ *mingw)
+ compare="$f.sed.ok"
+ sed 's/$/\r/' <"$f.ok" >"$compare"
+ ;;
+ *)
+ compare="$f.ok"
+ ;;
+ esac
+ if ! diff $compare $tmp; then
+ echo "difference with $flags"
+ fi
fi
fi
;;
1.10 +1 -0 mlton/runtime/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/.cvsignore,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- .cvsignore 1 Jun 2003 00:31:33 -0000 1.9
+++ .cvsignore 27 Aug 2004 00:50:42 -0000 1.10
@@ -1 +1,2 @@
gdtoa
+runtime.c
1.85 +25 -232 mlton/runtime/Makefile
Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- Makefile 25 Aug 2004 17:51:10 -0000 1.84
+++ Makefile 27 Aug 2004 00:50:42 -0000 1.85
@@ -31,237 +31,31 @@
FLAGS += -b $(TARGET)
endif
-CC = gcc -Wall -I. -D_FILE_OFFSET_BITS=64 $(FLAGS)
+CC = gcc -Wall -I. -Iplatform -D_FILE_OFFSET_BITS=64 $(FLAGS)
CFLAGS = -O2
DEBUGFLAGS = -gstabs+ -g2
-OBJS = \
- basis/Array/numElements.o \
- basis/CommandLine.o \
- basis/Date.o \
- basis/Debug.o \
- basis/GC.o \
- basis/IEEEReal.o \
- basis/IntInf.o \
- basis/Int/Word.o \
- basis/Int/Word8Array.o \
- basis/Int/Word8Vector.o \
- basis/Itimer/set.o \
- basis/MLton/allocTooLarge.o \
- basis/MLton/bug.o \
- basis/MLton/errno.o \
- basis/MLton/exit.o \
- basis/MLton/profile.o \
- basis/MLton/rlimit.o \
- basis/MLton/rusage.o \
- basis/MLton/spawne.o \
- basis/MLton/spawnp.o \
- basis/MLton/size.o \
- basis/MLton/world.o \
- basis/Net/Net.o \
- basis/Net/NetHostDB.o \
- basis/Net/NetProtDB.o \
- basis/Net/NetServDB.o \
- basis/Net/Socket/INetSock.o \
- basis/Net/Socket/Socket.o \
- basis/OS/IO/poll.o \
- basis/PackReal.o \
- basis/Ptrace.o \
- basis/Real/class.o \
- basis/Real/frexp.o \
- basis/Real/gdtoa.o \
- basis/Real/modf.o \
- basis/Real/nextAfter.o \
- basis/Real/real.o \
- basis/Real/signBit.o \
- basis/Real/strto.o \
- basis/Stdio.o \
- basis/Thread.o \
- basis/Time.o \
- Posix/Error.o \
- Posix/FileSys/Dirstream.o \
- Posix/FileSys/ST.o \
- Posix/FileSys/Stat.o \
- Posix/FileSys/Utimbuf.o \
- Posix/FileSys/access.o \
- Posix/FileSys/chdir.o \
- Posix/FileSys/chmod.o \
- Posix/FileSys/chown.o \
- Posix/FileSys/fchmod.o \
- Posix/FileSys/fchown.o \
- Posix/FileSys/fpathconf.o \
- Posix/FileSys/ftruncate.o \
- Posix/FileSys/getcwd.o \
- Posix/FileSys/link.o \
- Posix/FileSys/mkdir.o \
- Posix/FileSys/mkfifo.o \
- Posix/FileSys/open.o \
- Posix/FileSys/pathconf.o \
- Posix/FileSys/readlink.o \
- Posix/FileSys/rename.o \
- Posix/FileSys/rmdir.o \
- Posix/FileSys/symlink.o \
- Posix/FileSys/umask.o \
- Posix/FileSys/unlink.o \
- Posix/IO/FLock.o \
- Posix/IO/close.o \
- Posix/IO/dup.o \
- Posix/IO/dup2.o \
- Posix/IO/fcntl2.o \
- Posix/IO/fcntl3.o \
- Posix/IO/fsync.o \
- Posix/IO/lseek.o \
- Posix/IO/pipe.o \
- Posix/IO/read.o \
- Posix/IO/write.o \
- Posix/ProcEnv/ProcEnv.o \
- Posix/ProcEnv/Tms.o \
- Posix/ProcEnv/Uname.o \
- Posix/ProcEnv/environ.o \
- Posix/ProcEnv/getenv.o \
- Posix/ProcEnv/getgroups.o \
- Posix/ProcEnv/getlogin.o \
- Posix/ProcEnv/getpgrp.o \
- Posix/ProcEnv/isatty.o \
- Posix/ProcEnv/setenv.o \
- Posix/ProcEnv/sysconf.o \
- Posix/ProcEnv/ttyname.o \
- Posix/Process/alarm.o \
- Posix/Process/exece.o \
- Posix/Process/execp.o \
- Posix/Process/exit.o \
- Posix/Process/exitStatus.o \
- Posix/Process/fork.o \
- Posix/Process/ifExited.o \
- Posix/Process/ifSignaled.o \
- Posix/Process/ifStopped.o \
- Posix/Process/kill.o \
- Posix/Process/pause.o \
- Posix/Process/sleep.o \
- Posix/Process/stopSig.o \
- Posix/Process/termSig.o \
- Posix/Process/waitpid.o \
- Posix/Signal.o \
- Posix/SysDB/Group.o \
- Posix/SysDB/Passwd.o \
- Posix/TTY.o \
- gc.o \
- platform.o \
- platform/$(TARGET_OS).o
-
-DEBUG_OBJS = \
- basis/Array/numElements-gdb.o \
- basis/CommandLine-gdb.o \
- basis/Date-gdb.o \
- basis/Debug-gdb.o \
- basis/GC-gdb.o \
- basis/IEEEReal-gdb.o \
- basis/IntInf-gdb.o \
- basis/Int/Word-gdb.o \
- basis/Int/Word8Array-gdb.o \
- basis/Int/Word8Vector-gdb.o \
- basis/Itimer/set-gdb.o \
- basis/MLton/allocTooLarge-gdb.o \
- basis/MLton/bug-gdb.o \
- basis/MLton/errno-gdb.o \
- basis/MLton/exit-gdb.o \
- basis/MLton/profile-gdb.o \
- basis/MLton/rlimit-gdb.o \
- basis/MLton/rusage-gdb.o \
- basis/MLton/spawne-gdb.o \
- basis/MLton/spawnp-gdb.o \
- basis/MLton/size-gdb.o \
- basis/MLton/world-gdb.o \
- basis/Net/Net-gdb.o \
- basis/Net/NetHostDB-gdb.o \
- basis/Net/NetProtDB-gdb.o \
- basis/Net/NetServDB-gdb.o \
- basis/Net/Socket/INetSock-gdb.o \
- basis/Net/Socket/Socket-gdb.o \
- basis/OS/IO/poll-gdb.o \
- basis/PackReal-gdb.o \
- basis/Ptrace-gdb.o \
- basis/Real/class-gdb.o \
- basis/Real/frexp-gdb.o \
- basis/Real/gdtoa-gdb.o \
- basis/Real/modf-gdb.o \
- basis/Real/nextAfter-gdb.o \
- basis/Real/real-gdb.o \
- basis/Real/signBit-gdb.o \
- basis/Real/strto-gdb.o \
- basis/Stdio-gdb.o \
- basis/Thread-gdb.o \
- basis/Time-gdb.o \
- Posix/Error-gdb.o \
- Posix/FileSys/Dirstream-gdb.o \
- Posix/FileSys/ST-gdb.o \
- Posix/FileSys/Stat-gdb.o \
- Posix/FileSys/Utimbuf-gdb.o \
- Posix/FileSys/access-gdb.o \
- Posix/FileSys/chdir-gdb.o \
- Posix/FileSys/chmod-gdb.o \
- Posix/FileSys/chown-gdb.o \
- Posix/FileSys/fchmod-gdb.o \
- Posix/FileSys/fchown-gdb.o \
- Posix/FileSys/fpathconf-gdb.o \
- Posix/FileSys/ftruncate-gdb.o \
- Posix/FileSys/getcwd-gdb.o \
- Posix/FileSys/link-gdb.o \
- Posix/FileSys/mkdir-gdb.o \
- Posix/FileSys/mkfifo-gdb.o \
- Posix/FileSys/open-gdb.o \
- Posix/FileSys/pathconf-gdb.o \
- Posix/FileSys/readlink-gdb.o \
- Posix/FileSys/rename-gdb.o \
- Posix/FileSys/rmdir-gdb.o \
- Posix/FileSys/symlink-gdb.o \
- Posix/FileSys/umask-gdb.o \
- Posix/FileSys/unlink-gdb.o \
- Posix/IO/FLock-gdb.o \
- Posix/IO/close-gdb.o \
- Posix/IO/dup-gdb.o \
- Posix/IO/dup2-gdb.o \
- Posix/IO/fcntl2-gdb.o \
- Posix/IO/fcntl3-gdb.o \
- Posix/IO/fsync-gdb.o \
- Posix/IO/lseek-gdb.o \
- Posix/IO/pipe-gdb.o \
- Posix/IO/read-gdb.o \
- Posix/IO/write-gdb.o \
- Posix/ProcEnv/ProcEnv-gdb.o \
- Posix/ProcEnv/Tms-gdb.o \
- Posix/ProcEnv/Uname-gdb.o \
- Posix/ProcEnv/environ-gdb.o \
- Posix/ProcEnv/getenv-gdb.o \
- Posix/ProcEnv/getgroups-gdb.o \
- Posix/ProcEnv/getlogin-gdb.o \
- Posix/ProcEnv/getpgrp-gdb.o \
- Posix/ProcEnv/isatty-gdb.o \
- Posix/ProcEnv/setenv-gdb.o \
- Posix/ProcEnv/sysconf-gdb.o \
- Posix/ProcEnv/ttyname-gdb.o \
- Posix/Process/alarm-gdb.o \
- Posix/Process/exece-gdb.o \
- Posix/Process/execp-gdb.o \
- Posix/Process/exit-gdb.o \
- Posix/Process/exitStatus-gdb.o \
- Posix/Process/fork-gdb.o \
- Posix/Process/ifExited-gdb.o \
- Posix/Process/ifSignaled-gdb.o \
- Posix/Process/ifStopped-gdb.o \
- Posix/Process/kill-gdb.o \
- Posix/Process/pause-gdb.o \
- Posix/Process/sleep-gdb.o \
- Posix/Process/stopSig-gdb.o \
- Posix/Process/termSig-gdb.o \
- Posix/Process/waitpid-gdb.o \
- Posix/Signal-gdb.o \
- Posix/SysDB/Group-gdb.o \
- Posix/SysDB/Passwd-gdb.o \
- Posix/TTY-gdb.o \
- gc-gdb.o \
- platform-gdb.o \
- platform/$(TARGET_OS)-gdb.o
+CFILES = \
+ $(shell find basis -type f | grep '\.c$$') \
+ $(shell find Posix -type f | grep '\.c$$') \
+ gc.c \
+ platform.c
+
+FILES = $(basename $(CFILES))
+
+EXTRA_FILES = \
+ platform/$(TARGET_OS)
+
+ifeq ($(COMPILE_FAST), yes)
+ OBJS = runtime.o
+ DEBUG_OBJS = runtime-gdb.o
+else
+ OBJS = $(foreach f, $(FILES), $(f).o)
+ DEBUG_OBJS = $(foreach f, $(FILES), $(f)-gdb.o)
+endif
+
+OBJS += $(foreach f, $(EXTRA_FILES), $(f).o)
+DEBUG_OBJS += $(foreach f, $(EXTRA_FILES), $(f)-gdb.o)
all: libgdtoa.a libmlton.a libmlton-gdb.a
@@ -285,6 +79,9 @@
libmlton-gdb.a: $(DEBUG_OBJS)
$(AR) libmlton-gdb.a $(DEBUG_OBJS)
+runtime.c: $(CFILES)
+ cat $(CFILES) >runtime.c
+
# gcc 3.2 is buggy (or maybe we're not following the C spec)
# when compiling Real/*.c with -O2.
basis/Real/%.o: basis/Real/%.c
@@ -305,10 +102,6 @@
.PHONY: clean
clean:
../bin/clean
-
-.PHONY: depend
-depend:
- makedepend -f- -- $(CFLAGS) -- $(SRCS)
.PHONY: gdtoa-patch
gdtoa-patch:
1.200 +17 -4 mlton/runtime/gc.c
Index: gc.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.c,v
retrieving revision 1.199
retrieving revision 1.200
diff -u -r1.199 -r1.200
--- gc.c 26 Aug 2004 03:54:39 -0000 1.199
+++ gc.c 27 Aug 2004 00:50:42 -0000 1.200
@@ -18,12 +18,19 @@
* function entry limit.
*/
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
+
+#ifndef DEBUG_PROFILE
+#define DEBUG_PROFILE FALSE
+#endif
+
enum {
BOGUS_EXN_STACK = 0xFFFFFFFF,
COPY_CHUNK_SIZE = 0x2000000, /* 32M */
CROSS_MAP_EMPTY = 255,
CURRENT_SOURCE_UNDEFINED = 0xFFFFFFFF,
- DEBUG = FALSE,
DEBUG_ARRAY = FALSE,
DEBUG_CARD_MARKING = FALSE,
DEBUG_DETAILED = FALSE,
@@ -31,7 +38,6 @@
DEBUG_GENERATIONAL = FALSE,
DEBUG_MARK_COMPACT = FALSE,
DEBUG_MEM = FALSE,
- DEBUG_PROFILE = FALSE,
DEBUG_RESIZING = FALSE,
DEBUG_STACKS = FALSE,
DEBUG_THREADS = FALSE,
@@ -382,7 +388,7 @@
/* Return time as number of milliseconds. */
static uint currentTime () {
#if (defined(__MSVCRT__))
- return GetTickCount();
+ return GetTickCount ();
#else
struct rusage ru;
@@ -2809,7 +2815,11 @@
void MLton_Rusage_ru ();
#endif
static inline bool needGCTime (GC_state s) {
+#if (defined (__MSVCRT__))
+ return FALSE;
+#else
return DEBUG or s->summary or s->messages or (0 != MLton_Rusage_ru);
+#endif
}
static void doGC (GC_state s,
@@ -2913,8 +2923,11 @@
* The basis library uses it via _ffi, not _prim, and so does not treat it as a
* runtime call -- so the invariant in enter would fail miserably. It is OK
* because GC_startHandler must be called from within a critical section.
+ *
+ * Don't make it inline, because it is also called in basis/Thread.c, and when
+ * compiling with COMPILE_FAST, they may appear out of order.
*/
-inline void GC_startHandler (GC_state s) {
+void GC_startHandler (GC_state s) {
/* Switch to the signal handler thread. */
if (DEBUG_SIGNALS) {
fprintf (stderr, "switching to signal handler\n");
1.13 +3 -3 mlton/runtime/Posix/FileSys/open.c
Index: open.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/FileSys/open.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- open.c 25 Aug 2004 17:51:11 -0000 1.12
+++ open.c 27 Aug 2004 00:50:43 -0000 1.13
@@ -1,8 +1,8 @@
#include "platform.h"
-enum {
- DEBUG = 0,
-};
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
Int Posix_FileSys_open (NullString p, Word w, Mode m) {
Int res;
1.5 +3 -3 mlton/runtime/Posix/ProcEnv/Uname.c
Index: Uname.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/ProcEnv/Uname.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Uname.c 25 Aug 2004 17:51:13 -0000 1.4
+++ Uname.c 27 Aug 2004 00:50:43 -0000 1.5
@@ -1,8 +1,8 @@
#include "platform.h"
-enum {
- DEBUG = 0,
-};
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
static struct utsname utsname;
1.5 +3 -3 mlton/runtime/basis/Date.c
Index: Date.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Date.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Date.c 25 Aug 2004 17:51:16 -0000 1.4
+++ Date.c 27 Aug 2004 00:50:43 -0000 1.5
@@ -1,8 +1,8 @@
#include "platform.h"
-enum {
- DEBUG = 0,
-};
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
static struct tm tm;
static struct tm *tmp;
1.6 +3 -3 mlton/runtime/basis/Time.c
Index: Time.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Time.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Time.c 25 Aug 2004 17:51:16 -0000 1.5
+++ Time.c 27 Aug 2004 00:50:43 -0000 1.6
@@ -1,8 +1,8 @@
#include "platform.h"
-enum {
- DEBUG = 0,
-};
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
static struct timeval timeval;
1.3 +13 -4 mlton/runtime/basis/Int/Word.c
Index: Word.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Int/Word.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Word.c 25 Aug 2004 17:51:17 -0000 1.2
+++ Word.c 27 Aug 2004 00:50:43 -0000 1.3
@@ -24,14 +24,14 @@
* implements / and %.
*/
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
+
#if ! (defined (__i386__) || defined (__sparc__))
#error check that C {/,%} correctly implement {quot,rem} from the basis library
#endif
-enum {
- DEBUG = FALSE,
-};
-
#define coerce(f, t) \
t f##_to##t (f x) { \
return (t)x; \
@@ -104,3 +104,12 @@
all (32)
all (64)
+#undef coerce
+#undef bothCoerce
+#undef binary
+#undef bothBinary
+#undef compare
+#undef bothCompare
+#undef unary
+#undef shift
+#undef all
1.12 +3 -3 mlton/runtime/basis/MLton/profile.c
Index: profile.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/MLton/profile.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- profile.c 25 Aug 2004 17:51:17 -0000 1.11
+++ profile.c 27 Aug 2004 00:50:43 -0000 1.12
@@ -1,8 +1,8 @@
#include "platform.h"
-enum {
- DEBUG_PROFILE = FALSE,
-};
+#ifndef DEBUG_PROFILE
+#define DEBUG_PROFILE FALSE
+#endif
extern struct GC_state gcState;
1.3 +1 -1 mlton/runtime/basis/Net/Socket/UnixSock.c
Index: UnixSock.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Net/Socket/UnixSock.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- UnixSock.c 25 Aug 2004 17:51:18 -0000 1.2
+++ UnixSock.c 27 Aug 2004 00:50:43 -0000 1.3
@@ -38,7 +38,7 @@
int i;
struct sockaddr_un *sa = (struct sockaddr_un*)addr;
- assert(sa->sun_family == AF_UNIX);
+ assert (sa->sun_family == AF_UNIX);
for (i = 0; i < pathlen; i++) {
path[i] = sa->sun_path[i];
}
1.9 +3 -3 mlton/runtime/basis/Real/class.c
Index: class.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Real/class.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- class.c 25 Aug 2004 17:51:19 -0000 1.8
+++ class.c 27 Aug 2004 00:50:44 -0000 1.9
@@ -4,9 +4,9 @@
#include <ieeefp.h>
#endif
-enum {
- DEBUG = FALSE,
-};
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
/* All this code assumes IEEE 754/854 and little endian.
*
1.5 +3 -3 mlton/runtime/basis/Real/gdtoa.c
Index: gdtoa.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Real/gdtoa.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gdtoa.c 25 Aug 2004 17:51:19 -0000 1.4
+++ gdtoa.c 27 Aug 2004 00:50:44 -0000 1.5
@@ -1,9 +1,9 @@
#include "platform.h"
#include "gdtoa/gdtoa.h"
-enum {
- DEBUG = FALSE,
-};
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
#if (defined (__i386__))
#define _0 1
1.3 +284 -30 mlton/runtime/platform/mingw.c
Index: mingw.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/mingw.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mingw.c 26 Aug 2004 03:54:40 -0000 1.2
+++ mingw.c 27 Aug 2004 00:50:44 -0000 1.3
@@ -1,5 +1,7 @@
#include "platform.h"
+#include "showMem.win32.c"
+
int getpagesize (void) {
SYSTEM_INFO sysinfo;
GetSystemInfo(&sysinfo);
@@ -21,6 +23,18 @@
return _open (file_name, _O_CREAT | _O_RDWR, _S_IREAD | _S_IWRITE);
}
+Word32 totalRam (GC_state s) {
+ MEMORYSTATUS memStat;
+
+ memStat.dwLength = sizeof(memStat);
+ GlobalMemoryStatus(&memStat);
+ return memStat.dwTotalPhys;
+}
+
+/* ------------------------------------------------- */
+/* Date */
+/* ------------------------------------------------- */
+
#ifndef __GNUC__
#define EPOCHFILETIME (116444736000000000i64)
#else
@@ -51,12 +65,22 @@
return 0;
}
-Word32 totalRam (GC_state s) {
- MEMORYSTATUS memStat;
+/* ------------------------------------------------- */
+/* MLton.Itimer */
+/* ------------------------------------------------- */
- memStat.dwLength = sizeof(memStat);
- GlobalMemoryStatus(&memStat);
- return memStat.dwTotalPhys;
+int setitimer (int which,
+ const struct itimerval *value,
+ struct itimerval *ovalue) {
+ die ("setitimer not implemented");
+}
+
+/* ------------------------------------------------- */
+/* MLton.Ptrace */
+/* ------------------------------------------------- */
+
+int ptrace (int a, int b, int c, int d) {
+ die ("ptrace not implemented");
}
/* ------------------------------------------------- */
@@ -105,9 +129,26 @@
}
/* ------------------------------------------------- */
+/* MLton.Rusage */
+/* ------------------------------------------------- */
+
+int getrusage (int who, struct rusage *usage) {
+ die ("getrusage not implemented");
+}
+
+/* ------------------------------------------------- */
+/* OS.IO */
+/* ------------------------------------------------- */
+
+int poll (struct pollfd *ufds, unsigned int nfds, int timeout) {
+ die ("poll not implemented");
+}
+
+/* ------------------------------------------------- */
/* Posix.FileSys */
/* ------------------------------------------------- */
+#if FALSE
static void GetWin32FileName (int fd, char* fname) {
HANDLE fh, fhmap;
DWORD fileSize, fileSizeHi;
@@ -126,12 +167,34 @@
}
return;
}
+#endif
+
+int chown (const char *path, uid_t owner, gid_t group) {
+ die ("chown not implemented");
+}
int fchmod (int filedes, mode_t mode) {
- char fname[MAX_PATH + 1];
+ die ("chown not implemented");
+// char fname[MAX_PATH + 1];
+//
+// GetWin32FileName (filedes, fname);
+// return _chmod (fname, mode);
+}
- GetWin32FileName (filedes, fname);
- return _chmod (fname, mode);
+int fchown (int fd, uid_t owner, gid_t group) {
+ die ("fchown not implemented");
+}
+
+long fpathconf (int filedes, int name) {
+ die ("fpathconf not implemented");
+}
+
+int ftruncate (int fd, off_t length) {
+ die ("ftruncate not implemented");
+}
+
+int link (const char *oldpath, const char *newpath) {
+ die ("link not implemented");
}
int lstat (const char *file_name, struct stat *buf) {
@@ -143,6 +206,100 @@
return mkdir (pathname);
}
+int mkfifo (const char *pathname, mode_t mode) {
+ die ("mkfifo not implemented");
+}
+
+long pathconf (char *path, int name) {
+ die ("pathconf not implemented");
+}
+
+int readlink (const char *path, char *buf, size_t bufsiz) {
+ die ("readlink not implemented");
+}
+
+int symlink (const char *oldpath, const char *newpath) {
+ die ("symlink not implemented");
+}
+
+/* ------------------------------------------------- */
+/* Posix.IO */
+/* ------------------------------------------------- */
+
+int fcntl (int fd, int cmd, ...) {
+ die ("fcntl not implemented");
+}
+
+int fsync (int fd) {
+ die ("fsync not implemented");
+}
+
+int pipe (int filedes[2]) {
+ die ("pipe not implemented");
+}
+
+/* ------------------------------------------------- */
+/* Posix.ProcEnv */
+/* ------------------------------------------------- */
+
+char *ctermid (char *s) {
+ die ("*ctermid not implemented");
+}
+gid_t getegid (void) {
+ die ("getegid not implemented");
+}
+uid_t geteuid (void) {
+ die ("geteuid not implemented");
+}
+gid_t getgid (void) {
+ die ("getgid not implemented");
+}
+int getgroups (int size, gid_t list[]) {
+ die ("getgroups not implemented");
+}
+char *getlogin (void) {
+ die ("*getlogin not implemented");
+}
+pid_t getpgid(pid_t pid) {
+ die ("getpgid not implemented");
+}
+pid_t getpgrp(void) {
+ die ("getpgrp not implemented");
+}
+pid_t getpid (void) {
+ die ("getpid not implemented");
+}
+pid_t getppid (void) {
+ die ("getppid not implemented");
+}
+uid_t getuid (void) {
+ die ("getuid not implemented");
+}
+int setenv (const char *name, const char *value, int overwrite) {
+ die ("setenv not implemented");
+}
+int setgid (gid_t gid) {
+ die ("setgid not implemented");
+}
+pid_t setsid (void) {
+ die ("setsid not implemented");
+}
+int setuid (uid_t uid) {
+ die ("setuid not implemented");
+}
+long sysconf (int name) {
+ die ("sysconf not implemented");
+}
+clock_t times (struct tms *buf) {
+ die ("times not implemented");
+}
+char *ttyname (int desc) {
+ die ("*ttyname not implemented");
+}
+int uname (struct utsname *buf) {
+ die ("uname not implemented");
+}
+
/* ------------------------------------------------- */
/* Posix.Process */
/* ------------------------------------------------- */
@@ -194,6 +351,26 @@
return remaining;
}
+pid_t fork (void) {
+ die ("fork not implemented");
+}
+
+int kill (pid_t pid, int sig) {
+ die ("kill not implemented");
+}
+
+int pause (void) {
+ die ("pause not implemented");
+}
+
+unsigned int sleep (unsigned int seconds) {
+ die ("int not implemented");
+}
+
+pid_t wait (int *status) {
+ die ("wait not implemented");
+}
+
pid_t waitpid (pid_t pid, int *status, int options) {
return _cwait (status, pid, options);
}
@@ -202,12 +379,26 @@
/* Signals */
/* ------------------------------------------------- */
-int sigismember (const sigset_t *set, const int signum) {
+int sigaction (int signum,
+ const struct sigaction *newact,
+ struct sigaction *oldact) {
+
+ struct sigaction oa;
+
if (signum < 0 or signum >= NSIG) {
errno = EINVAL;
return -1;
}
- return (*set & SIGTOMASK(signum)) ? 1 : 0;
+ if (newact) {
+ if (signum == SIGKILL || signum == SIGSTOP) {
+ errno = EINVAL;
+ return -1;
+ }
+ oa.sa_handler = signal (signum, newact->sa_handler);
+ }
+ if (oldact)
+ oldact->sa_handler = oa.sa_handler;
+ return 0;
}
int sigaddset (sigset_t *set, const int signum) {
@@ -238,26 +429,16 @@
return 0;
}
-int sigaction (int signum,
- const struct sigaction *newact,
- struct sigaction *oldact) {
-
- struct sigaction oa;
-
+int sigismember (const sigset_t *set, const int signum) {
if (signum < 0 or signum >= NSIG) {
errno = EINVAL;
return -1;
}
- if (newact) {
- if (signum == SIGKILL || signum == SIGSTOP) {
- errno = EINVAL;
- return -1;
- }
- oa.sa_handler = signal (signum, newact->sa_handler);
- }
- if (oldact)
- oldact->sa_handler = oa.sa_handler;
- return 0;
+ return (*set & SIGTOMASK(signum)) ? 1 : 0;
+}
+
+int sigpending (sigset_t *set) {
+ die ("sigpending not implemented");
}
int sigprocmask (int how, const sigset_t *set, sigset_t *oldset) {
@@ -291,6 +472,10 @@
return 0;
}
+int sigsuspend (const sigset_t *mask) {
+ die ("sigsuspend not implemented");
+}
+
/* ------------------------------------------------- */
/* Posix.SysDB.Passwd */
/* ------------------------------------------------- */
@@ -300,11 +485,20 @@
static struct passwd passwd;
+struct group *getgrgid (gid_t gid) {
+ die ("getgrgid not implemented");
+}
+
+struct group *getgrnam (const char *name) {
+ die ("getgrnam not implemented");
+}
+
struct passwd *getpwnam (const char *name) {
- unless (NERR_Success ==
- NetUserGetInfo (NULL, (LPCWSTR)name, INFO_LEVEL,
- (LPBYTE*)&usrData))
- return NULL;
+ return NULL;
+// unless (NERR_Success ==
+// NetUserGetInfo (NULL, (LPCWSTR)name, INFO_LEVEL,
+// (LPBYTE*)&usrData))
+// return NULL;
passwd.pw_dir = (char*)usrData->usri3_home_dir;
passwd.pw_gid = usrData->usri3_primary_group_id;
passwd.pw_name = (char*)usrData->usri3_name;
@@ -318,8 +512,68 @@
}
/* ------------------------------------------------- */
+/* Posix.TTY */
+/* ------------------------------------------------- */
+
+speed_t cfgetispeed (struct termios *termios_p) {
+ die ("cfgetispeed not implemented");
+}
+
+speed_t cfgetospeed (struct termios *termios_p) {
+ die ("cfgetospeed not implemented");
+}
+
+int cfsetispeed (struct termios *termios_p, speed_t speed) {
+ die ("cfsetispeed not implemented");
+}
+
+int cfsetospeed (struct termios *termios_p, speed_t speed) {
+ die ("cfsetospeed not implemented");
+}
+
+int tcdrain (int fd) {
+ die ("tcdrain not implemented");
+}
+
+int tcflow (int fd, int action) {
+ die ("tcflow not implemented");
+}
+
+int tcflush (int fd, int queue_selector) {
+ die ("tcflush not implemented");
+}
+
+int tcgetattr (int fd, struct termios *termios_p) {
+ die ("tcgetattr not implemented");
+}
+
+pid_t tcgetpgrp (int fd) {
+ die ("tcgetpgrp not implemented");
+}
+
+int tcsendbreak (int fd, int duration) {
+ die ("tcsendbreak not implemented");
+}
+
+int tcsetattr (int fd, int optional_actions, struct termios *termios_p) {
+ die ("tcsetattr not implemented");
+}
+
+int tcsetpgrp (int fd, pid_t pgrpid) {
+ die ("tcsetpgrp not implemented");
+}
+
+/* ------------------------------------------------- */
/* Socket */
/* ------------------------------------------------- */
+
+int ioctl (int d, int request, ...) {
+ die ("ioctl not implemented");
+}
+
+int socketpair (int d, int type, int protocol, int sv[2]) {
+ die ("socketpair not implemented");
+}
void MLton_initSockets () {
static Bool isInitialized = FALSE;
1.4 +13 -25 mlton/runtime/platform/mingw.h
Index: mingw.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/mingw.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mingw.h 26 Aug 2004 17:15:22 -0000 1.3
+++ mingw.h 27 Aug 2004 00:50:44 -0000 1.4
@@ -3,7 +3,7 @@
#include <limits.h>
#include <lm.h>
#include <process.h>
-#include <psapi.h>
+//#include <psapi.h>
#include <sys/stat.h>
#include <sys/timeb.h>
#include <sys/types.h>
@@ -24,9 +24,7 @@
typedef unsigned short uid_t;
int getpagesize (void);
-int ioctl (int d, int request, ...);
int mkstemp (char *template);
-int socketpair (int d, int type, int protocol, int sv[2]);
#define POLLIN 1
#define POLLPRI 2
@@ -175,26 +173,6 @@
#define S_ISLNK(m) FALSE
#define S_ISSOCK(m) FALSE
-//static inline int chmod (const char *path, mode_t mode) {
-// return _chmod (path, mode);
-//}
-
-//static inline int mkdir (const char *pathname, mode_t mode) {
-// return _mkdir (pathname);
-//}
-
-//static inline int rmdir (const char *pathname) {
-// return _rmdir (pathname);
-//}
-
-//static inline mode_t umask (mode_t mask) {
-// return _umask (mask);
-//}
-
-//static inline int unlink (const char *pathname) {
-// return _unlink (pathname);
-//}
-
int chown (const char *path, uid_t owner, gid_t group);
int fchmod (int filedes, mode_t mode);
int fchown (int fd, uid_t owner, gid_t group);
@@ -205,7 +183,7 @@
int mkfifo (const char *pathname, mode_t mode);
long pathconf (char *path, int name);
int readlink (const char *path, char *buf, size_t bufsiz);
-int symlink(const char *oldpath, const char *newpath);
+int symlink (const char *oldpath, const char *newpath);
/* ------------------------------------------------- */
/* Posix.IO */
@@ -523,7 +501,17 @@
/* ------------------------------------------------- */
#define MSG_DONTWAIT 0
-struct sockaddr_un {};
+#define UNIX_PATH_MAX 108
+
+typedef unsigned short sa_family_t;
+
+struct sockaddr_un {
+ sa_family_t sun_family;
+ char sun_path[UNIX_PATH_MAX];
+};
+
+int ioctl (int d, int request, ...);
+int socketpair (int d, int type, int protocol, int sv[2]);
/* ------------------------------------------------- */
/* Syslog */