[project @ 2004-09-29 15:46:53 by simonmar]
[haskell-directory.git] / cbits / rawSystem.c
index 6402af4..0aac633 100644 (file)
@@ -1,15 +1,22 @@
 /* 
- * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
+ * (c) The University of Glasgow 1994-2004
  *
- * $Id: rawSystem.c,v 1.1 2002/08/28 13:59:19 simonmar Exp $
- *
- * shell-less system Runtime Support
+ * shell-less system Runtime Support (see System.Cmd.rawSystem).
  */
 
 /* The itimer stuff in this module is non-posix */
 /* #include "PosixSource.h" */
 
+/* This ifdef is required because this source might be compiled by an
+ * external compiler.  See ghc/utils/runghc/rawSystem.c for example.
+ */
+#ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ < 603
 #include "config.h"
+#else
+#include "ghcconfig.h"
+#endif
+#endif
 
 #include <stdio.h>
 #include <stdlib.h>
 #include <windows.h>
 #endif
 
+#ifdef HAVE_VFORK_H
+#include <vfork.h>
+#endif
+
+#ifdef HAVE_VFORK
+#define fork vfork
+#endif
+
+#if defined(mingw32_TARGET_OS)
+/* -------------------- WINDOWS VERSION --------------------- */
+
 HsInt
-rawSystemCmd(HsAddr cmd)
+rawSystem(HsAddr cmd)
 {
-  /* -------------------- WINDOWS VERSION --------------------- */
-#if defined(mingw32_TARGET_OS)
   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;
+  ZeroMemory(&sInfo, sizeof(sInfo));
+  sInfo.cb = sizeof(sInfo);
 
-  if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &sInfo, &pInfo))
+  if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &sInfo, &pInfo)) {
     /* The 'TRUE' says that the created process should share
        handles with the current process.  This is vital to ensure
        that error messages sent to stderr actually appear on the screen.
        Since we are going to wait for the process to terminate anyway,
        there is no problem with such sharing. */
 
-    return -1;
+      errno = EINVAL; // ToDo: wrong, caller should use GetLastError()
+      return -1;
+  }
   WaitForSingleObject(pInfo.hProcess, INFINITE);
-  if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) return -1;
+  if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) {
+      errno = EINVAL; // ToDo: wrong, caller should use GetLastError()
+      return -1;
+  }
+
   CloseHandle(pInfo.hProcess);
   CloseHandle(pInfo.hThread);
   return retCode;
+}
 
 #else
-  /* -------------------- UNIX VERSION --------------------- */
+/* -------------------- UNIX VERSION --------------------- */
+
+HsInt
+rawSystem(HsAddr cmd, HsAddr args)
+{
     int pid;
     int wstat;
 
     switch(pid = fork()) {
     case -1:
-       if (errno != EINTR) {
+       {
            return -1;
        }
     case 0:
@@ -98,7 +120,7 @@ rawSystemCmd(HsAddr cmd)
 #endif
 
        /* the child */
-       execl(cmd, NULL);
+       execvp(cmd, args);
        _exit(127);
       }
     }
@@ -118,5 +140,5 @@ rawSystemCmd(HsAddr cmd)
        /* This should never happen */
     }
     return -1;
-#endif
 }
+#endif