From: William Harold Newman Date: Sun, 10 Jun 2001 18:28:19 +0000 (+0000) Subject: 0.6.12.28: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6cbe4d8ba6d7bc469d03a72514c789b1f3944878;p=sbcl.git 0.6.12.28: cleanups pending from flaky2_branch and SB!FASL-package adventures, part I (deleting stale stuff).. ..deleted "blue bag" stuff ..deleted WANT_CGC and ibmrt stuff ..deleted x86-cgc stuff ..deleted "grep -i 'spare-[0-9]'" stuff ..deleted *SCAVENGE-READ-ONLY-SPACE* ..bumped fasl version number since *SCAVENGE-READ-ONLY-SPACE* is gone from *STATIC-SYMBOLS* --- 6cbe4d8ba6d7bc469d03a72514c789b1f3944878 diff --cc src/code/early-fasl.lisp index b5c7849,0000000..be0d3ab mode 100644,000000..100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@@ -1,134 -1,0 +1,135 @@@ +;;;; needed-early, or at least meaningful-early, stuff for FASL files + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!FASL") + +;;;; various constants and essentially-constants + +;;; a string which appears at the start of a fasl file header +;;; +;;; This value is used to identify fasl files. Even though this is not +;;; declared as a constant (because ANSI Common Lisp has no facility +;;; for declaring values which are constant under EQUAL but not EQL), +;;; obviously you shouldn't mess with it lightly. If you do set a new +;;; value for some reason, keep these things in mind: +;;; * To avoid confusion with the similar but incompatible CMU CL +;;; fasl file format, the value should not be "FASL FILE", which +;;; is what CMU CL used for the same purpose. +;;; * Since its presence at the head of a file is used by LOAD to +;;; decide whether a file is to be fasloaded or just loaded +;;; ordinarily (as source), the value should be something which +;;; can't legally appear at the head of a Lisp source file. +;;; * The value should not contain any line-terminating characters, +;;; because they're hard to express portably and because the LOAD +;;; code might reasonably use READ-LINE to get the value to compare +;;; against. +(defparameter *fasl-header-string-start-string* "# FASL") + +;;; the code for a character which terminates a fasl file header +(defconstant +fasl-header-string-stop-char-code+ 255) + +;;; This value should be incremented when the system changes in such +;;; a way that it will no longer work reliably with old fasl files. - (defconstant +fasl-file-version+ 12) ++(defconstant +fasl-file-version+ 13) +;;; 2 = sbcl-0.6.4 uses COMPILE-OR-LOAD-DEFGENERIC. +;;; 3 = sbcl-0.6.6 uses private symbol, not :EMPTY, for empty HASH-TABLE slot. +;;; 4 = sbcl-0.6.7 uses HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET +;;; when array headers or data element type uncertainty exist, and +;;; uses DATA-VECTOR-REF and DATA-VECTOR-SET only for VOPs. (Thus, +;;; full calls to DATA-VECTOR-REF and DATA-VECTOR-SET from older +;;; fasl files would fail, because there are no DEFUNs for these +;;; operations any more.) +;;; 5 = sbcl-0.6.8 has rearranged static symbols. +;;; 6 = sbcl-0.6.9, got rid of non-ANSI %DEFCONSTANT/%%DEFCONSTANT stuff +;;; and deleted a slot from DEBUG-SOURCE structure. +;;; 7 = around sbcl-0.6.9.8, merged SB-CONDITIONS package into SB-KERNEL +;;; 8 = sbcl-0.6.10.4 revived Gray stream support, changing stream layouts. +;;; 9 = deleted obsolete CONS-UNIQUE-TAG bytecode in sbcl-0.6.11.8 +;;; (somewhere in here also changes to AND and OR CTYPE layouts) +;;; 10 = new layout for CONDITION in sbcl-0.6.11.38 +;;; 11 = (a) new helper functions for MAKE-LOAD-FORM (HASH-TABLE) in - ;;; sbcl-0.6.12.11 - ;;; (b) new address space constants for OpenBSD in 0.6.12.17, - ;;; doesn't need separate version from (a) because the OpenBSD - ;;; port was broken from sometime before 0.6.12.11 until - ;;; the address space was changed ++;;; sbcl-0.6.12.11 ++;;; (b) new address space constants for OpenBSD in 0.6.12.17 ++;;; (doesn't need separate version from (a) because the ++;;; OpenBSD port was broken from sometime before 0.6.12.11 ++;;; until the address space was changed) +;;; 12 = sbcl-0.6.12.22 added new SB-FASL package ++;;; 13 = sbcl-0.6.12.x removed some elements from *STATIC-SYMBOLS* + +;;; the conventional file extension for fasl files on this +;;; architecture, e.g. "x86f" +(declaim (type (or simple-string null) *backend-fasl-file-type*)) +(defvar *backend-fasl-file-type* nil) + +;;; This is a sort of pun that we inherited from CMU CL. For ordinary, +;;; non-byte-coded fasl files, the "implementation" is basically the +;;; CPU. For byte-coded fasl files, the "implementation" is whether +;;; the data are stored big-endianly or little-endianly. +(defun backend-byte-fasl-file-implementation () + *backend-byte-order*) + +;;; information about below-Lisp-level linkage +;;; +;;; Note: +;;; Assembler routines are named by full Lisp symbols: they +;;; have packages and that sort of native Lisp stuff associated +;;; with them. We can compare them with EQ. +;;; Foreign symbols are named by Lisp strings: the Lisp package +;;; system doesn't extend out to symbols in languages like C. +;;; We want to use EQUAL to compare them. +;;; *STATIC-FOREIGN-SYMBOLS* are static as opposed to "dynamic" (not +;;; as opposed to "extern"). The table contains symbols known at +;;; the time that the program was built, but not symbols defined +;;; in object files which have been loaded dynamically since then. +(declaim (type hash-table *assembler-routines* *static-foreign-symbols*)) +(defvar *assembler-routines* (make-hash-table :test 'eq)) +(defvar *static-foreign-symbols* (make-hash-table :test 'equal)) + +;;;; the FOP database + +(declaim (simple-vector *fop-names* *fop-functions*)) + +;;; a vector indexed by a FaslOP that yields the FOP's name +(defvar *fop-names* (make-array 256 :initial-element nil)) + +;;; a vector indexed by a FaslOP that yields a function of 0 arguments +;;; which will perform the operation +(defvar *fop-functions* + (make-array 256 + :initial-element (lambda () + (error "corrupt fasl file: losing FOP")))) + +;;;; other miscellaneous loading-related stuff + + +;;;; variables + +(defvar *load-depth* 0 + #!+sb-doc + "the current number of recursive LOADs") +(declaim (type index *load-depth*)) + +;;; the FASL file we're reading from +(defvar *fasl-input-stream*) +(declaim (type lisp-stream *fasl-input-stream*)) + +(defvar *load-print* nil + #!+sb-doc + "the default for the :PRINT argument to LOAD") +(defvar *load-verbose* nil + ;; Note that CMU CL's default for this was T, and ANSI says it's + ;; implementation-dependent. We choose NIL on the theory that it's + ;; a nicer default behavior for Unix programs. + #!+sb-doc + "the default for the :VERBOSE argument to LOAD") + +(defvar *load-code-verbose* nil) + diff --cc src/code/early-impl.lisp index ec6b02b,c3bcaee..dd7fce5 --- a/src/code/early-impl.lisp +++ b/src/code/early-impl.lisp @@@ -50,7 -41,7 +50,4 @@@ sb!vm::*fp-constant-l2e* sb!vm::*fp-constant-lg2* sb!vm::*fp-constant-ln2* -- sb!vm::*scavenge-read-only-space* -- sb!pcl::..slot-unbound.. -- sb!vm::*x86-cgc-active-p* -- sb!vm::*static-blue-bag*)) ++ sb!pcl::..slot-unbound..)) diff --cc src/code/gc.lisp index 35f646b,89daf1f..34c98ba --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@@ -189,12 -190,12 +189,10 @@@ (declaim (type (or index null) *gc-trigger*)) --;;; On the RT, we store the GC trigger in a ``static'' symbol instead of --;;; letting magic C code handle it. It gets initialized by the startup --;;; code. The X86 port defines this here because it uses the `ibmrt' --;;; feature in the C code for allocation and binding stack access and --;;; a lot of stuff wants this INTERNAL_GC_TRIGGER available as well. --#!+(or ibmrt x86) ++;;; On the X86, we store the GC trigger in a ``static'' symbol instead ++;;; of letting magic C code handle it. It gets initialized by the ++;;; startup code. ++#!+x86 (defvar sb!vm::*internal-gc-trigger*) ;;;; The following specials are used to control when garbage collection diff --cc src/code/x86-vm.lisp index b907676,9c1e08c..73cb5eb --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@@ -320,10 -320,10 +320,6 @@@ (defvar *fp-constant-lg2*) (defvar *fp-constant-ln2*) --;;; Enable/disable scavenging of the read-only space. --(defvar *scavenge-read-only-space* nil) --;;; FIXME: should be *SCAVENGE-READ-ONLY-SPACE-P* -- ;;; The current alien stack pointer; saved/restored for non-local exits. (defvar *alien-stack*) diff --cc src/compiler/generic/genesis.lisp index b75b246,c50f246..55c58b2 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@@ -179,11 -176,11 +179,11 @@@ (gspace-name gspace) "unknown")))))))) --(defun allocate-descriptor (gspace length lowtag) -- #!+sb-doc -- "Return a descriptor for a block of LENGTH bytes out of GSPACE. The free -- word index is boosted as necessary, and if additional memory is needed, we -- grow the GSPACE. The descriptor returned is a pointer of type LOWTAG." ++;;; Return a descriptor for a block of LENGTH bytes out of GSPACE. The ++;;; free word index is boosted as necessary, and if additional memory ++;;; is needed, we grow the GSPACE. The descriptor returned is a ++;;; pointer of type LOWTAG. ++(defun allocate-cold-descriptor (gspace length lowtag) (let* ((bytes (round-up length (ash 1 sb!vm:lowtag-bits))) (old-free-word-index (gspace-free-word-index gspace)) (new-free-word-index (+ old-free-word-index @@@ -512,16 -509,16 +512,16 @@@ #!+sb-doc "Allocate LENGTH words in GSPACE and return a new descriptor of type LOWTAG pointing to them." -- (allocate-descriptor gspace (ash length sb!vm:word-shift) lowtag)) ++ (allocate-cold-descriptor gspace (ash length sb!vm:word-shift) lowtag)) (defun allocate-unboxed-object (gspace element-bits length type) #!+sb-doc "Allocate LENGTH units of ELEMENT-BITS bits plus a header word in GSPACE and return an ``other-pointer'' descriptor to them. Initialize the header word with the resultant length and TYPE." (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits)) -- (des (allocate-descriptor gspace -- (+ bytes sb!vm:word-bytes) -- sb!vm:other-pointer-type))) ++ (des (allocate-cold-descriptor gspace ++ (+ bytes sb!vm:word-bytes) ++ sb!vm:other-pointer-type))) (write-memory des (make-other-immediate-descriptor (ash bytes (- sb!vm:word-shift)) @@@ -535,8 -532,8 +535,9 @@@ ;; FIXME: Here and in ALLOCATE-UNBOXED-OBJECT, BYTES is calculated using ;; #'/ instead of #'CEILING, which seems wrong. (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits)) -- (des (allocate-descriptor gspace (+ bytes (* 2 sb!vm:word-bytes)) -- sb!vm:other-pointer-type))) ++ (des (allocate-cold-descriptor gspace ++ (+ bytes (* 2 sb!vm:word-bytes)) ++ sb!vm:other-pointer-type))) (write-memory des (make-other-immediate-descriptor 0 type)) (write-wordindexed des sb!vm:vector-length-slot @@@ -1243,9 -1242,9 +1244,7 @@@ (cold-set 'sb!vm::*fp-constant-lg2* (number-to-core (log 2L0 10L0))) (cold-set 'sb!vm::*fp-constant-ln2* (number-to-core -- (log 2L0 2.718281828459045235360287471352662L0)))) -- #!+gencgc -- (cold-set 'sb!vm::*SCAVENGE-READ-ONLY-GSPACE* *nil-descriptor*))) ++ (log 2L0 2.718281828459045235360287471352662L0)))))) ;;; Make a cold list that can be used as the arg list to MAKE-PACKAGE in order ;;; to make a package that is similar to PKG. @@@ -2228,14 -2243,14 +2227,11 @@@ ;; Note: we round the number of constants up to ensure ;; that the code vector will be properly aligned. (round-up raw-header-n-words 2)) -- (des (allocate-descriptor -- ;; In the X86 with CGC, code can't be relocated, so -- ;; we have to put it into static space. In all other -- ;; configurations, code can go into dynamic space. -- #!+(and x86 cgc) *static* ; KLUDGE: Why? -- WHN 19990907 -- #!-(and x86 cgc) *dynamic* -- (+ (ash header-n-words sb!vm:word-shift) code-size) -- sb!vm:other-pointer-type))) ++ (des (allocate-cold-descriptor *dynamic* ++ (+ (ash header-n-words ++ sb!vm:word-shift) ++ code-size) ++ sb!vm:other-pointer-type))) (write-memory des (make-other-immediate-descriptor header-n-words sb!vm:code-header-type)) @@@ -2363,10 -2378,10 +2359,11 @@@ ;; Note: we round the number of constants up to ensure that ;; the code vector will be properly aligned. (round-up sb!vm:code-constants-offset 2)) -- (des (allocate-descriptor *read-only* -- (+ (ash header-n-words sb!vm:word-shift) -- length) -- sb!vm:other-pointer-type))) ++ (des (allocate-cold-descriptor *read-only* ++ (+ (ash header-n-words ++ sb!vm:word-shift) ++ length) ++ sb!vm:other-pointer-type))) (write-memory des (make-other-immediate-descriptor header-n-words sb!vm:code-header-type)) @@@ -2996,11 -3011,11 +2993,17 @@@ initially undefined function references ;; Tell the target Lisp how much stuff we've allocated. (cold-set 'sb!vm:*read-only-space-free-pointer* -- (allocate-descriptor *read-only* 0 sb!vm:even-fixnum-type)) ++ (allocate-cold-descriptor *read-only* ++ 0 ++ sb!vm:even-fixnum-type)) (cold-set 'sb!vm:*static-space-free-pointer* -- (allocate-descriptor *static* 0 sb!vm:even-fixnum-type)) ++ (allocate-cold-descriptor *static* ++ 0 ++ sb!vm:even-fixnum-type)) (cold-set 'sb!vm:*initial-dynamic-space-free-pointer* -- (allocate-descriptor *dynamic* 0 sb!vm:even-fixnum-type)) ++ (allocate-cold-descriptor *dynamic* ++ 0 ++ sb!vm:even-fixnum-type)) (/show "done setting free pointers") ;; Write results to files. diff --cc src/compiler/x86/parms.lisp index 2a5a9b8,8bbe40c..b95bc6f --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@@ -224,8 -224,8 +224,6 @@@ ;;; Note these spaces grow from low to high addresses. (defvar *allocation-pointer*) (defvar *binding-stack-pointer*) --(defvar *x86-cgc-active-p*) ; FIXME: Document this. --(defvar *static-blue-bag* nil) ;;; FIXME: *!INITIAL-FDEFN-OBJECTS* and !COLD-INIT probably don't need ;;; to be in the static symbols table any more. Also, if @@@ -285,29 -285,29 +283,13 @@@ sb!vm::*fp-constant-lg2* sb!vm::*fp-constant-ln2* -- ;; used by gencgc -- sb!vm::*scavenge-read-only-space* -- ;; The ..SLOT-UNBOUND.. symbol is static in order to optimise the ;; common slot unbound check. -- sb!pcl::..slot-unbound.. -- -- ;; spare symbols -- sb!vm::spare-10 -- sb!vm::spare-9 -- sb!vm::spare-8 -- sb!vm::spare-7 -- sb!vm::spare-6 -- sb!vm::spare-5 -- sb!vm::spare-4 -- sb!vm::spare-3 -- sb!vm::spare-2 -- sb!vm::spare-1 -- -- ;; used by cgc -- sb!vm::*x86-cgc-active-p* -- sb!vm::*static-blue-bag* ; must be last or change C code -- )) ++ ;; ++ ;; FIXME: In SBCL, the CLOS code has become sufficiently tightly ++ ;; integrated into the system that it'd probably make sense to use ++ ;; the ordinary unbound marker for this. ++ sb!pcl::..slot-unbound..)) (defparameter *static-functions* '(length diff --cc src/runtime/alloc.c index c909e2f,c909e2f..c78d167 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@@ -20,25 -20,25 +20,16 @@@ #include "gc.h" #include --#ifdef ibmrt --#define GET_FREE_POINTER() ((lispobj *)SymbolValue(ALLOCATION_POINTER)) --#define SET_FREE_POINTER(new_value) \ -- (SetSymbolValue(ALLOCATION_POINTER,(lispobj)(new_value))) --#define GET_GC_TRIGGER() ((lispobj *)SymbolValue(INTERNAL_GC_TRIGGER)) --#define SET_GC_TRIGGER(new_value) \ -- (SetSymbolValue(INTERNAL_GC_TRIGGER,(lispobj)(new_value))) --#else #define GET_FREE_POINTER() dynamic_space_free_pointer #define SET_FREE_POINTER(new_value) \ (dynamic_space_free_pointer = (new_value)) #define GET_GC_TRIGGER() current_auto_gc_trigger #define SET_GC_TRIGGER(new_value) \ clear_auto_gc_trigger(); set_auto_gc_trigger(new_value); #define ALIGNED_SIZE(n) (n+lowtag_Mask) & ~lowtag_Mask --#if defined(WANT_CGC) || defined(GENCGC) ++#if defined GENCGC extern lispobj *alloc(int bytes); #else static lispobj * diff --cc src/runtime/coreparse.c index 64c495d,64c495d..f314449 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@@ -81,9 -81,9 +81,9 @@@ process_directory(int fd, long *ptr, in } #endif /* FIXME: Should the conditional here be reg_ALLOC instead of -- * defined(ibmrt) || defined(__i386__) ++ * defined(__i386__) * ? */ --#if defined(ibmrt) || defined(__i386__) ++#if defined(__i386__) SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer); #else dynamic_space_free_pointer = free_pointer; diff --cc src/runtime/dynbind.c index 503fb49,503fb49..8a3a548 --- a/src/runtime/dynbind.c +++ b/src/runtime/dynbind.c @@@ -18,7 -18,7 +18,7 @@@ #include "globals.h" #include "dynbind.h" --#if defined(ibmrt) || defined(__i386__) ++#if defined(__i386__) #define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER)) #define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value)) #else diff --cc src/runtime/gc.c index 0c79f92,90a0f40..fda4e74 --- a/src/runtime/gc.c +++ b/src/runtime/gc.c @@@ -230,11 -230,11 +230,7 @@@ struct timeval start_tv, stop_tv /* Set up from space and new space pointers. */ from_space = current_dynamic_space; --#ifndef ibmrt from_space_free_pointer = dynamic_space_free_pointer; --#else -- from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER); --#endif #ifdef PRINTNOISE fprintf(stderr,"from_space = %lx\n", @@@ -279,14 -279,14 +275,9 @@@ scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size); binding_stack_size = current_binding_stack_pointer - (lispobj *)BINDING_STACK_START; --#endif #ifdef PRINTNOISE printf("Scavenging the binding stack %x - %x (%d words) ...\n", BINDING_STACK_START,current_binding_stack_pointer, @@@ -331,11 -331,11 +322,7 @@@ (os_vm_size_t) DYNAMIC_SPACE_SIZE); current_dynamic_space = new_space; --#ifndef ibmrt dynamic_space_free_pointer = new_space_free_pointer; --#else -- SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer); --#endif #ifdef PRINTNOISE size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj); @@@ -2175,8 -2174,8 +2162,6 @@@ gc_init(void /* noise to manipulate the gc trigger stuff */ --#ifndef ibmrt -- void set_auto_gc_trigger(os_vm_size_t dynamic_usage) { os_vm_address_t addr=(os_vm_address_t)current_dynamic_space + @@@ -2229,5 -2228,5 +2214,3 @@@ void clear_auto_gc_trigger(void current_auto_gc_trigger = NULL; } } -- --#endif diff --cc src/runtime/gc.h index b3f5e04,b3f5e04..8861fec --- a/src/runtime/gc.h +++ b/src/runtime/gc.h @@@ -25,13 -25,13 +25,9 @@@ extern void gc_init(void) * adds another GC, or ports one of the other CMU CL GCs like gengc. */ extern void collect_garbage(unsigned last_gen); --#ifndef ibmrt -- #include "os.h" extern void set_auto_gc_trigger(os_vm_size_t usage); extern void clear_auto_gc_trigger(void); --#endif ibmrt -- #endif _GC_H_ diff --cc src/runtime/gencgc.c index f2becf0,f2becf0..11ddcfd --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@@ -5494,6 -5494,6 +5494,14 @@@ garbage_collect_generation(int generati (lispobj *)SymbolValue(BINDING_STACK_POINTER) - (lispobj *)BINDING_STACK_START); ++ /* The original CMU CL code had scavenge-read-only-space code ++ * controlled by the Lisp-level variable ++ * *SCAVENGE-READ-ONLY-SPACE*. It was disabled by default, and it ++ * wasn't documented under what circumstances it was useful or ++ * safe to turn it on, so it's been turned off in SBCL. If you ++ * want/need this functionality, and can test and document it, ++ * please submit a patch. */ ++#if 0 if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { read_only_space_size = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - @@@ -5503,6 -5503,6 +5511,7 @@@ read_only_space_size * sizeof(lispobj))); scavenge( (lispobj *) READ_ONLY_SPACE_START, read_only_space_size); } ++#endif static_space_size = (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) - diff --cc src/runtime/globals.h index 84f0324,5b45181..6989820 --- a/src/runtime/globals.h +++ b/src/runtime/globals.h @@@ -20,11 -20,11 +20,11 @@@ extern int foreign_function_call_active extern lispobj *current_control_stack_pointer; extern lispobj *current_control_frame_pointer; --#if !defined(ibmrt) && !defined(__i386__) ++#if !defined(__i386__) extern lispobj *current_binding_stack_pointer; #endif --#if !defined(ibmrt) && !defined(__i386__) ++#if !defined(__i386__) /* FIXME: Why doesn't the x86 need this? */ extern lispobj *dynamic_space_free_pointer; extern lispobj *current_auto_gc_trigger; @@@ -48,12 -48,12 +48,8 @@@ extern void globals_init(void) #endif #endif /**/ --#ifdef ibmrt --#define EXTERN(name,bytes) .globl _/**/name --#endif --/**/ #ifdef alpha -#ifdef linux +#ifdef __linux__ #define EXTERN(name,bytes) .globl name #endif #endif diff --cc src/runtime/lispregs.h index 2e94459,2e94459..8d7f39e --- a/src/runtime/lispregs.h +++ b/src/runtime/lispregs.h @@@ -17,10 -17,10 +17,6 @@@ #include "sparc-lispregs.h" #endif --#ifdef ibmrt --#include "rt-lispregs.h" --#endif -- #ifdef __i386__ #include "x86-lispregs.h" #endif diff --cc src/runtime/monitor.c index 9ebf171,b607f04..cbd9287 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@@ -172,7 -172,7 +172,7 @@@ regs_cmd(char **ptr { printf("CSP\t=\t0x%08lX\n", (unsigned long)current_control_stack_pointer); printf("FP\t=\t0x%08lX\n", (unsigned long)current_control_frame_pointer); --#if !defined(ibmrt) && !defined(__i386__) ++#if !defined(__i386__) printf("BSP\t=\t0x%08X\n", (unsigned long)current_binding_stack_pointer); #endif #ifdef __i386__ @@@ -181,7 -181,7 +181,7 @@@ #endif printf("DYNAMIC\t=\t0x%08lx\n", (unsigned long)DYNAMIC_SPACE_START); --#if defined(ibmrt) || defined(__i386__) ++#if defined(__i386__) printf("ALLOC\t=\t0x%08lx\n", (unsigned long)SymbolValue(ALLOCATION_POINTER)); printf("TRIGGER\t=\t0x%08lx\n", diff --cc src/runtime/parse.c index 17b61b1,17b61b1..7e1c8c1 --- a/src/runtime/parse.c +++ b/src/runtime/parse.c @@@ -247,7 -247,7 +247,7 @@@ static boolean lookup_symbol(char *name /* Search dynamic space. */ headerptr = (lispobj *)DYNAMIC_SPACE_START; --#if !defined(ibmrt) && !defined(__i386__) ++#if !defined(__i386__) count = dynamic_space_free_pointer - (lispobj *)DYNAMIC_SPACE_START; diff --cc src/runtime/purify.c index 63377e7,63377e7..136b8da --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@@ -31,7 -31,7 +31,7 @@@ #define PRINTNOISE --#if defined(ibmrt) || defined(__i386__) ++#if defined(__i386__) /* again, what's so special about the x86 that this is differently * visible there than on other platforms? -dan 20010125 */ @@@ -112,108 -112,108 +112,6 @@@ dynamic_pointer_p(lispobj ptr #ifdef __i386__ --#ifdef WANT_CGC --/* original x86/CGC stack scavenging code by Paul Werkowski */ -- --static int --maybe_can_move_p(lispobj thing) --{ -- lispobj *thingp,header; -- if (dynamic_pointer_p(thing)) { /* in dynamic space */ -- thingp = (lispobj*)PTR(thing); -- header = *thingp; -- if (Pointerp(header) && forwarding_pointer_p(header)) { -- return -1; /* must change it */ -- } else if (LowtagOf(thing) == type_ListPointer) { -- return type_ListPointer; /* can we check this somehow */ -- } else if (thing & 3) { /* not fixnum */ -- int kind = TypeOf(header); -- /* printf(" %x %x",header,kind); */ -- switch (kind) { /* something with a header */ -- case type_Bignum: -- case type_SingleFloat: -- case type_DoubleFloat: --#ifdef type_LongFloat -- case type_LongFloat: --#endif -- case type_Sap: -- case type_SimpleVector: -- case type_SimpleString: -- case type_SimpleBitVector: -- case type_SimpleArrayUnsignedByte2: -- case type_SimpleArrayUnsignedByte4: -- case type_SimpleArrayUnsignedByte8: -- case type_SimpleArrayUnsignedByte16: -- case type_SimpleArrayUnsignedByte32: --#ifdef type_SimpleArraySignedByte8 -- case type_SimpleArraySignedByte8: --#endif --#ifdef type_SimpleArraySignedByte16 -- case type_SimpleArraySignedByte16: --#endif --#ifdef type_SimpleArraySignedByte30 -- case type_SimpleArraySignedByte30: --#endif --#ifdef type_SimpleArraySignedByte32 -- case type_SimpleArraySignedByte32: --#endif -- case type_SimpleArraySingleFloat: -- case type_SimpleArrayDoubleFloat: --#ifdef type_SimpleArrayLongFloat -- case type_SimpleArrayLongFloat: --#endif --#ifdef type_SimpleArrayComplexSingleFloat -- case type_SimpleArrayComplexSingleFloat: --#endif --#ifdef type_SimpleArrayComplexDoubleFloat -- case type_SimpleArrayComplexDoubleFloat: --#endif --#ifdef type_SimpleArrayComplexLongFloat -- case type_SimpleArrayComplexLongFloat: --#endif -- case type_CodeHeader: -- case type_FunctionHeader: -- case type_ClosureFunctionHeader: -- case type_ReturnPcHeader: -- case type_ClosureHeader: -- case type_FuncallableInstanceHeader: -- case type_InstanceHeader: -- case type_ValueCellHeader: -- case type_ByteCodeFunction: -- case type_ByteCodeClosure: -- case type_WeakPointer: -- case type_Fdefn: -- return kind; -- break; -- default: -- return 0; -- } -- } -- } -- return 0; --} -- --static int pverbose=0; --#define PVERBOSE pverbose --static void --carefully_pscav_stack(lispobj*lowaddr, lispobj*base) --{ -- lispobj *sp = lowaddr; -- while (sp < base) { -- int k; -- lispobj thing = *sp; -- if ((unsigned)thing & 0x3) { /* may be pointer */ -- /* need to check for valid float/double? */ -- k = maybe_can_move_p(thing); -- if(PVERBOSE)printf("%8x %8x %d\n",sp, thing, k); -- if(k) -- pscav(sp, 1, 0); -- } -- sp++; -- } --} --#endif -- #ifdef GENCGC /* * enhanced x86/GENCGC stack scavenging by Douglas Crosher @@@ -1414,7 -1414,7 +1312,7 @@@ purify(lispobj static_roots, lispobj re return 0; } --#if defined(ibmrt) || defined(__i386__) ++#if defined(__i386__) dynamic_space_free_pointer = (lispobj*)SymbolValue(ALLOCATION_POINTER); #endif @@@ -1457,18 -1457,18 +1355,13 @@@ #ifdef GENCGC pscav_i386_stack(); #endif --#ifdef WANT_CGC -- gc_assert((lispobj *)control_stack_end > ((&read_only_roots)+1)); -- carefully_pscav_stack(((&read_only_roots)+1), -- (lispobj *)CONTROL_STACK_END); --#endif #endif #ifdef PRINTNOISE printf(" bindings"); fflush(stdout); #endif --#if !defined(ibmrt) && !defined(__i386__) ++#if !defined(__i386__) pscav( (lispobj *)BINDING_STACK_START, (lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START, 0); @@@ -1479,7 -1479,7 +1372,14 @@@ 0); #endif --#ifdef SCAVENGE_READ_ONLY_SPACE ++ /* The original CMU CL code had scavenge-read-only-space code ++ * controlled by the Lisp-level variable ++ * *SCAVENGE-READ-ONLY-SPACE*. It was disabled by default, and it ++ * wasn't documented under what circumstances it was useful or ++ * safe to turn it on, so it's been turned off in SBCL. If you ++ * want/need this functionality, and can test and document it, ++ * please submit a patch. */ ++#if 0 if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != type_UnboundMarker && SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { unsigned read_only_space_size = @@@ -1527,15 -1527,15 +1427,8 @@@ fflush(stdout); #endif --#if defined(WANT_CGC) && defined(X86_CGC_ACTIVE_P) -- if(SymbolValue(X86_CGC_ACTIVE_P) != T) { -- os_zero((os_vm_address_t) DYNAMIC_SPACE_START, -- (os_vm_size_t) DYNAMIC_SPACE_SIZE); -- } --#else os_zero((os_vm_address_t) current_dynamic_space, (os_vm_size_t) DYNAMIC_SPACE_SIZE); --#endif /* Zero the stack. Note that the stack is also zeroed by SUB-GC * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */ @@@ -1547,44 -1547,44 +1440,18 @@@ sizeof(lispobj)))); #endif --#if defined(WANT_CGC) && defined(STATIC_BLUE_BAG) -- { -- lispobj bag = SymbolValue(STATIC_BLUE_BAG); -- struct cons*cons = (struct cons*)static_free; -- struct cons*pair = cons + 1; -- static_free += 2*WORDS_PER_CONS; -- if(bag == type_UnboundMarker) -- bag = NIL; -- cons->cdr = bag; -- cons->car = (lispobj)pair | type_ListPointer; -- pair->car = (lispobj)static_end; -- pair->cdr = (lispobj)static_free; -- bag = (lispobj)cons | type_ListPointer; -- SetSymbolValue(STATIC_BLUE_BAG, bag); -- } --#endif -- /* It helps to update the heap free pointers so that free_heap can * verify after it's done. */ SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free); SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free); --#if !defined(ibmrt) && !defined(__i386__) ++#if !defined(__i386__) dynamic_space_free_pointer = current_dynamic_space; #else #if defined GENCGC gc_free_heap(); #else -- /* ibmrt using GC */ -- SetSymbolValue(ALLOCATION_POINTER, (lispobj)DYNAMIC_SPACE_START); --#endif ++#error unsupported case /* in CMU CL, was "ibmrt using GC" */ #endif #endif diff --cc src/runtime/runtime.c index c4251cb,c4251cb..d39b892 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@@ -264,16 -264,16 +264,6 @@@ More information on SBCL is available a #if defined GENCGC gencgc_pickup_dynamic(); #else --#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) { -- /* Enable allocator. */ -- use_cgc_p = 1; -- } -- } --#endif #endif #ifdef BINDING_STACK_POINTER diff --cc src/runtime/save.c index 70b439c,70b439c..5059aa5 --- a/src/runtime/save.c +++ b/src/runtime/save.c @@@ -82,24 -82,24 +82,6 @@@ boolea save(char *filename, lispobj init_function) { FILE *file; --#if defined WANT_CGC -- volatile lispobj*func_ptr = &init_function; -- char sbuf[128]; -- strcpy(sbuf,filename); -- filename=sbuf; -- /* Get rid of remnant stuff. This is a MUST so that the memory -- * manager can get started correctly when we restart after this -- * save. Purify is going to maybe move the args so we need to -- * consider them volatile, especially if the gcc optimizer is -- * working!! */ -- purify(NIL,NIL); -- -- init_function = *func_ptr; -- /* Set dynamic space pointer to base value so we don't write out -- * MBs of just cleared heap. */ -- if(SymbolValue(X86_CGC_ACTIVE_P) != NIL) -- SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_SPACE_START); --#endif /* Open the file: */ unlink(filename); file = fopen(filename, "w"); @@@ -114,9 -114,9 +96,6 @@@ SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0); SetSymbolValue(EVAL_STACK_TOP, 0); printf("done]\n"); --#if defined WANT_CGC && defined X86_CGC_ACTIVE_P -- SetSymbolValue(X86_CGC_ACTIVE_P, T); --#endif printf("[saving current Lisp image into %s:\n", filename); putw(CORE_MAGIC, file); diff --cc src/runtime/undefineds.h index 4211971,503ac31..3130fb4 --- a/src/runtime/undefineds.h +++ b/src/runtime/undefineds.h @@@ -136,7 -136,7 +136,7 @@@ F(shutdown F(sigblock) #endif F(sigpause) --#if !defined(ibmrt) && !defined(hpux) && !defined(SVR4) && !defined(__i386__) ++#if !defined(hpux) && !defined(SVR4) && !defined(__i386__) F(sigreturn) #endif #if !defined(SVR4) && !defined(__FreeBSD__) && !defined(__OpenBSD__) diff --cc src/runtime/x86-assem.S index 5d77b3e,5d77b3e..5941e0a --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@@ -328,63 -328,63 +328,6 @@@ GNAME(do_pending_interrupt) ret .size GNAME(do_pending_interrupt),.-GNAME(do_pending_interrupt) --#ifdef WANT_CGC --/* This is a copy function which is optimized for the Pentium and -- * works OK on 486 as well. This assumes (does not check) that the -- * input byte count is a multiple of 8 bytes (one Lisp object). -- * This code takes advantage of pairing in the Pentium as well -- * as the 128-bit cache line. -- */ -- .global GNAME(fastcopy16) -- .type GNAME(fastcopy16),@function -- .align align_4byte,0x90 --GNAME(fastcopy16): -- pushl %ebp -- movl %esp,%ebp -- movl 8(%ebp), %edx # dst -- movl 12(%ebp),%eax # src -- movl 16(%ebp),%ecx # bytes -- pushl %ebx -- pushl %esi -- pushl %edi -- movl %edx,%edi -- movl %eax,%esi -- sarl $3,%ecx # number 8-byte units -- testl $1,%ecx # odd? -- jz Lquad -- movl (%esi),%eax -- movl 4(%esi),%ebx -- movl %eax,(%edi) -- movl %ebx,4(%edi) -- leal 8(%esi),%esi -- leal 8(%edi),%edi --Lquad: sarl $1,%ecx # count 16-byte units -- jz Lend -- movl %ecx,%ebp # use ebp for loop counter -- .align align_16byte,0x90 --Ltop: -- movl (%edi),%eax # prefetch! MAJOR Pentium win.. -- movl (%esi),%eax -- movl 4(%esi),%ebx -- movl 8(%esi),%ecx -- movl 12(%esi),%edx -- movl %eax, (%edi) -- movl %ebx, 4(%edi) -- movl %ecx, 8(%edi) -- movl %edx,12(%edi) -- leal 16(%esi),%esi -- leal 16(%edi),%edi -- decl %ebp -- jnz Ltop # non-prefixed jump saves cycles --Lend: -- popl %edi -- popl %esi -- popl %ebx -- popl %ebp -- ret -- .size GNAME(fastcopy16),.-GNAME(fastcopy16) --#endif -- #ifdef GENCGC /* This is a fast bzero using the FPU. The first argument is the start * address which needs to be aligned on an 8 byte boundary, the second diff --cc version.lisp-expr index 524a610,dd677f1..770f79e --- a/version.lisp-expr +++ b/version.lisp-expr @@@ -15,4 -15,4 +15,4 @@@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. - "0.6.12.27" -"0.6.12.21.flaky2.2" ++"0.6.12.28"