1 /* This file defines Racket's main(), which is a jumble of
2 platform-specific initialization. The included file "cmdline.inc"
3 implements command-line parsing. (GRacket also uses "cmdline.inc".)
4
5 The rest of the source code resides in the `src' subdirectory
6 (except for the garbage collector, which is in `gc', `sgc', or
7 `gc2', depending on which one you're using). */
8
9 #ifdef __MINGW32__
10 # define __MINGW32_DELAY_LOAD__ 1
11 #endif
12 #include "scheme.h"
13
14 /*========================================================================*/
15 /* configuration and includes */
16 /*========================================================================*/
17
18 /* #define STANDALONE_WITH_EMBEDDED_EXTENSION */
19 /* STANDALONE_WITH_EMBEDDED_EXTENSION builds an executable with
20 built-in extensions. The extension is initialized by calling
21 scheme_initialize(env), where `env' is the initial environment.
22 By default, command-line parsing, the REPL, and initialization
23 file loading are turned off. */
24
25 #ifdef STANDALONE_WITH_EMBEDDED_EXTENSION
26 # define DONT_PARSE_COMMAND_LINE
27 # define DONT_RUN_REP
28 # define DONT_LOAD_INIT_FILE
29 #endif
30
31 #if defined(MZ_XFORM) && defined(__MINGW32__) && !defined(USE_THREAD_LOCAL)
32 XFORM_GC_VARIABLE_STACK_THROUGH_DIRECT_FUNCTION;
33 #endif
34
35 #ifdef MZ_XFORM
36 START_XFORM_SUSPEND;
37 #endif
38
39 #include <sys/types.h>
40 #ifndef DOS_FILE_SYSTEM
41 # include <sys/time.h>
42 #endif
43 #ifndef NO_USER_BREAK_HANDLER
44 # include <signal.h>
45 #endif
46 #ifdef OS_X
47 # include <unistd.h>
48 #endif
49
50 #ifdef INSTRUMENT_PRIMITIVES
51 extern int g_print_prims;
52 #endif
53
54 #ifdef MZ_XFORM
55 END_XFORM_SUSPEND;
56 #endif
57
58 /*========================================================================*/
59 /* configuration for command-line parsing */
60 /*========================================================================*/
61
62 #ifndef DONT_LOAD_INIT_FILE
63 /*
64 * Get the init filename for the system
65 * * First look to see if <addon-dir>/interactive.rkt exists
66 * * Otherwise check config file for location
67 */
get_init_filename(Scheme_Env * env,char * init_filename_sym,char * default_init_module,char * user_init_module)68 static Scheme_Object *get_init_filename(Scheme_Env *env,
69 char *init_filename_sym,
70 char *default_init_module,
71 char *user_init_module)
72 {
73 Scheme_Object *f, *a[2], *build_path;
74 Scheme_Thread * volatile p;
75 mz_jmp_buf * volatile save, newbuf;
76
77 p = scheme_get_current_thread();
78 save = p->error_buf;
79 p->error_buf = &newbuf;
80
81 if(!scheme_setjmp(newbuf)) {
82 build_path = scheme_builtin_value("build-path");
83
84 /* First test to see if user init file exists */
85 f = scheme_builtin_value("find-system-path");
86 a[0] = scheme_intern_symbol("addon-dir");
87 a[0] = _scheme_apply(f, 1, a);
88 a[1] = scheme_make_path(user_init_module);
89 f = _scheme_apply(build_path, 2, a);
90 if (SCHEME_PATHP(f)) {
91 char *filename;
92 filename = scheme_expand_filename(SCHEME_PATH_VAL(f), -1, "startup", NULL, SCHEME_GUARD_FILE_EXISTS);
93 if(scheme_file_exists(filename)) {
94 p->error_buf = save;
95 return scheme_make_path(filename);
96 }
97 }
98
99 /* Failed, next check config.rkt fo system init file */
100 f = scheme_builtin_value("find-main-config");
101 a[0] = _scheme_apply(f, 0, NULL);
102 a[1] = scheme_make_path("config.rktd");
103 f = _scheme_apply(build_path, 2, a);
104 if (SCHEME_PATHP(f)) {
105 char *filename;
106 filename = scheme_expand_filename(SCHEME_PATH_VAL(f), -1, "startup", NULL,
107 SCHEME_GUARD_FILE_EXISTS | SCHEME_GUARD_FILE_READ);
108 if(scheme_file_exists(filename)) {
109 Scheme_Object * port;
110 port = scheme_open_input_file(SCHEME_PATH_VAL(f), "get-init-filename");
111 f = scheme_read(port);
112 scheme_close_input_port(port);
113 if(SCHEME_HASHTRP(f)) {
114 f = scheme_hash_tree_get((Scheme_Hash_Tree *)f, scheme_intern_symbol(init_filename_sym));
115 if(f) {
116 p->error_buf = save;
117 return f;
118 }
119 }
120 }
121 }
122
123 /* Failed to load custom init file, load racket/interactive */
124 f = scheme_intern_symbol(default_init_module);
125 p->error_buf = save;
126 return f;
127 }
128
129 p->error_buf = save;
130
131 return NULL;
132 }
133 #endif
134
135 #ifdef STANDALONE_WITH_EMBEDDED_EXTENSION
136 extern Scheme_Object *scheme_initialize(Scheme_Env *env);
137 #endif
138
139 #ifndef UNIX_INIT_FILENAME
140 # define UNIX_INIT_FILENAME "~/.racketrc"
141 # define WINDOWS_INIT_FILENAME "<home-dir>\\racketrc.rktl"
142 # define INIT_FILENAME_CONF_SYM "interactive-file"
143 # define DEFAULT_INIT_MODULE "racket/interactive"
144 # define USER_INIT_MODULE "interactive.rkt"
145 # define PRINTF printf
146 # define PROGRAM "Racket"
147 # define PROGRAM_LC "racket"
148 # define INITIAL_BIN_TYPE "zi"
149 # define RACKET_CMD_LINE
150 # define INITIAL_NAMESPACE_MODULE "racket/init"
151 #endif
152
153 #ifdef DOS_FILE_SYSTEM
154 # define INIT_FILENAME WINDOWS_INIT_FILENAME
155 #else
156 # define INIT_FILENAME UNIX_INIT_FILENAME
157 #endif
158
159 #define CMDLINE_FFLUSH fflush
160
161 #define BANNER scheme_banner()
162
163 /*========================================================================*/
164 /* OS process name */
165 /*========================================================================*/
166
167 #if defined(__linux__)
168 # include <sys/prctl.h>
169 # ifdef PR_SET_NAME
170 # define CAN_SET_OS_PROCESS_NAME 1
set_os_process_name(char * sprog)171 void set_os_process_name(char *sprog)
172 {
173 int i = strlen(sprog) - 1;
174 while (i && (sprog[i - 1] != '/')) {
175 --i;
176 }
177 prctl(PR_SET_NAME, sprog + i);
178 }
179 # endif
180 #endif
181
182 /*========================================================================*/
183 /* command-line parsing */
184 /*========================================================================*/
185
186 #include "cmdline.inc"
187
188 /*========================================================================*/
189 /* ctl-C handler */
190 /*========================================================================*/
191
192 #if !defined(NO_USER_BREAK_HANDLER) || defined(DOS_FILE_SYSTEM)
193
194 static void *break_handle;
195 static void *signal_handle;
196
197 # ifndef NO_USER_BREAK_HANDLER
198
user_break_hit(int ignore)199 static void user_break_hit(int ignore)
200 XFORM_SKIP_PROC
201 {
202 scheme_break_main_thread_at(break_handle);
203 scheme_signal_received_at(signal_handle);
204 }
205
206 # ifndef NO_SIGTERM_HANDLER
term_hit(int ignore)207 static void term_hit(int ignore)
208 XFORM_SKIP_PROC
209 {
210 scheme_break_kind_main_thread_at(break_handle, MZEXN_BREAK_TERMINATE);
211 scheme_signal_received_at(signal_handle);
212 }
213 # endif
214
215 # ifndef NO_SIGHUP_HANDLER
hup_hit(int ignore)216 static void hup_hit(int ignore)
217 XFORM_SKIP_PROC
218 {
219 scheme_break_kind_main_thread_at(break_handle, MZEXN_BREAK_HANG_UP);
220 scheme_signal_received_at(signal_handle);
221 }
222 # endif
223
224 # endif
225
226 # ifdef DOS_FILE_SYSTEM
ConsoleBreakHandler(DWORD op)227 static BOOL WINAPI ConsoleBreakHandler(DWORD op)
228 {
229 scheme_break_main_thread_at(break_handle);
230 scheme_signal_received_at(signal_handle);
231 return TRUE;
232 }
233 #endif
234
235 #endif
236
237 /*========================================================================*/
238 /* main */
239 /*========================================================================*/
240
241 #ifdef USE_SENORA_GC
242 # include "sgc/sgc.h"
243 #endif
244
245 /* Forward declarations: */
246 static void do_scheme_rep(Scheme_Env *, FinishArgs *f);
247 static int cont_run(FinishArgs *f);
248
249 #if defined(__MINGW32__)
250 # define MAIN zmain
251 # define MAIN_char char
252 # define MAIN_argv argv
253 #elif defined(WINDOWS_UNICODE_SUPPORT) && !defined(__CYGWIN32__) && !defined(MZ_DEFINE_UTF8_MAIN)
254 # define MAIN wmain
255 # define MAIN_char wchar_t
256 # define MAIN_argv wargv
257 # define WINDOWS_UNICODE_MAIN
258 #else
259 # define MAIN main
260 # define MAIN_char char
261 # define MAIN_argv argv
262 #endif
263
264 /***************************** main ********************************/
265 /* Prepare for delayload, then call main_after_dlls */
266
267 static int main_after_dlls(int argc, MAIN_char **MAIN_argv);
268 static int main_after_stack(void *data);
269
270 # ifdef MZ_PRECISE_GC
271 START_XFORM_SKIP;
272 # endif
273
274 #if defined(__MINGW32__) || defined(WINMAIN_ALREADY)
275 # include "../start/cmdl_to_argv.inc"
276 #endif
277
278 #ifdef DOS_FILE_SYSTEM
279 # include "win_tls.inc"
280 # include "../start/embedded_dll.inc"
281 #endif
282
283 #ifdef DOS_FILE_SYSTEM
284 static int load_delayed_done;
285
load_delayed()286 void load_delayed()
287 {
288 if (load_delayed_done)
289 return;
290 load_delayed_done = 1;
291
292 (void)SetErrorMode(SEM_FAILCRITICALERRORS);
293
294 parse_embedded_dlls();
295
296 # ifndef MZ_NO_LIBRACKET_DLL
297 /* Order matters: load dependencies first */
298 # ifndef MZ_PRECISE_GC
299 load_delayed_dll(NULL, "libmzgcxxxxxxx.dll");
300 # endif
301 load_delayed_dll(NULL, "libracket" DLL_3M_SUFFIX "xxxxxxx.dll");
302 # endif
303 record_dll_path();
304
305 register_embedded_dll_hooks();
306
307 register_win_tls();
308 }
309 #endif
310
MAIN(int argc,MAIN_char ** MAIN_argv)311 int MAIN(int argc, MAIN_char **MAIN_argv)
312 {
313 #if defined(DOS_FILE_SYSTEM) && !defined(__MINGW32__)
314 load_delayed();
315 #endif
316
317 return main_after_dlls(argc, MAIN_argv);
318 }
319
320 #if defined(__MINGW32__) && !defined(WINMAIN_ALREADY)
WinMain(HINSTANCE hInstance,HINSTANCE hPrevInstance,LPSTR ignored,int nCmdShow)321 int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored, int nCmdShow)
322 {
323 int argc;
324 char **argv;
325
326 load_delayed();
327
328 scheme_set_atexit(atexit);
329
330 argv = cmdline_to_argv(&argc, NULL);
331
332 return zmain(argc, argv);
333 }
334 #endif
335
336 # ifdef MZ_PRECISE_GC
337 END_XFORM_SKIP;
338 # endif
339
340 /************************ main_after_dlls **************************/
341 /* Prep stack for GC, then call main_after_stack (indirectly) */
342
343 typedef struct {
344 int argc;
345 MAIN_char **argv;
346 } Main_Args;
347
348 # ifdef MZ_PRECISE_GC
349 START_XFORM_SKIP;
350 # endif
351
main_after_dlls(int argc,MAIN_char ** argv)352 static int main_after_dlls(int argc, MAIN_char **argv)
353 {
354 Main_Args ma;
355 ma.argc = argc;
356 ma.argv = argv;
357 return scheme_main_stack_setup(1, main_after_stack, &ma);
358 }
359
360 # ifdef MZ_PRECISE_GC
361 END_XFORM_SKIP;
362 # endif
363
364 /************************ main_after_stack *************************/
365 /* Setup, parse command-line, and go to cont_run */
366
main_after_stack(void * data)367 static int main_after_stack(void *data)
368 {
369 int rval;
370 int argc;
371 MAIN_char **MAIN_argv;
372 #ifdef WINDOWS_UNICODE_MAIN
373 char **argv;
374 #endif
375
376 argc = ((Main_Args *)data)->argc;
377 MAIN_argv = ((Main_Args *)data)->argv;
378
379 #ifdef WINDOWS_UNICODE_MAIN
380 {
381 char *a;
382 int i;
383 argv = (char **)malloc(sizeof(char*)*argc);
384 for (i = 0; i < argc; i++) {
385 a = string_to_utf8(wargv[i]);
386 argv[i] = a;
387 }
388 }
389 #endif
390
391
392 #if !defined(NO_USER_BREAK_HANDLER) || defined(DOS_FILE_SYSTEM)
393 break_handle = scheme_get_main_thread_break_handle();
394 signal_handle = scheme_get_signal_handle();
395 # ifndef NO_USER_BREAK_HANDLER
396 scheme_set_signal_handler(SIGINT, user_break_hit);
397 # ifndef NO_SIGTERM_HANDLER
398 scheme_set_signal_handler(SIGTERM, term_hit);
399 # endif
400 # ifndef NO_SIGHUP_HANDLER
401 scheme_set_signal_handler(SIGHUP, hup_hit);
402 # endif
403 # endif
404 # ifdef DOS_FILE_SYSTEM
405 SetConsoleCtrlHandler(ConsoleBreakHandler, TRUE);
406 # endif
407 #endif
408
409 #ifdef PRE_FILTER_CMDLINE_ARGUMENTS
410 pre_filter_cmdline_arguments(&argc, &MAIN_argv);
411 #endif
412
413 rval = run_from_cmd_line(argc, argv, scheme_basic_env, cont_run);
414
415 #ifndef DEFER_EXPLICIT_EXIT
416 scheme_immediate_exit(rval);
417 /* shouldn't get here */
418 #endif
419
420 return rval;
421 }
422
423 /************************* cont_run ******************************/
424 /* Go to do_scheme_rep */
425
cont_run(FinishArgs * f)426 static int cont_run(FinishArgs *f)
427 {
428 return finish_cmd_line_run(f, do_scheme_rep);
429 }
430
431 /************************* do_scheme_rep *****************************/
432 /* Finally, do a read-eval-print-loop */
433
do_scheme_rep(Scheme_Env * env,FinishArgs * fa)434 static void do_scheme_rep(Scheme_Env *env, FinishArgs *fa)
435 {
436 /* enter read-eval-print loop */
437 Scheme_Object *rep, *a[2];
438 int ending_newline = 1;
439
440 #ifdef GRAPHICAL_REPL
441 if (!fa->a->alternate_rep) {
442 a[0] = scheme_intern_symbol("racket/gui/base");
443 a[1] = scheme_intern_symbol("graphical-read-eval-print-loop");
444 ending_newline = 0;
445 } else
446 #endif
447 {
448 a[0] = scheme_intern_symbol("racket/repl");
449 a[1] = scheme_intern_symbol("read-eval-print-loop");
450 }
451
452 rep = scheme_dynamic_require(2, a);
453
454 if (rep) {
455 scheme_apply(rep, 0, NULL);
456 if (ending_newline)
457 printf("\n");
458 }
459 }
460
461 /*========================================================================*/
462 /* junk for testing */
463 /*========================================================================*/
464
465 #if 0
466 /* For testing STANDALONE_WITH_EMBEDDED_EXTENSION */
467 Scheme_Object *scheme_initialize(Scheme_Env *env)
468 {
469 return scheme_eval_string("(lambda (v) (and (eq? v #t) "
470 " (lambda () "
471 " (printf \"These were the args: ~a~n\" argv))))",
472 env);
473 }
474 #endif
475