/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- usage
- version
- further_options
- profiler_options
- parse_options
- sig_setup
- cleanup_main
- main
1 /*
2 * main.c - interpreter main program
3 *
4 * Copyright (c) 2000-2005 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: main.c,v 1.86 2005/09/05 12:05:25 shirok Exp $
34 */
35
36 #include <unistd.h>
37 #include <string.h>
38 #include <stdlib.h>
39 #include <sys/stat.h>
40 #include <signal.h>
41 #include <ctype.h>
42 #include "gauche.h"
43
44 #ifdef HAVE_GETOPT_H
45 #include <getopt.h>
46 #endif
47
48 /* options */
49 int load_initfile = TRUE; /* if false, not to load init files */
50 int batch_mode = FALSE; /* force batch mode */
51 int interactive_mode = FALSE; /* force interactive mode */
52 int test_mode = FALSE; /* add . and ../lib implicitly */
53 int profiling_mode = FALSE; /* profile the script? */
54 int stats_mode = FALSE; /* collect stats (EXPERIMENTAL) */
55
56 ScmObj pre_cmds = SCM_NIL; /* assoc list of commands that needs to be
57 processed before entering repl.
58 Each car has either #\I, #\A, #\u, #\l
59 or #\e, according to the given cmdargs. */
60
61 void usage(void)
62 {
63 fprintf(stderr,
64 "Usage: gosh [-biqV][-I<path>][-A<path>][-u<module>][-l<file>][-e<expr>][--] [file]\n"
65 "options:\n"
66 " -V Prints version and exits.\n"
67 " -b Batch mode. Doesn't print prompts. Supersedes -i.\n"
68 " -i Interactive mode. Forces to print prompts.\n"
69 " -q Doesn't read the default initialization file.\n"
70 " -I<path> Adds <path> to the head of the load path list.\n"
71 " -A<path> Adds <path> to the tail of the load path list.\n"
72 " -u<module> (use) load and import <module>\n"
73 " -l<file> Loads <file> before executing the script file or\n"
74 " entering repl.\n"
75 " -e<expr> Evaluate Scheme expression <expr> before executing\n"
76 " the script file or entering repl.\n"
77 " -E<expr> Similar to -e, but reads <expr> as if it is surrounded\n"
78 " by parenthesis.\n"
79 " -p<type> Turn on the profiler. Currently <type> can only be\n"
80 " 'time'.\n"
81 " -f<flag> Sets various flags\n"
82 " case-fold uses case-insensitive reader (as in R5RS)\n"
83 " load-verbose report while loading files\n"
84 " no-inline don't inline procedures & constants (combined\n"
85 " no-inline-globals, no-inline-locals, and\n"
86 " no-inline-constants.\n"
87 " no-inline-globals don't inline global procedures.\n"
88 " no-inline-locals don't inline local procedures.\n"
89 " no-inline-constants don't inline constants.\n"
90 " no-source-info don't preserve source information for debug\n"
91 " test test mode, to run gosh inside the build tree\n"
92 );
93 exit(1);
94 }
95
96 #ifdef GAUCHE_USE_PTHREADS
97 #define PTHREAD_OPT ",pthreads"
98 #else
99 #define PTHREAD_OPT ""
100 #endif
101
102 void version(void)
103 {
104 printf("Gauche scheme interpreter, version %s [%s%s]\n",
105 GAUCHE_VERSION, SCM_CHAR_ENCODING_NAME, PTHREAD_OPT);
106 exit(0);
107 }
108
109 void further_options(const char *optarg)
110 {
111 ScmVM *vm = Scm_VM();
112 if (strcmp(optarg, "no-inline-globals") == 0) {
113 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_GLOBALS);
114 }
115 else if (strcmp(optarg, "no-inline-locals") == 0) {
116 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_LOCALS);
117 }
118 else if (strcmp(optarg, "no-inline-constants") == 0) {
119 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_CONSTS);
120 }
121 else if (strcmp(optarg, "no-inline") == 0) {
122 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_GLOBALS);
123 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_LOCALS);
124 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOINLINE_CONSTS);
125 }
126 else if (strcmp(optarg, "no-source-info") == 0) {
127 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOSOURCE);
128 }
129 else if (strcmp(optarg, "load-verbose") == 0) {
130 SCM_VM_RUNTIME_FLAG_SET(vm, SCM_LOAD_VERBOSE);
131 }
132 else if (strcmp(optarg, "case-fold") == 0) {
133 SCM_VM_RUNTIME_FLAG_SET(vm, SCM_CASE_FOLD);
134 }
135 else if (strcmp(optarg, "test") == 0) {
136 test_mode = TRUE;
137 }
138 /* For development; not for public use */
139 else if (strcmp(optarg, "collect-stats") == 0) {
140 stats_mode = TRUE;
141 SCM_VM_RUNTIME_FLAG_SET(vm, SCM_COLLECT_VM_STATS);
142 }
143 /* For development; not for public use */
144 else if (strcmp(optarg, "no-combine-instructions") == 0) {
145 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_NOCOMBINE);
146 }
147 /* For development; not for public use */
148 else if (strcmp(optarg, "debug-compiler") == 0) {
149 SCM_VM_COMPILER_FLAG_SET(vm, SCM_COMPILE_SHOWRESULT);
150 }
151 /* Experimental */
152 else if (strcmp(optarg, "limit-module-mutation") == 0) {
153 SCM_VM_RUNTIME_FLAG_SET(vm, SCM_LIMIT_MODULE_MUTATION);
154 }
155 else {
156 fprintf(stderr, "unknown -f option: %s\n", optarg);
157 fprintf(stderr, "supported options are: -fcase-fold or -fload-verbose, -fno-inline, -fno-inline-globals, -fno-inline-locals, -fno-inline-constants, -fno-source-info, -ftest\n");
158 exit(1);
159 }
160 }
161
162 void profiler_options(const char *optarg)
163 {
164 if (strcmp(optarg, "time") == 0) {
165 profiling_mode = TRUE;
166 }
167 else {
168 fprintf(stderr, "unknown -p option: %s\n", optarg);
169 fprintf(stderr, "supported profiling options are: -ptime\n");
170 }
171 }
172
173 int parse_options(int argc, char *argv[])
174 {
175 int c;
176 while ((c = getopt(argc, argv, "+be:E:ip:ql:u:Vf:I:A:-")) >= 0) {
177 switch (c) {
178 case 'b': batch_mode = TRUE; break;
179 case 'i': interactive_mode = TRUE; break;
180 case 'q': load_initfile = FALSE; break;
181 case 'V': version(); break;
182 case 'f': further_options(optarg); break;
183 case 'p': profiler_options(optarg); break;
184 case 'u': /*FALLTHROUGH*/;
185 case 'l': /*FALLTHROUGH*/;
186 case 'I': /*FALLTHROUGH*/;
187 case 'A': /*FALLTHROUGH*/;
188 case 'e': /*FALLTHROUGH*/;
189 case 'E': /*FALLTHROUGH*/;
190 pre_cmds = Scm_Acons(SCM_MAKE_CHAR(c),
191 SCM_MAKE_STR_COPYING(optarg), pre_cmds);
192 break;
193 case '-': break;
194 case '?': usage(); break;
195 }
196 }
197 return optind;
198 }
199
200 /* signal handler setup. let's catch as many signals as possible. */
201 static void sig_setup(void)
202 {
203 sigset_t set;
204 sigfillset(&set);
205 sigdelset(&set, SIGABRT);
206 sigdelset(&set, SIGILL);
207 #ifdef SIGKILL
208 sigdelset(&set, SIGKILL);
209 #endif
210 #ifdef SIGCONT
211 sigdelset(&set, SIGCONT);
212 #endif
213 #ifdef SIGSTOP
214 sigdelset(&set, SIGSTOP);
215 #endif
216 sigdelset(&set, SIGSEGV);
217 //#ifdef SIGPROF
218 // sigdelset(&set, SIGPROF);
219 //#endif /*SIGPROF*/
220 #ifdef SIGBUS
221 sigdelset(&set, SIGBUS);
222 #endif /*SIGBUS*/
223 #if defined(GC_LINUX_THREADS)
224 /* some signals are used in the system */
225 sigdelset(&set, SIGPWR); /* used in gc */
226 sigdelset(&set, SIGXCPU); /* used in gc */
227 sigdelset(&set, SIGUSR1); /* used in linux threads */
228 sigdelset(&set, SIGUSR2); /* used in linux threads */
229 #endif /*GC_LINUX_THREADS*/
230 #if defined(GC_FREEBSD_THREADS)
231 sigdelset(&set, SIGUSR1); /* used by GC to stop the world */
232 sigdelset(&set, SIGUSR2); /* used by GC to restart the world */
233 #endif /*GC_FREEBSD_THREADS*/
234 Scm_SetMasterSigmask(&set);
235 }
236
237 /* Cleanup */
238 void cleanup_main(void *data)
239 {
240 ScmVM *vm = Scm_VM();
241
242 if (profiling_mode) {
243 Scm_ProfilerStop();
244 Scm_Eval(Scm_ReadFromCString("(profiler-show)"),
245 SCM_OBJ(SCM_FIND_MODULE("gauche.vm.profiler", 0)));
246 }
247
248 if (stats_mode) { /* EXPERIMENTAL */
249 fprintf(stderr, "\n;; Statistics (*: main thread only):\n");
250 fprintf(stderr,
251 ";; GC: %dbytes heap, %dbytes allocated\n",
252 GC_get_heap_size(), GC_get_total_bytes());
253 fprintf(stderr,
254 ";; stack overflow*: %dtimes, %.2fms total/%.2fms avg\n",
255 vm->stat.sovCount,
256 vm->stat.sovTime/1000.0,
257 (vm->stat.sovCount > 0?
258 (double)(vm->stat.sovTime/vm->stat.sovCount)/1000.0 :
259 0.0));
260 }
261 }
262
263 /*-----------------------------------------------------------------
264 * MAIN
265 */
266 int main(int argc, char **argv)
267 {
268 int argind;
269 ScmObj cp;
270 const char *scriptfile = NULL;
271 ScmObj av = SCM_NIL;
272 int exit_code;
273
274 GC_INIT();
275 Scm_Init(GAUCHE_SIGNATURE);
276 sig_setup();
277
278 argind = parse_options(argc, argv);
279
280 /* If -ftest option is given and we seem to be in the source
281 tree, adds build directories to the library path _before_
282 loading init file. This is to help development of Gauche
283 itself; normal user should never need this. */
284 if (test_mode) {
285 /* The order of directories is important. 'lib' should
286 be searched first (hence it should come latter), since some
287 extension modules are built from the file in src then linked
288 from lib, and we want to test the one in lib. */
289 if (access("../src/stdlib.stub", R_OK) == 0
290 && access("../libsrc/srfi-1.scm", R_OK) == 0
291 && access("../lib/srfi-0.scm", R_OK) == 0) {
292 Scm_AddLoadPath("../src", FALSE);
293 Scm_AddLoadPath("../libsrc", FALSE);
294 Scm_AddLoadPath("../lib", FALSE);
295 } else if (access("../../src/stdlib.stub", R_OK) == 0
296 && access("../../libsrc/srfi-1.scm", R_OK) == 0
297 && access("../../lib/srfi-0.scm", R_OK) == 0) {
298 Scm_AddLoadPath("../../src", FALSE);
299 Scm_AddLoadPath("../../libsrc", FALSE);
300 Scm_AddLoadPath("../../lib", FALSE);
301 }
302 }
303
304 /* load init file */
305 if (load_initfile) {
306 SCM_UNWIND_PROTECT {
307 Scm_Load("gauche-init.scm", 0);
308 }
309 SCM_WHEN_ERROR {
310 fprintf(stderr, "Error in initialization file.\n");
311 }
312 SCM_END_PROTECT;
313 }
314
315 /* prepare *program-name* and *argv* */
316 if (optind < argc) {
317 /* We have a script file specified. */
318 ScmObj at = SCM_NIL;
319 int ac;
320 struct stat statbuf;
321
322 /* if the script name is given in relative pathname, see if
323 it exists from the current directory. if not, leave it
324 to load() to search in the load paths */
325 if (argv[optind][0] == '\0') Scm_Error("bad script name");
326 if (argv[optind][0] == '/') {
327 scriptfile = argv[optind];
328 #ifdef __CYGWIN__
329 } else if (isalpha(argv[optind][0]) && argv[optind][1] == ':') {
330 /* support of wicked legacy DOS drive letter */
331 scriptfile = argv[optind];
332 #endif /* __CYGWIN__ */
333 } else {
334 if (stat(argv[optind], &statbuf) == 0) {
335 ScmDString ds;
336 Scm_DStringInit(&ds);
337 Scm_DStringPutz(&ds, "./", -1);
338 Scm_DStringPutz(&ds, argv[optind], -1);
339 scriptfile = Scm_DStringGetz(&ds);
340 } else {
341 scriptfile = argv[optind];
342 }
343 }
344
345 /* sets up arguments. */
346 for (ac = optind; ac < argc; ac++) {
347 SCM_APPEND1(av, at, SCM_MAKE_STR_IMMUTABLE(argv[ac]));
348 }
349 } else {
350 av = SCM_LIST1(SCM_MAKE_STR_IMMUTABLE(argv[0]));
351 }
352 SCM_DEFINE(Scm_UserModule(), "*argv*", SCM_CDR(av));
353 SCM_DEFINE(Scm_UserModule(), "*program-name*", SCM_CAR(av));
354
355 /* process pre-commands */
356 SCM_FOR_EACH(cp, Scm_Reverse(pre_cmds)) {
357 ScmObj p = SCM_CAR(cp);
358 ScmObj v = SCM_CDR(p);
359 switch (SCM_CHAR_VALUE(SCM_CAR(p))) {
360 case 'I':
361 Scm_AddLoadPath(Scm_GetStringConst(SCM_STRING(v)), FALSE);
362 break;
363 case 'A':
364 Scm_AddLoadPath(Scm_GetStringConst(SCM_STRING(v)), TRUE);
365 break;
366 case 'l':
367 Scm_Load(Scm_GetStringConst(SCM_STRING(v)), 0);
368 break;
369 case 'u':
370 Scm_Require(Scm_StringJoin(Scm_StringSplitByChar(SCM_STRING(v),
371 '.'),
372 SCM_STRING(SCM_MAKE_STR("/")),
373 SCM_STRING_JOIN_INFIX));
374 Scm_ImportModules(SCM_CURRENT_MODULE(),
375 SCM_LIST1(Scm_Intern(SCM_STRING(v))));
376 break;
377 case 'e':
378 Scm_Eval(Scm_ReadFromString(SCM_STRING(v)),
379 SCM_OBJ(Scm_UserModule()));
380 break;
381 case 'E':
382 v = Scm_StringAppend(SCM_LIST3(SCM_MAKE_STR("("),
383 v,
384 SCM_MAKE_STR(")")));
385 Scm_Eval(Scm_ReadFromString(SCM_STRING(v)),
386 SCM_OBJ(Scm_UserModule()));
387 break;
388 }
389 }
390
391 /* Set up instruments. */
392 if (profiling_mode) {
393 Scm_Require(SCM_MAKE_STR("gauche/vm/profiler"));
394 Scm_ProfilerStart();
395 }
396 Scm_AddCleanupHandler(cleanup_main, NULL);
397
398 /* Following is the main dish. */
399
400 if (scriptfile != NULL) {
401 /* If script file is specified, load it. */
402 ScmObj result, mainproc;
403
404 Scm_Load(scriptfile, 0);
405
406 /* if symbol 'main is bound to a procedure in the user module,
407 call it. (SRFI-22) */
408 mainproc = Scm_SymbolValue(Scm_UserModule(),
409 SCM_SYMBOL(SCM_INTERN("main")));
410 if (SCM_PROCEDUREP(mainproc)) {
411 result = Scm_Apply(mainproc, SCM_LIST1(av));
412 if (SCM_INTP(result)) exit_code = SCM_INT_VALUE(result);
413 else exit_code = 70; /* EX_SOFTWARE, see SRFI-22. */
414 } else {
415 exit_code = 0;
416 }
417 } else {
418 /* We're in interactive mode. (use gauche.interactive) */
419 if (load_initfile) {
420 SCM_UNWIND_PROTECT {
421 Scm_Require(SCM_MAKE_STR("gauche/interactive"));
422 Scm_ImportModules(SCM_CURRENT_MODULE(),
423 SCM_LIST1(SCM_INTERN("gauche.interactive")));
424 }
425 SCM_WHEN_ERROR {
426 Scm_Warn("couldn't load gauche.interactive\n");
427 }
428 SCM_END_PROTECT;
429 }
430
431 if (batch_mode || (!isatty(0) && !interactive_mode)) {
432 Scm_LoadFromPort(SCM_PORT(Scm_Stdin()), 0);
433 } else {
434 Scm_Repl(SCM_FALSE, SCM_FALSE, SCM_FALSE, SCM_FALSE);
435 }
436 exit_code = 0;
437 }
438
439 /* All is done. */
440 Scm_Exit(exit_code);
441 return 0;
442 }