Skip to content
Snippets Groups Projects
lisp.c 5.9 KiB
Newer Older
wlott's avatar
wlott committed
/*
 * main() entry point for a stand alone lisp image.
 *
 * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.20 2000/10/24 13:32:32 dtc Exp $
wlott's avatar
wlott committed
 *
 */

#include <stdio.h>
#include <sys/types.h>
#include <stdlib.h>
#include <sys/file.h>
#include <sys/param.h>
#include <sys/stat.h>

#include "signal.h"

#include "lisp.h"
#include "internals.h"
#include "alloc.h"
#include "vars.h"
#include "globals.h"
#include "os.h"
ram's avatar
ram committed
#include "interrupt.h"
wlott's avatar
wlott committed
#include "arch.h"
#include "gc.h"
#include "monitor.h"
#include "validate.h"
dtc's avatar
dtc committed
#if defined GENCGC
#include "gencgc.h"
#endif
wlott's avatar
wlott committed
#include "core.h"
#include "save.h"
#include "lispregs.h"

hallgren's avatar
hallgren committed
#ifdef irix
#include <string.h>
#include "interr.h"
#endif

wlott's avatar
wlott committed

/* SIGINT handler that invokes the monitor. */

ram's avatar
ram committed
static void sigint_handler(HANDLER_ARGS)
wlott's avatar
wlott committed
{
pw's avatar
pw committed
#if ( defined( __linux__ ) && defined( i386 ) )
ram's avatar
ram committed
  GET_CONTEXT
#endif

ram's avatar
ram committed
    SAVE_CONTEXT();

ram's avatar
ram committed
    printf("\nSIGINT hit at 0x%08lX\n", SC_PC(context));
wlott's avatar
wlott committed
    ldb_monitor();
}

/* Not static, because we want to be able to call it from lisp land. */
void sigint_init(void)
{
    install_handler(SIGINT, sigint_handler);
}


/* Noise to convert argv and argp into lists. */

static lispobj alloc_str_list(char *list[])
{
    lispobj result, newcons;
    struct cons *ptr;

    if (*list == NULL)
        result = NIL;
    else {
        result = newcons = alloc_cons(alloc_string(*list++), NIL);

        while (*list != NULL) {
            ptr = (struct cons *)PTR(newcons);
            newcons = alloc_cons(alloc_string(*list++), NIL);
            ptr->cdr = newcons;
        }
    }

    return result;
}


/* And here be main. */

void main(int argc, char *argv[], char *envp[])
{
    char *arg, **argptr;
    char *core = NULL, *default_core;
    boolean monitor;
    lispobj initial_function;
wlott's avatar
wlott committed

wlott's avatar
wlott committed
#ifdef MACH
wlott's avatar
wlott committed
    mach_init();
wlott's avatar
wlott committed
#endif
ram's avatar
ram committed
#if defined(SVR4) || defined(__linux__)
ram's avatar
ram committed
    tzset();
#endif
wlott's avatar
wlott committed

    set_lossage_handler(ldb_monitor);

    monitor = FALSE;
#ifdef DEFAULT_DYNAMIC_SPACE_SIZE
    dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE;
#else
    dynamic_space_size = DYNAMIC_SPACE_SIZE;
#endif
wlott's avatar
wlott committed

    argptr = argv;
    while ((arg = *++argptr) != NULL)
      {
        if (strcmp(arg, "-core") == 0)
	  {
            if (core != NULL)
	      {
wlott's avatar
wlott committed
                fprintf(stderr, "can only specify one core file.\n");
                exit(1);
wlott's avatar
wlott committed
            core = *++argptr;
            if (core == NULL)
	      {
		fprintf(stderr, "-core must be followed by the name of the core file to use.\n");
wlott's avatar
wlott committed
                exit(1);
	      }
	  }
        else if (strcmp(arg, "-dynamic-space-size") == 0)
	  {
            char *str = *++argptr;
            if (str == NULL)
	      {
                fprintf(stderr, "-dynamic-space-size must be followed by the size to use in MBytes.\n");
                exit(1);
	      }
	    dynamic_space_size = atoi(str) * 1024 * 1024;
	    if (dynamic_space_size > DYNAMIC_SPACE_SIZE)
	      {
                fprintf(stderr, "-dynamic-space-size must be no greater than %d MBytes.\n",
			DYNAMIC_SPACE_SIZE / (1024 * 1024));
                exit(1);
	      }
	  }
	else if (strcmp(arg, "-monitor") == 0)
	  {
wlott's avatar
wlott committed
	    monitor = TRUE;
wlott's avatar
wlott committed

    default_core = arch_init();
    if (default_core == NULL)
	default_core = "lisp.core";

    if (core == NULL) {
wlott's avatar
wlott committed
	extern char *getenv(char *var);
hallgren's avatar
hallgren committed
#endif
wlott's avatar
wlott committed
	static char buf[MAXPATHLEN];
	char *lib = getenv("CMUCLLIB");

	if (lib != NULL) {
	    char *dst;
	    struct stat statbuf;

	    do {
		dst = buf;
		while (*lib != '\0' && *lib != ':')
		    *dst++ = *lib++;
		if (dst != buf && dst[-1] != '/')
		    *dst++ = '/';
		strcpy(dst, default_core);
		if (stat(buf, &statbuf) == 0) {
		    core = buf;
		    break;
		}
	    } while (*lib++ == ':');
	}
	if (core == NULL) {
	    /* Note: the /usr/misc/.cmucl/lib/ default path is also wired
ram's avatar
ram committed
	       into the lisp code in .../code/save.lisp. */
wlott's avatar
wlott committed
	    strcpy(buf, "/usr/misc/.cmucl/lib/");
ram's avatar
ram committed
#else
#ifdef __linux__
	    strcpy(buf, "/usr/lib/cmucl/");
#else
	    strcpy(buf, "/usr/local/lib/cmucl/lib/");
ram's avatar
ram committed
#endif
wlott's avatar
wlott committed
	    strcat(buf, default_core);
	    core = buf;
	}
    }

    os_init();
    gc_init();
    validate();

    /* This is the first use of malloc() and must come after the
     * static memory layout is mmapped to avoid conflicts with possible
     * use of mmap() by malloc().
     */
    define_var("nil", NIL, TRUE);
    define_var("t"  ,   T, TRUE);

wlott's avatar
wlott committed
    globals_init();

    initial_function = load_core_file(core);
wlott's avatar
wlott committed

dtc's avatar
dtc committed

#if defined GENCGC
    gencgc_pickup_dynamic();
#else
ram's avatar
ram committed
#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
    {
      extern int use_cgc_p;
      lispobj x = SymbolValue(X86_CGC_ACTIVE_P);
      if(x != type_UnboundMarker && x != NIL)
	use_cgc_p = 1;		/* enable allocator */
    }
#endif
dtc's avatar
dtc committed
#endif
ram's avatar
ram committed

wlott's avatar
wlott committed
#ifdef BINDING_STACK_POINTER
    SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack);
wlott's avatar
wlott committed
#endif
ram's avatar
ram committed
#if defined INTERNAL_GC_TRIGGER && !defined i386
    SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
wlott's avatar
wlott committed
#endif

    interrupt_init();

    arch_install_interrupt_handlers();
    os_install_interrupt_handlers();

#ifdef PSEUDO_ATOMIC_ATOMIC
    /* Turn on pseudo atomic for when we call into lisp. */
    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
#endif

    /* Convert the argv and envp to something Lisp can grok. */
    SetSymbolValue(LISP_COMMAND_LINE_LIST, alloc_str_list(argv));
    SetSymbolValue(LISP_ENVIRONMENT_LIST, alloc_str_list(envp));
wlott's avatar
wlott committed

    /*
     * Parse the command line again, picking up values that override
     * those loaded from the core.
     */

    argptr = argv;
    while ((arg = *++argptr) != NULL)
      {
	if (strcmp(arg, "-batch") == 0)
dtc's avatar
dtc committed
	  SetSymbolValue(BATCH_MODE, T);
      }

    /*
     * Pick off sigint until the lisp system gets far enough along to
     * install it's own.
     */
wlott's avatar
wlott committed
    sigint_init();

wlott's avatar
wlott committed
	    ldb_monitor();
    else {
	funcall0(initial_function);
	printf("Initial function returned?\n");
	exit(1);
wlott's avatar
wlott committed
    }
}