diff --git a/code/save.lisp b/code/save.lisp index b77807accee8cc35692f91b696257487fe645cba..703bd8dba9dd5c779ce27390a3907b523cb4c0ee 100644 --- a/code/save.lisp +++ b/code/save.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.16 1992/08/06 01:44:17 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.17 1993/04/28 01:56:52 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -47,10 +47,6 @@ (defvar lisp-environment-list) -(alien:def-alien-routine "save" (alien:boolean) - (file c-call:c-string)) - - ;;; PARSE-UNIX-SEARCH-LIST -- Internal ;;; ;;; Returns a list of the directories that are in the specified Unix @@ -99,13 +95,19 @@ (or (parse-unix-search-list :cmucllib) '("/usr/misc/.cmucl/lib/")))) + + +;;;; SAVE-LISP itself. + +(alien:def-alien-routine "save" (alien:boolean) + (file c-call:c-string) + (initial-function (alien:unsigned #.vm:word-bits))) + (defun save-lisp (core-file-name &key (purify t) (root-structures ()) (constants nil) - (init-function - #'(lambda () - (throw 'top-level-catcher nil))) + (init-function #'%top-level) (load-init-file t) (site-init "library:site-init") (print-herald t) @@ -128,9 +130,8 @@ :init-function This is a function which is called when the created core file is - resumed. The default function simply aborts to the top level - read-eval-print loop. If the function returns it will be the value - of Save-Lisp. + resumed. The default function simply invokes the top level + read-eval-print loop. If the function returns the lisp will exit. :load-init-file If true, then look for an init.lisp or init.fasl file when the core @@ -148,40 +149,58 @@ (if purify (purify :root-structures root-structures :constants constants) (gc)) - (unless (save (unix-namestring core-file-name nil)) - (reinit) - (dolist (f *before-save-initializations*) (funcall f)) - (dolist (f *after-save-initializations*) (funcall f)) - (environment-init) - (when site-init (load site-init :if-does-not-exist nil :verbose nil)) - (when process-command-line (ext::process-command-strings)) - (setf *editor-lisp-p* nil) - (macrolet ((find-switch (name) - `(find ,name *command-line-switches* - :key #'cmd-switch-name - :test #'(lambda (x y) - (declare (simple-string x y)) - (string-equal x y))))) - (when (and process-command-line (find-switch "edit")) - (setf *editor-lisp-p* t)) - (when (and load-init-file - (not (and process-command-line (find-switch "noinit")))) - (let* ((cl-switch (find-switch "init")) - (name (and cl-switch - (or (cmd-switch-value cl-switch) - (car (cmd-switch-words cl-switch)))))) - (if name - (load (merge-pathnames name #p"home:") :if-does-not-exist nil) - (or (load "home:init" :if-does-not-exist nil) - (load "home:.cmucl-init" :if-does-not-exist nil)))))) - (when process-command-line - (ext::invoke-switch-demons *command-line-switches* - *command-switch-demons*)) - (when print-herald - (print-herald)) - (funcall init-function))) + (flet + ((restart-lisp () + (catch '%end-of-the-world + (with-simple-restart (abort "Skip remaining initializations.") + (catch 'top-level-catcher + (reinit) + (dolist (f *before-save-initializations*) (funcall f)) + (dolist (f *after-save-initializations*) (funcall f)) + (environment-init) + (when site-init + (load site-init :if-does-not-exist nil :verbose nil)) + (when process-command-line + (ext::process-command-strings)) + (setf *editor-lisp-p* nil) + (macrolet ((find-switch (name) + `(find ,name *command-line-switches* + :key #'cmd-switch-name + :test #'(lambda (x y) + (declare (simple-string x y)) + (string-equal x y))))) + (when (and process-command-line (find-switch "edit")) + (setf *editor-lisp-p* t)) + (when (and load-init-file + (not (and process-command-line + (find-switch "noinit")))) + (let* ((cl-switch (find-switch "init")) + (name (and cl-switch + (or (cmd-switch-value cl-switch) + (car (cmd-switch-words + cl-switch)))))) + (if name + (load (merge-pathnames name #p"home:") + :if-does-not-exist nil) + (or (load "home:init" :if-does-not-exist nil) + (load "home:.cmucl-init" + :if-does-not-exist nil)))))) + (when process-command-line + (ext::invoke-switch-demons *command-line-switches* + *command-switch-demons*)) + (when print-herald + (print-herald)))) + (funcall init-function)) + (unix:unix-exit 0))) + (let ((initial-function (get-lisp-obj-address #'restart-lisp))) + (without-gcing + (save (unix-namestring core-file-name nil) initial-function)))) + nil) + +;;;; PRINT-HERALD support. + (defvar *herald-items* () "Determines what PRINT-HERALD prints (the system startup banner.) This is a database which can be augmented by each loaded system. The format is a diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index 9666ca9a7cb338e8ea8505236379008b9179964b..a721b2a69d2dcaa166f9fc4cec188ec85508254a 100644 --- a/compiler/generic/new-genesis.lisp +++ b/compiler/generic/new-genesis.lisp @@ -6,7 +6,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.4 1993/02/26 08:42:50 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.5 1993/04/28 02:03:42 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1915,7 +1915,11 @@ header-name (make-pathname :type "h"))) core-name))) - (write-initial-core-file core-name version))) + (write-initial-core-file + core-name version + (let ((fdefn (cold-fdefinition-object + (cold-intern '%initial-function)))) + (read-indexed fdefn vm:fdefn-function-slot))))) (dolist (space (list *static* *dynamic* *read-only*)) (when space (deallocate-space space)))))) @@ -1974,6 +1978,7 @@ (defparameter validate-entry-type-code 3845) (defparameter directory-entry-type-code 3841) (defparameter new-directory-entry-type-code 3861) +(defparameter initial-function-entry-type-code 3863) (defparameter end-entry-type-code 3840) (defun write-long (num) @@ -2031,7 +2036,7 @@ (write-long pages) (incf *data-page* pages))) -(defun write-initial-core-file (name version) +(defun write-initial-core-file (name version initial-function) (format t "[Building Initial Core File (version ~D) in file ~S: ~%" version (namestring name)) (force-output) @@ -2062,6 +2067,10 @@ (output-space *static*) (output-space *dynamic*) + (write-long initial-function-entry-type-code) + (write-long 3) + (write-long (descriptor-bits initial-function)) + ;; Write the End entry. ;; (write-long end-entry-type-code) diff --git a/lisp/core.h b/lisp/core.h index 1010fd0388644a683d0eda5baf4e52c808442133..8a98cf6c86b1dc569731c911dd09a670596ebde8 100644 --- a/lisp/core.h +++ b/lisp/core.h @@ -1,10 +1,9 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/core.h,v 1.1 1992/07/28 20:14:19 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/core.h,v 1.2 1993/04/28 01:58:30 wlott Exp $ */ #ifndef _CORE_H_ #define _CORE_H_ #include "lisp.h" -#include "lispregs.h" #define CORE_PAGESIZE OS_VM_DEFAULT_PAGESIZE #define CORE_MAGIC (('C' << 24) | ('O' << 16) | ('R' << 8) | 'E') @@ -13,6 +12,7 @@ #define CORE_VALIDATE 3845 #define CORE_VERSION 3860 #define CORE_MACHINE_STATE 3862 +#define CORE_INITIAL_FUNCTION 3863 #define DYNAMIC_SPACE_ID (1) #define STATIC_SPACE_ID (2) @@ -26,20 +26,6 @@ struct ndir_entry { long page_count; }; -struct machine_state { - lispobj *csp; - lispobj *cfp; - long control_stack_page; - -#ifdef reg_BSP - lispobj *bsp; -#endif - long binding_stack_page; - - char *nsp; - long number_stack_page; -}; - -extern boolean load_core_file(char *file); +extern lispobj load_core_file(char *file); #endif diff --git a/lisp/coreparse.c b/lisp/coreparse.c index ec98103a59f3a4f271fff3180517c0bf1ab524de..e9418e4d60e171e4c24fbf60852c23fbd3a8e996 100644 --- a/lisp/coreparse.c +++ b/lisp/coreparse.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.1 1992/07/28 20:14:21 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.2 1993/04/28 01:58:31 wlott Exp $ */ #include <stdio.h> #include <sys/types.h> #include <sys/file.h> @@ -7,134 +7,139 @@ #include "lisp.h" #include "globals.h" #include "core.h" -#include "save.h" +#include "internals.h" extern int version; static void process_directory(int fd, long *ptr, int count) { - long id, offset, len; - lispobj *free_pointer; - os_vm_address_t addr; - struct ndir_entry *entry; - - entry = (struct ndir_entry *) ptr; - - while (count-- > 0) { - id = entry->identifier; - offset = CORE_PAGESIZE * (1 + entry->data_page); - addr = (os_vm_address_t) (CORE_PAGESIZE * entry->address); - free_pointer = (lispobj *) addr + entry->nwords; - len = CORE_PAGESIZE * entry->page_count; - - if (len != 0) { - os_vm_address_t real_addr; + long id, offset, len; + lispobj *free_pointer; + os_vm_address_t addr; + struct ndir_entry *entry; + + entry = (struct ndir_entry *) ptr; + + while (count-- > 0) { + id = entry->identifier; + offset = CORE_PAGESIZE * (1 + entry->data_page); + addr = (os_vm_address_t) (CORE_PAGESIZE * entry->address); + free_pointer = (lispobj *) addr + entry->nwords; + len = CORE_PAGESIZE * entry->page_count; + + if (len != 0) { + os_vm_address_t real_addr; #ifdef PRINTNOISE - printf("Mapping %d bytes at 0x%x.\n", len, addr); + printf("Mapping %d bytes at 0x%x.\n", len, addr); #endif - real_addr=os_map(fd, offset, addr, len); - if(real_addr!=addr) - fprintf(stderr, - "process_directory: file mapped in wrong place! (0x%08x != 0x%08x)\n", - real_addr, - addr); - } + real_addr=os_map(fd, offset, addr, len); + if(real_addr!=addr) + fprintf(stderr, + "process_directory: file mapped in wrong place! (0x%08x != 0x%08x)\n", + real_addr, + addr); + } #if 0 - printf("Space ID = %d, free pointer = 0x%08x.\n", id, free_pointer); + printf("Space ID = %d, free pointer = 0x%08x.\n", id, free_pointer); #endif - switch (id) { - case DYNAMIC_SPACE_ID: - if (addr != (os_vm_address_t)dynamic_0_space && addr != (os_vm_address_t)dynamic_1_space) - printf("Strange ... dynamic space lossage.\n"); - current_dynamic_space = (lispobj *)addr; + switch (id) { + case DYNAMIC_SPACE_ID: + if (addr != (os_vm_address_t)dynamic_0_space + && addr != (os_vm_address_t)dynamic_1_space) + printf("Strange ... dynamic space lossage.\n"); + current_dynamic_space = (lispobj *)addr; #ifdef ibmrt - SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer); + SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer); #else - current_dynamic_space_free_pointer = free_pointer; + current_dynamic_space_free_pointer = free_pointer; #endif - break; - case STATIC_SPACE_ID: - static_space = (lispobj *) addr; - break; - case READ_ONLY_SPACE_ID: - /* Don't care about read only space */ - break; - default: - printf("Strange space ID: %d; ignored.\n", id); - break; - } - entry++; + break; + case STATIC_SPACE_ID: + static_space = (lispobj *) addr; + break; + case READ_ONLY_SPACE_ID: + /* Don't care about read only space */ + break; + default: + printf("Strange space ID: %d; ignored.\n", id); + break; } + entry++; + } } -boolean load_core_file(char *file) +lispobj load_core_file(char *file) { int fd = open(file, O_RDONLY), count; long header[CORE_PAGESIZE / sizeof(long)], val, len, *ptr; - boolean restore_state = FALSE; + lispobj initial_function = NIL; if (fd < 0) { - fprintf(stderr, "Could not open file \"%s\".\n", file); - perror("open"); - exit(1); + fprintf(stderr, "Could not open file \"%s\".\n", file); + perror("open"); + exit(1); } count = read(fd, header, CORE_PAGESIZE); if (count < 0) { - perror("read"); - exit(1); + perror("read"); + exit(1); } if (count < CORE_PAGESIZE) { - fprintf(stderr, "Premature EOF.\n"); - exit(1); + fprintf(stderr, "Premature EOF.\n"); + exit(1); } ptr = header; val = *ptr++; if (val != CORE_MAGIC) { - fprintf(stderr, "Invalid magic number: 0x%x should have been 0x%x.\n", - val, CORE_MAGIC); - exit(1); + fprintf(stderr, "Invalid magic number: 0x%x should have been 0x%x.\n", + val, CORE_MAGIC); + exit(1); } while (val != CORE_END) { - val = *ptr++; - len = *ptr++; - - switch (val) { - case CORE_END: - break; - - case CORE_VERSION: - if (*ptr != version) { - fprintf(stderr, "WARNING: ldb version (%d) different from core version (%d).\nYou may lose big.\n", version, *ptr); - } - break; - - case CORE_VALIDATE: - fprintf(stderr, "Validation no longer supported; ignored.\n"); - break; - - case CORE_NDIRECTORY: - process_directory(fd, ptr, - (len-2) / (sizeof(struct ndir_entry) / sizeof(long))); - break; - - case CORE_MACHINE_STATE: - restore_state = TRUE; - load(fd, (struct machine_state *)ptr); - break; - - default: - printf("Unknown core file entry: %d; skipping.\n", val); - break; - } - - ptr += len - 2; + val = *ptr++; + len = *ptr++; + + switch (val) { + case CORE_END: + break; + + case CORE_VERSION: + if (*ptr != version) { + fprintf(stderr, "WARNING: startup-code version (%d) different from core version (%d).\nYou may lose big.\n", version, *ptr); + } + break; + + case CORE_VALIDATE: + fprintf(stderr, "Validation no longer supported; ignored.\n"); + break; + + case CORE_NDIRECTORY: + process_directory(fd, ptr, + (len-2) / (sizeof(struct ndir_entry) / sizeof(long))); + break; + + case CORE_INITIAL_FUNCTION: + initial_function = (lispobj)*ptr; + break; + + case CORE_MACHINE_STATE: + fprintf(stderr, "Obsolete core file.\n"); + exit(1); + break; + + default: + printf("Unknown core file entry: %d; skipping.\n", val); + break; + } + + ptr += len - 2; } - return restore_state; + return initial_function; } diff --git a/lisp/hppa-validate.h b/lisp/hppa-validate.h index 693f241fa4aa02299a1ab04a7aa2a6501ad2b3c6..b53075ad90db1cabdecb2f7473fa1b2e2f1a2aac 100644 --- a/lisp/hppa-validate.h +++ b/lisp/hppa-validate.h @@ -14,7 +14,3 @@ #define BINDING_STACK_START (0x70000000) #define BINDING_STACK_SIZE (0x00100000) - -#define NUMBER_STACK_START (0x60000000) -#define NUMBER_STACK_SIZE (0x00100000) -#define NUMBER_STACK_GROWS_UP diff --git a/lisp/lisp.c b/lisp/lisp.c index 6ec41ebd0c2521bade9ac1e9e4fbe61f7dd08d5f..ea500561ad3dadc1553d0883e21c0699dd3c79f3 100644 --- a/lisp/lisp.c +++ b/lisp/lisp.c @@ -1,7 +1,7 @@ /* * main() entry point for a stand alone lisp image. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.3 1993/02/09 14:02:37 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.4 1993/04/28 01:58:33 wlott Exp $ * */ @@ -29,9 +29,6 @@ #include "save.h" #include "lispregs.h" -lispobj lisp_nil_reg = NIL; -char *lisp_csp_reg, *lisp_bsp_reg; - /* SIGINT handler that invokes the monitor. */ @@ -70,24 +67,6 @@ static lispobj alloc_str_list(char *list[]) return result; } - -/* stuff to start a kernel core */ - -extern void call_on_stack(void fn(), os_vm_address_t new_sp); - -void call_initial_function() -{ - funcall0(SymbolFunction(INITIAL_FUNCTION)); - printf("%%INITIAL-FUNCTION returned?\n"); -} - -void call_ldb_monitor() -{ - while (1) - ldb_monitor(); -} - - /* And here be main. */ @@ -95,7 +74,8 @@ void main(int argc, char *argv[], char *envp[]) { char *arg, **argptr; char *core = NULL, *default_core; - boolean restore_state, monitor; + boolean monitor; + lispobj initial_function; #ifdef MACH mach_init(); @@ -166,16 +146,14 @@ void main(int argc, char *argv[], char *envp[]) validate(); globals_init(); - restore_state = load_core_file(core); + initial_function = load_core_file(core); - if (!restore_state) { #ifdef BINDING_STACK_POINTER - SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack); + SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack); #endif #ifdef INTERNAL_GC_TRIGGER - SetSymbolValue(INTERNAL_GC_TRIGGER, fixnum(-1)); + SetSymbolValue(INTERNAL_GC_TRIGGER, fixnum(-1)); #endif - } interrupt_init(); @@ -196,19 +174,12 @@ void main(int argc, char *argv[], char *envp[]) /* install it's own. */ sigint_init(); - if (restore_state) { - if (monitor) { - printf("exit ldb monitor to restore\n"); + if (monitor) + while (1) ldb_monitor(); - } - restore(); + else { + funcall0(initial_function); + printf("Initial function returned?\n"); + exit(1); } - else - call_on_stack(monitor ? call_ldb_monitor : call_initial_function, -#ifdef NUMBER_STACK_GROWS_UP - NUMBER_STACK_START -#else - NUMBER_STACK_START+NUMBER_STACK_SIZE -#endif - ); } diff --git a/lisp/mips-validate.h b/lisp/mips-validate.h index 749ac5b01c5de957c9e84058f5990b7c5053e4b0..f0ee9d76658474f3589c720c868bba0b9a163099 100644 --- a/lisp/mips-validate.h +++ b/lisp/mips-validate.h @@ -14,6 +14,3 @@ #define BINDING_STACK_START (0x60000000) #define BINDING_STACK_SIZE (0x00100000) - -#define NUMBER_STACK_START (0x70000000) -#define NUMBER_STACK_SIZE (0x00100000) diff --git a/lisp/monitor.c b/lisp/monitor.c index 50224b8be2ca5f0f8fb751d27e685f040688b02d..e752f9cfb1bdd2eebd090a0ef5130866841d51f9 100644 --- a/lisp/monitor.c +++ b/lisp/monitor.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.c,v 1.2 1992/12/17 13:20:45 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.c,v 1.3 1993/04/28 01:59:00 wlott Exp $ */ #include <stdio.h> #include <sys/types.h> @@ -22,7 +22,6 @@ #include "gc.h" #include "search.h" #include "purify.h" -#include "save.h" extern boolean isatty(int fd); @@ -31,7 +30,7 @@ typedef void cmd(char **ptr); static cmd call_cmd, dump_cmd, print_cmd, quit, help; static cmd flush_cmd, search_cmd, regs_cmd, exit_cmd; static cmd gc_cmd, print_context_cmd; -static cmd backtrace_cmd, purify_cmd, catchers_cmd, save_cmd; +static cmd backtrace_cmd, purify_cmd, catchers_cmd; static cmd grab_sigs_cmd; static struct cmd { @@ -55,7 +54,6 @@ static struct cmd { {"p", NULL, print_cmd}, {"quit", "quit.", quit}, {"regs", "display current lisp regs.", regs_cmd}, - {"save", "save the current lisp image.", save_cmd}, {"search", "search for TYPE starting at ADDRESS for a max of COUNT words.", search_cmd}, {"s", NULL, search_cmd}, {NULL, NULL, NULL} @@ -393,14 +391,6 @@ static void catchers_cmd(char **ptr) } } -static void save_cmd(char **ptr) -{ - if (more_p(ptr)) - save(*ptr); - else - save("lisp.core"); -} - static void grab_sigs_cmd(char **ptr) { extern void sigint_init(void); diff --git a/lisp/save.c b/lisp/save.c index 33748565e068510c7d59709e500c454df6d86bea..15563dd4c8946b9e7090df97318c446bb08d21dc 100644 --- a/lisp/save.c +++ b/lisp/save.c @@ -8,16 +8,12 @@ #include "internals.h" #include "core.h" #include "globals.h" -#include "lispregs.h" -#include "interrupt.h" #include "save.h" +#include "lispregs.h" #include "validate.h" extern int version; -extern void restore_state(char *stack_ptr, int result); -extern int save_state(int fn(char *stack_ptr, FILE *file), FILE *file); - static long write_bytes(FILE *file, char *addr, long bytes) { long count, here, data; @@ -65,24 +61,26 @@ static void output_space(FILE *file, int id, lispobj *addr, lispobj *end) putw((bytes + CORE_PAGESIZE - 1) / CORE_PAGESIZE, file); } -static long write_stack(FILE *file, char *name, char *start, char *end) +boolean save(char *filename, lispobj init_function) { - long len; - - start = (char *)os_trunc_to_page((os_vm_address_t)start); - end = (char *)os_round_up_to_page((os_vm_address_t)end); - - len = end-start; - - printf("Writing %d bytes from the %s stack at 0x%08X.\n", len, name, - (unsigned long)start); + FILE *file; - return write_bytes(file, start, len); -} + /* Open the file: */ + unlink(filename); + file = fopen(filename, "w"); + if (file == NULL) { + perror(filename); + return TRUE; + } + printf("[Undoing binding stack... "); + fflush(stdout); + unbind_to_here((lispobj *)BINDING_STACK_START); + SetSymbolValue(CURRENT_CATCH_BLOCK, 0); + SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0); + SetSymbolValue(EVAL_STACK_TOP, 0); + printf("done]\n"); -static int do_save(char *stack_ptr, FILE *file) -{ - struct machine_state ms; + printf("[Saving current lisp image into %s:\n", filename); putw(CORE_MAGIC, file); @@ -105,125 +103,14 @@ static int do_save(char *stack_ptr, FILE *file) (lispobj *)SymbolValue(ALLOCATION_POINTER)); #endif - putw(CORE_MACHINE_STATE, file); - putw(2 + sizeof(ms)/sizeof(long), file); - - ms.csp = current_control_stack_pointer; - ms.cfp = current_control_frame_pointer; - ms.control_stack_page = write_stack(file, "Control", - (char *)control_stack, - (char *)current_control_stack_pointer); - -#ifdef reg_BSP - ms.bsp = current_binding_stack_pointer; - ms.binding_stack_page = write_stack(file, "Binding", - (char *)binding_stack, - (char *)current_binding_stack_pointer); -#else - ms.binding_stack_page = write_stack(file, "Binding", - (char *)binding_stack, - (char *)SymbolValue(BINDING_STACK_POINTER)); -#endif - - ms.nsp = stack_ptr; -#ifdef NUMBER_STACK_GROWS_UP - ms.number_stack_page = write_stack(file, "Number", - (char *)NUMBER_STACK_START, - stack_ptr); -#else - ms.number_stack_page = write_stack(file, "Number", stack_ptr, - (char *)(NUMBER_STACK_START+NUMBER_STACK_SIZE)); -#endif - - fwrite((void *)&ms, sizeof(ms), 1, file); + putw(CORE_INITIAL_FUNCTION, file); + putw(3, file); + putw(init_function, file); putw(CORE_END, file); fclose(file); printf("done.]\n"); - return 1; -} - -int save(char *filename) -{ - FILE *file; - - /* Open the file: */ - unlink(filename); - file = fopen(filename, "w"); - if (file == NULL) { - perror(filename); - return TRUE; - } - printf("[Saving current lisp image into %s:\n", filename); - - return save_state(do_save, file); -} - -static os_vm_address_t map_stack(int fd, os_vm_address_t start, - os_vm_address_t end, - long data_page, - char *name) -{ - os_vm_size_t len; - - start = os_trunc_to_page(start); - len = os_round_up_to_page(end) - start; - - if (len != 0) { -#ifdef PRINTNOISE - printf("Mapping %d bytes onto the %s stack at 0x%08x.\n", len, name, start); -#endif - start=os_map(fd, (1+data_page)*CORE_PAGESIZE, start, len); - } - - return start; -} - -static char *restored_nsp; - -void load(int fd, struct machine_state *ms) -{ - current_control_stack_pointer = ms->csp; - current_control_frame_pointer = ms->cfp; -#ifdef reg_BSP - current_binding_stack_pointer = ms->bsp; -#endif - - map_stack(fd, - (os_vm_address_t)control_stack, - (os_vm_address_t)current_control_stack_pointer, - ms->control_stack_page, - "Control"); - - map_stack(fd, - (os_vm_address_t)binding_stack, -#ifdef reg_BSP - (os_vm_address_t)current_binding_stack_pointer, -#else - (os_vm_address_t)SymbolValue(BINDING_STACK_POINTER), -#endif - ms->binding_stack_page, - "Binding"); - - map_stack(fd, -#ifdef NUMBER_STACK_GROWS_UP - NUMBER_STACK_START, - (os_vm_address_t)ms->nsp, -#else - (os_vm_address_t)ms->nsp, - NUMBER_STACK_START+NUMBER_STACK_SIZE, -#endif - ms->number_stack_page, - "Number"); - - restored_nsp = ms->nsp; -} - -void restore(void) -{ - restore_state(restored_nsp, 0); - - fprintf(stderr, "Hm, tried to restore, but nothing happened.\n"); + exit(0); } diff --git a/lisp/save.h b/lisp/save.h index f197387b135fcdf591b3445ed56814d9585106fd..51c8a37cb4c02b7b9f11179fa57f94f40fee1c9f 100644 --- a/lisp/save.h +++ b/lisp/save.h @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.h,v 1.1 1992/07/28 20:15:30 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.h,v 1.2 1993/04/28 01:58:37 wlott Exp $ */ #ifndef _SAVE_H_ @@ -7,8 +7,6 @@ #include "core.h" -extern void restore(void); -extern boolean save(char *filename); -extern void load(int fd, struct machine_state *ms); +extern boolean save(char *filename, lispobj initfun); #endif diff --git a/lisp/sparc-validate.h b/lisp/sparc-validate.h index c6b150faec7ad681b560a0c9058a893a46dd749b..c46e7d11fe4db30b2ad85fc8acb69abb0e1c42db 100644 --- a/lisp/sparc-validate.h +++ b/lisp/sparc-validate.h @@ -15,12 +15,5 @@ #define BINDING_STACK_START (0x00180000) #define BINDING_STACK_SIZE (0x00078000) -#ifdef SUNOS -#define NUMBER_STACK_START (0xf7ef0000) -#else -#define NUMBER_STACK_START (0xf0000000) -#endif -#define NUMBER_STACK_SIZE (0x00100000) - #define HOLES {0x0bff8000, 0x0fff8000, 0x17ff8000, 0x1fff8000} #define HOLE_SIZE 0x2000 diff --git a/lisp/validate.c b/lisp/validate.c index c10186b68d8039b199b006a6ee9b0d28bad99fdb..e931de6a25a3820c5ad042ab1e672b669bdb4e3d 100644 --- a/lisp/validate.c +++ b/lisp/validate.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.3 1993/01/18 02:12:17 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.4 1993/04/28 01:58:43 wlott Exp $ * * Memory Validation */ @@ -75,11 +75,6 @@ void validate(void) binding_stack = (lispobj *) BINDING_STACK_START; ensure_space(binding_stack, BINDING_STACK_SIZE); - /* Number stack */ -#ifndef SUNOS - ensure_space((lispobj *)NUMBER_STACK_START, NUMBER_STACK_SIZE); -#endif - #ifdef HOLES make_holes(); #endif