[MLton-commit] r7155

[Matthew Fluet]

Add Windows_Process_getexitcode for implementing MLton.Process.reap.
----------------------------------------------------------------------

U   mlton/trunk/basis-library/primitive/basis-ffi.sml
U   mlton/trunk/runtime/basis-ffi.h
U   mlton/trunk/runtime/gen/basis-ffi.def
U   mlton/trunk/runtime/gen/basis-ffi.h
U   mlton/trunk/runtime/gen/basis-ffi.sml
U   mlton/trunk/runtime/platform/windows.c

----------------------------------------------------------------------

Modified: mlton/trunk/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/trunk/basis-library/primitive/basis-ffi.sml	2009-06-17 16:22:56 UTC (rev 7154)
+++ mlton/trunk/basis-library/primitive/basis-ffi.sml	2009-06-17 16:35:44 UTC (rev 7155)
@@ -1142,6 +1142,7 @@
 structure Process = 
 struct
 val create = _import "Windows_Process_create" private : NullString8.t * NullString8.t * NullString8.t * C_Fd.t * C_Fd.t * C_Fd.t -> (C_PId.t) C_Errno.t;
+val getexitcode = _import "Windows_Process_getexitcode" private : C_PId.t * (C_Status.t) ref -> (C_Int.t) C_Errno.t;
 val terminate = _import "Windows_Process_terminate" private : C_PId.t * C_Signal.t -> (C_Int.t) C_Errno.t;
 end
 end

Modified: mlton/trunk/runtime/basis-ffi.h
===================================================================
--- mlton/trunk/runtime/basis-ffi.h	2009-06-17 16:22:56 UTC (rev 7154)
+++ mlton/trunk/runtime/basis-ffi.h	2009-06-17 16:35:44 UTC (rev 7155)
@@ -934,6 +934,7 @@
 PRIVATE void Stdio_printStdout(String8_t);
 PRIVATE C_Int_t Time_getTimeOfDay(Ref(C_Time_t),Ref(C_SUSeconds_t));
 PRIVATE C_Errno_t(C_PId_t) Windows_Process_create(NullString8_t,NullString8_t,NullString8_t,C_Fd_t,C_Fd_t,C_Fd_t);
+PRIVATE C_Errno_t(C_Int_t) Windows_Process_getexitcode(C_PId_t,Ref(C_Status_t));
 PRIVATE C_Errno_t(C_Int_t) Windows_Process_terminate(C_PId_t,C_Signal_t);
 MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_add(Word16_t,Word16_t);
 MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_andb(Word16_t,Word16_t);

Modified: mlton/trunk/runtime/gen/basis-ffi.def
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.def	2009-06-17 16:22:56 UTC (rev 7154)
+++ mlton/trunk/runtime/gen/basis-ffi.def	2009-06-17 16:35:44 UTC (rev 7155)
@@ -824,6 +824,7 @@
 Stdio.printStdout = _import PRIVATE : String8.t -> unit
 Time.getTimeOfDay = _import PRIVATE : C_Time.t ref * C_SUSeconds.t ref -> C_Int.t
 Windows.Process.create = _import PRIVATE : NullString8.t * NullString8.t * NullString8.t * C_Fd.t * C_Fd.t * C_Fd.t -> C_PId.t C_Errno.t
+Windows.Process.getexitcode = _import PRIVATE : C_PId.t * C_Status.t ref -> C_Int.t C_Errno.t
 Windows.Process.terminate = _import PRIVATE : C_PId.t * C_Signal.t -> C_Int.t C_Errno.t
 ##
 Real32.Math.acos = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t

Modified: mlton/trunk/runtime/gen/basis-ffi.h
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.h	2009-06-17 16:22:56 UTC (rev 7154)
+++ mlton/trunk/runtime/gen/basis-ffi.h	2009-06-17 16:35:44 UTC (rev 7155)
@@ -934,6 +934,7 @@
 PRIVATE void Stdio_printStdout(String8_t);
 PRIVATE C_Int_t Time_getTimeOfDay(Ref(C_Time_t),Ref(C_SUSeconds_t));
 PRIVATE C_Errno_t(C_PId_t) Windows_Process_create(NullString8_t,NullString8_t,NullString8_t,C_Fd_t,C_Fd_t,C_Fd_t);
+PRIVATE C_Errno_t(C_Int_t) Windows_Process_getexitcode(C_PId_t,Ref(C_Status_t));
 PRIVATE C_Errno_t(C_Int_t) Windows_Process_terminate(C_PId_t,C_Signal_t);
 MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_add(Word16_t,Word16_t);
 MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_andb(Word16_t,Word16_t);

Modified: mlton/trunk/runtime/gen/basis-ffi.sml
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.sml	2009-06-17 16:22:56 UTC (rev 7154)
+++ mlton/trunk/runtime/gen/basis-ffi.sml	2009-06-17 16:35:44 UTC (rev 7155)
@@ -1142,6 +1142,7 @@
 structure Process = 
 struct
 val create = _import "Windows_Process_create" private : NullString8.t * NullString8.t * NullString8.t * C_Fd.t * C_Fd.t * C_Fd.t -> (C_PId.t) C_Errno.t;
+val getexitcode = _import "Windows_Process_getexitcode" private : C_PId.t * (C_Status.t) ref -> (C_Int.t) C_Errno.t;
 val terminate = _import "Windows_Process_terminate" private : C_PId.t * C_Signal.t -> (C_Int.t) C_Errno.t;
 end
 end

Modified: mlton/trunk/runtime/platform/windows.c
===================================================================
--- mlton/trunk/runtime/platform/windows.c	2009-06-17 16:22:56 UTC (rev 7154)
+++ mlton/trunk/runtime/platform/windows.c	2009-06-17 16:35:44 UTC (rev 7155)
@@ -399,6 +399,21 @@
         return result;
 }
 
+C_Errno_t(C_Int_t) Windows_Process_getexitcode (C_PId_t pid, Ref(C_Status_t) status) {
+        HANDLE h;
+
+        h = (HANDLE)pid;
+        unless (WaitForSingleObject (h, INFINITE) == WAIT_OBJECT_0) {
+                errno = ECHILD;
+                return -1;
+        }
+        unless (GetExitCodeProcess (h, (DWORD*)status)) {
+                errno = ECHILD;
+                return -1;
+        }
+        return 0;
+}
+
 C_Errno_t(C_Int_t) Windows_Process_terminate (C_PId_t pid, C_Signal_t sig) {
         HANDLE h;