/***********************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1998 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file ../LICENSE. */ /* */ /***********************************************************************/ #define STRICT #define WIN32_LEAN_AND_MEAN #include #include "caml/mlvalues.h" #include "caml/exec.h" #ifndef __MINGW32__ #pragma comment(linker , "/entry:headerentry") #pragma comment(linker , "/subsystem:console") #pragma comment(lib , "kernel32") #endif char * default_runtime_name = RUNTIME_NAME; static #if _MSC_VER >= 1200 __forceinline #else __inline #endif unsigned long read_size(const char * const ptr) { const unsigned char * const p = (const unsigned char * const) ptr; return ((unsigned long) p[0] << 24) | ((unsigned long) p[1] << 16) | ((unsigned long) p[2] << 8) | p[3]; } static __inline char * read_runtime_path(HANDLE h) { char buffer[TRAILER_SIZE]; static char runtime_path[MAX_PATH]; DWORD nread; int num_sections, path_size, i; long ofs; if (SetFilePointer(h, -TRAILER_SIZE, NULL, FILE_END) == -1) return NULL; if (! ReadFile(h, buffer, TRAILER_SIZE, &nread, NULL)) return NULL; if (nread != TRAILER_SIZE) return NULL; num_sections = read_size(buffer); ofs = TRAILER_SIZE + num_sections * 8; if (SetFilePointer(h, - ofs, NULL, FILE_END) == -1) return NULL; path_size = 0; for (i = 0; i < num_sections; i++) { if (! ReadFile(h, buffer, 8, &nread, NULL) || nread != 8) return NULL; if (buffer[0] == 'R' && buffer[1] == 'N' && buffer[2] == 'T' && buffer[3] == 'M') { path_size = read_size(buffer + 4); ofs += path_size; } else if (path_size > 0) ofs += read_size(buffer + 4); } if (path_size == 0) return default_runtime_name; if (path_size >= MAX_PATH) return NULL; if (SetFilePointer(h, -ofs, NULL, FILE_END) == -1) return NULL; if (! ReadFile(h, runtime_path, path_size, &nread, NULL)) return NULL; if (nread != path_size) return NULL; runtime_path[path_size - 1] = 0; return runtime_path; } static BOOL WINAPI ctrl_handler(DWORD event) { if (event == CTRL_C_EVENT || event == CTRL_BREAK_EVENT) return TRUE; /* pretend we've handled them */ else return FALSE; } #define msg_and_length(msg) msg , (sizeof(msg) - 1) static __inline void __declspec(noreturn) run_runtime(char * runtime, char * const cmdline) { char path[MAX_PATH]; STARTUPINFO stinfo; PROCESS_INFORMATION procinfo; DWORD retcode; if (SearchPath(NULL, runtime, ".exe", MAX_PATH, path, &runtime) == 0) { HANDLE errh; DWORD numwritten; errh = GetStdHandle(STD_ERROR_HANDLE); WriteFile(errh, msg_and_length("Cannot exec "), &numwritten, NULL); WriteFile(errh, runtime, strlen(runtime), &numwritten, NULL); WriteFile(errh, msg_and_length("\r\n"), &numwritten, NULL); ExitProcess(2); #if _MSC_VER >= 1200 __assume(0); /* Not reached */ #endif } /* Need to ignore ctrl-C and ctrl-break, otherwise we'll die and take the underlying OCaml program with us! */ SetConsoleCtrlHandler(ctrl_handler, TRUE); stinfo.cb = sizeof(stinfo); stinfo.lpReserved = NULL; stinfo.lpDesktop = NULL; stinfo.lpTitle = NULL; stinfo.dwFlags = 0; stinfo.cbReserved2 = 0; stinfo.lpReserved2 = NULL; if (!CreateProcess(path, cmdline, NULL, NULL, TRUE, 0, NULL, NULL, &stinfo, &procinfo)) { HANDLE errh; DWORD numwritten; errh = GetStdHandle(STD_ERROR_HANDLE); WriteFile(errh, msg_and_length("Cannot exec "), &numwritten, NULL); WriteFile(errh, runtime, strlen(runtime), &numwritten, NULL); WriteFile(errh, msg_and_length("\r\n"), &numwritten, NULL); ExitProcess(2); #if _MSC_VER >= 1200 __assume(0); /* Not reached */ #endif } CloseHandle(procinfo.hThread); WaitForSingleObject(procinfo.hProcess , INFINITE); GetExitCodeProcess(procinfo.hProcess , &retcode); CloseHandle(procinfo.hProcess); ExitProcess(retcode); #if _MSC_VER >= 1200 __assume(0); /* Not reached */ #endif } #ifdef __MINGW32__ int main() #else void __declspec(noreturn) __cdecl headerentry() #endif { char truename[MAX_PATH]; char * cmdline = GetCommandLine(); char * runtime_path; HANDLE h; GetModuleFileName(NULL, truename, sizeof(truename)); h = CreateFile(truename, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING, 0, NULL); if (h == INVALID_HANDLE_VALUE || (runtime_path = read_runtime_path(h)) == NULL) { HANDLE errh; DWORD numwritten; errh = GetStdHandle(STD_ERROR_HANDLE); WriteFile(errh, truename, strlen(truename), &numwritten, NULL); WriteFile(errh, msg_and_length(" not found or is not a bytecode" " executable file\r\n"), &numwritten, NULL); ExitProcess(2); #if _MSC_VER >= 1200 __assume(0); /* Not reached */ #endif } CloseHandle(h); run_runtime(runtime_path , cmdline); #if _MSC_VER >= 1200 __assume(0); /* Not reached */ #endif #ifdef __MINGW32__ return 0; #endif }