From ec2616d216958a608581802c47496c0194478dc8 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 7 Mar 2002 01:00:11 +0000 Subject: [PATCH] 0.7.1.32: merged MNA cleanups patch (sbcl-devel 2002-03-05)... ...correct FTYPE for SAPINT-TO-CORE, which has been renamed to SAP-INT-TO-CORE ...dead code removal ...*TARGET-MOST-NEGATIVE-FIXNUM*" is renamed to +TARGET-MOST-NEGATIVE-FIXNUM+, as well as being defined as a constant now (same for the POSITIVE). ...SB!KERNEL::ARG-COUNT-ERROR is defined as a stub, to silence the flood of style-warnings a little bit. ...some other FIXMEs (renaming DEFINE-STORAGE-CLASSES to !DEFINE-STORAGE-CLASSES, introducing SB-SHOW dependencies) further cleanups of MOST-FOOATIVE-FIXNUM stuff... ...renamed again, this time to SB!XC:MOST-FOOATIVE-FIXNUM ...removed now-redundant DEFCONSTANTs in toplevel.lisp ...removed now-redundant #. wrappers other tweaks to the patch... ...Instead of defining a second version of ARG-COUNT-ERROR for use at compile time, move the definition of ARG-COUNT-ERROR earlier so it'll be visible in more of the code which uses it. moved src/code/globals.lisp much earlier in build-order.lisp, since there's no such thing as too early and since the previous location was too late for some uses of SB!DEBUG:*STACK-TOP-HINT* s/sap-int-type/sap-int/ --- CREDITS | 9 +++++++-- build-order.lisp-expr | 10 +++++++--- package-data-list.lisp-expr | 6 ++---- src/code/class.lisp | 4 ++-- src/code/cross-sap.lisp | 4 ++-- src/code/cross-type.lisp | 4 +--- src/code/defboot.lisp | 1 + src/code/defstruct.lisp | 5 +---- src/code/early-array.lisp | 4 ++-- src/code/exhaust.lisp | 6 +++--- src/code/fop.lisp | 2 +- src/code/globals.lisp | 2 +- src/code/late-type.lisp | 4 ++-- src/code/parse-defmacro-errors.lisp | 12 ------------ src/code/parse-defmacro.lisp | 12 ++++++++++++ src/code/target-sap.lisp | 2 +- src/code/toplevel.lisp | 8 -------- src/cold/compile-cold-sbcl.lisp | 18 ------------------ src/cold/shared.lisp | 10 +++++----- src/compiler/alpha/macros.lisp | 7 ++----- src/compiler/alpha/vm.lisp | 8 +++----- src/compiler/fndb.lisp | 2 +- src/compiler/generic/early-vm.lisp | 14 ++++---------- src/compiler/generic/genesis.lisp | 15 ++++++++------- src/compiler/generic/objdef.lisp | 2 +- src/compiler/main.lisp | 20 ++++++-------------- src/compiler/sparc/macros.lisp | 14 ++++++-------- src/compiler/sparc/vm.lisp | 21 ++++++++++----------- src/compiler/srctran.lisp | 4 ++-- src/compiler/x86/vm.lisp | 12 ++++-------- version.lisp-expr | 2 +- 31 files changed, 98 insertions(+), 146 deletions(-) diff --git a/CREDITS b/CREDITS index 91fc72f..ec08b96 100644 --- a/CREDITS +++ b/CREDITS @@ -539,6 +539,11 @@ Nathan Froyd: read without being an expert in ancient languages and so that can delete a thousand lines of implement-ITERATE macrology.) +Arthur Lemmens: + He found and fixed a number of SBCL bugs while partially porting SBCL + to bootstrap under . + Robert MacLachlan: He has continued to answer questions about, and contribute fixes to, the CMU CL project. Some of these fixes, especially for compiler @@ -561,8 +566,7 @@ Christophe Rhodes: He has done various low-level work on SBCL, especially for the SPARC port (and for CPU-architecture-neutral things motivated by it, like *BACKEND-FEATURES*). He's also contributed miscellaneous - bug fixes. As of 2002-01-17, he seems to be mostly done with a port - of SBCL to the SPARC CPU. + bug fixes. Raymond Toy: He continued to work on CMU CL after the SBCL fork, especially on @@ -589,6 +593,7 @@ Raymond Wiker: INITIALS GLOSSARY (helpful when reading comments, CVS commit logs, etc.) +AL Arthur Lemmens MNA Martin Atzmueller DB Daniel Barlow DTC Douglas Crosher diff --git a/build-order.lisp-expr b/build-order.lisp-expr index e8b6315..921c0d4 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -42,6 +42,11 @@ ;; leaking into target SBCL code. ("src/code/backq") + ;; It's difficult to be too early with a DECLAIM SPECIAL (or DEFVAR + ;; or whatever) thanks to the sullenly-do-the-wrong-thing semantics + ;; of CL special binding when the variable is undeclared. + ("src/code/globals" :not-host) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; various DEFSETFs and/or other DEFMACROish things, defined as early as ;; possible so we don't need to fiddle with any subtleties of defining them @@ -75,7 +80,7 @@ ("src/code/primordial-extensions") - ;; for various constants e.g. SB!VM:*TARGET-MOST-POSITIVE-FIXNUM* and + ;; for various constants e.g. SB!XC:MOST-POSITIVE-FIXNUM and ;; SB!VM:N-LOWTAG-BITS, needed by "early-objdef" and others ("src/compiler/generic/early-vm") ("src/compiler/generic/early-objdef") @@ -142,7 +147,6 @@ ;; and stuff." ;; Dunno exactly what this meant or whether it still holds. -- WHN 19990803 ;; FIXME: more informative and up-to-date comment? - ("src/code/globals" :not-host) ("src/code/kernel" :not-host) ("src/code/toplevel" :not-host) ("src/code/cold-error" :not-host) @@ -574,7 +578,7 @@ ; "compiler/generic/core" ("src/code/eval" :not-host) ; uses INFO, wants compiler macro - ("src/code/target-sap" :not-host) ; uses SAP-INT-TYPE + ("src/code/target-sap" :not-host) ; uses SAP-INT type ("src/code/target-package" :not-host) ; needs "code/package" ("src/code/target-random" :not-host) ; needs "code/random" ("src/code/target-hash-table" :not-host) ; needs "code/hash-table" diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index ca9bc9a..61a0121 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1510,7 +1510,7 @@ SB-KERNEL) have been undone, but probably more remain." "REMOVE-FD-HANDLER" "REMOVE-PORT-DEATH-HANDLER" "REMOVE-PORT-OBJECT" "RESOLVE-LOADED-ASSEMBLER-REFERENCES" - "SAP+" "SAP-" "SAP-INT" "SAP-INT-TYPE" + "SAP+" "SAP-" "SAP-INT" "SAP-REF-16" "SAP-REF-32" "SAP-REF-64" "SAP-REF-8" "SAP-REF-DESCRIPTOR" "SAP-REF-DOUBLE" "SAP-REF-LONG" @@ -1843,9 +1843,7 @@ structure representations" #!-gencgc "DYNAMIC-1-SPACE-START" #!-gencgc "DYNAMIC-1-SPACE-END" "READ-ONLY-SPACE-START" "READ-ONLY-SPACE-END" - "TARGET-BYTE-ORDER" - "TARGET-HEAP-ADDRESS-SPACE" "*TARGET-MOST-NEGATIVE-FIXNUM*" - "*TARGET-MOST-POSITIVE-FIXNUM*" + "TARGET-BYTE-ORDER" "TARGET-HEAP-ADDRESS-SPACE" "STATIC-SPACE-START" "STATIC-SPACE-END" "TRACE-TABLE-CALL-SITE" "TRACE-TABLE-FUN-EPILOGUE" "TRACE-TABLE-FUN-PROLOGUE" diff --git a/src/code/class.lisp b/src/code/class.lisp index a3e8f69..fbf4fd9 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -1185,8 +1185,8 @@ :translation integer :inherits (rational real number generic-number)) (fixnum - :translation (integer #.sb!vm:*target-most-negative-fixnum* - #.sb!vm:*target-most-positive-fixnum*) + :translation (integer #.sb!xc:most-negative-fixnum + #.sb!xc:most-positive-fixnum) :inherits (integer rational real number generic-number) :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag)) diff --git a/src/code/cross-sap.lisp b/src/code/cross-sap.lisp index 0db3c16..fc0d0a0 100644 --- a/src/code/cross-sap.lisp +++ b/src/code/cross-sap.lisp @@ -18,13 +18,13 @@ (defstruct (system-area-pointer (:constructor make-sap) (:conc-name "SAP-")) ;; the integer representation of the address - (int (error "missing SAP-INT argument") :type sap-int-type :read-only t)) + (int (error "missing SAP-INT argument") :type sap-int :read-only t)) ;;; cross-compilation-host analogues of target-CMU CL primitive SAP operations (defun int-sap (int) (make-sap :int int)) (defun sap+ (sap offset) - (declare (type system-area-pointer sap) (type sap-int-type offset)) + (declare (type system-area-pointer sap) (type sap-int offset)) (make-sap :int (+ (sap-int sap) offset))) #.`(progn ,@(mapcar (lambda (info) diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp index 8110183..cfb1a78 100644 --- a/src/code/cross-type.lisp +++ b/src/code/cross-type.lisp @@ -14,9 +14,7 @@ ;;; Is X a fixnum in the target Lisp? (defun fixnump (x) (and (integerp x) - (<= sb!vm:*target-most-negative-fixnum* - x - sb!vm:*target-most-positive-fixnum*))) + (<= sb!xc:most-negative-fixnum x sb!xc:most-positive-fixnum))) ;;; (This was a useful warning when trying to get bootstrapping ;;; to work, but it's mostly irrelevant noise now that the system diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index a816b28..fdec808 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -176,6 +176,7 @@ (block ,(fun-name-block-name name) ,@forms))) (lambda `(lambda ,@lambda-guts)) + #-sb-xc-host (named-lambda `(named-lambda ,name ,@lambda-guts)) (inline-lambda (cond (;; Does the user not even want to inline? diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 2a81fb3..26a222e 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -890,9 +890,7 @@ (%compiler-set-up-layout dd inherits) - (let* ((dd-name (dd-name dd)) - (dtype (dd-declarable-type dd)) - (class (sb!xc:find-class dd-name))) + (let* ((dtype (dd-declarable-type dd))) (let ((copier-name (dd-copier-name dd))) (when copier-name @@ -1409,7 +1407,6 @@ :metaclass-name metaclass-name :metaclass-constructor metaclass-constructor :dd-type dd-type)) - (conc-name (concatenate 'string (symbol-name class-name) "-")) (dd-slots (dd-slots dd)) (dd-length (1+ (length slot-names))) (object-gensym (gensym "OBJECT")) diff --git a/src/code/early-array.lisp b/src/code/early-array.lisp index 808cfef..8e6ea61 100644 --- a/src/code/early-array.lisp +++ b/src/code/early-array.lisp @@ -13,10 +13,10 @@ #!+sb-doc "the exclusive upper bound on the rank of an array") -(defconstant sb!xc:array-dimension-limit sb!vm:*target-most-positive-fixnum* +(defconstant sb!xc:array-dimension-limit sb!xc:most-positive-fixnum #!+sb-doc "the exclusive upper bound on any given dimension of an array") -(defconstant sb!xc:array-total-size-limit sb!vm:*target-most-positive-fixnum* +(defconstant sb!xc:array-total-size-limit sb!xc:most-positive-fixnum #!+sb-doc "the exclusive upper bound on the total number of elements in an array") diff --git a/src/code/exhaust.lisp b/src/code/exhaust.lisp index 67f5a38..1879245 100644 --- a/src/code/exhaust.lisp +++ b/src/code/exhaust.lisp @@ -28,14 +28,14 @@ (first-try (ash native-address -2)) ;; final encoding (second-try - (if (<= first-try sb!vm:*target-most-positive-fixnum*) + (if (<= first-try sb!xc:most-positive-fixnum) ;; looks good first-try ;; When the naive encoding fails to make a FIXNUM ;; because the sign is wrong, subtracting *T-M-P-F* ;; should fix it. - (- first-try sb!vm:*target-most-positive-fixnum*)))) - (aver (<= second-try sb!vm:*target-most-positive-fixnum*)) + (- first-try sb!xc:most-positive-fixnum)))) + (aver (<= second-try sb!xc:most-positive-fixnum)) second-try))) ;;; a FIXNUM, to be interpreted as a native pointer, which serves diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 514d631..ea2ceef 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -137,7 +137,7 @@ (declare (type index size)) (do ((n (1- size) (1- n))) ((minusp n)) - (declare (type (integer -1 #.most-positive-fixnum) n)) + (declare (type index-or-minus-1 n)) (setf (%instance-ref res n) (pop-stack))) res)) diff --git a/src/code/globals.lisp b/src/code/globals.lisp index c6f9f36..1306822 100644 --- a/src/code/globals.lisp +++ b/src/code/globals.lisp @@ -34,7 +34,7 @@ assert-prompt check-type-error case-body-error print-object describe-object sb!pcl::check-wrapper-validity)) -;;; Gray streams functions not defined until after PCL is loaded. +;;; Gray streams functions not defined until after PCL is loaded (declaim (ftype (function * *) stream-advance-to-column stream-clear-input stream-clear-output stream-finish-output stream-force-output diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 6ffd5c9..3005a9b 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -1118,8 +1118,8 @@ `(unsigned-byte ,high-length)) (t `(mod ,(1+ high))))) - ((and (= low sb!vm:*target-most-negative-fixnum*) - (= high sb!vm:*target-most-positive-fixnum*)) + ((and (= low sb!xc:most-negative-fixnum) + (= high sb!xc:most-positive-fixnum)) 'fixnum) ((and (= low (lognot high)) (= high-count high-length) diff --git a/src/code/parse-defmacro-errors.lisp b/src/code/parse-defmacro-errors.lisp index b4bc377..a9f8e96 100644 --- a/src/code/parse-defmacro-errors.lisp +++ b/src/code/parse-defmacro-errors.lisp @@ -13,18 +13,6 @@ (in-package "SB!KERNEL") -;;; We save space in macro definitions by calling this function. -(defun arg-count-error (error-kind name args lambda-list minimum maximum) - (let (#-sb-xc-host - (sb!debug:*stack-top-hint* (nth-value 1 (find-caller-name-and-frame)))) - (error 'arg-count-error - :kind error-kind - :name name - :args args - :lambda-list lambda-list - :minimum minimum - :maximum maximum))) - (define-condition defmacro-lambda-list-bind-error (error) ((kind :reader defmacro-lambda-list-bind-error-kind :initarg :kind) diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp index ca00f44..378d0ec 100644 --- a/src/code/parse-defmacro.lisp +++ b/src/code/parse-defmacro.lisp @@ -239,6 +239,18 @@ *arg-tests*))) (values env-arg-used minimum explicit-maximum)))) +;;; We save space in macro definitions by calling this function. +(defun arg-count-error (error-kind name args lambda-list minimum maximum) + (let (#-sb-xc-host + (sb!debug:*stack-top-hint* (nth-value 1 (find-caller-name-and-frame)))) + (error 'arg-count-error + :kind error-kind + :name name + :args args + :lambda-list lambda-list + :minimum minimum + :maximum maximum))) + (defun push-sub-list-binding (variable path object name error-kind error-fun) (let ((var (gensym "TEMP-"))) (push `(,variable diff --git a/src/code/target-sap.lisp b/src/code/target-sap.lisp index 5a429b6..20383b1 100644 --- a/src/code/target-sap.lisp +++ b/src/code/target-sap.lisp @@ -56,7 +56,7 @@ ;;; Convert an integer into a SAP. (defun int-sap (int) - (declare (type sap-int-type int)) + (declare (type sap-int int)) (int-sap int)) ;;; Return the 8-bit byte at OFFSET bytes from SAP. diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index 380be18..7389eb5 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -13,14 +13,6 @@ (in-package "SB!IMPL") -(defconstant most-positive-fixnum #.sb!vm:*target-most-positive-fixnum* - #!+sb-doc - "the fixnum closest in value to positive infinity") - -(defconstant most-negative-fixnum #.sb!vm:*target-most-negative-fixnum* - #!+sb-doc - "the fixnum closest in value to negative infinity") - ;;;; magic specials initialized by GENESIS ;;; FIXME: The DEFVAR here is redundant with the (DECLAIM (SPECIAL ..)) diff --git a/src/cold/compile-cold-sbcl.lisp b/src/cold/compile-cold-sbcl.lisp index 987e65a..62e886b 100644 --- a/src/cold/compile-cold-sbcl.lisp +++ b/src/cold/compile-cold-sbcl.lisp @@ -16,24 +16,6 @@ (defvar *target-object-file-names*) -;;; KLUDGE.. -;;; -;;; CMU CL (as of 2.4.6 for Debian, anyway) issues warnings (and not -;;; just STYLE-WARNINGs, either, alas) when it tries to interpret code -;;; containing references to undefined functions. The most common -;;; problem is that macroexpanded code refers to this function, which -;;; isn't defined until late. -;;; -;;; This -;;; #+cmu (defun sb!kernel::arg-count-error (&rest rest) -;;; (error "stub version of ARG-COUNT-ERROR, rest=~S" rest)) -;;; doesn't work, with or without this -;;; (compile 'sb!kernel::arg-count-error)) -;;; so perhaps I should try -;;; (declaim (ftype ..) ..) -;;; instead? -(declaim (ftype (function (&rest t) nil) sb!kernel::arg-count-error)) - (let ((reversed-target-object-file-names nil)) (do-stems-and-flags (stem flags) (unless (position :not-target flags) diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index b4ff892..a55036c 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -250,11 +250,11 @@ ;;; values of special variables such as *** and +, anyway). Set up ;;; machinery to warn us when/if we change it. ;;; -;;; FIXME: All this machinery should probably be conditional on -;;; #!+SB-SHOW, i.e. we should be able to wrap #!+SB-SHOW around both -;;; the LOAD and the DEFVAR here. -(load "src/cold/snapshot.lisp") -(defvar *cl-snapshot* (take-snapshot "COMMON-LISP")) +;;; All code depending on this is itself dependent on #!+SB-SHOW. +#!+sb-show +(progn + (load "src/cold/snapshot.lisp") + (defvar *cl-snapshot* (take-snapshot "COMMON-LISP"))) ;;;; master list of source files and their properties diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index 96eb188..c6a2de8 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -250,18 +250,15 @@ ,error))))) -;;; PSEUDO-ATOMIC -- Handy macro for making sequences look atomic. -;;; +;;; a handy macro for making sequences look atomic (defmacro pseudo-atomic ((&key (extra 0)) &rest forms) `(progn (inst addq alloc-tn 1 alloc-tn) ,@forms (inst lda alloc-tn (1- ,extra) alloc-tn) (inst stl zero-tn 0 alloc-tn))) - - -;;;; Memory accessor vop generators +;;;; memory accessor vop generators (deftype load/store-index (scale lowtag min-offset &optional (max-offset min-offset)) diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp index 3dd28ab..c8f77dd 100644 --- a/src/compiler/alpha/vm.lisp +++ b/src/compiler/alpha/vm.lisp @@ -93,10 +93,8 @@ ;;; a handy macro so we don't have to keep changing all the numbers ;;; whenever we insert a new storage class. -;;; -;;; FIXME: This macro is not needed in the runtime target. -(defmacro define-storage-classes (&rest classes) +(defmacro !define-storage-classes (&rest classes) (do ((forms (list 'progn) (let* ((class (car classes)) (sc-name (car class)) @@ -124,9 +122,9 @@ ;;; and seems to be working so far -dan (defconstant sb!vm::kludge-nondeterministic-catch-block-size 7) -(define-storage-classes +(!define-storage-classes - ;; Non-immediate contstants in the constant pool + ;; non-immediate constants in the constant pool (constant constant) ;; ZERO and NULL are in registers. diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 8423f5e..f5bc4fd 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -756,7 +756,7 @@ (foldable flushable)) (defknown hash-table-size (hash-table) index (flushable)) (defknown hash-table-test (hash-table) symbol (foldable flushable)) -(defknown sxhash (t) (integer 0 #.sb!vm:*target-most-positive-fixnum*) +(defknown sxhash (t) (integer 0 #.sb!xc:most-positive-fixnum) (foldable flushable)) ;;;; from the "Arrays" chapter diff --git a/src/compiler/generic/early-vm.lisp b/src/compiler/generic/early-vm.lisp index ae59eff..606b087 100644 --- a/src/compiler/generic/early-vm.lisp +++ b/src/compiler/generic/early-vm.lisp @@ -24,15 +24,9 @@ ;;; a mask to extract the type from a data block header word (defconstant widetag-mask (1- (ash 1 n-widetag-bits))) -;;; FIXME: Couldn't/shouldn't these be DEFCONSTANT instead of -;;; DEFPARAMETER? (It might seem even more tempting to make them -;;; SB!XC:MOST-POSITIVE-FIXNUM and SB!XC:MOST-NEGATIVE-FIXNUM, -;;; but that's probably not a good idea, since then we'd need -;;; to worry about the effect of UNCROSS in expressions like -;;; (DEFTYPE INDX3 () `(INTEGER 3 ,SB!XC:MOST-POSITIVE-FIXNUM)).) -(defparameter *target-most-positive-fixnum* (1- (ash 1 29)) +(defconstant sb!xc:most-positive-fixnum (1- (ash 1 29)) #!+sb-doc - "most-positive-fixnum in the target architecture") -(defparameter *target-most-negative-fixnum* (ash -1 29) + "the fixnum closest in value to positive infinity") +(defconstant sb!xc:most-negative-fixnum (ash -1 29) #!+sb-doc - "most-negative-fixnum in the target architecture") + "the fixnum closest in value to negative infinity") diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index bbd2b84..4f4f5f1 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -463,12 +463,13 @@ (read-wordindexed address 0)) ;;; (Note: In CMU CL, this function expected a SAP-typed ADDRESS -;;; value, instead of the SAPINT we use here.) -(declaim (ftype (function (sb!vm:word descriptor) (values)) note-load-time-value-reference)) +;;; value, instead of the SAP-INT we use here.) +(declaim (ftype (function (sb!vm:word descriptor) (values)) + note-load-time-value-reference)) (defun note-load-time-value-reference (address marker) (cold-push (cold-cons (cold-intern :load-time-value-fixup) - (cold-cons (sapint-to-core address) + (cold-cons (sap-int-to-core address) (cold-cons (number-to-core (descriptor-word-offset marker)) *nil-descriptor*))) @@ -719,15 +720,15 @@ (float (float-to-core number)) (t (error "~S isn't a cold-loadable number at all!" number)))) -(declaim (ftype (function (sb!vm:word) descriptor) sap-to-core)) -(defun sapint-to-core (sapint) +(declaim (ftype (function (sb!vm:word) descriptor) sap-int-to-core)) +(defun sap-int-to-core (sap-int) (let ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits (1- sb!vm:sap-size) sb!vm:sap-widetag))) (write-wordindexed des sb!vm:sap-pointer-slot - (make-random-descriptor sapint)) + (make-random-descriptor sap-int)) des)) ;;; Allocate a cons cell in GSPACE and fill it in with CAR and CDR. @@ -766,7 +767,7 @@ (write-wordindexed symbol sb!vm:symbol-hash-slot (make-fixnum-descriptor - (1+ (random sb!vm:*target-most-positive-fixnum*)))) + (1+ (random sb!xc:most-positive-fixnum)))) (write-wordindexed symbol sb!vm:symbol-plist-slot *nil-descriptor*) (write-wordindexed symbol sb!vm:symbol-name-slot (string-to-core name *dynamic*)) diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index bf9217d..f945ad3 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -310,7 +310,7 @@ ;;;; symbols #!+x86 -(defknown symbol-hash (symbol) (integer 0 #.*target-most-positive-fixnum*) +(defknown symbol-hash (symbol) (integer 0 #.sb!xc:most-positive-fixnum) (flushable movable)) (define-primitive-object (symbol :lowtag other-pointer-lowtag diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 780ee91..67d6412 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -1115,15 +1115,8 @@ ;;; Compile FORM and arrange for it to be called at load-time. Return ;;; the dumper handle and our best guess at the type of the object. -(defun compile-load-time-value - (form &optional - (name (let ((*print-level* 2) (*print-length* 3)) - (format nil "load time value of ~S" - (if (and (listp form) - (eq (car form) 'make-value-cell)) - (second form) - form))))) - (let ((lambda (compile-load-time-stuff form name t))) +(defun compile-load-time-value (form) + (let ((lambda (compile-load-time-stuff form t))) (values (fasl-dump-load-time-value-lambda lambda *compile-object*) (let ((type (leaf-type lambda))) @@ -1133,13 +1126,13 @@ ;;; Compile the FORMS and arrange for them to be called (for effect, ;;; not value) at load time. -(defun compile-make-load-form-init-forms (forms name) - (let ((lambda (compile-load-time-stuff `(progn ,@forms) name nil))) +(defun compile-make-load-form-init-forms (forms) + (let ((lambda (compile-load-time-stuff `(progn ,@forms) nil))) (fasl-dump-toplevel-lambda-call lambda *compile-object*))) ;;; Do the actual work of COMPILE-LOAD-TIME-VALUE or ;;; COMPILE-MAKE-LOAD-FORM-INIT-FORMS. -(defun compile-load-time-stuff (form name for-value) +(defun compile-load-time-stuff (form for-value) (with-ir1-namespace (let* ((*lexenv* (make-null-lexenv)) (lambda (ir1-toplevel form *current-path* for-value))) @@ -1630,8 +1623,7 @@ (fasl-note-handle-for-constant constant (compile-load-time-value - creation-form - (format nil "creation form for ~A" name)) + creation-form) *compile-object*) nil) (compiler-error "circular references in creation form for ~S" diff --git a/src/compiler/sparc/macros.lisp b/src/compiler/sparc/macros.lisp index d0b30b7..d897cf2 100644 --- a/src/compiler/sparc/macros.lisp +++ b/src/compiler/sparc/macros.lisp @@ -232,25 +232,23 @@ -;;; PSEUDO-ATOMIC -- Handy macro for making sequences look atomic. -;;; +;;; a handy macro for making sequences look atomic (defmacro pseudo-atomic ((&key (extra 0)) &rest forms) (let ((n-extra (gensym))) `(let ((,n-extra ,extra)) - ;; Set the pseudo-atomic flag + ;; Set the pseudo-atomic flag. (without-scheduling () (inst add alloc-tn 4)) ,@forms - ;; Reset the pseudo-atomic flag + ;; Reset the pseudo-atomic flag. (without-scheduling () #+nil (inst taddcctv alloc-tn (- ,n-extra 4)) - ;; Remove the pseudo-atomic flag + ;; Remove the pseudo-atomic flag. (inst add alloc-tn (- ,n-extra 4)) - ;; Check to see if pseudo-atomic interrupted flag is set (bit 0 = 1) + ;; Check to see if pseudo-atomic interrupted flag is set (bit 0 = 1). (inst andcc zero-tn alloc-tn 3) ;; The C code needs to process this correctly and fixup alloc-tn. - (inst t :ne pseudo-atomic-trap) - )))) + (inst t :ne pseudo-atomic-trap))))) ;;; FIXME: test typing macros. Should(?) be in type-vops.lisp, except ;;; that they're also used in subprim.lisp diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index 6c95405..fd64d6e 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -29,7 +29,7 @@ (list ,@(mapcar (lambda (name) (symbolicate name "-OFFSET")) regs)))))) - ;; "c.f. src/runtime/sparc-lispregs.h + ;; c.f. src/runtime/sparc-lispregs.h ;; Globals. These are difficult to extract from a sigcontext. (defreg zero 0) ; %g0 @@ -79,7 +79,7 @@ (defregset *register-arg-offsets* a0 a1 a2 a3 a4 a5)) -;;;; SB and SC definition: +;;;; SB and SC definition (define-storage-base registers :finite :size 32) (define-storage-base float-registers :finite :size 64) @@ -88,11 +88,9 @@ (define-storage-base constant :non-packed) (define-storage-base immediate-constant :non-packed) -;;; Handy macro so we don't have to keep changing all the numbers whenever -;;; we insert a new storage class. -;;; -;;; FIXME: This macro is not needed in the runtime target. -(defmacro define-storage-classes (&rest classes) +;;; handy macro so we don't have to keep changing all the numbers +;;; whenever we insert a new storage class +(defmacro !define-storage-classes (&rest classes) (do ((forms (list 'progn) (let* ((class (car classes)) (sc-name (car class)) @@ -122,9 +120,9 @@ ;;; arbitrarily taken for alpha, too. - Christophe (defconstant sb!vm::kludge-nondeterministic-catch-block-size 7) -(define-storage-classes +(!define-storage-classes - ;; Non-immediate contstants in the constant pool + ;; non-immediate constants in the constant pool (constant constant) ;; ZERO and NULL are in registers. @@ -134,8 +132,9 @@ ;; Anything else that can be an immediate. (immediate immediate-constant) - - ;; **** The stacks. + ;; + ;; the stacks + ;; ;; The control stack. (Scanned by GC) (control-stack control-stack) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 9855e46..db2a385 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1354,14 +1354,14 @@ (flet ((ash-outer (n s) (when (and (fixnump s) (<= s 64) - (> s sb!vm:*target-most-negative-fixnum*)) + (> s sb!xc:most-negative-fixnum)) (ash n s))) ;; KLUDGE: The bare 64's here should be related to ;; symbolic machine word size values somehow. (ash-inner (n s) (if (and (fixnump s) - (> s sb!vm:*target-most-negative-fixnum*)) + (> s sb!xc:most-negative-fixnum)) (ash n (min s 64)) (if (minusp n) -1 0)))) (or (and (csubtypep n-type (specifier-type 'integer)) diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 8457029..92f537d 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -13,10 +13,7 @@ ;;; the size of an INTEGER representation of a SYSTEM-AREA-POINTER, i.e. ;;; size of a native memory address -(deftype sap-int-type () '(unsigned-byte 32)) -;;; FIXME: This should just named be SAP-INT, not SAP-INT-TYPE. And -;;; grep for SAPINT in the code and replace it with SAP-INT as -;;; appropriate. +(deftype sap-int () '(unsigned-byte 32)) ;;;; register specs @@ -131,8 +128,7 @@ ;;; a handy macro so we don't have to keep changing all the numbers whenever ;;; we insert a new storage class ;;; -;;; FIXME: This macro is not needed in the runtime target. -(defmacro define-storage-classes (&rest classes) +(defmacro !define-storage-classes (&rest classes) (collect ((forms)) (let ((index 0)) (dolist (class classes) @@ -166,9 +162,9 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defconstant kludge-nondeterministic-catch-block-size 6)) -(define-storage-classes +(!define-storage-classes - ;; non-immediate contstants in the constant pool + ;; non-immediate constants in the constant pool (constant constant) ;; some FP constants can be generated in the i387 silicon diff --git a/version.lisp-expr b/version.lisp-expr index 923fdc4..6f2e94e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.31" +"0.7.1.32" -- 1.7.10.4