[project @ 2001-06-12 17:19:34 by rrt]

[ghc-hetmet.git] / ghc / lib / std / cbits / system.c

diff --git a/ghc/lib/std/cbits/system.c b/ghc/lib/std/cbits/system.c
index dddf993..b35b2b5 100644 (file)
--- a/ghc/lib/std/cbits/system.c
+++ b/ghc/lib/std/cbits/system.c
@@ -1,69 +1,43 @@
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: system.c,v 1.7 2000/03/17 09:48:48 simonmar Exp $
+ * $Id: system.c,v 1.14 2001/06/12 17:19:34 rrt Exp $
  *
  * system Runtime Support
  */
 
-#include "Rts.h"
-#include "stgio.h"
+/* The itimer stuff in this module is non-posix */
+#define NON_POSIX_SOURCE
 
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#if TIME_WITH_SYS_TIME
-# include <sys/time.h>
-# include <time.h>
-#else
-# if HAVE_SYS_TIME_H
-#  include <sys/time.h>
-# else
-#  include <time.h>
-# endif
-#endif
-
-#ifndef mingw32_TARGET_OS
-# ifdef HAVE_SYS_WAIT_H
-#  include <sys/wait.h>
-# endif
-#endif
-
-#ifdef HAVE_VFORK_H
-#include <vfork.h>
-#endif
+#include "HsStd.h"
 
-#ifdef HAVE_VFORK
-#define fork vfork
+#if defined(mingw32_TARGET_OS)
+#include <windows.h>
 #endif
 
-StgInt
-systemCmd(StgByteArray cmd)
+HsInt
+systemCmd(HsAddr cmd)
 {
 #if defined(mingw32_TARGET_OS)
-  if (system(cmd) < 0) {
-     cvtErrno();
-     stdErrno();
-     return -1;
-  }
-  sleep(1);
-  return 0;
-#else
-#if defined(cygwin32_TARGET_OS)
-   /* The implementation of std. fork() has its problems
-      under cygwin32-b18, so we fall back on using libc's
-      system() instead. (It in turn has problems, as it
-      does not wait until the sub shell has finished before
-      returning. Using sleep() works around that.)
-  */
-  if (system(cmd) < 0) {
-     cvtErrno();
-     stdErrno();
-     return -1;
-  }
-  sleep(1);
-  return 0;
+  STARTUPINFO sInfo;
+  PROCESS_INFORMATION pInfo;
+  DWORD retCode;
+
+  sInfo.cb              = sizeof(STARTUPINFO);
+  sInfo.lpReserved      = NULL;
+  sInfo.lpReserved2     = NULL;
+  sInfo.cbReserved2     = 0;
+  sInfo.lpDesktop       = NULL;
+  sInfo.lpTitle         = NULL;
+  sInfo.dwFlags         = 0;
+
+  if (!CreateProcess(NULL, cmd, NULL, NULL, FALSE, 0, NULL, NULL, &sInfo, &pInfo))
+    return -1;
+  WaitForSingleObject(pInfo.hProcess, INFINITE);
+  if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) return -1;
+  CloseHandle(pInfo.hProcess);
+  CloseHandle(pInfo.hThread);
+  return retCode;
 #else
     int pid;
     int wstat;
@@ -71,12 +45,11 @@ systemCmd(StgByteArray cmd)
     switch(pid = fork()) {
     case -1:
        if (errno != EINTR) {
-           cvtErrno();
-           stdErrno();
            return -1;
        }
     case 0:
       {
+#ifdef HAVE_SETITIMER
        /* Reset the itimers in the child, so it doesn't get plagued
         * by SIGVTALRM interrupts.
         */
@@ -87,6 +60,7 @@ systemCmd(StgByteArray cmd)
        setitimer(ITIMER_REAL, &itv, NULL);
        setitimer(ITIMER_VIRTUAL, &itv, NULL);
        setitimer(ITIMER_PROF, &itv, NULL);
+#endif
 
        /* the child */
        execl("/bin/sh", "sh", "-c", cmd, NULL);
@@ -96,8 +70,6 @@ systemCmd(StgByteArray cmd)
 
     while (waitpid(pid, &wstat, 0) < 0) {
        if (errno != EINTR) {
-           cvtErrno();
-           stdErrno();
            return -1;
        }
     }
@@ -105,15 +77,11 @@ systemCmd(StgByteArray cmd)
     if (WIFEXITED(wstat))
        return WEXITSTATUS(wstat);
     else if (WIFSIGNALED(wstat)) {
-       ghc_errtype = ERR_INTERRUPTED;
-       ghc_errstr = "system command interrupted";
+       errno = EINTR;
     }
     else {
        /* This should never happen */
-       ghc_errtype = ERR_OTHERERROR;
-       ghc_errstr = "internal error (process neither exited nor signalled)";
     }
     return -1;
 #endif
-#endif
 }