[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                       */