Skip to content
Snippets Groups Projects
lisp.c 15.3 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.35 2003/08/18 20:48:38 toy Exp $
wlott's avatar
wlott committed
 *
 */

#include <stdio.h>
#include <sys/types.h>
#include <stdlib.h>
toy's avatar
toy committed
#include <limits.h>
wlott's avatar
wlott committed
#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
#include "interr.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 envp into lists. */
wlott's avatar
wlott committed

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;
}

/* Default paths for CMUCLLIB */
static char* cmucllib_search_list[] =
{
    "./.",
    "./../lib/cmucl/lib",
    "./../lib",
    "/usr/local/lib/cmucl/lib",
    NULL
};

/*
 * Define this to get some debugging printfs for searching for the
 * lisp core file.  Sometimes needed because you can't debug this with
 * gdb which always seems to set argv[0] to the full pathname.
 */

/* #define DEBUG_LISP_SEARCH */

/*
 * From the current location of the lisp executable, create a suitable
 * default for CMUCLLIB
 */
char *
cracauer's avatar
 
cracauer committed
default_cmucllib(const char const* argv0arg)
{
    char* p;
    char* defpath;
    char* cwd;
    char *argv0_dir = strdup(argv0arg);
    
    /*
     * From argv[0], create the appropriate directory by lopping off the
     * executable name
     */

    p = strrchr(argv0_dir, '/');
        *argv0_dir = '\0';
    } else if (p != argv0_dir) {
        *p = '\0';
    }
    
    /*
     * Create the full pathname of the directory containing the
     * executable.  argv[0] can be an absolute or relative path.
     */
#ifdef DEBUG_LISP_SEARCH
    fprintf(stderr, "argv[0] = %s\n", argv0arg);
    fprintf(stderr, "argv_dir = %s\n", argv0_dir);
#endif
    
    if (argv0_dir[0] == '/') {
        cwd = malloc(strlen(argv0_dir) + 2);
        strcpy(cwd, argv0_dir);
#ifdef DEBUG_LISP_SEARCH
        fprintf(stderr, "absolute path, argv[0] = %s\n", cwd);
#endif
    } else if (*argv0_dir != '\0') {
        /*
         * argv[0] is a relative path.  Get the current directory and
         * append argv[0], after stripping off the executable name.
         */
        cwd = malloc(MAXPATHLEN + strlen(argv0_dir) + 100);
        getcwd(cwd, MAXPATHLEN);
        strcat(cwd, "/");
        if (*argv0_dir != '\0') {
            strcat(cwd, argv0_dir);
#ifdef DEBUG_LISP_SEARCH
        fprintf(stderr, "relative path, argv[0] = %s\n", cwd);
#endif
    } else {
       /*
        * argv[0] is someplace on the user's PATH
        *
        */
       char *path = getenv("PATH");
       char *p1, *p2 = NULL;
       struct stat buf;

#ifdef DEBUG_LISP_SEARCH
        fprintf(stderr, "User's PATH = %s\n", path);
#endif
       cwd = malloc(MAXPATHLEN + strlen(argv0arg) + 100);

       if (p == NULL) {
         p = argv0arg;
       }

       for (p1 = path ; *p1 != '\0' ; p1 = p2) {
           p2 = strchr(p1, ':');
           if (p2 == NULL)
               p2 = p1 + strlen(p1);
           strncpy(cwd, p1, p2 - p1);
           cwd[p2 - p1] = '/';
           cwd[p2 - p1 + 1] = '\0';
           strcpy(cwd + (p2 - p1 + 1), p);

#ifdef DEBUG_LISP_SEARCH
           fprintf(stderr, "User's PATH, trying %s\n", cwd);
#endif
           if (stat(cwd, &buf) == 0) {

#ifdef DEBUG_LISP_SEARCH
             fprintf(stderr, "User's PATH, found %s\n", cwd);
#endif
             break;
           }
           
           if (*p2 == ':') {
               p2++;
           }
           
       }
       if (p1 == p2) {
         cwd[0] = '\0';
       } else {
         cwd[p2 - p1 + 1] = '\0';
       }
#ifdef DEBUG_LISP_SEARCH
             fprintf(stderr, "User's PATH, Final cwd %s\n", cwd);
#endif
       
    }

    /* Create the appropriate value for CMUCLLIB */

    {
        char** ptr;
        int total_len;
        int cwd_len;
        
	/* First figure out how much space we need */

        total_len = 0;
        cwd_len = strlen(cwd);

        ptr = cmucllib_search_list;
        
        while (*ptr != NULL) {
            /* Plus 2 for the ":" and "/" we need to add */
            total_len += strlen(*ptr) + cwd_len + 2;
            ++ptr;
        }

	/* Create the colon separated list of directories */
	
        defpath = malloc(total_len + 1);

        ptr = cmucllib_search_list;
        while (*ptr != NULL) {
            if (*ptr[0] != '/') {
                strcat(defpath, cwd);
            }
            
            strcat(defpath, *ptr);

            if (ptr[1] != NULL) {
                strcat(defpath, ":");
            }
            
            ++ptr;
        }

	if (strlen(defpath) > total_len) {
	    abort();
	}
    }
cracauer's avatar
 
cracauer committed

    free(cwd);

    return defpath;
}

/*
 * Search the a core file with the name given by default_core in the
 * colon-separated list of directories given by lib.
 *
 * Return the full path, if found, or NULL if not.
 */

char*
search_core(const char* lib, const char* default_core)
{
    char *buf;
    char *dst;
    struct stat statbuf;

    /*
     * A buffer that's large enough to hold lib, default_core, a
     * slash, and a the string terminator
     */
    buf = malloc(strlen(lib) + strlen(default_core) + 2);
    
    do {
	dst = buf;
	/*
	 * Extract out everything to the first colon, then append a
	 * "/" and the core name.  See if the file exists.
	 */
	while (*lib != '\0' && *lib != ':')
	    *dst++ = *lib++;
	if (dst != buf && dst[-1] != '/')
	    *dst++ = '/';
	strcpy(dst, default_core);
	/* If it exists, we are done! */

#ifdef DEBUG_LISP_SEARCH
        fprintf(stderr, "Looking at `%s'\n", buf);
#endif
	if (stat(buf, &statbuf) == 0) {
	    return buf;
	}
    } while (*lib++ == ':');

    free(buf);
    return NULL;
}

/*
 * Given the path to a core file, prepend the absolute location of the
 * core file to the lib path.
 *
 * Return the new lib path.
 */
char*
prepend_core_path(char* lib, char* corefile)
{
    char cwd[MAXPATHLEN];
    char *path;
    char *result;
    char *sep;
    
    if (*corefile == '/') {
	path = strdup(corefile);
    } else {
	/*
	 * We have a relative path for the corefile.  Prepend our current
	 * directory to get the full path.
	 */
	getcwd(cwd, MAXPATHLEN);
	path = malloc(MAXPATHLEN + strlen(corefile) + 2);
	strcpy(path, cwd);
	strcat(path, "/");
	strcat(path, corefile);
    }

    /*
     * Now remove the name portion by finding the last slash.
     */
    sep = strrchr(path, '/');
    if (sep != NULL) {
	*sep = '\0';
    }

    result = malloc(strlen(path) + strlen(lib) + 2);
    strcpy(result, path);
    strcat(result, ":");
    strcat(result, lib);

    free(path);
    return result;
}
wlott's avatar
wlott committed


/* The symbol initial_function_addr is used globally as a flag to
   indicate whether the executable contains the lisp image.  The
   reason for this is that we use the linker to set the value of the
   symbol.  But the symbol is an address, not a variable value.  So
   for this to work as a flag, it must end up pointing to a valid
   place in memory or we'll get a bus error or segmentation violation
   when we check it.  The initial function address will be a valid
   place in memory (or else we have worse problems).  FMG */

int initial_function_addr = 0;

wlott's avatar
wlott committed
/* And here be main. */

pw's avatar
pw committed
int main(int argc, char *argv[], char *envp[])
wlott's avatar
wlott committed
{
    char *arg, **argptr;
    char *core = NULL;
    char *default_core;
    char *lib = NULL;
    char *cmucllib = NULL;

    lispobj initial_function = 0;

    if (initial_function_addr != 0)
      initial_function = &initial_function_addr;
wlott's avatar
wlott committed

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 (initial_function_addr) {
	      fprintf(stderr, "Cannot specify core file in executable image --- sorry about that.\n");
	      exit(1);
	    }	      
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, "-lib") == 0)
	  {
	    lib = *++argptr;
	    if (lib == NULL)
	      {
		fprintf(stderr, "-lib must be followed by a string denoting the CMUCL library path.\n");
		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";

    os_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);

    /*
     * Basic algorithm for setting CMUCLLIB and CMUCLCORE, from Pierre
     * Mai.
     *
     * if CMUCLLIB envvar is not set
     *	 CMUCLLIB = our list of places to look
     *	 if -core option/CMUCLCORE given
     *	    CMUCLLIB = CMUCLLIB + full path to the specified core file
     *	 endif
     * endif
     *
     * if -core option/CMUCLCORE unset
     *	 search for a core file (named whatever arch_init returns or
     *	   lisp.core) somewhere in the CMUCLLIB list.
     * endif
     *
     * if core found
     *	 use that
     * else
     *	 give error message and die
     * endif
     *
     * CMUCLCORE = where the core file was found/specced
     */

    /*
     * Set cmucllib to the -lib option, or to CMUCLLIB envvar.  If
     * neither are set, set cmucllib to our default search path.
     */
    if (lib != NULL) {
	cmucllib = strdup(lib);
    } else {
	char *libvar;

	libvar = getenv("CMUCLLIB");
	if (libvar != NULL) {
	    cmucllib = strdup(libvar);
	} else {
	    char *newlib = NULL;

	    /*
	     * We need to use our default search path.  If a core file
	     * is given, we prepend the directory of the core file to
	     * the search path.
	     */
	    cmucllib = default_cmucllib(argv[0]);
	    if (core != NULL) {
		newlib = prepend_core_path(cmucllib, core);
	    } else if (getenv("CMUCLCORE") != NULL) {
		core = getenv("CMUCLCORE");
		newlib = prepend_core_path(cmucllib, core);
	    }

	    if (newlib != NULL) {
		free(cmucllib);
		cmucllib = newlib;
	    }
	}
    }


    /* Only look for a core file if we're not using a built-in image.*/
    if (initial_function_addr == 0) {
      /*
       * If no core file specified, search for it in CMUCLLIB
       */
      if (core == NULL) {
	  if (getenv("CMUCLCORE") == NULL) {
	      core = search_core(cmucllib, default_core);
	  } else {
	      core = getenv("CMUCLCORE");
	  }
      }
      /* Die if the core file doesn't exist. */
      {
	  struct stat statbuf;
	  if (stat(core, &statbuf) != 0) {
	      /* Can't find it so print a message and exit */
              fprintf(stderr, "Cannot find core file");
	      if (core != NULL) {
                  fprintf(stderr, " %s", core);
	      }
	      fprintf(stderr, "\n");
	      fprintf(stderr, "Based on lisp binary path `%s'\n", argv[0]);
	      exit(1);
	  }
      }
    } else {
      /* The "core file" is the executable.  We have to do this
       * because this file actually gets checked for later."
       */
      core = argv[0];
wlott's avatar
wlott committed
    globals_init();

    if(initial_function_addr != 0) {
      extern int image_dynamic_space_size;
      int allocation_pointer = dynamic_0_space + (int)&image_dynamic_space_size;
#ifdef i386
      SetSymbolValue(ALLOCATION_POINTER, (lispobj)allocation_pointer);
#else
      current_dynamic_space_free_pointer = (lispobj)allocation_pointer;
#endif
    } else {
      initial_function = load_core_file(core);
    }

moore's avatar
 
moore committed
#if defined LINKAGE_TABLE
    os_foreign_linkage_init();
#endif /* LINKAGE_TABLE */
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

    /* Set cmucllib and cmuclcore appropriately */
    SetSymbolValue(CMUCL_LIB, alloc_string(cmucllib));
    SetSymbolValue(CMUCL_CORE_PATH, alloc_string(core));
    
    /*
     * 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();

    if (monitor) {
        while (1) {
            ldb_monitor();
        }
    } else {
	funcall0(initial_function);
	printf("Initial function returned?\n");
	exit(1);
wlott's avatar
wlott committed
    }
toy's avatar
toy committed
    return 0;                   /* not reached */
wlott's avatar
wlott committed
}