Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / lisp.c
1 /*
2  * main() entry point for a stand alone lisp image.
3  *
4  */
5
6 #include <stdio.h>
7 #include <stdlib.h>
8 #include <limits.h>
9 #include <sys/stat.h>
10 #include <string.h>
11 #include <unistd.h>
12
13 #include "signal.h"
14
15 #include "lisp.h"
16 #include "internals.h"
17 #include "alloc.h"
18 #include "vars.h"
19 #include "globals.h"
20 #include "os.h"
21 #include "interrupt.h"
22 #include "arch.h"
23 #include "gc.h"
24 #include "monitor.h"
25 #include "validate.h"
26 #include "interr.h"
27 #if defined GENCGC
28 #include "gencgc.h"
29 #endif
30 #include "core.h"
31 #include "save.h"
32 #include "lispregs.h"
33 #if defined(FEATURE_EXECUTABLE)
34 #include "elf.h"
35 #endif
36
37 #ifdef __linux__
38 #include <sys/utsname.h>
39 #endif
40
41 #if defined(__linux__)
42 #include <time.h>
43 #endif
44
45 \f
46
47 /* SIGINT handler that invokes the monitor. */
48
49 static void
50 sigint_handler(HANDLER_ARGS)
51 {
52     os_context_t *os_context = (os_context_t *) context;
53     
54     SAVE_CONTEXT();
55
56     printf("\nSIGINT hit at 0x%08lX\n", (unsigned long) SC_PC(os_context));
57     ldb_monitor();
58 }
59
60 /* Not static, because we want to be able to call it from lisp land. */
61 void
62 sigint_init(void)
63 {
64     install_handler(SIGINT, sigint_handler);
65 }
66 \f
67
68 /* Noise to convert argv and envp into lists. */
69
70 static lispobj
71 alloc_str_list(const char *list[])
72 {
73     lispobj result, newcons;
74     struct cons *ptr;
75
76     if (*list == NULL)
77         result = NIL;
78     else {
79         result = newcons = alloc_cons(alloc_string(*list++), NIL);
80
81         while (*list != NULL) {
82             ptr = (struct cons *) PTR(newcons);
83             newcons = alloc_cons(alloc_string(*list++), NIL);
84             ptr->cdr = newcons;
85         }
86     }
87
88     return result;
89 }
90
91 /* Default paths for CMUCLLIB */
92 static char *cmucllib_search_list[] = {
93     "./.",
94     "./../lib/cmucl/lib",
95     "./../lib",
96     "/usr/local/lib/cmucl/lib",
97     "/usr/lib/cmucl",
98     NULL
99 };
100
101 void
102 getcwd_or_die(char* buf, size_t size)
103 {
104     char *result = getcwd(buf, size);
105
106     if (result == NULL) {
107         perror("Cannot get cwd");
108         exit(1);
109     }
110 }
111
112 /* Set this to see how we're doing our search */
113 int debug_lisp_search = FALSE;
114
115 /*
116  * Define this to get some debugging printfs for searching for the
117  * lisp core file.  Sometimes needed because you can't debug this with
118  * gdb which always seems to set argv[0] to the full pathname.
119  */
120
121 /* #define DEBUG_LISP_SEARCH */
122
123 /*
124  * From the current location of the lisp executable, create a suitable
125  * default for CMUCLLIB
126  */
127 static const char *
128 default_cmucllib(const char *argv0arg)
129 {
130     char *p0;
131     char *defpath;
132     char *cwd;
133     char *argv0_dir = strdup(argv0arg);
134
135     /*
136      * From argv[0], create the appropriate directory by lopping off the
137      * executable name
138      */
139
140     p0 = strrchr(argv0_dir, '/');
141     if (p0 == NULL) {
142         *argv0_dir = '\0';
143     } else if (p0 != argv0_dir) {
144         *p0 = '\0';
145     }
146
147     /*
148      * Create the full pathname of the directory containing the
149      * executable.  argv[0] can be an absolute or relative path.
150      */
151     if (debug_lisp_search) {
152         fprintf(stderr, "argv[0] = %s\n", argv0arg);
153         fprintf(stderr, "argv_dir = %s\n", argv0_dir);
154     }
155
156
157     if (argv0_dir[0] == '/') {
158         cwd = malloc(strlen(argv0_dir) + 2);
159         strcpy(cwd, argv0_dir);
160         strcat(cwd, "/");
161         if (debug_lisp_search) {
162             fprintf(stderr, "absolute path, argv[0] = %s\n", cwd);
163         }
164
165     } else if (*argv0_dir != '\0') {
166         /*
167          * argv[0] is a relative path.  Get the current directory and
168          * append argv[0], after stripping off the executable name.
169          */
170         cwd = malloc(FILENAME_MAX + strlen(argv0_dir) + 100);
171         getcwd_or_die(cwd, FILENAME_MAX);
172         strcat(cwd, "/");
173         if (*argv0_dir != '\0') {
174             strcat(cwd, argv0_dir);
175             strcat(cwd, "/");
176         }
177         if (debug_lisp_search) {
178             fprintf(stderr, "relative path, argv[0] = %s\n", cwd);
179         }
180     } else {
181         /*
182          * argv[0] is someplace on the user's PATH
183          *
184          */
185         char *path = getenv("PATH");
186         char *p1, *p2 = NULL;
187         struct stat buf;
188
189         if (debug_lisp_search) {
190             fprintf(stderr, "User's PATH = %s\n", path ? path : "<NULL>");
191         }
192
193         cwd = malloc(FILENAME_MAX + strlen(argv0arg) + 100);
194         cwd[0] = '\0';
195
196         if (path) {
197             const char *ptr = (p0 != NULL) ? p0 : argv0arg;
198
199             for (p1 = path; *p1 != '\0'; p1 = p2) {
200                 p2 = strchr(p1, ':');
201                 if (p2 == NULL)
202                     p2 = p1 + strlen(p1);
203                 strncpy(cwd, p1, p2 - p1);
204                 cwd[p2 - p1] = '/';
205                 cwd[p2 - p1 + 1] = '\0';
206                 strcpy(cwd + (p2 - p1 + 1), ptr);
207
208                 if (debug_lisp_search) {
209                     fprintf(stderr, "User's PATH, trying %s\n", cwd);
210                 }
211
212                 if (stat(cwd, &buf) == 0) {
213
214                     if (debug_lisp_search) {
215                         fprintf(stderr, "User's PATH, found %s\n", cwd);
216                     }
217                     if (access(cwd, X_OK) == 0) {
218                         break;
219                     } else {
220                         if (debug_lisp_search) {
221                             fprintf(stderr,
222                                     " But not executable.  Continuing...\n");
223                         }
224                     }
225
226                 }
227
228                 if (*p2 == ':') {
229                     p2++;
230                 }
231
232             }
233             if ((p1 == p2) || (p2 == NULL)) {
234                 cwd[0] = '\0';
235             } else {
236                 cwd[p2 - p1 + 1] = '\0';
237             }
238             if (debug_lisp_search) {
239                 fprintf(stderr, "User's PATH, Final cwd %s\n", cwd);
240             }
241
242         }
243     }
244
245     /* Create the appropriate value for CMUCLLIB */
246
247     {
248         char **ptr;
249         int total_len;
250         int cwd_len;
251
252         /* First figure out how much space we need */
253
254         total_len = 0;
255         cwd_len = strlen(cwd);
256
257         ptr = cmucllib_search_list;
258
259         while (*ptr != NULL) {
260             /* Plus 2 for the ":" and "/" we need to add */
261             total_len += strlen(*ptr) + cwd_len + 2;
262             ++ptr;
263         }
264
265         /* Create the colon separated list of directories */
266
267         defpath = malloc(total_len + 1);
268         *defpath = '\0';
269
270         ptr = cmucllib_search_list;
271         while (*ptr != NULL) {
272             if (*ptr[0] != '/') {
273                 strcat(defpath, cwd);
274             }
275
276             strcat(defpath, *ptr);
277
278             if (ptr[1] != NULL) {
279                 strcat(defpath, ":");
280             }
281
282             ++ptr;
283         }
284
285         if (strlen(defpath) > total_len) {
286             abort();
287         }
288     }
289
290     free(argv0_dir);
291     free(cwd);
292
293     return (const char *) defpath;
294 }
295
296 /*
297  * Search the a core file with the name given by default_core in the
298  * colon-separated list of directories given by lib.
299  *
300  * Return the full path, if found, or NULL if not.
301  */
302
303 char *
304 search_core(const char *lib, const char *default_core)
305 {
306     char *buf;
307     char *dst;
308
309     /*
310      * A buffer that's large enough to hold lib, default_core, a
311      * slash, and a the string terminator
312      */
313     buf = malloc(strlen(lib) + strlen(default_core) + 2);
314
315     do {
316         dst = buf;
317         /*
318          * Extract out everything to the first colon, then append a
319          * "/" and the core name.  See if the file exists.
320          */
321         while (*lib != '\0' && *lib != ':')
322             *dst++ = *lib++;
323         if (dst != buf && dst[-1] != '/')
324             *dst++ = '/';
325         strcpy(dst, default_core);
326         /* If it exists, we are done! */
327
328         if (debug_lisp_search) {
329             fprintf(stderr, "Looking at `%s'\n", buf);
330         }
331
332         if (access(buf, R_OK) == 0) {
333             if (debug_lisp_search) {
334                 fprintf(stderr, "Found it!\n");
335             }
336
337             return buf;
338         } else {
339             if (debug_lisp_search) {
340                 fprintf(stderr, "Found it, but we can't read it!\n");
341             }
342         }
343     } while (*lib++ == ':');
344
345     free(buf);
346     return NULL;
347 }
348
349 /*
350  * Given the path to a core file, prepend the absolute location of the
351  * core file to the lib path.
352  *
353  * Return the new lib path.
354  */
355 static const char *
356 prepend_core_path(const char *lib, const char *corefile)
357 {
358     char cwd[FILENAME_MAX];
359     char *path;
360     char *result;
361     char *sep;
362
363     if (*corefile == '/') {
364         path = strdup(corefile);
365     } else {
366         /*
367          * We have a relative path for the corefile.  Prepend our current
368          * directory to get the full path.
369          */
370         getcwd_or_die(cwd, FILENAME_MAX);
371         path = malloc(FILENAME_MAX + strlen(corefile) + 2);
372         strcpy(path, cwd);
373         strcat(path, "/");
374         strcat(path, corefile);
375     }
376
377     /*
378      * Now remove the name portion by finding the last slash.
379      */
380     sep = strrchr(path, '/');
381     if (sep != NULL) {
382         *sep = '\0';
383     }
384
385     result = malloc(strlen(path) + strlen(lib) + 2);
386     strcpy(result, path);
387     strcat(result, ":");
388     strcat(result, lib);
389
390     free(path);
391     return (const char *) result; /* Don't let the caller modify the buffer we built */
392 }
393
394 /*
395  * The value of the variable builtin_image_flag indicate whether the
396  * executable contains the lisp image or not.  The variable
397  * initial_function_addr indicates the address of the initial
398  * function.  How these are interpreted depends on the system.
399  *
400  * For Linux/x86, Darwin/x86, and Solaris/sparc, the
401  * builtin_image_flag is a normal symbol mapped into a normal data
402  * area.  If true, the executable contains the lisp image.  Likewise,
403  * initial_function_addr is a symbol mapped into a normal data area.
404  * The value of this variable is the address of the initial function.
405  *
406  * For other systems, we use the linker to set the value of the symbol.
407  * But the symbol is an address, not a variable value.  So for this to
408  * work as a flag, it must end up pointing to a valid place in memory
409  * or we'll get a bus error or segmentation violation when we check
410  * it.  If the lisp image is built in, we'll set this symbol to point
411  * to the beginning of the process.
412  *
413  * We also use the linker to set initial_function_addr so that if the
414  * lisp core is built in, taking the address of initial_function_addr
415  * will give the address of the initial function.
416  *
417  * The details of how these variables are set up are in
418  * tools/linker.sh and tools/linker-x86.sh.  Which script is used is
419  * set in src/lisp/elf.h.
420  */
421
422 extern int builtin_image_flag;
423 extern long initial_function_addr;
424
425 fpu_mode_t fpu_mode = AUTO;
426
427 static const char*
428 locate_core(const char* cmucllib, const char* core, const char* default_core)
429 {
430     if (core == NULL) {
431         if (getenv("CMUCLCORE") == NULL) {
432             core = search_core(cmucllib, default_core);
433         } else {
434             core = getenv("CMUCLCORE");
435         }
436     }
437
438     if (access(core, R_OK) != 0) {
439       core = NULL;
440     }
441     
442     return core;
443 }
444
445 static void
446 core_failure(const char* core, const char* argv[])
447 {
448     
449     fprintf(stderr, "Cannot find core file");
450     if (core != NULL) {
451         fprintf(stderr, ": `%s'", core);
452     }
453     fprintf(stderr, "\n");
454     fprintf(stderr, "Based on lisp binary path `%s'\n", argv[0]);
455     exit(1);
456 }
457
458 int
459 main(int argc, const char *argv[], const char *envp[])
460 {
461     const char *arg, **argptr;
462     const char *core = NULL;
463     const char *default_core;
464     const char *lib = NULL;
465     const char *cmucllib = NULL;
466     const char *unidata = NULL;
467     
468     fpu_mode_t fpu_type = AUTO;
469     boolean monitor;
470     lispobj initial_function = 0;
471
472     if (builtin_image_flag != 0) {
473 #if defined(SOLARIS) || (defined(i386) && (defined(__linux__) || defined(DARWIN) || defined(__FreeBSD__) || defined(__NetBSD__)))
474         initial_function = (lispobj) initial_function_addr;
475 #else
476         initial_function = (lispobj) & initial_function_addr;
477 #endif
478     }
479     
480
481     /*
482      * Do any special OS initialization that needs to be done early.
483      * In particular, on Linux, we might re-exec ourselves to set our
484      * personality correctly.  Not normally a problem, but this does
485      * cause any output to happen twice.  That can be confusing.
486      *
487      * So make sure we don't do any output before this point!
488      */
489     
490     os_init0(argv, envp);
491 #if defined(SVR4)
492     tzset();
493 #endif
494
495     set_lossage_handler(ldb_monitor);
496
497     monitor = FALSE;
498
499 #ifdef DEFAULT_DYNAMIC_SPACE_SIZE
500     dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE;
501 #else
502     dynamic_space_size = DYNAMIC_SPACE_SIZE;
503 #endif
504 #ifdef DEFAULT_READ_ONLY_SIZE
505     read_only_space_size = DEFAULT_READ_ONLY_SIZE;
506 #else
507     read_only_space_size = READ_ONLY_SPACE_SIZE;
508 #endif
509 #ifdef DEFAULT_STATIC_SIZE
510     static_space_size = DEFAULT_STATIC_SIZE;
511 #else
512     static_space_size = STATIC_SPACE_SIZE;
513 #endif
514 #ifdef DEFAULT_BINDING_SIZE
515     binding_stack_size = DEFAULT_BINDING_SIZE;
516 #else
517     binding_stack_size = BINDING_STACK_SIZE;
518 #endif    
519 #ifdef DEFAULT_CONTROL_SIZE
520     control_stack_size = DEFAULT_CONTROL_SIZE;
521 #else
522     control_stack_size = CONTROL_STACK_SIZE;
523 #endif
524
525     argptr = argv;
526     while ((arg = *++argptr) != NULL) {
527         if (strcmp(arg, "-core") == 0) {
528             if (builtin_image_flag) {
529                 fprintf(stderr,
530                         "Warning:  specifying a core file with an executable image is unusual,\nbut should work.\n");
531                 builtin_image_flag = 0;
532             }
533
534             if (core != NULL) {
535                 fprintf(stderr, "can only specify one core file.\n");
536                 exit(1);
537             }
538             core = *++argptr;
539             if (core == NULL) {
540                 fprintf(stderr,
541                         "-core must be followed by the name of the core file to use.\n");
542                 exit(1);
543             }
544         } else if (strcmp(arg, "-lib") == 0) {
545             lib = *++argptr;
546             if (lib == NULL) {
547                 fprintf(stderr,
548                         "-lib must be followed by a string denoting the CMUCL library path.\n");
549                 exit(1);
550             }
551         } else if (strcmp(arg, "-read-only-space-size") == 0) {
552             const char *str = *++argptr;
553
554             if (str == NULL) {
555                 fprintf(stderr,
556                         "-read-only-space-size must be followed by the size in MBytes.\n");
557                 exit(1);
558             }
559             read_only_space_size = atoi(str) * 1024 * 1024;
560             if (read_only_space_size > READ_ONLY_SPACE_SIZE) {
561                 fprintf(stderr,
562                         "-read-only-space-size must be no greater than %lu MBytes.\n",
563                         READ_ONLY_SPACE_SIZE / (1024 * 1024UL));
564                 fprintf(stderr, "  Continuing with default size.\n");
565                 read_only_space_size = READ_ONLY_SPACE_SIZE;
566             }
567         } else if (strcmp(arg, "-static-space-size") == 0) {
568             const char *str = *++argptr;
569
570             if (str == NULL) {
571                 fprintf(stderr,
572                         "-static-space-size must be followed by the size in MBytes.\n");
573                 exit(1);
574             }
575             static_space_size = atoi(str) * 1024 * 1024;
576             if (static_space_size > STATIC_SPACE_SIZE) {
577                 fprintf(stderr,
578                         "-static-space-size must be no greater than %lu MBytes.\n",
579                         STATIC_SPACE_SIZE / (1024 * 1024UL));
580                 fprintf(stderr, "  Continuing with default size.\n");
581                 static_space_size = STATIC_SPACE_SIZE;
582             }
583         } else if (strcmp(arg, "-binding-stack-size") == 0) {
584             const char *str = *++argptr;
585
586             if (str == NULL) {
587                 fprintf(stderr,
588                         "-binding-stack-size must be followed by the size in MBytes.\n");
589                 exit(1);
590             }
591             binding_stack_size = atoi(str) * 1024 * 1024;
592             if (binding_stack_size > BINDING_STACK_SIZE) {
593                 fprintf(stderr,
594                         "-binding-stack-size must be no greater than %lu MBytes.\n",
595                         BINDING_STACK_SIZE / (1024 * 1024UL));
596                 fprintf(stderr, "  Continuing with default size.\n");
597                 binding_stack_size = BINDING_STACK_SIZE;
598             }
599         } else if (strcmp(arg, "-control-stack-size") == 0) {
600             const char *str = *++argptr;
601
602             if (str == NULL) {
603                 fprintf(stderr,
604                         "-control-stack-size must be followed by the size in MBytes.\n");
605                 exit(1);
606             }
607             control_stack_size = atoi(str) * 1024 * 1024;
608             if (control_stack_size > CONTROL_STACK_SIZE) {
609                 fprintf(stderr,
610                         "-control-stack-size must be no greater than %lu MBytes.\n",
611                         CONTROL_STACK_SIZE / (1024 * 1024UL));
612                 fprintf(stderr, "  Continuing with default size.\n");
613                 control_stack_size = CONTROL_STACK_SIZE;
614             }
615         } else if (strcmp(arg, "-dynamic-space-size") == 0) {
616             const char *str;
617
618             str = *++argptr;
619             if (str == NULL) {
620                 fprintf(stderr,
621                         "-dynamic-space-size must be followed by the size to use in MBytes.\n");
622                 exit(1);
623             }
624 #ifndef sparc
625             dynamic_space_size = atoi(str) * 1024 * 1024;
626 #else
627             {
628                 int val;
629
630                 /*
631                  * Martin Rydstrom says core sizes that aren't a
632                  * multiple of 8 MB eventually causes GC lossage with
633                  * gencgc on Solaris 10.  No one seems to understand why
634                  * that is, but it is.  So here we enforce the 8 MB
635                  * boundary by rounding up the size.  We print a warning
636                  * message if we do have to round.
637                  *
638                  * We do this for all versions, since it doesn't hurt
639                  * other versions of Solaris.
640                  */
641                 val = atoi(str);
642                 dynamic_space_size = (val + 7) & ~7;
643
644                 if (val != dynamic_space_size) {
645                     fprintf(stderr,
646                             "Note:  Rounding dynamic-space-size from %d MB to %d MB\n",
647                             val, dynamic_space_size);
648                 }
649                 dynamic_space_size *= 1024 * 1024;
650             }
651 #endif
652             if (dynamic_space_size > DYNAMIC_SPACE_SIZE) {
653                 fprintf(stderr,
654                         "-dynamic-space-size must be no greater than %lu MBytes.\n",
655                         DYNAMIC_SPACE_SIZE / (1024 * 1024UL));
656                 exit(1);
657             }
658         } else if (strcmp(arg, "-monitor") == 0) {
659             monitor = TRUE;
660         } else if (strcmp(arg, "-debug-lisp-search") == 0) {
661             debug_lisp_search = TRUE;
662         } else if (strcmp(arg, "-unidata") == 0) {
663           unidata = *++argptr;
664         }
665 #ifdef i386
666         else if (strcmp(arg, "-fpu") == 0) {
667             const char *str;
668
669             str = *++argptr;
670             if (str == NULL) {
671                 fprintf(stderr, "-fpu must be followed by the FPU type:  auto, x87, sse2\n");
672                 exit(1);
673             }
674
675             if (builtin_image_flag != 0) {
676                 fprintf(stderr,
677                         "Warning:  -fpu cannot change the fpu mode of an executable image\n");
678             } else {
679                 if (strcmp(str, "auto") == 0) {
680                     fpu_mode = AUTO;
681                 } else if (strcmp(str, "x87") == 0) {
682                     fpu_mode = X87;
683                 } else if (strcmp(str, "sse2") == 0) {
684                     fpu_mode = SSE2;
685                 } else {
686                     fprintf(stderr, "Unknown fpu type: `%s'.  Using auto\n", str);
687                 }
688             }
689         }
690 #endif
691     }
692
693     default_core = arch_init(fpu_mode);
694
695     if (default_core == NULL)
696         default_core = "lisp.core";
697
698     os_init(argv, envp);
699 #if defined FEATURE_EXECUTABLE
700     if (builtin_image_flag != 0)
701         map_core_sections(argv[0]);
702 #endif
703     validate();
704     gc_init();
705
706     /* This is the first use of malloc() and must come after the
707      * static memory layout is mmapped to avoid conflicts with possible
708      * use of mmap() by malloc().
709      */
710     define_var("nil", NIL, TRUE);
711     define_var("t", T, TRUE);
712
713     /*
714      * Basic algorithm for setting CMUCLLIB and CMUCLCORE, from Pierre
715      * Mai.
716      *
717      * if CMUCLLIB envvar is not set
718      *   CMUCLLIB = our list of places to look
719      *   if -core option/CMUCLCORE given
720      *      CMUCLLIB = CMUCLLIB + full path to the specified core file
721      *   endif
722      * endif
723      *
724      * if -core option/CMUCLCORE unset
725      *   search for a core file (named whatever arch_init returns or
726      *     lisp.core) somewhere in the CMUCLLIB list.
727      * endif
728      *
729      * if core found
730      *   use that
731      * else
732      *   give error message and die
733      * endif
734      *
735      * CMUCLCORE = where the core file was found/specced
736      */
737
738     /*
739      * Set cmucllib to the -lib option, or to CMUCLLIB envvar.  If
740      * neither are set, set cmucllib to our default search path.
741      */
742     if (lib != NULL) {
743         cmucllib = strdup(lib);
744     } else {
745         char *libvar;
746
747         libvar = getenv("CMUCLLIB");
748         if (libvar != NULL) {
749             cmucllib = strdup(libvar);
750         } else {
751             /*
752              * The following doesn't make sense for executables.  They
753              * need to use the saved library path from the lisp from
754              * which they were dumped.
755              */
756             if (builtin_image_flag == 0) {
757                 const char *newlib = NULL;
758
759                 /*
760                  * We need to use our default search path.  If a core file
761                  * is given, we prepend the directory of the core file to
762                  * the search path.
763                  */
764                 cmucllib = default_cmucllib(argv[0]);
765                 if (core != NULL) {
766                     newlib = prepend_core_path(cmucllib, core);
767                 } else if (getenv("CMUCLCORE") != NULL) {
768                     core = getenv("CMUCLCORE");
769                     newlib = prepend_core_path(cmucllib, core);
770                 }
771
772                 if (newlib != NULL) {
773                     free((void *) cmucllib);
774                     cmucllib = newlib;
775                 }
776             }
777         }
778     }
779
780
781     /* Only look for a core file if we're not using a built-in image. */
782     if (builtin_image_flag == 0) {
783         /*
784          * If no core file specified, search for it in CMUCLLIB
785          */
786         const char* found_core;
787             
788         found_core = locate_core(cmucllib, core, default_core);
789 #ifdef FEATURE_SSE2
790         if ((found_core == NULL) && (fpu_mode == AUTO)) {
791             /*
792              * If we support SSE2 but couldn't find the SSE2 core, try
793              * to fall back to the x87 core.
794              */
795             found_core = locate_core(cmucllib, core, "lisp-x87.core");
796             if (found_core == NULL) {
797                 core_failure(core, argv);
798             }
799             fprintf(stderr, "Warning:  Chip supports SSE2, but could not find SSE2 core.\n");
800             fprintf(stderr, "  Falling back to x87 core.\n");
801         }
802 #endif
803         if (!found_core) {
804             core_failure(core, argv);
805         }
806         core = found_core;
807     } else {
808         /*
809          * The "core file" is the executable.  We have to save the
810          * executable path because we operate on the executable file
811          * later.
812          */
813         core = argv[0];
814     }
815
816     globals_init();
817
818     if (builtin_image_flag != 0) {
819         extern int image_dynamic_space_size;
820         long allocation_pointer =
821             (long) dynamic_0_space + (int) image_dynamic_space_size;
822 #if defined(i386) || defined(__x86_64)
823         SetSymbolValue(ALLOCATION_POINTER, (lispobj) allocation_pointer);
824 #else
825         current_dynamic_space_free_pointer = (lispobj *) allocation_pointer;
826 #endif
827     } else {
828         initial_function = load_core_file(core, &fpu_type);
829     }
830
831 #ifdef i386
832     if ((fpu_type == SSE2) && (!arch_support_sse2() || !os_support_sse2())) {
833         fprintf(stderr, "Core uses SSE2, but CPU/OS doesn't support SSE2.  Exiting\n");
834         exit(1);
835     }
836     fpu_mode = fpu_type;
837 #endif
838
839 #if defined LINKAGE_TABLE
840     os_foreign_linkage_init();
841 #endif /* LINKAGE_TABLE */
842
843 #if defined GENCGC
844     gencgc_pickup_dynamic();
845 #else
846 #if defined WANT_CGC && defined X86_CGC_ACTIVE_P
847     {
848         extern int use_cgc_p;
849         lispobj x = SymbolValue(X86_CGC_ACTIVE_P);
850
851         if (x != type_UnboundMarker && x != NIL)
852             use_cgc_p = 1;      /* enable allocator */
853     }
854 #endif
855 #endif
856
857 #ifdef BINDING_STACK_POINTER
858     SetSymbolValue(BINDING_STACK_POINTER, (lispobj) binding_stack);
859 #endif
860 #if defined INTERNAL_GC_TRIGGER && !defined i386
861     SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
862 #endif
863
864     interrupt_init();
865
866     arch_install_interrupt_handlers();
867     os_install_interrupt_handlers();
868
869 #ifdef PSEUDO_ATOMIC_ATOMIC
870     /* Turn on pseudo atomic for when we call into lisp. */
871     SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
872     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
873 #endif
874
875     /* Convert the argv and envp to something Lisp can grok. */
876     SetSymbolValue(LISP_COMMAND_LINE_LIST, alloc_str_list(argv));
877     SetSymbolValue(LISP_ENVIRONMENT_LIST, alloc_str_list(envp));
878
879     /* Set cmucllib and cmuclcore appropriately */
880     /*
881      * This test will preserve the library: search list dumped with
882      * the executable unless the user specifically overrides it with
883      * the -lib flag or by setting the CMUCLLIB environment variable.
884      */
885
886     if (cmucllib) {
887         SetSymbolValue(CMUCL_LIB, alloc_string(cmucllib));
888     }
889     
890     SetSymbolValue(CMUCL_CORE_PATH, alloc_string(core));
891
892     /*
893      * Parse the command line again, picking up values that override
894      * those loaded from the core.
895      */
896
897     argptr = argv;
898     while ((arg = *++argptr) != NULL) {
899         if (strcmp(arg, "-batch") == 0)
900             SetSymbolValue(BATCH_MODE, T);
901     }
902
903 #ifdef UNIDATA_PATH
904     if (unidata) {
905       SetSymbolValue(UNIDATA_PATH, alloc_string(unidata));
906     }
907 #endif
908     
909     /*
910      * Pick off sigint until the lisp system gets far enough along to
911      * install it's own.
912      */
913     sigint_init();
914
915 #ifdef DEBUG_BAD_HEAP
916     /*
917      * At this point, there should be exactly 4 objects in static
918      * space pointing to apparently free pages.  These 4 objects were
919      * just created above for *lisp-command-line-list*,
920      * *lisp-environment-list*, *cmucl-lib*, and *cmucl-core-path*.
921      */
922     verify_gc();
923 #endif
924
925 #if defined(__linux__)
926     /*
927      * On newer (?) versions of Linux, tzset appears to call malloc.
928      * We set up the timezone here so that malloc happens as late as
929      * possible.
930      */
931     tzset();
932 #endif
933     
934     if (monitor) {
935         while (1) {
936             ldb_monitor();
937         }
938     } else {
939         funcall0(initial_function);
940         printf("Initial function returned?\n");
941         exit(1);
942     }
943     return 0;                   /* not reached */
944 }