[MLton] Finished (?) MLton.Child
Wesley W. Terpstra
terpstra@gkec.tu-darmstadt.de
Sun, 28 Nov 2004 00:27:09 +0100
--nFreZHaLTZJo0R7j
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
On Thu, Nov 25, 2004 at 11:53:50AM -0800, Stephen Weeks wrote:
> > carrot:~$ mlton test.sml
> > call to system failed with Function not implemented:
> > gcc -c -I/usr/lib/mlton/include -O1 ....
> >
> > Any ideas? It's stopping me from testing the current CVS.
>
> Whoops. I switched the test on forkIsEnabled in posix/process.sml.
> I've checked in a fix.
Now when I rebuild cvs/HEAD mlton under cygwin for cygwin I still get an
unusable compiler (with default options):
call to system failed with exit status 80:
gcc -c -I/home/terpstra/src/mlton/head/build/bin/../lib/include -O1
-fno-strict-aliasing -fomit-frame-pointer -w -fno-strength-reduce
-fschedule-insns -fschedule-insns2 -malign-functions=5 -malign-jumps=2
-malign-loops=2 -mcpu=pentiumpro -o /tmp/fileE2X1rE.o /tmp/fileieAdg1.1.c
Using 'mlton @MLton use-mmap -- test.sml' does succeed in building.
It also now works in linux again.
Why is system() and/or spawn() broken?
My patch did not touch these.
Using mlton+mmap compiles, but the resulting binary is also FUBAR'd.
When run with '@MLton use-mmap --' I get:
unhandled exception: SysErr: Function not implemented [nosys]
What function is unimplemented?
This is cygwin+mmap! This worked with my patch.
I have not tried mingw at all since it takes me about three hours to rebuild
mlton under windows and I got quite frustrated after repeated problems.
I don't understand what is going on! The patch I sent you did not cause any
of these problems on my systems and I tested it very thoroughly.
I was trying to prepare a patch to make cygwin+VirtualAlloc+CreateProcess
work. However, I am unable to test it because the cvs compiler is unusable
under cygwin. I have attached it in case your compiler still works.
--
Wesley W. Terpstra <wesley@terpstra.ca>
--nFreZHaLTZJo0R7j
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="cygwin-cp.patch"
? tmp.c
? mlton/1548.sml
? mlton/2112.sml
? mlton/2272
? mlton/2272.sml
? mlton/2380.sml
? mlton/2496.sml
? mlton/256.sml
? mlton/2764.sml
? mlton/3040.sml
? mlton/3728.sml
? mlton/3840.sml
? mlton/692.sml
? mlton/mlton-compile.stackdump
Index: basis-library/misc/primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.132
diff -u -r1.132 primitive.sml
--- basis-library/misc/primitive.sml 25 Nov 2004 04:39:58 -0000 1.132
+++ basis-library/misc/primitive.sml 27 Nov 2004 22:52:08 -0000
@@ -927,6 +927,12 @@
val create =
_import "MLton_Process_create"
: NullString.t * NullString.t * int * int * int -> Pid.t;
+ val terminate =
+ _import "MLton_Process_terminate"
+ : Pid.t * int -> int;
+ val cwait =
+ _import "MLton_Process_cwait"
+ : Pid.t * int ref -> Pid.t;
val spawne =
_import "MLton_Process_spawne"
: (NullString.t * NullString.t array * NullString.t array
Index: basis-library/mlton/process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/process.sml,v
retrieving revision 1.17
diff -u -r1.17 process.sml
--- basis-library/mlton/process.sml 25 Nov 2004 04:39:58 -0000 1.17
+++ basis-library/mlton/process.sml 27 Nov 2004 22:52:08 -0000
@@ -186,7 +186,27 @@
in
DynamicWind.wind (fn () => f x, fn () => Mask.unblock Mask.all)
end
-
+
+ local
+ fun sys (pid, status) =
+ SysCall.syscall
+ (fn () =>
+ let
+ val p = Prim.cwait (pid, status)
+ val p' = Pid.toInt p
+ in
+ (p', fn () => p)
+ end)
+ in
+ fun cwait pid =
+ let
+ val status: int ref = ref 0
+ val pid = sys (pid, status)
+ in
+ (pid, Process.fromStatus (Exit.Status.fromInt (!status)))
+ end
+ end
+
fun reap (T {pid, status, stderr, stdin, stdout}) =
case !status of
NONE =>
@@ -195,18 +215,28 @@
(* protect is probably too much; typically, one
* would only mask SIGINT, SIGQUIT and SIGHUP
*)
- val (_, st) = protect Process.waitpid (Process.W_CHILD pid, [])
+ val (_, st) =
+ if useWindowsProcess
+ then cwait pid
+ else protect Process.waitpid (Process.W_CHILD pid, [])
val () = status := SOME st
in
st
end
| SOME status => status
+ fun terminate (pid, s) =
+ SysCall.simple
+ (fn () => Prim.terminate (pid, PosixSignal.toInt s))
+
fun kill (p as T {pid, status, ...}, signal) =
case !status of
NONE =>
let
- val () = Process.kill (Process.K_PROC pid, signal)
+ val () =
+ if useWindowsProcess
+ then terminate (pid, signal)
+ else Process.kill (Process.K_PROC pid, signal)
in
ignore (reap p)
end
Index: runtime/platform.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform.h,v
retrieving revision 1.11
diff -u -r1.11 platform.h
--- runtime/platform.h 25 Nov 2004 04:39:59 -0000 1.11
+++ runtime/platform.h 27 Nov 2004 22:52:11 -0000
@@ -392,8 +392,12 @@
/* MLton.Process */
/* ---------------------------------- */
+/* these are different pids are should stick together */
Pid MLton_Process_create (NullString cmds, NullString envs,
Fd in, Fd out, Fd err);
+Int MLton_Process_terminate(Pid p, Int s);
+Pid MLton_Process_cwait(Pid p, Pointer s);
+
Int MLton_Process_spawne (NullString p, Pointer a, Pointer e);
Int MLton_Process_spawnp (NullString p, Pointer a);
Index: runtime/platform/create.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/create.c,v
retrieving revision 1.1
diff -u -r1.1 create.c
--- runtime/platform/create.c 25 Nov 2004 01:35:49 -0000 1.1
+++ runtime/platform/create.c 27 Nov 2004 22:52:11 -0000
@@ -1,7 +1,7 @@
static HANDLE dupHandle (int fd) {
HANDLE raw, dupd;
- raw = (HANDLE)_get_osfhandle (fd);
+ raw = (HANDLE)GET_OSFHANDLE(fd);
if (raw == (HANDLE)-1 || raw == 0) {
errno = EBADF;
return 0;
@@ -79,3 +79,17 @@
return result;
}
+Int MLton_Process_terminate(Pid pid, Int sig) {
+ HANDLE h;
+
+ h = (HANDLE)pid;
+ /* We terminate with 'sig' for the _return_ code + 0x80
+ * Then in the basis library I test for this to decide W_SIGNALED.
+ * Perhaps not the best choice, but I have no better idea.
+ */
+ unless (TerminateProcess (h, sig | 0x80)) {
+ errno = ECHILD;
+ return -1;
+ }
+ return 0;
+}
Index: runtime/platform/cygwin.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/cygwin.c,v
retrieving revision 1.5
diff -u -r1.5 cygwin.c
--- runtime/platform/cygwin.c 25 Nov 2004 04:39:59 -0000 1.5
+++ runtime/platform/cygwin.c 27 Nov 2004 22:52:11 -0000
@@ -1,5 +1,6 @@
#include "platform.h"
+#include "create.c"
#include "getrusage.c"
#include "mkdir2.c"
#include "mmap.c"
@@ -36,4 +37,12 @@
void Posix_IO_settext (Fd fd) {
/* cygwin has a different method for working with its fds */
setmode (fd, O_TEXT);
+}
+
+Pid MLton_Process_cwait(Pid pid, Pointer status) {
+ HANDLE h;
+
+ h = (HANDLE)pid;
+ /* -1 on error, the casts here are due to bad types on both sides */
+ return cwait((int*)status, (int)h, 0);
}
Index: runtime/platform/cygwin.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/cygwin.h,v
retrieving revision 1.7
diff -u -r1.7 cygwin.h
--- runtime/platform/cygwin.h 25 Nov 2004 04:39:59 -0000 1.7
+++ runtime/platform/cygwin.h 27 Nov 2004 22:52:11 -0000
@@ -31,6 +31,7 @@
#define HAS_TIME_PROFILING FALSE
#define HAS_WEAK 0
#define USE_VIRTUAL_ALLOC TRUE
+#define GET_OSFHANDLE get_osfhandle
#define _SC_BOGUS 0xFFFFFFFF
#define _SC_2_FORT_DEV _SC_BOGUS
Index: runtime/platform/mingw.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/mingw.c,v
retrieving revision 1.8
diff -u -r1.8 mingw.c
--- runtime/platform/mingw.c 25 Nov 2004 04:39:59 -0000 1.8
+++ runtime/platform/mingw.c 27 Nov 2004 22:52:12 -0000
@@ -427,18 +427,7 @@
}
int kill (pid_t pid, int sig) {
- HANDLE h;
-
- h = (HANDLE)pid;
- /* We terminate with 'sig' for the _return_ code + 0x80
- * Then in the basis library I test for this to decide W_SIGNALED.
- * Perhaps not the best choice, but I have no better idea.
- */
- unless (TerminateProcess (h, sig | 0x80)) {
- errno = ECHILD;
- return -1;
- }
- return 0;
+ return MLton_Process_terminate(pid, sig);
}
int pause (void) {
@@ -454,12 +443,16 @@
die ("wait not implemented");
}
-pid_t waitpid (pid_t pid, int *status, int options) {
+pid_t MLton_Process_cwait(pid_t pid, int* status) {
HANDLE h;
-
+
h = (HANDLE)pid;
/* -1 on error, the casts here are due to bad types on both sides */
- return _cwait (status, (_pid_t)h, 0);
+ return _cwait(status, (_pid_t)h, 0);
+}
+
+pid_t waitpid (pid_t pid, int *status, int options) {
+ return MLton_Process_cwait(pid, status);
}
/* ------------------------------------------------- */
Index: runtime/platform/mingw.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/mingw.h,v
retrieving revision 1.9
diff -u -r1.9 mingw.h
--- runtime/platform/mingw.h 25 Nov 2004 01:35:49 -0000 1.9
+++ runtime/platform/mingw.h 27 Nov 2004 22:52:12 -0000
@@ -20,6 +20,7 @@
#define HAS_TIME_PROFILING FALSE
#define HAS_WEAK FALSE
#define USE_VIRTUAL_ALLOC TRUE
+#define GET_OSFHANDLE _get_osfhandle
#define MLton_Platform_OS_host "mingw"
--nFreZHaLTZJo0R7j--