l4/pkg/ocaml/contrib/stdlib/headernt.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1998 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../LICENSE.     */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: headernt.c 7829 2007-02-07 10:31:36Z ertai $ */
  15
  16 #define STRICT
  17 #define WIN32_LEAN_AND_MEAN
  18
  19 #include <windows.h>
  20 #include "mlvalues.h"
  21 #include "exec.h"
  22
  23 #ifndef __MINGW32__
  24 #pragma comment(linker , "/entry:headerentry")
  25 #pragma comment(linker , "/subsystem:console")
  26 #pragma comment(lib , "kernel32")
  27 #endif
  28
  29 char * default_runtime_name = "ocamlrun";
  30
  31 static
  32 #if _MSC_VER >= 1200
  33 __forceinline
  34 #else
  35 __inline
  36 #endif
  37 unsigned long read_size(const char * const ptr)
  38 {
  39   const unsigned char * const p = (const unsigned char * const) ptr;
  40   return ((unsigned long) p[0] << 24) | ((unsigned long) p[1] << 16) |
  41          ((unsigned long) p[2] << 8) | p[3];
  42 }
  43
  44 static __inline char * read_runtime_path(HANDLE h)
  45 {
  46   char buffer[TRAILER_SIZE];
  47   static char runtime_path[MAX_PATH];
  48   DWORD nread;
  49   int num_sections, path_size, i;
  50   long ofs;
  51
  52   if (SetFilePointer(h, -TRAILER_SIZE, NULL, FILE_END) == -1) return NULL;
  53   if (! ReadFile(h, buffer, TRAILER_SIZE, &nread, NULL)) return NULL;
  54   if (nread != TRAILER_SIZE) return NULL;
  55   num_sections = read_size(buffer);
  56   ofs = TRAILER_SIZE + num_sections * 8;
  57   if (SetFilePointer(h, - ofs, NULL, FILE_END) == -1) return NULL;
  58   path_size = 0;
  59   for (i = 0; i < num_sections; i++) {
  60     if (! ReadFile(h, buffer, 8, &nread, NULL) || nread != 8) return NULL;
  61     if (buffer[0] == 'R' && buffer[1] == 'N' &&
  62         buffer[2] == 'T' && buffer[3] == 'M') {
  63       path_size = read_size(buffer + 4);
  64       ofs += path_size;
  65     } else if (path_size > 0)
  66       ofs += read_size(buffer + 4);
  67   }
  68   if (path_size == 0) return default_runtime_name;
  69   if (path_size >= MAX_PATH) return NULL;
  70   if (SetFilePointer(h, -ofs, NULL, FILE_END) == -1) return NULL;
  71   if (! ReadFile(h, runtime_path, path_size, &nread, NULL)) return NULL;
  72   if (nread != path_size) return NULL;
  73   runtime_path[path_size - 1] = 0;
  74   return runtime_path;
  75 }
  76
  77 static BOOL WINAPI ctrl_handler(DWORD event)
  78 {
  79   if (event == CTRL_C_EVENT || event == CTRL_BREAK_EVENT)
  80     return TRUE;                /* pretend we've handled them */
  81   else
  82     return FALSE;
  83 }
  84
  85 #define msg_and_length(msg) msg , (sizeof(msg) - 1)
  86
  87 static __inline void __declspec(noreturn) run_runtime(char * runtime,
  88          char * const cmdline)
  89 {
  90   char path[MAX_PATH];
  91   STARTUPINFO stinfo;
  92   PROCESS_INFORMATION procinfo;
  93   DWORD retcode;
  94   if (SearchPath(NULL, runtime, ".exe", MAX_PATH, path, &runtime) == 0) {
  95     HANDLE errh;
  96     DWORD numwritten;
  97     errh = GetStdHandle(STD_ERROR_HANDLE);
  98     WriteFile(errh, msg_and_length("Cannot exec "), &numwritten, NULL);
  99     WriteFile(errh, runtime, strlen(runtime), &numwritten, NULL);
 100     WriteFile(errh, msg_and_length("\r\n"), &numwritten, NULL);
 101     ExitProcess(2);
 102 #if _MSC_VER >= 1200
 103     __assume(0); /* Not reached */
 104 #endif
 105   }
 106   /* Need to ignore ctrl-C and ctrl-break, otherwise we'll die and take
 107      the underlying OCaml program with us! */
 108   SetConsoleCtrlHandler(ctrl_handler, TRUE);
 109
 110   stinfo.cb = sizeof(stinfo);
 111   stinfo.lpReserved = NULL;
 112   stinfo.lpDesktop = NULL;
 113   stinfo.lpTitle = NULL;
 114   stinfo.dwFlags = 0;
 115   stinfo.cbReserved2 = 0;
 116   stinfo.lpReserved2 = NULL;
 117   if (!CreateProcess(path, cmdline, NULL, NULL, TRUE, 0, NULL, NULL,
 118                      &stinfo, &procinfo)) {
 119     HANDLE errh;
 120     DWORD numwritten;
 121     errh = GetStdHandle(STD_ERROR_HANDLE);
 122     WriteFile(errh, msg_and_length("Cannot exec "), &numwritten, NULL);
 123     WriteFile(errh, runtime, strlen(runtime), &numwritten, NULL);
 124     WriteFile(errh, msg_and_length("\r\n"), &numwritten, NULL);
 125     ExitProcess(2);
 126 #if _MSC_VER >= 1200
 127     __assume(0); /* Not reached */
 128 #endif
 129   }
 130   CloseHandle(procinfo.hThread);
 131   WaitForSingleObject(procinfo.hProcess , INFINITE);
 132   GetExitCodeProcess(procinfo.hProcess , &retcode);
 133   CloseHandle(procinfo.hProcess);
 134   ExitProcess(retcode);
 135 #if _MSC_VER >= 1200
 136     __assume(0); /* Not reached */
 137 #endif
 138 }
 139
 140 #ifdef __MINGW32__
 141 int main()
 142 #else
 143 void __declspec(noreturn) __cdecl headerentry()
 144 #endif
 145 {
 146   char truename[MAX_PATH];
 147   char * cmdline = GetCommandLine();
 148   char * runtime_path;
 149   HANDLE h;
 150
 151   GetModuleFileName(NULL, truename, sizeof(truename));
 152   h = CreateFile(truename, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE,
 153                  NULL, OPEN_EXISTING, 0, NULL);
 154   if (h == INVALID_HANDLE_VALUE ||
 155       (runtime_path = read_runtime_path(h)) == NULL) {
 156     HANDLE errh;
 157     DWORD numwritten;
 158     errh = GetStdHandle(STD_ERROR_HANDLE);
 159     WriteFile(errh, truename, strlen(truename), &numwritten, NULL);
 160     WriteFile(errh, msg_and_length(" not found or is not a bytecode executable file\r\n"),
 161               &numwritten, NULL);
 162     ExitProcess(2);
 163 #if _MSC_VER >= 1200
 164     __assume(0); /* Not reached */
 165 #endif
 166   }
 167   CloseHandle(h);
 168   run_runtime(runtime_path , cmdline);
 169 #if _MSC_VER >= 1200
 170     __assume(0); /* Not reached */
 171 #endif
 172 #ifdef __MINGW32__
 173     return 0;
 174 #endif
 175 }