1 /***********************************************************************/
5 /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
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. */
12 /***********************************************************************/
17 #define WIN32_LEAN_AND_MEAN
24 #pragma comment(linker , "/entry:headerentry")
25 #pragma comment(linker , "/subsystem:console")
26 #pragma comment(lib , "kernel32")
29 char * default_runtime_name
= "ocamlrun";
37 unsigned long read_size(const char * const ptr
)
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];
44 static __inline
char * read_runtime_path(HANDLE h
)
46 char buffer
[TRAILER_SIZE
];
47 static char runtime_path
[MAX_PATH
];
49 int num_sections
, path_size
, i
;
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
;
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);
65 } else if (path_size
> 0)
66 ofs
+= read_size(buffer
+ 4);
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;
77 static BOOL WINAPI
ctrl_handler(DWORD event
)
79 if (event
== CTRL_C_EVENT
|| event
== CTRL_BREAK_EVENT
)
80 return TRUE
; /* pretend we've handled them */
85 #define msg_and_length(msg) msg , (sizeof(msg) - 1)
87 static __inline
void __declspec(noreturn
) run_runtime(char * runtime
,
92 PROCESS_INFORMATION procinfo
;
94 if (SearchPath(NULL
, runtime
, ".exe", MAX_PATH
, path
, &runtime
) == 0) {
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
);
103 __assume(0); /* Not reached */
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
);
110 stinfo
.cb
= sizeof(stinfo
);
111 stinfo
.lpReserved
= NULL
;
112 stinfo
.lpDesktop
= NULL
;
113 stinfo
.lpTitle
= NULL
;
115 stinfo
.cbReserved2
= 0;
116 stinfo
.lpReserved2
= NULL
;
117 if (!CreateProcess(path
, cmdline
, NULL
, NULL
, TRUE
, 0, NULL
, NULL
,
118 &stinfo
, &procinfo
)) {
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
);
127 __assume(0); /* Not reached */
130 CloseHandle(procinfo
.hThread
);
131 WaitForSingleObject(procinfo
.hProcess
, INFINITE
);
132 GetExitCodeProcess(procinfo
.hProcess
, &retcode
);
133 CloseHandle(procinfo
.hProcess
);
134 ExitProcess(retcode
);
136 __assume(0); /* Not reached */
143 void __declspec(noreturn
) __cdecl
headerentry()
146 char truename
[MAX_PATH
];
147 char * cmdline
= GetCommandLine();
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
) {
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"),
164 __assume(0); /* Not reached */
168 run_runtime(runtime_path
, cmdline
);
170 __assume(0); /* Not reached */