[project @ 1998-04-10 11:33:12 by simonm]

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

diff --git a/ghc/lib/std/cbits/system.lc b/ghc/lib/std/cbits/system.lc
new file mode 100644 (file)
index 0000000..924c8d4
--- /dev/null
+++ b/ghc/lib/std/cbits/system.lc
@@ -0,0 +1,81 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1995
+%
+\subsection[system.lc]{system Runtime Support}
+
+\begin{code}
+
+#include "rtsdefs.h"
+#include "stgio.h"
+
+#ifdef HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+
+#ifdef HAVE_VFORK_H
+#include <vfork.h>
+#endif
+
+#ifdef HAVE_VFORK
+#define fork vfork
+#endif
+
+StgInt
+systemCmd(cmd)
+StgByteArray cmd;
+{
+#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;
+#else
+    int pid;
+    int wstat;
+
+    switch(pid = fork()) {
+    case -1:
+       if (errno != EINTR) {
+           cvtErrno();
+           stdErrno();
+           return -1;
+       }
+    case 0:
+       /* the child */
+       execl("/bin/sh", "sh", "-c", cmd, NULL);
+       _exit(127);
+    }
+
+    while (waitpid(pid, &wstat, 0) < 0) {
+       if (errno != EINTR) {
+           cvtErrno();
+           stdErrno();
+           return -1;
+       }
+    }
+
+    if (WIFEXITED(wstat))
+       return WEXITSTATUS(wstat);
+    else if (WIFSIGNALED(wstat)) {
+       ghc_errtype = ERR_INTERRUPTED;
+       ghc_errstr = "system command interrupted";
+    }
+    else {
+       /* This should never happen */
+       ghc_errtype = ERR_OTHERERROR;
+       ghc_errstr = "internal error (process neither exited nor signalled)";
+    }
+    return -1;
+#endif
+}
+
+\end{code}