src/lisp/lisp.c

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