Skip to content
Snippets Groups Projects
Commit a20170bc authored by toy's avatar toy
Browse files

o Adds support for searching for the lisp.core file based on the

  location of the lisp C binary, when CMUCLLIB is not given, and the
  core file is not specified.
o Add support for a CMUCLCORE envvar, and a -lib option for setting
  the path for the library: search-list.
o Added some spare static symbols for the sparc port so we don't have
  to cross-compile again for a while.

See cmucl-imp archives for some more details.
parent 3e74d923
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/commandline.lisp,v 1.12 2001/12/08 18:42:39 pmai Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/commandline.lisp,v 1.13 2003/01/29 19:47:47 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -214,3 +214,4 @@ ...@@ -214,3 +214,4 @@
(defswitch "hinit") (defswitch "hinit")
(defswitch "batch") (defswitch "batch")
(defswitch "dynamic-space-size") (defswitch "dynamic-space-size")
(defswitch "lib")
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.44 2002/07/10 16:40:43 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.45 2003/01/29 19:47:47 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -43,6 +43,8 @@ ...@@ -43,6 +43,8 @@
;;; Filled in by the startup code. ;;; Filled in by the startup code.
(defvar lisp-environment-list) (defvar lisp-environment-list)
(defvar *cmucl-lib*) ; Essentially the envvar CMUCLLIB, where available
(defvar *cmucl-core-path*) ; Path to where the Lisp core file was found.
;;; PARSE-UNIX-SEARCH-LIST -- Internal ;;; PARSE-UNIX-SEARCH-LIST -- Internal
...@@ -50,23 +52,26 @@ ...@@ -50,23 +52,26 @@
;;; Returns a list of the directories that are in the specified Unix ;;; Returns a list of the directories that are in the specified Unix
;;; environment variable. Return NIL if the variable is undefined. ;;; environment variable. Return NIL if the variable is undefined.
;;; ;;;
(defun parse-unix-search-path (path)
(do* ((i 0 (1+ p))
(p (position #\: path :start i)
(position #\: path :start i))
(pl ()))
((null p)
(let ((s (subseq path i)))
(if (string= s "")
(push "default:" pl)
(push (concatenate 'simple-string s "/") pl)))
(nreverse pl))
(let ((s (subseq path i p)))
(if (string= s "")
(push "default:" pl)
(push (concatenate 'simple-string s "/") pl)))))
(defun parse-unix-search-list (var) (defun parse-unix-search-list (var)
(let ((path (cdr (assoc var ext::*environment-list*)))) (let ((path (cdr (assoc var ext::*environment-list*))))
(when path (when path
(do* ((i 0 (1+ p)) (parse-unix-search-path path))))
(p (position #\: path :start i)
(position #\: path :start i))
(pl ()))
((null p)
(let ((s (subseq path i)))
(if (string= s "")
(push "default:" pl)
(push (concatenate 'simple-string s "/") pl)))
(nreverse pl))
(let ((s (subseq path i p)))
(if (string= s "")
(push "default:" pl)
(push (concatenate 'simple-string s "/") pl)))))))
;;; ENVIRONMENT-INIT -- Internal ;;; ENVIRONMENT-INIT -- Internal
...@@ -90,7 +95,8 @@ ...@@ -90,7 +95,8 @@
(list (default-directory)))) (list (default-directory))))
(setf (search-list "library:") (setf (search-list "library:")
(or (parse-unix-search-list :cmucllib) (if (boundp '*cmucl-lib*)
(parse-unix-search-path *cmucl-lib*)
'("/usr/local/lib/cmucl/lib/"))) '("/usr/local/lib/cmucl/lib/")))
(setf (search-list "modules:") '("library:subsystems/"))) (setf (search-list "modules:") '("library:subsystems/")))
...@@ -119,7 +125,7 @@ ...@@ -119,7 +125,7 @@
If true (the default), do a purifying GC which moves all dynamically If true (the default), do a purifying GC which moves all dynamically
allocated objects into static space so that they stay pure. This takes allocated objects into static space so that they stay pure. This takes
somewhat longer than the normal GC which is otherwise done, but GC's will somewhat longer than the normal GC which is otherwise done, but GC's will
done less often and take less time in the resulting core file. See be done less often and take less time in the resulting core file. See
EXT:PURIFY. EXT:PURIFY.
:root-structures :root-structures
...@@ -246,7 +252,17 @@ ...@@ -246,7 +252,17 @@
,#'(lambda (stream) ,#'(lambda (stream)
(write-string (lisp-implementation-version) stream)) (write-string (lisp-implementation-version) stream))
", running on " ", running on "
,#'(lambda (stream) (write-string (machine-instance) stream)))) ,#'(lambda (stream) (write-string (machine-instance) stream))
terpri
,#'(lambda (stream)
(let ((core (if (boundp '*cmucl-core-path*)
(truename *cmucl-core-path*)
nil)))
(when core
(write-string "With core: " stream)
(write-string (namestring core) stream))))
terpri
))
(setf (getf *herald-items* :bugs) (setf (getf *herald-items* :bugs)
'("Send questions to cmucl-help@cons.org. and bug reports to cmucl-imp@cons.org." '("Send questions to cmucl-help@cons.org. and bug reports to cmucl-imp@cons.org."
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.37 2002/10/25 21:49:08 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.38 2003/01/29 19:47:48 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -280,6 +280,21 @@ ...@@ -280,6 +280,21 @@
;; Foreign linkage stuff ;; Foreign linkage stuff
#+linkage-table #+linkage-table
lisp::*linkage-table-data* lisp::*linkage-table-data*
;;
lisp::*cmucl-lib*
lisp::*cmucl-core-path*
;;
spare-9
spare-8
spare-7
spare-6
spare-5
spare-4
spare-3
spare-2
spare-1
spare-0
)) ))
(defparameter static-functions (defparameter static-functions
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.20 2002/08/27 22:18:28 moore Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.21 2003/01/29 19:47:48 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -302,9 +302,12 @@ ...@@ -302,9 +302,12 @@
;; common slot unbound check. ;; common slot unbound check.
pcl::..slot-unbound.. pcl::..slot-unbound..
;; Spare symbols ;; These are filled in the C run-time.
spare-10 lisp::*cmucl-lib*
spare-9 lisp::*cmucl-core-path*
;; Spare symbols. Rename these when you need to add some static
;; symbols and don't want to do a cross-compile.
spare-8 spare-8
spare-7 spare-7
spare-6 spare-6
......
/* /*
* main() entry point for a stand alone lisp image. * main() entry point for a stand alone lisp image.
* *
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.27 2003/01/23 21:05:38 toy Exp $ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.28 2003/01/29 19:47:49 toy Exp $
* *
*/ */
...@@ -61,7 +61,7 @@ void sigint_init(void) ...@@ -61,7 +61,7 @@ void sigint_init(void)
} }
/* Noise to convert argv and argp into lists. */ /* Noise to convert argv and envp into lists. */
static lispobj alloc_str_list(char *list[]) static lispobj alloc_str_list(char *list[])
{ {
...@@ -83,13 +83,207 @@ static lispobj alloc_str_list(char *list[]) ...@@ -83,13 +83,207 @@ static lispobj alloc_str_list(char *list[])
return result; return result;
} }
/* Default paths for CMUCLLIB */
static char* cmucllib_search_list[] =
{
"./.",
"./../lib/cmucl/lib",
"./../lib",
"/usr/local/lib/cmucl/lib",
NULL
};
/*
* From the current location of the lisp executable, create a suitable
* default for CMUCLLIB
*/
char *
default_cmucllib(char* argv0)
{
char* p;
char* defpath;
char* cwd;
/*
* From argv[0], create the appropriate directory by lopping off the
* executable name
*/
p = strrchr(argv0, '/');
if (p == NULL) {
*argv0 = '\0';
} else if (p != argv0) {
*p = '\0';
}
/*
* Create the full pathname of the directory containing the
* executable. argv[0] can be an absolute or relative path.
*/
if (argv0[0] == '/') {
cwd = malloc(strlen(argv0) + 2);
strcpy(cwd, argv0);
strcat(cwd, "/");
} else {
/*
* 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) + 100);
getcwd(cwd, MAXPATHLEN);
strcat(cwd, "/");
if (*argv0 != '\0') {
strcat(cwd, argv0);
strcat(cwd, "/");
}
}
/* 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();
}
}
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! */
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;
}
/* And here be main. */ /* And here be main. */
int main(int argc, char *argv[], char *envp[]) int main(int argc, char *argv[], char *envp[])
{ {
char *arg, **argptr; char *arg, **argptr;
char *core = NULL, *default_core; char *core = NULL;
char *default_core;
char *lib = NULL;
char *cmucllib = NULL;
boolean monitor; boolean monitor;
lispobj initial_function; lispobj initial_function;
...@@ -100,6 +294,7 @@ int main(int argc, char *argv[], char *envp[]) ...@@ -100,6 +294,7 @@ int main(int argc, char *argv[], char *envp[])
set_lossage_handler(ldb_monitor); set_lossage_handler(ldb_monitor);
monitor = FALSE; monitor = FALSE;
#ifdef DEFAULT_DYNAMIC_SPACE_SIZE #ifdef DEFAULT_DYNAMIC_SPACE_SIZE
dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE; dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE;
#else #else
...@@ -123,6 +318,15 @@ int main(int argc, char *argv[], char *envp[]) ...@@ -123,6 +318,15 @@ int main(int argc, char *argv[], char *envp[])
exit(1); 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) else if (strcmp(arg, "-dynamic-space-size") == 0)
{ {
char *str = *++argptr; char *str = *++argptr;
...@@ -149,47 +353,6 @@ int main(int argc, char *argv[], char *envp[]) ...@@ -149,47 +353,6 @@ int main(int argc, char *argv[], char *envp[])
if (default_core == NULL) if (default_core == NULL)
default_core = "lisp.core"; default_core = "lisp.core";
if (core == NULL) {
#ifdef MACH
extern char *getenv(char *var);
#endif
static char buf[_POSIX_PATH_MAX];
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)
fprintf(stderr, "WARNING: Couldn't find core in specified CMUCLLIB, using default path.\n");
}
if (core == NULL) {
/* Note: the /usr/misc/.cmucl/lib/ default path is also wired
into the lisp code in .../code/save.lisp. */
#ifdef MACH
strcpy(buf, "/usr/misc/.cmucl/lib/");
#else
strcpy(buf, "/usr/local/lib/cmucl/lib/");
#endif
strcat(buf, default_core);
core = buf;
}
}
os_init(); os_init();
validate(); validate();
gc_init(); gc_init();
...@@ -201,6 +364,88 @@ int main(int argc, char *argv[], char *envp[]) ...@@ -201,6 +364,88 @@ int main(int argc, char *argv[], char *envp[])
define_var("nil", NIL, TRUE); define_var("nil", NIL, TRUE);
define_var("t" , T, 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;
}
}
}
/*
* 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 die */
fprintf(stderr, "Cannot find core file %s\n", core);
exit(1);
}
}
globals_init(); globals_init();
initial_function = load_core_file(core); initial_function = load_core_file(core);
...@@ -243,6 +488,10 @@ int main(int argc, char *argv[], char *envp[]) ...@@ -243,6 +488,10 @@ int main(int argc, char *argv[], char *envp[])
SetSymbolValue(LISP_COMMAND_LINE_LIST, alloc_str_list(argv)); SetSymbolValue(LISP_COMMAND_LINE_LIST, alloc_str_list(argv));
SetSymbolValue(LISP_ENVIRONMENT_LIST, alloc_str_list(envp)); SetSymbolValue(LISP_ENVIRONMENT_LIST, alloc_str_list(envp));
/* 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 * Parse the command line again, picking up values that override
* those loaded from the core. * those loaded from the core.
...@@ -261,10 +510,11 @@ int main(int argc, char *argv[], char *envp[]) ...@@ -261,10 +510,11 @@ int main(int argc, char *argv[], char *envp[])
*/ */
sigint_init(); sigint_init();
if (monitor) if (monitor) {
while (1) while (1) {
ldb_monitor(); ldb_monitor();
else { }
} else {
funcall0(initial_function); funcall0(initial_function);
printf("Initial function returned?\n"); printf("Initial function returned?\n");
exit(1); exit(1);
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment