summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hadrian/bindist/cwrappers/cwrapper.c161
-rw-r--r--hadrian/bindist/cwrappers/cwrapper.h7
-rw-r--r--hadrian/bindist/cwrappers/getLocation.c40
-rw-r--r--hadrian/bindist/cwrappers/getLocation.h4
-rw-r--r--hadrian/bindist/cwrappers/version-wrapper.c14
-rw-r--r--hadrian/bindist/version-wrapper.hs17
-rw-r--r--hadrian/src/Rules/BinaryDist.hs11
7 files changed, 232 insertions, 22 deletions
diff --git a/hadrian/bindist/cwrappers/cwrapper.c b/hadrian/bindist/cwrappers/cwrapper.c
new file mode 100644
index 0000000000..522c2b329a
--- /dev/null
+++ b/hadrian/bindist/cwrappers/cwrapper.c
@@ -0,0 +1,161 @@
+
+/* gcc on mingw is hardcoded to use /mingw (which is c:/mingw) to
+ find various files. If this is a different version of mingw to the
+ one that we have in the GHC tree then things can go wrong. We
+ therefore need to add various -B flags to the gcc commandline,
+ so that it uses our in-tree mingw. Hence this wrapper. */
+
+#include "cwrapper.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <windows.h>
+
+void die(const char *fmt, ...) {
+ va_list argp;
+
+ va_start(argp, fmt);
+ vfprintf(stderr, fmt, argp);
+ va_end(argp);
+ exit(1);
+}
+
+char *mkString(const char *fmt, ...) {
+ char *p;
+ int i, j;
+ va_list argp;
+
+ va_start(argp, fmt);
+ i = vsnprintf(NULL, 0, fmt, argp);
+ va_end(argp);
+
+ if (i < 0) {
+ die("vsnprintf 0 failed: errno %d: %s\n", errno, strerror(errno));
+ }
+
+ p = malloc(i + 1);
+ if (p == NULL) {
+ die("malloc failed: errno %d: %s\n", errno, strerror(errno));
+ }
+
+ va_start(argp, fmt);
+ j = vsnprintf(p, i + 1, fmt, argp);
+ va_end(argp);
+ if (j < 0) {
+ die("vsnprintf with %d failed: errno %d: %s\n",
+ i + 1, errno, strerror(errno));
+ }
+
+ return p;
+}
+
+char *flattenAndQuoteArgs(char *ptr, int argc, char *argv[])
+{
+ int i;
+ char *src;
+
+ for (i = 0; i < argc; i++) {
+ *ptr++ = '"';
+ src = argv[i];
+ while(*src) {
+ if (*src == '"' || *src == '\\') {
+ *ptr++ = '\\';
+ }
+ *ptr++ = *src++;
+ }
+ *ptr++ = '"';
+ *ptr++ = ' ';
+ }
+ return ptr;
+}
+
+/* This function takes a callback to be called after the creation of the child
+ process but before we block waiting for the child. Can be NULL. */
+__attribute__((noreturn)) int run (char *exePath,
+ int numArgs1, char **args1,
+ int numArgs2, char **args2,
+ runCallback callback)
+{
+ int i, cmdline_len;
+ char *new_cmdline, *ptr;
+
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+
+ ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
+ ZeroMemory(&si, sizeof(STARTUPINFO));
+ si.cb = sizeof(STARTUPINFO);
+
+ /* Compute length of the flattened 'argv'. for each arg:
+ * + 1 for the space
+ * + chars * 2 (accounting for possible escaping)
+ * + 2 for quotes
+ */
+ cmdline_len = 1 + strlen(exePath)*2 + 2;
+ for (i=0; i < numArgs1; i++) {
+ cmdline_len += 1 + strlen(args1[i])*2 + 2;
+ }
+ for (i=0; i < numArgs2; i++) {
+ cmdline_len += 1 + strlen(args2[i])*2 + 2;
+ }
+
+ new_cmdline = (char*)malloc(sizeof(char) * (cmdline_len + 1));
+ if (!new_cmdline) {
+ die("failed to start up %s; insufficient memory", exePath);
+ }
+
+ ptr = flattenAndQuoteArgs(new_cmdline, 1, &exePath);
+ ptr = flattenAndQuoteArgs(ptr, numArgs1, args1);
+ ptr = flattenAndQuoteArgs(ptr, numArgs2, args2);
+ *--ptr = '\0'; // replace the final space with \0
+
+ /* Note: Used to use _spawnv(_P_WAIT, ...) here, but it suffered
+ from the parent intercepting console events such as Ctrl-C,
+ which it shouldn't. Installing an ignore-all console handler
+ didn't do the trick either.
+
+ Irrespective of this issue, using CreateProcess() is preferable,
+ as it makes this wrapper work on both mingw and cygwin.
+ */
+#if 0
+ fprintf(stderr, "Invoking %s\n", new_cmdline); fflush(stderr);
+#endif
+ if (!CreateProcess(exePath,
+ new_cmdline,
+ NULL,
+ NULL,
+ TRUE,
+ 0, /* dwCreationFlags */
+ NULL, /* lpEnvironment */
+ NULL, /* lpCurrentDirectory */
+ &si, /* lpStartupInfo */
+ &pi) ) {
+ die("Unable to start %s (error code: %lu)\n", exePath, GetLastError());
+ }
+
+ /* Synchronize input and wait for target to be ready. */
+ WaitForInputIdle(pi.hProcess, INFINITE);
+
+ /* If we have a registered callback then call it before we block. */
+ if (callback)
+ callback();
+
+ switch (WaitForSingleObject(pi.hProcess, INFINITE) ) {
+ case WAIT_OBJECT_0:
+ {
+ DWORD pExitCode;
+ if (GetExitCodeProcess(pi.hProcess, &pExitCode) == 0) {
+ exit(1);
+ }
+ exit(pExitCode);
+ }
+ case WAIT_ABANDONED:
+ case WAIT_FAILED:
+ /* in the event we get any hard errors, bring the child to a halt. */
+ TerminateProcess(pi.hProcess,1);
+ exit(1);
+ default:
+ exit(1);
+ }
+}
diff --git a/hadrian/bindist/cwrappers/cwrapper.h b/hadrian/bindist/cwrappers/cwrapper.h
new file mode 100644
index 0000000000..3e9ccd4fe5
--- /dev/null
+++ b/hadrian/bindist/cwrappers/cwrapper.h
@@ -0,0 +1,7 @@
+
+void die(const char *fmt, ...);
+char *mkString(const char *fmt, ...);
+typedef void (*runCallback)(void);
+__attribute__((noreturn)) int run(char *exePath, int numArgs1, char **args1,
+ int numArgs2, char **args2,
+ runCallback callback);
diff --git a/hadrian/bindist/cwrappers/getLocation.c b/hadrian/bindist/cwrappers/getLocation.c
new file mode 100644
index 0000000000..fcbe1b940c
--- /dev/null
+++ b/hadrian/bindist/cwrappers/getLocation.c
@@ -0,0 +1,40 @@
+
+#include "getLocation.h"
+#include <stdio.h>
+#include <windows.h>
+
+static void die(char *msg) {
+ fprintf(stderr, "%s", msg);
+ exit(1);
+}
+
+char *getExecutable(void) {
+ char *p;
+ int i;
+ int r;
+
+ i = 2048; /* plenty, PATH_MAX is 512 under Win32 */
+ p = malloc(i);
+ if (p == NULL) {
+ die("Malloc failed\n");
+ }
+ r = GetModuleFileNameA(NULL, p, i);
+ if (r == 0) {
+ die("getModuleFileName failed\n");
+ }
+ return p;
+}
+
+char *getExecutablePath(void) {
+ char *p;
+ char *f;
+
+ p = getExecutable();
+ f = strrchr(p, '\\');
+ if (f == NULL) {
+ die("No '\\' in executable location\n");
+ }
+ f[0] = '\0';
+ return p;
+}
+
diff --git a/hadrian/bindist/cwrappers/getLocation.h b/hadrian/bindist/cwrappers/getLocation.h
new file mode 100644
index 0000000000..689a4427ad
--- /dev/null
+++ b/hadrian/bindist/cwrappers/getLocation.h
@@ -0,0 +1,4 @@
+
+char *getExecutable(void);
+char *getExecutablePath(void);
+
diff --git a/hadrian/bindist/cwrappers/version-wrapper.c b/hadrian/bindist/cwrappers/version-wrapper.c
new file mode 100644
index 0000000000..f91c4c7f83
--- /dev/null
+++ b/hadrian/bindist/cwrappers/version-wrapper.c
@@ -0,0 +1,14 @@
+
+#include "cwrapper.h"
+#include "getLocation.h"
+#include <stddef.h>
+
+int main(int argc, char** argv) {
+ char *binDir;
+ char *exePath;
+
+ binDir = getExecutablePath();
+ exePath = mkString("%s/%s", binDir, EXE_PATH);
+
+ run(exePath, 0, NULL, argc - 1, argv + 1, NULL);
+}
diff --git a/hadrian/bindist/version-wrapper.hs b/hadrian/bindist/version-wrapper.hs
deleted file mode 100644
index dc7c344c5c..0000000000
--- a/hadrian/bindist/version-wrapper.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE CPP #-}
-module Main (main) where
-
-import System.Environment (getArgs, getExecutablePath)
-import System.Exit (exitWith)
-import System.Process (spawnProcess, waitForProcess)
-import System.FilePath (replaceFileName)
-
-exe = EXE_PATH
-
-main :: IO ()
-main = do
- args <- getArgs
- exe_name <- getExecutablePath
- ph <- spawnProcess (replaceFileName exe_name exe) args
- code <- waitForProcess ph
- exitWith code
diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs
index 6d812cefad..8cd7923547 100644
--- a/hadrian/src/Rules/BinaryDist.hs
+++ b/hadrian/src/Rules/BinaryDist.hs
@@ -419,13 +419,14 @@ iservBins = do
-- | Create a wrapper script calls the executable given as first argument
createVersionWrapper :: String -> FilePath -> Action ()
createVersionWrapper versioned_exe install_path = do
- ghcPath <- builderPath (Ghc CompileHs Stage2)
+ ccPath <- builderPath (Cc CompileC Stage2)
top <- topDirectory
- let version_wrapper = top -/- "hadrian" -/- "bindist" -/- "version-wrapper.hs"
- cmd ghcPath ["-o", install_path, "-no-keep-hi-files"
- , "-no-keep-o-files", "-rtsopts=ignore"
+ let version_wrapper_dir = top -/- "hadrian" -/- "bindist" -/- "cwrappers"
+ wrapper_files = [ version_wrapper_dir -/- file | file <- ["version-wrapper.c", "getLocation.c", "cwrapper.c"]]
+
+ cmd ccPath (["-o", install_path, "-I", version_wrapper_dir
, "-DEXE_PATH=\"" ++ versioned_exe ++ "\""
- , version_wrapper]
+ ] ++ wrapper_files)
{-
Note [Two Types of Wrappers]