Skip to content
Snippets Groups Projects
lisp.c 4.62 KiB
Newer Older
wlott's avatar
wlott committed
/*
 * main() entry point for a stand alone lisp image.
 *
ram's avatar
ram committed
 * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.11 1997/01/21 00:28:13 ram 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"
#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
{
ram's avatar
ram committed
#ifdef __linux__
  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);

    define_var("nil", NIL, TRUE);
    define_var("t", T, TRUE);
    monitor = FALSE;

    argptr = argv;
    while ((arg = *++argptr) != NULL) {
        if (strcmp(arg, "-core") == 0) {
            if (core != NULL) {
                fprintf(stderr, "can only specify one core file.\n");
                exit(1);
            }
            core = *++argptr;
            if (core == NULL) {
                fprintf(stderr, "-core must be followed by the name of the core file to use.\n");
                exit(1);
            }
        }
	else if (strcmp(arg, "-monitor") == 0) {
	    monitor = TRUE;
	}
    }

    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();
    globals_init();

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

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

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, fixnum(-1));
wlott's avatar
wlott committed
#endif

    interrupt_init();

    arch_install_interrupt_handlers();
    os_install_interrupt_handlers();

    /* 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));

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

    /* Pick off sigint until the lisp system gets far enough along to */
    /* install it's own. */
    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
    }
}