From: Christophe Rhodes Date: Sun, 19 May 2002 13:55:31 +0000 (+0000) Subject: 0.7.3.18: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8731c1a7c1a585d190151fa881050fb5e14c0616;p=sbcl.git 0.7.3.18: Merged def!constant patch (CSR sbcl-devel 2002-05-17) ... cross-compiler now starts knowing about constant values src/compiler/assem tweaks ... declare some things ignorable ... comment tweaks other backend tweaks ... declare the type for with-adjustable-vector [ the fact that I had to do this four times, once for each backend, is not optimal. ] --- diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 1d0440a..508c40f 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -77,6 +77,7 @@ ("src/code/defbangtype") ("src/code/defbangmacro") + ("src/code/defbangconstant") ("src/code/primordial-extensions") @@ -91,6 +92,7 @@ ("src/code/parse-defmacro") ; on host for PARSE-DEFMACRO ("src/code/early-extensions") ; on host for COLLECT, SYMBOLICATE, etc. ("src/compiler/deftype") ; on host for SB!XC:DEFTYPE + ("src/compiler/defconstant") ("src/code/early-alieneval") ; for vars needed both at build and run time ("src/code/specializable-array") @@ -297,6 +299,7 @@ ("src/compiler/globaldb") ("src/compiler/info-functions") + ("src/code/force-delayed-defbangconstants") ("src/code/defmacro") ("src/code/force-delayed-defbangmacros") diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index c8bcf36..0e35531 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -684,7 +684,7 @@ retained, possibly temporariliy, because it might be used internally." ;; bootstrapping magic, to make things happen both in ;; the cross-compilation host compiler's environment and ;; in the cross-compiler's environment - "DEF!MACRO" "DEF!METHOD" "DEF!STRUCT" "DEF!TYPE" + "DEF!CONSTANT" "DEF!MACRO" "DEF!METHOD" "DEF!STRUCT" "DEF!TYPE" ;; stuff for hinting to the compiler "NAMED-LAMBDA" diff --git a/src/code/char.lisp b/src/code/char.lisp index e1c7ca7..07ea350 100644 --- a/src/code/char.lisp +++ b/src/code/char.lisp @@ -12,6 +12,6 @@ (in-package "SB!IMPL") -(defconstant sb!xc:char-code-limit 256 +(def!constant sb!xc:char-code-limit 256 #!+sb-doc "the upper exclusive bound on values produced by CHAR-CODE") diff --git a/src/code/class.lisp b/src/code/class.lisp index fbf4fd9..cfa2a1b 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -96,7 +96,7 @@ ;;; Note: This bound is set somewhat less than MOST-POSITIVE-FIXNUM ;;; in order to guarantee that several hash values can be added without ;;; overflowing into a bignum. -(defconstant layout-clos-hash-max (ash most-positive-fixnum -3) +(def!constant layout-clos-hash-max (ash most-positive-fixnum -3) #!+sb-doc "the inclusive upper bound on LAYOUT-CLOS-HASH values") @@ -233,7 +233,7 @@ ;;;; support for the hash values used by CLOS when working with LAYOUTs -(defconstant layout-clos-hash-length 8) +(def!constant layout-clos-hash-length 8) #!-sb-fluid (declaim (inline layout-clos-hash)) (defun layout-clos-hash (layout i) ;; FIXME: Either this I should be declared to be `(MOD diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index 02a19c4..829694c 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -51,11 +51,11 @@ ;;; FIXME: The first two are no longer used in SBCL. ;;;(defconstant compiled-debug-var-uninterned #b00000001) ;;;(defconstant compiled-debug-var-packaged #b00000010) -(defconstant compiled-debug-var-environment-live #b00000100) -(defconstant compiled-debug-var-save-loc-p #b00001000) -(defconstant compiled-debug-var-id-p #b00010000) -(defconstant compiled-debug-var-minimal-p #b00100000) -(defconstant compiled-debug-var-deleted-p #b01000000) +(def!constant compiled-debug-var-environment-live #b00000100) +(def!constant compiled-debug-var-save-loc-p #b00001000) +(def!constant compiled-debug-var-id-p #b00010000) +(def!constant compiled-debug-var-minimal-p #b00100000) +(def!constant compiled-debug-var-deleted-p #b01000000) ;;;; compiled debug blocks ;;;; @@ -74,7 +74,7 @@ ;;;; tuples... (defconstant-eqx compiled-debug-block-nsucc-byte (byte 2 0) #'equalp) -(defconstant compiled-debug-block-elsewhere-p #b00000100) +(def!constant compiled-debug-block-elsewhere-p #b00000100) (defconstant-eqx compiled-code-location-kind-byte (byte 3 0) #'equalp) (defparameter *compiled-code-location-kinds* diff --git a/src/code/defbangconstant.lisp b/src/code/defbangconstant.lisp new file mode 100644 index 0000000..e248a20 --- /dev/null +++ b/src/code/defbangconstant.lisp @@ -0,0 +1,54 @@ +;;;; 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!KERNEL") + +;;;; the DEF!CONSTANT macro + +;;; FIXME: This code was created by cut-and-paste from the +;;; corresponding code for DEF!TYPE. DEF!CONSTANT, DEF!TYPE and +;;; DEF!MACRO are currently very parallel, and if we ever manage to +;;; rationalize the use of UNCROSS in the cross-compiler, they should +;;; become completely parallel, at which time they should be merged to +;;; eliminate the duplicate code. + +;;; *sigh* -- Even the comments are cut'n'pasted :-/ If I were more +;;; confident in my understanding, I might try to do drastic surgery, +;;; but my head is currently spinning (host? target? both?) so I'll go +;;; for the minimal changeset... -- CSR, 2002-05-11 +(defmacro def!constant (&rest rest name value &optional doc) + `(progn + #-sb-xc-host + (defconstant ,@rest) + #+sb-xc-host + ,(unless (eql (find-symbol (symbol-name name) :cl) name) + `(defconstant ,@rest)) + #+sb-xc-host + ,(let ((form `(sb!xc:defconstant ,@rest))) + (if (boundp '*delayed-def!constants*) + `(push ',form *delayed-def!constants*) + form)))) + +;;; machinery to implement DEF!CONSTANT delays +#+sb-xc-host +(progn + (/show "binding *DELAYED-DEF!CONSTANTS*") + (defvar *delayed-def!constants* nil) + (/show "done binding *DELAYED-DEF!CONSTANTS*") + (defun force-delayed-def!constants () + (if (boundp '*delayed-def!constants*) + (progn + (mapc #'eval *delayed-def!constants*) + (makunbound '*delayed-def!constants*)) + ;; This condition is probably harmless if it comes up when + ;; interactively experimenting with the system by loading a + ;; source file into it more than once. But it's worth warning + ;; about it because it definitely shouldn't come up in an + ;; ordinary build process. + (warn "*DELAYED-DEF!CONSTANTS* is already unbound.")))) diff --git a/src/code/defbangtype.lisp b/src/code/defbangtype.lisp index c42a0c1..6fac80c 100644 --- a/src/code/defbangtype.lisp +++ b/src/code/defbangtype.lisp @@ -11,7 +11,7 @@ ;;;; the DEF!TYPE macro -;;; DEF!MACRO = cold DEFTYPE, a version of DEFTYPE which at +;;; DEF!TYPE = cold DEFTYPE, a version of DEFTYPE which at ;;; build-the-cross-compiler time defines its macro both in the ;;; cross-compilation host Lisp and in the target Lisp. Basically, ;;; DEF!TYPE does something like diff --git a/src/code/early-array.lisp b/src/code/early-array.lisp index 8e6ea61..9d1dba2 100644 --- a/src/code/early-array.lisp +++ b/src/code/early-array.lisp @@ -9,14 +9,14 @@ (in-package "SB!IMPL") -(defconstant sb!xc:array-rank-limit 65529 +(def!constant sb!xc:array-rank-limit 65529 #!+sb-doc "the exclusive upper bound on the rank of an array") -(defconstant sb!xc:array-dimension-limit sb!xc:most-positive-fixnum +(def!constant 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!xc:most-positive-fixnum +(def!constant 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/early-extensions.lisp b/src/code/early-extensions.lisp index 26eb070..0f6fba9 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -53,7 +53,6 @@ ;; at load time (so that we don't need to teach the cross-compiler ;; how to represent and dump non-STANDARD-CHARs like #\NULL) (defparameter *default-init-char-form* '(code-char 0))) -(defconstant default-init-char #.*default-init-char-form*) ;;; CHAR-CODE values for ASCII characters which we care about but ;;; which aren't defined in section "2.1.3 Standard Characters" of the @@ -66,14 +65,14 @@ ;;; if so, perhaps implement a DEFTRANSFORM or something to stop it. ;;; (or just find a nicer way of expressing characters portably?) -- ;;; WHN 19990713 -(defconstant bell-char-code 7) -(defconstant backspace-char-code 8) -(defconstant tab-char-code 9) -(defconstant line-feed-char-code 10) -(defconstant form-feed-char-code 12) -(defconstant return-char-code 13) -(defconstant escape-char-code 27) -(defconstant rubout-char-code 127) +(def!constant bell-char-code 7) +(def!constant backspace-char-code 8) +(def!constant tab-char-code 9) +(def!constant line-feed-char-code 10) +(def!constant form-feed-char-code 12) +(def!constant return-char-code 13) +(def!constant escape-char-code 27) +(def!constant rubout-char-code 127) ;;;; type-ish predicates diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 84ac9dd..8ab9068 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -34,7 +34,7 @@ (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) +(def!constant +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. In @@ -42,7 +42,7 @@ ;;; versions which break binary compatibility. But it certainly should ;;; be incremented for release versions which break binary ;;; compatibility. -(defconstant +fasl-file-version+ 28) +(def!constant +fasl-file-version+ 28) ;;; (record of versions before 0.7.0 deleted in 0.7.1.41) ;;; 23 = sbcl-0.7.0.1 deleted no-longer-used EVAL-STACK stuff, ;;; causing changes in *STATIC-SYMBOLS*. diff --git a/src/code/force-delayed-defbangconstants.lisp b/src/code/force-delayed-defbangconstants.lisp new file mode 100644 index 0000000..ce95dec --- /dev/null +++ b/src/code/force-delayed-defbangconstants.lisp @@ -0,0 +1,19 @@ +;;;; Now that all the cross-compiler INFO machinery has been set up, we +;;;; can feed the stored DEF!CONSTANTS argument lists to it. +;;;; +;;;; KLUDGE: There's no real reason for this to be in its own file, except +;;;; perhaps the parallelism with FORCE-DELAYED-DEF!STRUCTS (which does have a +;;;; good reason). + +;;;; 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!KERNEL") + +#+sb-xc-host (force-delayed-def!constants) diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 5ee726a..adceea0 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -76,110 +76,6 @@ (setf ,place (check-type-error ',place ,place-value ',type ,type-string))))) -;;;; DEFCONSTANT - -(defmacro-mundanely defconstant (name value &optional documentation) - #!+sb-doc - "Define a global constant, saying that the value is constant and may be - compiled into code. If the variable already has a value, and this is not - EQL to the new value, the code is not portable (undefined behavior). The - third argument is an optional documentation string for the variable." - `(eval-when (:compile-toplevel :load-toplevel :execute) - (sb!c::%defconstant ',name ,value ',documentation))) - -;;; the guts of DEFCONSTANT -(defun sb!c::%defconstant (name value doc) - (unless (symbolp name) - (error "The constant name is not a symbol: ~S" name)) - (about-to-modify-symbol-value name) - (when (looks-like-name-of-special-var-p name) - (style-warn "defining ~S as a constant, even though the name follows~@ -the usual naming convention (names like *FOO*) for special variables" - name)) - (let ((kind (info :variable :kind name))) - (case kind - (:constant - ;; Note: This behavior (discouraging any non-EQL modification) - ;; is unpopular, but it is specified by ANSI (i.e. ANSI says a - ;; non-EQL change has undefined consequences). If people really - ;; want bindings which are constant in some sense other than - ;; EQL, I suggest either just using DEFVAR (which is usually - ;; appropriate, despite the un-mnemonic name), or defining - ;; something like the DEFCONSTANT-EQX macro used in SBCL (which - ;; is occasionally more appropriate). -- WHN 2001-12-21 - (unless (eql value - (info :variable :constant-value name)) - (cerror "Go ahead and change the value." - "The constant ~S is being redefined." - name))) - (:global - ;; (This is OK -- undefined variables are of this kind. So we - ;; don't warn or error or anything, just fall through.) - ) - (t (warn "redefining ~(~A~) ~S to be a constant" kind name)))) - (when doc - (setf (fdocumentation name 'variable) doc)) - - ;; We want to set the cross-compilation host's symbol value, not just - ;; the cross-compiler's (INFO :VARIABLE :CONSTANT-VALUE NAME), so - ;; that code like - ;; (defconstant max-entries 61) - ;; (deftype entry-index () `(mod ,max-entries)) - ;; will be cross-compiled correctly. - #-sb-xc-host (setf (symbol-value name) value) - #+sb-xc-host (progn - ;; Redefining our cross-compilation host's CL symbols - ;; would be poor form. - ;; - ;; FIXME: Having to check this and then not treat it - ;; as a fatal error seems like a symptom of things - ;; being pretty broken. It's also a problem in and of - ;; itself, since it makes it too easy for cases of - ;; using the cross-compilation host Lisp's CL - ;; constant values in the target Lisp to slip by. I - ;; got backed into this because the cross-compiler - ;; translates DEFCONSTANT SB!XC:FOO into DEFCONSTANT - ;; CL:FOO. It would be good to unscrew the - ;; cross-compilation package hacks so that that - ;; translation doesn't happen. Perhaps: - ;; * Replace SB-XC with SB-CL. SB-CL exports all the - ;; symbols which ANSI requires to be exported from CL. - ;; * Make a nickname SB!CL which behaves like SB!XC. - ;; * Go through the loaded-on-the-host code making - ;; every target definition be in SB-CL. E.g. - ;; DEFMACRO-MUNDANELY DEFCONSTANT becomes - ;; DEFMACRO-MUNDANELY SB!CL:DEFCONSTANT. - ;; * Make IN-TARGET-COMPILATION-MODE do - ;; UNUSE-PACKAGE CL and USE-PACKAGE SB-CL in each - ;; of the target packages (then undo it on exit). - ;; * Make the cross-compiler's implementation of - ;; EVAL-WHEN (:COMPILE-TOPLEVEL) do UNCROSS. - ;; (This may not require any change.) - ;; * Hack GENESIS as necessary so that it outputs - ;; SB-CL stuff as COMMON-LISP stuff. - ;; * Now the code here can assert that the symbol - ;; being defined isn't in the cross-compilation - ;; host's CL package. - (unless (eql (find-symbol (symbol-name name) :cl) name) - ;; KLUDGE: In the cross-compiler, we use the - ;; cross-compilation host's DEFCONSTANT macro - ;; instead of just (SETF SYMBOL-VALUE), in order to - ;; get whatever blessing the cross-compilation host - ;; may expect for a global (SETF SYMBOL-VALUE). - ;; (CMU CL, at least around 2.4.19, generated full - ;; WARNINGs for code -- e.g. DEFTYPE expanders -- - ;; which referred to symbols which had been set by - ;; (SETF SYMBOL-VALUE). I doubt such warnings are - ;; ANSI-compliant, but I'm not sure, so I've - ;; written this in a way that CMU CL will tolerate - ;; and which ought to work elsewhere too.) -- WHN - ;; 2001-03-24 - (eval `(defconstant ,name ',value)))) - - (setf (info :variable :kind name) :constant - (info :variable :constant-value name) value) - name) - ;;;; DEFINE-SYMBOL-MACRO (defmacro-mundanely define-symbol-macro (name expansion) diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp index 38aa063..9299521 100644 --- a/src/code/primordial-extensions.lisp +++ b/src/code/primordial-extensions.lisp @@ -46,7 +46,7 @@ ;;; until SBCL's EVAL-WHEN is fixed, which is waiting for the IR1 ;;; interpreter to go away, which is waiting for sbcl-0.7.x.. (eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant +empty-ht-slot+ '%empty-ht-slot%)) + (def!constant +empty-ht-slot+ '%empty-ht-slot%)) ;;; We shouldn't need this mess now that EVAL-WHEN works. #+nil (defconstant +empty-ht-slot+ '#.+empty-ht-slot+) ; egads.. See FIXME above. ;;; KLUDGE: Using a private symbol still leaves us vulnerable to users @@ -224,7 +224,7 @@ (if (consp id) (values (car id) (cdr id)) (values id nil)) - (push `(defconstant ,(symbolicate prefix root suffix) + (push `(def!constant ,(symbolicate prefix root suffix) ,(+ start (* step index)) ,@docs) results))) @@ -254,7 +254,7 @@ ;;; need to avoid runtime indirection through a symbol, you might be ;;; able to do something with LOAD-TIME-VALUE or MAKE-LOAD-FORM. (defmacro defconstant-eqx (symbol expr eqx &optional doc) - `(defconstant ,symbol + `(def!constant ,symbol (%defconstant-eqx-value ',symbol ,expr ,eqx) ,@(when doc (list doc)))) (defun %defconstant-eqx-value (symbol expr eqx) diff --git a/src/code/random.lisp b/src/code/random.lisp index d0d672d..4126036 100644 --- a/src/code/random.lisp +++ b/src/code/random.lisp @@ -10,18 +10,18 @@ (in-package "SB!KERNEL") ;;; the size of the chunks returned by RANDOM-CHUNK -(defconstant random-chunk-length 32) +(def!constant random-chunk-length 32) ;;; the amount that we overlap chunks by when building a large integer ;;; to make up for the loss of randomness in the low bits -(defconstant random-integer-overlap 3) +(def!constant random-integer-overlap 3) ;;; extra bits of randomness that we generate before taking the value MOD the ;;; limit, to avoid loss of randomness near the limit -(defconstant random-integer-extra-bits 10) +(def!constant random-integer-extra-bits 10) ;;; the largest fixnum we can compute from one chunk of bits -(defconstant random-fixnum-max +(def!constant random-fixnum-max (1- (ash 1 (- random-chunk-length random-integer-extra-bits)))) (sb!xc:defstruct (random-state (:constructor %make-random-state) diff --git a/src/code/readtable.lisp b/src/code/readtable.lisp index 0359169..3764b16 100644 --- a/src/code/readtable.lisp +++ b/src/code/readtable.lisp @@ -16,19 +16,19 @@ ;;; constants for readtable character attributes. These are all as in ;;; the manual. -(defconstant +char-attr-whitespace+ 0) -(defconstant +char-attr-terminating-macro+ 1) -(defconstant +char-attr-escape+ 2) -(defconstant +char-attr-constituent+ 3) -(defconstant +char-attr-constituent-dot+ 4) -(defconstant +char-attr-constituent-expt+ 5) -(defconstant +char-attr-constituent-slash+ 6) -(defconstant +char-attr-constituent-digit+ 7) -(defconstant +char-attr-constituent-sign+ 8) +(def!constant +char-attr-whitespace+ 0) +(def!constant +char-attr-terminating-macro+ 1) +(def!constant +char-attr-escape+ 2) +(def!constant +char-attr-constituent+ 3) +(def!constant +char-attr-constituent-dot+ 4) +(def!constant +char-attr-constituent-expt+ 5) +(def!constant +char-attr-constituent-slash+ 6) +(def!constant +char-attr-constituent-digit+ 7) +(def!constant +char-attr-constituent-sign+ 8) ;; the "9" entry intentionally left blank for some reason -- WHN 19990806 -(defconstant +char-attr-multiple-escape+ 10) -(defconstant +char-attr-package-delimiter+ 11) -(defconstant +char-attr-delimiter+ 12) ; (a fake for READ-UNQUALIFIED-TOKEN) +(def!constant +char-attr-multiple-escape+ 10) +(def!constant +char-attr-package-delimiter+ 11) +(def!constant +char-attr-delimiter+ 12) ; (a fake for READ-UNQUALIFIED-TOKEN) (sb!xc:defstruct (readtable (:conc-name nil) (:predicate readtablep) diff --git a/src/compiler/alpha/backend-parms.lisp b/src/compiler/alpha/backend-parms.lisp index f92efe7..ab49a3c 100644 --- a/src/compiler/alpha/backend-parms.lisp +++ b/src/compiler/alpha/backend-parms.lisp @@ -17,7 +17,7 @@ ;;;; compiler constants -(defconstant +backend-fasl-file-implementation+ :alpha) +(def!constant +backend-fasl-file-implementation+ :alpha) (setf *backend-register-save-penalty* 3) diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index d90c721..b6bfa75 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -409,14 +409,14 @@ (define-fp-operate subt #x16 #x0a1) ;;; IEEE support - (defconstant +su+ #x500) ; software, underflow enabled - (defconstant +sui+ #x700) ; software, inexact & underflow enabled - (defconstant +sv+ #x500) ; software, interger overflow enabled - (defconstant +svi+ #x700) - (defconstant +rnd+ #x0c0) ; dynamic rounding mode - (defconstant +sud+ #x5c0) - (defconstant +svid+ #x7c0) - (defconstant +suid+ #x7c0) + (def!constant +su+ #x500) ; software, underflow enabled + (def!constant +sui+ #x700) ; software, inexact & underflow enabled + (def!constant +sv+ #x500) ; software, interger overflow enabled + (def!constant +svi+ #x700) + (def!constant +rnd+ #x0c0) ; dynamic rounding mode + (def!constant +sud+ #x5c0) + (def!constant +svid+ #x7c0) + (def!constant +suid+ #x7c0) (define-fp-operate cvtqs_su #x16 (logior +su+ #x0bc) 2) (define-fp-operate cvtqs_sui #x16 (logior +sui+ #x0bc) 2) diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index b3e2624..bb5e3d0 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -185,6 +185,7 @@ :element-type '(unsigned-byte 8) :fill-pointer 0 :adjustable t)))) + (declare (type (vector (unsigned-byte 8) 16) ,var)) (setf (fill-pointer ,var) 0) (unwind-protect (progn diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 143db40..872102d 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -11,44 +11,44 @@ (eval-when (:compile-toplevel :load-toplevel :execute) -(defconstant n-word-bits 32 +(def!constant n-word-bits 32 #!+sb-doc "Number of bits per word where a word holds one lisp descriptor.") -(defconstant n-byte-bits 8 +(def!constant n-byte-bits 8 #!+sb-doc "Number of bits per byte where a byte is the smallest addressable object.") -(defconstant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))) +(def!constant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))) #!+sb-doc "Number of bits to shift between word addresses and byte addresses.") -(defconstant n-word-bytes (/ n-word-bits n-byte-bits) +(def!constant n-word-bytes (/ n-word-bits n-byte-bits) #!+sb-doc "Number of bytes in a word.") -(defconstant float-sign-shift 31) +(def!constant float-sign-shift 31) -(defconstant single-float-bias 126) +(def!constant single-float-bias 126) (defconstant-eqx single-float-exponent-byte (byte 8 23) #'equalp) (defconstant-eqx single-float-significand-byte (byte 23 0) #'equalp) -(defconstant single-float-normal-exponent-min 1) -(defconstant single-float-normal-exponent-max 254) -(defconstant single-float-hidden-bit (ash 1 23)) -(defconstant single-float-trapping-nan-bit (ash 1 22)) +(def!constant single-float-normal-exponent-min 1) +(def!constant single-float-normal-exponent-max 254) +(def!constant single-float-hidden-bit (ash 1 23)) +(def!constant single-float-trapping-nan-bit (ash 1 22)) -(defconstant double-float-bias 1022) +(def!constant double-float-bias 1022) (defconstant-eqx double-float-exponent-byte (byte 11 20) #'equalp) (defconstant-eqx double-float-significand-byte (byte 20 0) #'equalp) -(defconstant double-float-normal-exponent-min 1) -(defconstant double-float-normal-exponent-max #x7FE) -(defconstant double-float-hidden-bit (ash 1 20)) -(defconstant double-float-trapping-nan-bit (ash 1 19)) +(def!constant double-float-normal-exponent-min 1) +(def!constant double-float-normal-exponent-max #x7FE) +(def!constant double-float-hidden-bit (ash 1 20)) +(def!constant double-float-trapping-nan-bit (ash 1 19)) -(defconstant single-float-digits +(def!constant single-float-digits (+ (byte-size single-float-significand-byte) 1)) -(defconstant double-float-digits +(def!constant double-float-digits (+ (byte-size double-float-significand-byte) n-word-bits 1)) ;;; These values are originally from the DEC Assembly Language @@ -77,11 +77,11 @@ ;;; ;;; trap enables are set in software (fp_control) -(defconstant float-inexact-trap-bit (ash 1 4)) ; rw -(defconstant float-underflow-trap-bit (ash 1 3)) ; rw -(defconstant float-overflow-trap-bit (ash 1 2)) ; ro -(defconstant float-divide-by-zero-trap-bit (ash 1 1)) ; ro -(defconstant float-invalid-trap-bit (ash 1 0)) ; ro +(def!constant float-inexact-trap-bit (ash 1 4)) ; rw +(def!constant float-underflow-trap-bit (ash 1 3)) ; rw +(def!constant float-overflow-trap-bit (ash 1 2)) ; ro +(def!constant float-divide-by-zero-trap-bit (ash 1 1)) ; ro +(def!constant float-invalid-trap-bit (ash 1 0)) ; ro (defconstant-eqx float-traps-byte (byte 6 1) #'equalp) ;;; exceptions are also read/written in software (by syscalls, no less). @@ -94,15 +94,15 @@ (defconstant-eqx float-exceptions-byte (byte 6 17) #'equalp) ;;; Rounding modes can only be set by frobbing the hardware fpcr directly -(defconstant float-round-to-zero 0) -(defconstant float-round-to-negative 1) -(defconstant float-round-to-nearest 2) -(defconstant float-round-to-positive 3) +(def!constant float-round-to-zero 0) +(def!constant float-round-to-negative 1) +(def!constant float-round-to-nearest 2) +(def!constant float-round-to-positive 3) (defconstant-eqx float-rounding-mode (byte 2 58) #'equalp) ;;; Miscellaneous stuff - I think it's far to say that you deserve ;;; what you get if you ask for fast mode. -(defconstant float-fast-bit 0) +(def!constant float-fast-bit 0) ); eval-when @@ -115,29 +115,29 @@ #!+linux (progn - (defconstant read-only-space-start #x20000000) - (defconstant read-only-space-end #x24000000) + (def!constant read-only-space-start #x20000000) + (def!constant read-only-space-end #x24000000) - (defconstant static-space-start #x28000000) - (defconstant static-space-end #x2c000000) + (def!constant static-space-start #x28000000) + (def!constant static-space-end #x2c000000) ;; this is used in PURIFY as part of a sloppy check to see if a pointer ;; is in dynamic space. Chocolate brownie for the first person to fix it ;; -dan 20010502 - (defconstant dynamic-space-start #x30000000) - (defconstant dynamic-space-end #x3fff0000) + (def!constant dynamic-space-start #x30000000) + (def!constant dynamic-space-end #x3fff0000) - (defconstant dynamic-0-space-start #x30000000) - (defconstant dynamic-0-space-end #x3fff0000) + (def!constant dynamic-0-space-start #x30000000) + (def!constant dynamic-0-space-end #x3fff0000) - (defconstant dynamic-1-space-start #x40000000) - (defconstant dynamic-1-space-end #x4fff0000) + (def!constant dynamic-1-space-start #x40000000) + (def!constant dynamic-1-space-end #x4fff0000) - (defconstant control-stack-start #x50000000) - (defconstant control-stack-end #x51000000) + (def!constant control-stack-start #x50000000) + (def!constant control-stack-end #x51000000) - (defconstant binding-stack-start #x70000000) - (defconstant binding-stack-end #x71000000)) + (def!constant binding-stack-start #x70000000) + (def!constant binding-stack-end #x71000000)) #!+osf1 ;as if (progn @@ -150,10 +150,10 @@ ;;; backend, so they could probably be removed. ;; The space-register holding the lisp heap. -(defconstant lisp-heap-space 4) +(def!constant lisp-heap-space 4) ;; The space-register holding the C text segment. -(defconstant c-text-space 4) +(def!constant c-text-space 4) ;;; the X86 port defines *nil-value* as (+ *target-static-space-start* #xB) ;;; here, but it seems to be the only port that needs to know the diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp index c8f77dd..cb00650 100644 --- a/src/compiler/alpha/vm.lisp +++ b/src/compiler/alpha/vm.lisp @@ -19,7 +19,7 @@ (macrolet ((defreg (name offset) (let ((offset-sym (symbolicate name "-OFFSET"))) `(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant ,offset-sym ,offset) + (def!constant ,offset-sym ,offset) (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) (defregset (name &rest regs) @@ -103,7 +103,7 @@ "-SC-NUMBER")))) (list* `(define-storage-class ,sc-name ,index ,@(cdr class)) - `(defconstant ,constant-name ,index) + `(def!constant ,constant-name ,index) ;; (The CMU CL version of this macro did ;; `(EXPORT ',CONSTANT-NAME) ;; here, but in SBCL we try to have package @@ -120,7 +120,7 @@ ;;; see comment in ../x86/vm.lisp. The value of 7 was taken from ;;; vm:catch-block-size in a cmucl that I happened to have around ;;; and seems to be working so far -dan -(defconstant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) (!define-storage-classes @@ -307,19 +307,19 @@ ;;;; function call parameters ;;; the SC numbers for register and stack arguments/return values -(defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) -(defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) -(defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) +(def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) +(def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) +(def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) (eval-when (:compile-toplevel :load-toplevel :execute) ;;; offsets of special stack frame locations -(defconstant ocfp-save-offset 0) -(defconstant lra-save-offset 1) -(defconstant nfp-save-offset 2) +(def!constant ocfp-save-offset 0) +(def!constant lra-save-offset 1) +(def!constant nfp-save-offset 2) ;;; the number of arguments/return values passed in registers -(defconstant register-arg-count 6) +(def!constant register-arg-count 6) ;;; (Names to use for the argument registers would go here, but there ;;; are none.) @@ -335,7 +335,7 @@ *register-arg-offsets*)) ;;; This is used by the debugger. -(defconstant single-value-return-byte-offset 4) +(def!constant single-value-return-byte-offset 4) ;;; This function is called by debug output routines that want a ;;; pretty name for a TN's location. It returns a thing that can be diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp index 5373290..aa706a1 100644 --- a/src/compiler/assem.lisp +++ b/src/compiler/assem.lisp @@ -1124,6 +1124,7 @@ p ;; the branch has two dependents and one of them dpends on ,@(mapcar (lambda (name) `(,name (gen-label))) new-labels)) + (declare (ignorable ,vop-var ,seg-var)) (macrolet ((%%current-segment%% () '**current-segment**) (%%current-vop%% () '**current-vop**)) (symbol-macrolet (,@(when (or inherited-labels nested-labels) @@ -1166,6 +1167,7 @@ p ;; the branch has two dependents and one of them dpends on ,@(mapcar (lambda (name) `(,name (gen-label))) new-labels)) + (declare (ignorable ,vop-var ,seg-var)) (macrolet ((%%current-segment%% () '**current-segment**) (%%current-vop%% () '**current-vop**)) (symbol-macrolet (,@(when (or inherited-labels nested-labels) @@ -1187,16 +1189,15 @@ p ;; the branch has two dependents and one of them dpends on (t `(,inst (%%current-segment%%) (%%current-vop%%) ,@args))))) -;;; Note: The need to capture SYMBOL-MACROLET bindings of -;;; **CURRENT-SEGMENT* and **CURRENT-VOP** prevents this from being an -;;; ordinary function. +;;; Note: The need to capture MACROLET bindings of %%CURRENT-SEGMENT%% +;;; and %%CURRENT-VOP%% prevents this from being an ordinary function. (defmacro emit-label (label) #!+sb-doc "Emit LABEL at this location in the current segment." `(%emit-label (%%current-segment%%) (%%current-vop%%) ,label)) -;;; Note: The need to capture SYMBOL-MACROLET bindings of -;;; **CURRENT-SEGMENT* prevents this from being an ordinary function. +;;; Note: The need to capture MACROLET bindings of +;;; %%CURRENT-SEGMENT%% prevents this from being an ordinary function. (defmacro emit-postit (function) `(%emit-postit (%%current-segment%%) ,function)) diff --git a/src/compiler/defconstant.lisp b/src/compiler/defconstant.lisp new file mode 100644 index 0000000..3356b18 --- /dev/null +++ b/src/compiler/defconstant.lisp @@ -0,0 +1,107 @@ +;;;; 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!IMPL") + +(def!macro sb!xc:defconstant (name value &optional documentation) + #!+sb-doc + "Define a global constant, saying that the value is constant and may be + compiled into code. If the variable already has a value, and this is not + EQL to the new value, the code is not portable (undefined behavior). The + third argument is an optional documentation string for the variable." + `(eval-when (:compile-toplevel :load-toplevel :execute) + (sb!c::%defconstant ',name ,value ',documentation))) + +;;; the guts of DEFCONSTANT +(defun sb!c::%defconstant (name value doc) + (unless (symbolp name) + (error "The constant name is not a symbol: ~S" name)) + (about-to-modify-symbol-value name) + (when (looks-like-name-of-special-var-p name) + (style-warn "defining ~S as a constant, even though the name follows~@ +the usual naming convention (names like *FOO*) for special variables" + name)) + (let ((kind (info :variable :kind name))) + (case kind + (:constant + ;; Note: This behavior (discouraging any non-EQL modification) + ;; is unpopular, but it is specified by ANSI (i.e. ANSI says a + ;; non-EQL change has undefined consequences). If people really + ;; want bindings which are constant in some sense other than + ;; EQL, I suggest either just using DEFVAR (which is usually + ;; appropriate, despite the un-mnemonic name), or defining + ;; something like the DEFCONSTANT-EQX macro used in SBCL (which + ;; is occasionally more appropriate). -- WHN 2001-12-21 + (unless (eql value + (info :variable :constant-value name)) + (cerror "Go ahead and change the value." + "The constant ~S is being redefined." + name))) + (:global + ;; (This is OK -- undefined variables are of this kind. So we + ;; don't warn or error or anything, just fall through.) + ) + (t (warn "redefining ~(~A~) ~S to be a constant" kind name)))) + (when doc + (setf (fdocumentation name 'variable) doc)) + #-sb-xc-host + (setf (symbol-value name) value) + #+sb-xc-host + (progn + ;; Redefining our cross-compilation host's CL symbols + ;; would be poor form. + ;; + ;; FIXME: Having to check this and then not treat it + ;; as a fatal error seems like a symptom of things + ;; being pretty broken. It's also a problem in and of + ;; itself, since it makes it too easy for cases of + ;; using the cross-compilation host Lisp's CL + ;; constant values in the target Lisp to slip by. I + ;; got backed into this because the cross-compiler + ;; translates DEFCONSTANT SB!XC:FOO into DEFCONSTANT + ;; CL:FOO. It would be good to unscrew the + ;; cross-compilation package hacks so that that + ;; translation doesn't happen. Perhaps: + ;; * Replace SB-XC with SB-CL. SB-CL exports all the + ;; symbols which ANSI requires to be exported from CL. + ;; * Make a nickname SB!CL which behaves like SB!XC. + ;; * Go through the loaded-on-the-host code making + ;; every target definition be in SB-CL. E.g. + ;; DEFMACRO-MUNDANELY DEFCONSTANT becomes + ;; DEFMACRO-MUNDANELY SB!CL:DEFCONSTANT. + ;; * Make IN-TARGET-COMPILATION-MODE do + ;; UNUSE-PACKAGE CL and USE-PACKAGE SB-CL in each + ;; of the target packages (then undo it on exit). + ;; * Make the cross-compiler's implementation of + ;; EVAL-WHEN (:COMPILE-TOPLEVEL) do UNCROSS. + ;; (This may not require any change.) + ;; * Hack GENESIS as necessary so that it outputs + ;; SB-CL stuff as COMMON-LISP stuff. + ;; * Now the code here can assert that the symbol + ;; being defined isn't in the cross-compilation + ;; host's CL package. + (unless (eql (find-symbol (symbol-name name) :cl) name) + ;; KLUDGE: In the cross-compiler, we use the + ;; cross-compilation host's DEFCONSTANT macro + ;; instead of just (SETF SYMBOL-VALUE), in order to + ;; get whatever blessing the cross-compilation host + ;; may expect for a global (SETF SYMBOL-VALUE). + ;; (CMU CL, at least around 2.4.19, generated full + ;; WARNINGs for code -- e.g. DEFTYPE expanders -- + ;; which referred to symbols which had been set by + ;; (SETF SYMBOL-VALUE). I doubt such warnings are + ;; ANSI-compliant, but I'm not sure, so I've + ;; written this in a way that CMU CL will tolerate + ;; and which ought to work elsewhere too.) -- WHN + ;; 2001-03-24 + (eval `(defconstant ,name ',value)))) + + (setf (info :variable :kind name) :constant + (info :variable :constant-value name) value) + name) diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 0e59665..f25e490 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -13,7 +13,7 @@ ;;; types and defaults -(defconstant label-column-width 7) +(def!constant label-column-width 7) (deftype text-width () '(integer 0 1000)) (deftype alignment () '(integer 0 64)) @@ -22,7 +22,7 @@ (deftype length () '(unsigned-byte 24)) (deftype column () '(integer 0 1000)) -(defconstant max-filtered-value-index 32) +(def!constant max-filtered-value-index 32) (deftype filtered-value-index () `(integer 0 ,max-filtered-value-index)) (deftype filtered-value-vector () @@ -132,15 +132,15 @@ dchunk= dchunk-count-bits)) -(defconstant dchunk-bits 32) +(def!constant dchunk-bits 32) (deftype dchunk () `(unsigned-byte ,dchunk-bits)) (deftype dchunk-index () `(integer 0 ,dchunk-bits)) -(defconstant dchunk-zero 0) -(defconstant dchunk-one #xFFFFFFFF) +(def!constant dchunk-zero 0) +(def!constant dchunk-one #xFFFFFFFF) (defun dchunk-extract (from pos) (declare (type dchunk from)) diff --git a/src/compiler/early-assem.lisp b/src/compiler/early-assem.lisp index 39b33ff..13e756a 100644 --- a/src/compiler/early-assem.lisp +++ b/src/compiler/early-assem.lisp @@ -28,8 +28,8 @@ ;;; ASSEMBLY-UNIT-BITS -- the number of bits in the minimum assembly ;;; unit, (also referred to as a ``byte''). Hopefully, different ;;; instruction sets won't require changing this. -(defconstant assembly-unit-bits 8) -(defconstant assembly-unit-mask (1- (ash 1 assembly-unit-bits))) +(def!constant assembly-unit-bits 8) +(def!constant assembly-unit-mask (1- (ash 1 assembly-unit-bits))) (deftype assembly-unit () `(unsigned-byte ,assembly-unit-bits)) @@ -45,7 +45,7 @@ ;;; the maximum alignment we can guarantee given the object format. If ;;; the loader only loads objects 8-byte aligned, we can't do any ;;; better then that ourselves. -(defconstant max-alignment 3) +(def!constant max-alignment 3) (deftype alignment () `(integer 0 ,max-alignment)) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 1e3f616..ce5199b 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -16,16 +16,16 @@ (in-package "SB!C") ;;; ANSI limits on compilation -(defconstant sb!xc:call-arguments-limit most-positive-fixnum +(def!constant sb!xc:call-arguments-limit most-positive-fixnum #!+sb-doc "The exclusive upper bound on the number of arguments which may be passed to a function, including &REST args.") -(defconstant sb!xc:lambda-parameters-limit most-positive-fixnum +(def!constant sb!xc:lambda-parameters-limit most-positive-fixnum #!+sb-doc "The exclusive upper bound on the number of parameters which may be specifed in a given lambda list. This is actually the limit on required and &OPTIONAL parameters. With &KEY and &AUX you can get more.") -(defconstant sb!xc:multiple-values-limit most-positive-fixnum +(def!constant sb!xc:multiple-values-limit most-positive-fixnum #!+sb-doc "The exclusive upper bound on the number of multiple VALUES that you can return.") diff --git a/src/compiler/generic/early-vm.lisp b/src/compiler/generic/early-vm.lisp index 606b087..79321a6 100644 --- a/src/compiler/generic/early-vm.lisp +++ b/src/compiler/generic/early-vm.lisp @@ -11,22 +11,22 @@ ;;; the number of bits at the low end of a pointer used for type ;;; information -(defconstant n-lowtag-bits 3) +(def!constant n-lowtag-bits 3) ;;; a mask to extract the low tag bits from a pointer -(defconstant lowtag-mask (1- (ash 1 n-lowtag-bits))) +(def!constant lowtag-mask (1- (ash 1 n-lowtag-bits))) ;;; the exclusive upper bound on the value of the low tag bits from a ;;; pointer -(defconstant lowtag-limit (ash 1 n-lowtag-bits)) +(def!constant lowtag-limit (ash 1 n-lowtag-bits)) ;;; the number of bits used in the header word of a data block to store ;;; the type -(defconstant n-widetag-bits 8) +(def!constant n-widetag-bits 8) ;;; a mask to extract the type from a data block header word -(defconstant widetag-mask (1- (ash 1 n-widetag-bits))) +(def!constant widetag-mask (1- (ash 1 n-widetag-bits))) -(defconstant sb!xc:most-positive-fixnum (1- (ash 1 29)) +(def!constant sb!xc:most-positive-fixnum (1- (ash 1 29)) #!+sb-doc "the fixnum closest in value to positive infinity") -(defconstant sb!xc:most-negative-fixnum (ash -1 29) +(def!constant sb!xc:most-negative-fixnum (ash -1 29) #!+sb-doc "the fixnum closest in value to negative infinity") diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp index 8219a5a..984e83b 100644 --- a/src/compiler/generic/vm-macs.lisp +++ b/src/compiler/generic/vm-macs.lisp @@ -84,7 +84,7 @@ '(:docs :rest-p :length)))) (let ((offset-sym (symbolicate name "-" slot-name (if rest-p "-OFFSET" "-SLOT")))) - (constants `(defconstant ,offset-sym ,offset + (constants `(def!constant ,offset-sym ,offset ,@(when docs (list docs)))) (exports offset-sym)) (when ref-trans @@ -107,7 +107,7 @@ (incf offset length))) (unless var-length (let ((size (symbolicate name "-SIZE"))) - (constants `(defconstant ,size ,offset)) + (constants `(def!constant ,size ,offset)) (exports size))) (when alloc-trans (forms `(def-alloc ,alloc-trans ,offset ,var-length ,widetag @@ -148,4 +148,4 @@ (in-package "SB!C") ;;; the maximum number of SCs in any implementation -(defconstant sc-number-limit 32) +(def!constant sc-number-limit 32) diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 275f15d..88e3971 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -100,7 +100,7 @@ ;;; At run time, we represent the type of info that we want by a small ;;; non-negative integer. (eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant type-number-bits 6)) + (def!constant type-number-bits 6)) (deftype type-number () `(unsigned-byte ,type-number-bits)) ;;; Why do we suppress the :COMPILE-TOPLEVEL situation here when we're @@ -480,7 +480,7 @@ ;;;; compact info environments ;;; The upper limit on the size of the ENTRIES vector in a COMPACT-INFO-ENV. -(defconstant compact-info-env-entries-bits 16) +(def!constant compact-info-env-entries-bits 16) (deftype compact-info-entries-index () `(unsigned-byte ,compact-info-env-entries-bits)) ;;; the type of the values in COMPACT-INFO-ENTRIES-INFO @@ -516,8 +516,8 @@ ;; last entry. (entries-info (missing-arg) :type (simple-array compact-info-entry (*)))) -(defconstant compact-info-entry-type-mask (ldb (byte type-number-bits 0) -1)) -(defconstant compact-info-entry-last (ash 1 type-number-bits)) +(def!constant compact-info-entry-type-mask (ldb (byte type-number-bits 0) -1)) +(def!constant compact-info-entry-last (ash 1 type-number-bits)) ;;; Return the value of the type corresponding to NUMBER for the ;;; currently cached name in ENV. @@ -572,7 +572,7 @@ ;;; the exact density (modulo rounding) of the hashtable in a compact ;;; info environment in names/bucket -(defconstant compact-info-environment-density 65) +(def!constant compact-info-environment-density 65) ;;; Return a new compact info environment that holds the same ;;; information as ENV. @@ -882,7 +882,7 @@ ;;; ;;; FIXME: actually seems to be measured in percent, should be ;;; converted to be measured in names/bucket -(defconstant volatile-info-environment-density 50) +(def!constant volatile-info-environment-density 50) ;;; Make a new volatile environment of the specified size. (defun make-info-environment (&key (size 42) (name "Unknown")) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index f7185ea..fd63e74 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -213,7 +213,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) ;; The EVAL-WHEN is necessary for #.(1+ LIST-TO-HASH-TABLE-THRESHOLD) ;; below. -- AL 20010227 - (defconstant list-to-hash-table-threshold 32)) + (def!constant list-to-hash-table-threshold 32)) (defun maybe-emit-make-load-forms (constant) (let ((things-processed nil) (count 0)) diff --git a/src/compiler/ppc/backend-parms.lisp b/src/compiler/ppc/backend-parms.lisp index 71f5771..9f061d6 100644 --- a/src/compiler/ppc/backend-parms.lisp +++ b/src/compiler/ppc/backend-parms.lisp @@ -1,6 +1,6 @@ (in-package "SB!VM") -(defconstant +backend-fasl-file-implementation+ :ppc) +(def!constant +backend-fasl-file-implementation+ :ppc) (setf *backend-register-save-penalty* 3) (setf *backend-byte-order* :big-endian) (setf *backend-page-size* 4096) diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index fa66c78..c59e49a 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -347,6 +347,7 @@ :element-type '(unsigned-byte 8) :fill-pointer 0 :adjustable t)))) + (declare (type (vector (unsigned-byte 8) 16) ,var)) (setf (fill-pointer ,var) 0) (unwind-protect (progn diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index a8246fc..9d0a4a1 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -5,61 +5,61 @@ (in-package "SB!VM") -(defconstant n-word-bits 32 +(def!constant n-word-bits 32 "Number of bits per word where a word holds one lisp descriptor.") -(defconstant n-byte-bits 8 +(def!constant n-byte-bits 8 "Number of bits per byte where a byte is the smallest addressable object.") -(defconstant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))) +(def!constant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))) "Number of bits to shift between word addresses and byte addresses.") -(defconstant n-word-bytes (/ n-word-bits n-byte-bits) +(def!constant n-word-bytes (/ n-word-bits n-byte-bits) "Number of bytes in a word.") -(defconstant float-sign-shift 31) +(def!constant float-sign-shift 31) -(defconstant single-float-bias 126) +(def!constant single-float-bias 126) (defconstant-eqx single-float-exponent-byte (byte 8 23) #'equalp) (defconstant-eqx single-float-significand-byte (byte 23 0) #'equalp) -(defconstant single-float-normal-exponent-min 1) -(defconstant single-float-normal-exponent-max 254) -(defconstant single-float-hidden-bit (ash 1 23)) -(defconstant single-float-trapping-nan-bit (ash 1 22)) +(def!constant single-float-normal-exponent-min 1) +(def!constant single-float-normal-exponent-max 254) +(def!constant single-float-hidden-bit (ash 1 23)) +(def!constant single-float-trapping-nan-bit (ash 1 22)) -(defconstant double-float-bias 1022) +(def!constant double-float-bias 1022) (defconstant-eqx double-float-exponent-byte (byte 11 20) #'equalp) (defconstant-eqx double-float-significand-byte (byte 20 0) #'equalp) -(defconstant double-float-normal-exponent-min 1) -(defconstant double-float-normal-exponent-max #x7FE) -(defconstant double-float-hidden-bit (ash 1 20)) -(defconstant double-float-trapping-nan-bit (ash 1 19)) +(def!constant double-float-normal-exponent-min 1) +(def!constant double-float-normal-exponent-max #x7FE) +(def!constant double-float-hidden-bit (ash 1 20)) +(def!constant double-float-trapping-nan-bit (ash 1 19)) -(defconstant single-float-digits +(def!constant single-float-digits (+ (byte-size single-float-significand-byte) 1)) -(defconstant double-float-digits +(def!constant double-float-digits (+ (byte-size double-float-significand-byte) n-word-bits 1)) -(defconstant float-inexact-trap-bit (ash 1 0)) -(defconstant float-divide-by-zero-trap-bit (ash 1 1)) -(defconstant float-underflow-trap-bit (ash 1 2)) -(defconstant float-overflow-trap-bit (ash 1 3)) -(defconstant float-invalid-trap-bit (ash 1 4)) +(def!constant float-inexact-trap-bit (ash 1 0)) +(def!constant float-divide-by-zero-trap-bit (ash 1 1)) +(def!constant float-underflow-trap-bit (ash 1 2)) +(def!constant float-overflow-trap-bit (ash 1 3)) +(def!constant float-invalid-trap-bit (ash 1 4)) -(defconstant float-round-to-nearest 0) -(defconstant float-round-to-zero 1) -(defconstant float-round-to-positive 2) -(defconstant float-round-to-negative 3) +(def!constant float-round-to-nearest 0) +(def!constant float-round-to-zero 1) +(def!constant float-round-to-positive 2) +(def!constant float-round-to-negative 3) (defconstant-eqx float-rounding-mode (byte 2 0) #'equalp) ; RD (defconstant-eqx float-sticky-bits (byte 10 19) #'equalp) (defconstant-eqx float-traps-byte (byte 6 3) #'equalp) (defconstant-eqx float-exceptions-byte (byte 5 0) #'equalp) ; cexc -(defconstant float-fast-bit 2) ; Non-IEEE mode +(def!constant float-fast-bit 2) ; Non-IEEE mode ;;; NUMBER-STACK-DISPLACEMENT @@ -68,7 +68,7 @@ ;;; slots are required by architecture, mostly (?) to make C backtrace ;;; work. ;;; -(defconstant number-stack-displacement +(def!constant number-stack-displacement (* 2 sb!vm:n-word-bytes)) @@ -77,29 +77,29 @@ ;;; Where to put the different spaces. ;;; -(defconstant read-only-space-start #x01000000) -(defconstant read-only-space-end #x04ff8000) +(def!constant read-only-space-start #x01000000) +(def!constant read-only-space-end #x04ff8000) -(defconstant binding-stack-start #x06000000) -(defconstant binding-stack-end #x06ff0000) +(def!constant binding-stack-start #x06000000) +(def!constant binding-stack-end #x06ff0000) -(defconstant control-stack-start #x07000000) -(defconstant control-stack-end #x07ff0000) +(def!constant control-stack-start #x07000000) +(def!constant control-stack-end #x07ff0000) -(defconstant static-space-start #x08000000) -(defconstant static-space-end #x097fff00) +(def!constant static-space-start #x08000000) +(def!constant static-space-end #x097fff00) ;;; FIXME: this is a gross violation of OAOO, done purely to support ;;; the #define of DYNAMIC_SPACE_SIZE in validate.c -- CSR, 2002-02-25 ;;; (these numbers should match dynamic-0-*) -(defconstant dynamic-space-start #x40000000) -(defconstant dynamic-space-end #x47fff000) +(def!constant dynamic-space-start #x40000000) +(def!constant dynamic-space-end #x47fff000) ;;; nothing _seems_ to be using these addresses -(defconstant dynamic-0-space-start #x40000000) -(defconstant dynamic-0-space-end #x47fff000) -(defconstant dynamic-1-space-start #x48000000) -(defconstant dynamic-1-space-end #x4ffff000) +(def!constant dynamic-0-space-start #x40000000) +(def!constant dynamic-0-space-end #x47fff000) +(def!constant dynamic-1-space-start #x48000000) +(def!constant dynamic-1-space-end #x4ffff000) diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index 7b482c4..6e20e08 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -10,7 +10,7 @@ (macrolet ((defreg (name offset) (let ((offset-sym (symbolicate name "-OFFSET"))) `(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant ,offset-sym ,offset) + (def!constant ,offset-sym ,offset) (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) (defregset (name &rest regs) @@ -86,7 +86,7 @@ "-SC-NUMBER")))) (list* `(define-storage-class ,sc-name ,index ,@(cdr class)) - `(defconstant ,constant-name ,index) + `(def!constant ,constant-name ,index) forms))) (index 0 (1+ index)) (classes classes (cdr classes))) @@ -95,7 +95,7 @@ ;; XXX this is most likely wrong. Check with Eric Marsden next time you ;; see him -(defconstant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) (define-storage-classes @@ -268,20 +268,20 @@ ;;; The SC numbers for register and stack arguments/return values. ;;; -(defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) -(defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) -(defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) +(def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) +(def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) +(def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) (eval-when (:compile-toplevel :load-toplevel :execute) ;;; Offsets of special stack frame locations -(defconstant ocfp-save-offset 0) -(defconstant lra-save-offset 1) -(defconstant nfp-save-offset 2) +(def!constant ocfp-save-offset 0) +(def!constant lra-save-offset 1) +(def!constant nfp-save-offset 2) ;;; The number of arguments/return values passed in registers. ;;; -(defconstant register-arg-count 4) +(def!constant register-arg-count 4) ;;; Names to use for the argument registers. ;;; @@ -305,7 +305,7 @@ ;;; ;;; This is used by the debugger. ;;; -(defconstant single-value-return-byte-offset 8) +(def!constant single-value-return-byte-offset 8) ;;; LOCATION-PRINT-NAME -- Interface diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index b10fd2e..f7e170a 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -611,7 +611,7 @@ ;;; use that here, so that the compiler is born knowing this value. ;;; FIXME: Add a comment telling whether this holds for all vectors ;;; or only for vectors based on simple arrays (non-adjustable, etc.). -(defconstant vector-data-bit-offset +(def!constant vector-data-bit-offset (* sb!vm:vector-data-offset sb!vm:n-word-bits)) ;;; FIXME: Shouldn't we be testing for legality of diff --git a/src/compiler/sparc/backend-parms.lisp b/src/compiler/sparc/backend-parms.lisp index bdec468..3ca7012 100644 --- a/src/compiler/sparc/backend-parms.lisp +++ b/src/compiler/sparc/backend-parms.lisp @@ -17,7 +17,7 @@ ;;;; compiler constants -(defconstant +backend-fasl-file-implementation+ :sparc) +(def!constant +backend-fasl-file-implementation+ :sparc) (setf *backend-register-save-penalty* 3) diff --git a/src/compiler/sparc/insts.lisp b/src/compiler/sparc/insts.lisp index c378b73..a3fdce7 100644 --- a/src/compiler/sparc/insts.lisp +++ b/src/compiler/sparc/insts.lisp @@ -129,7 +129,7 @@ about function addresses and register values.") `(,(eval nn) ,nn))) names))) `(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant header-word-type-alist + (def!constant header-word-type-alist ',results))))) ;; This is the same list as in objdefs. (frob bignum @@ -381,7 +381,7 @@ about function addresses and register values.") (error "Unknown branch condition: ~S~%Must be one of: ~S" condition branch-conditions))) -(defconstant branch-cond-true +(def!constant branch-cond-true #b1000) (defconstant-eqx branch-fp-conditions @@ -929,7 +929,7 @@ about function addresses and register values.") (eval-when (:compile-toplevel :execute) -;;; have to do this because defconstant is evalutated in the null lex env. +;;; have to do this because def!constant is evalutated in the null lex env. (defmacro with-ref-format (printer) `(let* ((addend '(:choose (:plus-integer immed) ("+" rs2))) diff --git a/src/compiler/sparc/macros.lisp b/src/compiler/sparc/macros.lisp index bfe10f0..2fb99fd 100644 --- a/src/compiler/sparc/macros.lisp +++ b/src/compiler/sparc/macros.lisp @@ -166,6 +166,7 @@ :element-type '(unsigned-byte 8) :fill-pointer 0 :adjustable t)))) + (delclare (type (vector (unsigned-byte 8) 16) ,var)) (setf (fill-pointer ,var) 0) (unwind-protect (progn diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index bfa49e2..b6c6306 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -12,84 +12,84 @@ ;;;; Machine Architecture parameters: (eval-when (:compile-toplevel :load-toplevel :execute) -(defconstant n-word-bits 32 +(def!constant n-word-bits 32 #!+sb-doc "Number of bits per word where a word holds one lisp descriptor.") -(defconstant n-byte-bits 8 +(def!constant n-byte-bits 8 #!+sb-doc "Number of bits per byte where a byte is the smallest addressable object.") -(defconstant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))) +(def!constant word-shift (1- (integer-length (/ n-word-bits n-byte-bits))) #!+sb-doc "Number of bits to shift between word addresses and byte addresses.") -(defconstant n-word-bytes (/ n-word-bits n-byte-bits) +(def!constant n-word-bytes (/ n-word-bits n-byte-bits) #!+sb-doc "Number of bytes in a word.") -(defconstant n-fixnum-tag-bits (1- n-lowtag-bits) +(def!constant n-fixnum-tag-bits (1- n-lowtag-bits) #!+sb-doc "Number of tag bits used for a fixnum") -(defconstant fixnum-tag-mask (1- (ash 1 n-fixnum-tag-bits)) +(def!constant fixnum-tag-mask (1- (ash 1 n-fixnum-tag-bits)) #!+sb-doc "Mask to get the fixnum tag") -(defconstant n-positive-fixnum-bits (- n-word-bits n-fixnum-tag-bits 1) +(def!constant n-positive-fixnum-bits (- n-word-bits n-fixnum-tag-bits 1) #!+sb-doc "Maximum number of bits in a positive fixnum") -(defconstant float-sign-shift 31) +(def!constant float-sign-shift 31) -(defconstant single-float-bias 126) +(def!constant single-float-bias 126) (defconstant-eqx single-float-exponent-byte (byte 8 23) #'equalp) (defconstant-eqx single-float-significand-byte (byte 23 0) #'equalp) -(defconstant single-float-normal-exponent-min 1) -(defconstant single-float-normal-exponent-max 254) -(defconstant single-float-hidden-bit (ash 1 23)) -(defconstant single-float-trapping-nan-bit (ash 1 22)) +(def!constant single-float-normal-exponent-min 1) +(def!constant single-float-normal-exponent-max 254) +(def!constant single-float-hidden-bit (ash 1 23)) +(def!constant single-float-trapping-nan-bit (ash 1 22)) -(defconstant double-float-bias 1022) +(def!constant double-float-bias 1022) (defconstant-eqx double-float-exponent-byte (byte 11 20) #'equalp) (defconstant-eqx double-float-significand-byte (byte 20 0) #'equalp) -(defconstant double-float-normal-exponent-min 1) -(defconstant double-float-normal-exponent-max #x7FE) -(defconstant double-float-hidden-bit (ash 1 20)) -(defconstant double-float-trapping-nan-bit (ash 1 19)) +(def!constant double-float-normal-exponent-min 1) +(def!constant double-float-normal-exponent-max #x7FE) +(def!constant double-float-hidden-bit (ash 1 20)) +(def!constant double-float-trapping-nan-bit (ash 1 19)) ;;; CMUCL COMMENT: ;;; X These values are for the x86 80 bit format and are no doubt ;;; incorrect for the sparc. ;;; FIXME -(defconstant long-float-bias 16382) +(def!constant long-float-bias 16382) (defconstant-eqx long-float-exponent-byte (byte 15 0) #'equalp) (defconstant-eqx long-float-significand-byte (byte 31 0) #'equalp) -(defconstant long-float-normal-exponent-min 1) -(defconstant long-float-normal-exponent-max #x7FFE) -(defconstant long-float-hidden-bit (ash 1 31)) -(defconstant long-float-trapping-nan-bit (ash 1 30)) +(def!constant long-float-normal-exponent-min 1) +(def!constant long-float-normal-exponent-max #x7FFE) +(def!constant long-float-hidden-bit (ash 1 31)) +(def!constant long-float-trapping-nan-bit (ash 1 30)) -(defconstant single-float-digits +(def!constant single-float-digits (+ (byte-size single-float-significand-byte) 1)) -(defconstant double-float-digits +(def!constant double-float-digits (+ (byte-size double-float-significand-byte) n-word-bits 1)) ;;; This looks wrong - CSR -(defconstant long-float-digits +(def!constant long-float-digits (+ (byte-size long-float-significand-byte) n-word-bits 1)) -(defconstant float-inexact-trap-bit (ash 1 0)) -(defconstant float-divide-by-zero-trap-bit (ash 1 1)) -(defconstant float-underflow-trap-bit (ash 1 2)) -(defconstant float-overflow-trap-bit (ash 1 3)) -(defconstant float-invalid-trap-bit (ash 1 4)) +(def!constant float-inexact-trap-bit (ash 1 0)) +(def!constant float-divide-by-zero-trap-bit (ash 1 1)) +(def!constant float-underflow-trap-bit (ash 1 2)) +(def!constant float-overflow-trap-bit (ash 1 3)) +(def!constant float-invalid-trap-bit (ash 1 4)) -(defconstant float-round-to-nearest 0) -(defconstant float-round-to-zero 1) -(defconstant float-round-to-positive 2) -(defconstant float-round-to-negative 3) +(def!constant float-round-to-nearest 0) +(def!constant float-round-to-zero 1) +(def!constant float-round-to-positive 2) +(def!constant float-round-to-negative 3) (defconstant-eqx float-rounding-mode (byte 2 30) #'equalp) ; RD (defconstant-eqx float-sticky-bits (byte 5 5) #'equalp) ; aexc @@ -100,7 +100,7 @@ ;;; bit (EFM) is "reserved", and should always be zero. However, for ;;; sparc-V8 and sparc-V9, it appears to work, causing denormals to ;;; be truncated to 0 silently. -(defconstant float-fast-bit (ash 1 22)) +(def!constant float-fast-bit (ash 1 22)) ); eval-when @@ -110,7 +110,7 @@ ;;; slots are required by architecture for a place to spill register windows. ;;; ;;; FIXME: Where is this used? -(defconstant number-stack-displacement +(def!constant number-stack-displacement (* 16 n-word-bytes)) @@ -119,53 +119,53 @@ ;;; Where to put the different spaces. Must match the C code! #!+linux (progn - (defconstant read-only-space-start #x10000000) - (defconstant read-only-space-end #x15000000) + (def!constant read-only-space-start #x10000000) + (def!constant read-only-space-end #x15000000) - (defconstant static-space-start #x28000000) - (defconstant static-space-end #x2c000000) + (def!constant static-space-start #x28000000) + (def!constant static-space-end #x2c000000) ;; From alpha/parms.lisp: ;; this is used in PURIFY as part of a sloppy check to see if a pointer ;; is in dynamic space. Chocolate brownie for the first person to fix it ;; -dan 20010502 - (defconstant dynamic-space-start #x30000000) - (defconstant dynamic-space-end #x38000000) + (def!constant dynamic-space-start #x30000000) + (def!constant dynamic-space-end #x38000000) - (defconstant dynamic-0-space-start #x30000000) - (defconstant dynamic-0-space-end #x38000000) + (def!constant dynamic-0-space-start #x30000000) + (def!constant dynamic-0-space-end #x38000000) - (defconstant dynamic-1-space-start #x40000000) - (defconstant dynamic-1-space-end #x48000000) + (def!constant dynamic-1-space-start #x40000000) + (def!constant dynamic-1-space-end #x48000000) - (defconstant control-stack-start #x50000000) - (defconstant control-stack-end #x51000000) + (def!constant control-stack-start #x50000000) + (def!constant control-stack-end #x51000000) - (defconstant binding-stack-start #x60000000) - (defconstant binding-stack-end #x61000000)) + (def!constant binding-stack-start #x60000000) + (def!constant binding-stack-end #x61000000)) #!+sunos ; might as well start by trying the same numbers (progn - (defconstant read-only-space-start #x10000000) - (defconstant read-only-space-end #x15000000) + (def!constant read-only-space-start #x10000000) + (def!constant read-only-space-end #x15000000) - (defconstant static-space-start #x28000000) - (defconstant static-space-end #x2c000000) + (def!constant static-space-start #x28000000) + (def!constant static-space-end #x2c000000) - (defconstant dynamic-space-start #x30000000) - (defconstant dynamic-space-end #x38000000) + (def!constant dynamic-space-start #x30000000) + (def!constant dynamic-space-end #x38000000) - (defconstant dynamic-0-space-start #x30000000) - (defconstant dynamic-0-space-end #x38000000) + (def!constant dynamic-0-space-start #x30000000) + (def!constant dynamic-0-space-end #x38000000) - (defconstant dynamic-1-space-start #x40000000) - (defconstant dynamic-1-space-end #x48000000) + (def!constant dynamic-1-space-start #x40000000) + (def!constant dynamic-1-space-end #x48000000) - (defconstant control-stack-start #x50000000) - (defconstant control-stack-end #x51000000) + (def!constant control-stack-start #x50000000) + (def!constant control-stack-end #x51000000) - (defconstant binding-stack-start #x60000000) - (defconstant binding-stack-end #x61000000)) + (def!constant binding-stack-start #x60000000) + (def!constant binding-stack-end #x61000000)) ;;;; other random constants. @@ -256,6 +256,6 @@ ;;; for pseudo-atomic) to propagate a magic number to C land via ;;; sbcl.h. #!-linux -(defconstant pseudo-atomic-trap #x10) +(def!constant pseudo-atomic-trap #x10) #!+linux -(defconstant pseudo-atomic-trap #x40) +(def!constant pseudo-atomic-trap #x40) diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index fd64d6e..40eca83 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -19,7 +19,7 @@ (macrolet ((defreg (name offset) (let ((offset-sym (symbolicate name "-OFFSET"))) `(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant ,offset-sym ,offset) + (def!constant ,offset-sym ,offset) (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) @@ -99,7 +99,7 @@ "-SC-NUMBER")))) (list* `(define-storage-class ,sc-name ,index ,@(cdr class)) - `(defconstant ,constant-name ,index) + `(def!constant ,constant-name ,index) ;; (The CMU CL version of this macro did ;; `(EXPORT ',CONSTANT-NAME) ;; here, but in SBCL we try to have package @@ -118,7 +118,7 @@ ;;; and seems to be working so far -dan ;;; ;;; arbitrarily taken for alpha, too. - Christophe -(defconstant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) (!define-storage-classes @@ -316,20 +316,20 @@ ;;;; function call parameters ;;; the SC numbers for register and stack arguments/return values. -(defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) -(defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) -(defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) +(def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) +(def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) +(def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) (eval-when (:compile-toplevel :load-toplevel :execute) ;; offsets of special stack frame locations - (defconstant ocfp-save-offset 0) - (defconstant lra-save-offset 1) - (defconstant nfp-save-offset 2) + (def!constant ocfp-save-offset 0) + (def!constant lra-save-offset 1) + (def!constant nfp-save-offset 2) ;; the number of arguments/return values passed in registers. ;; - (defconstant register-arg-count 6) + (def!constant register-arg-count 6) ;; names to use for the argument registers. ;; @@ -346,7 +346,7 @@ *register-arg-offsets*)) ;;; This is used by the debugger. -(defconstant single-value-return-byte-offset 8) +(def!constant single-value-return-byte-offset 8) ;;; This function is called by debug output routines that want a diff --git a/src/compiler/trace-table.lisp b/src/compiler/trace-table.lisp index 6c77bd1..f006add 100644 --- a/src/compiler/trace-table.lisp +++ b/src/compiler/trace-table.lisp @@ -18,11 +18,11 @@ (push (cons label state) *trace-table-info*)) (values)) -(defconstant tt-bits-per-state 3) -(defconstant tt-bytes-per-entry 2) -(defconstant tt-bits-per-entry (* tt-bytes-per-entry sb!vm:n-byte-bits)) -(defconstant tt-bits-per-offset (- tt-bits-per-entry tt-bits-per-state)) -(defconstant tt-max-offset (1- (ash 1 tt-bits-per-offset))) +(def!constant tt-bits-per-state 3) +(def!constant tt-bytes-per-entry 2) +(def!constant tt-bits-per-entry (* tt-bytes-per-entry sb!vm:n-byte-bits)) +(def!constant tt-bits-per-offset (- tt-bits-per-entry tt-bits-per-state)) +(def!constant tt-max-offset (1- (ash 1 tt-bits-per-offset))) (deftype tt-state () `(unsigned-byte ,tt-bits-per-state)) diff --git a/src/compiler/vmdef.lisp b/src/compiler/vmdef.lisp index 5af6cd4..d4e0595 100644 --- a/src/compiler/vmdef.lisp +++ b/src/compiler/vmdef.lisp @@ -102,7 +102,7 @@ ;; -- AL 20010218 ;; ;; See also the description of VOP-INFO-TARGETS. -- APD, 2002-01-30 - (defconstant max-vop-tn-refs 256)) + (def!constant max-vop-tn-refs 256)) (defvar *vop-tn-refs* (make-array max-vop-tn-refs :initial-element nil)) (defvar *using-vop-tn-refs* nil) @@ -113,7 +113,7 @@ (pushnew 'flush-vop-tn-refs *before-gc-hooks*) -(defconstant sc-bits (integer-length (1- sc-number-limit))) +(def!constant sc-bits (integer-length (1- sc-number-limit))) (defun emit-generic-vop (node block template args results &optional info) (%emit-generic-vop node block template args results info)) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index 4f3b7d3..5f047c7 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -14,7 +14,7 @@ ;;; the largest number of TNs whose liveness changes that we can have ;;; in any block -(defconstant local-tn-limit 64) +(def!constant local-tn-limit 64) (deftype local-tn-number () `(integer 0 (,local-tn-limit))) (deftype local-tn-count () `(integer 0 ,local-tn-limit)) diff --git a/src/compiler/x86/backend-parms.lisp b/src/compiler/x86/backend-parms.lisp index 4fcd8e6..44e0634 100644 --- a/src/compiler/x86/backend-parms.lisp +++ b/src/compiler/x86/backend-parms.lisp @@ -17,7 +17,7 @@ ;;;; compiler constants -(defconstant +backend-fasl-file-implementation+ :x86) +(def!constant +backend-fasl-file-implementation+ :x86) (setf *backend-register-save-penalty* 3) diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index 3187f30..3de7373 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -2046,9 +2046,9 @@ (defknown ((setf floating-point-modes)) (float-modes) float-modes) -(defconstant npx-env-size (* 7 n-word-bytes)) -(defconstant npx-cw-offset 0) -(defconstant npx-sw-offset 4) +(def!constant npx-env-size (* 7 n-word-bytes)) +(def!constant npx-cw-offset 0) +(def!constant npx-sw-offset 4) (define-vop (floating-point-modes) (:results (res :scs (unsigned-reg))) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index e64d650..759a8fb 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -20,7 +20,7 @@ (deftype reg () '(unsigned-byte 3)) -(defconstant +default-operand-size+ :dword) +(def!constant +default-operand-size+ :dword) (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) @@ -793,7 +793,7 @@ ;;;; utilities -(defconstant +operand-size-prefix-byte+ #b01100110) +(def!constant +operand-size-prefix-byte+ #b01100110) (defun maybe-emit-operand-size-prefix (segment size) (unless (or (eq size :byte) (eq size +default-operand-size+)) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 50c4322..ca4519c 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -280,6 +280,7 @@ :element-type '(unsigned-byte 8) :fill-pointer 0 :adjustable t)))) + (declare (type (vector (unsigned-byte 8) 16) ,var)) (setf (fill-pointer ,var) 0) (unwind-protect (progn diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index a9b9727..bf151fa 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -25,79 +25,79 @@ ;;;; machine architecture parameters ;;; the number of bits per word, where a word holds one lisp descriptor -(defconstant n-word-bits 32) +(def!constant n-word-bits 32) ;;; the number of bits per byte, where a byte is the smallest ;;; addressable object -(defconstant n-byte-bits 8) +(def!constant n-byte-bits 8) ;;; the number of bits to shift between word addresses and byte addresses -(defconstant word-shift (1- (integer-length (/ n-word-bits n-byte-bits)))) +(def!constant word-shift (1- (integer-length (/ n-word-bits n-byte-bits)))) ;;; the number of bytes in a word -(defconstant n-word-bytes (/ n-word-bits n-byte-bits)) +(def!constant n-word-bytes (/ n-word-bits n-byte-bits)) -(defconstant float-sign-shift 31) +(def!constant float-sign-shift 31) ;;; comment from CMU CL: ;;; These values were taken from the alpha code. The values for ;;; bias and exponent min/max are not the same as shown in the 486 book. ;;; They may be correct for how Python uses them. -(defconstant single-float-bias 126) ; Intel says 127. +(def!constant single-float-bias 126) ; Intel says 127. (defconstant-eqx single-float-exponent-byte (byte 8 23) #'equalp) (defconstant-eqx single-float-significand-byte (byte 23 0) #'equalp) ;;; comment from CMU CL: ;;; The 486 book shows the exponent range -126 to +127. The Lisp ;;; code that uses these values seems to want already biased numbers. -(defconstant single-float-normal-exponent-min 1) -(defconstant single-float-normal-exponent-max 254) -(defconstant single-float-hidden-bit (ash 1 23)) -(defconstant single-float-trapping-nan-bit (ash 1 22)) +(def!constant single-float-normal-exponent-min 1) +(def!constant single-float-normal-exponent-max 254) +(def!constant single-float-hidden-bit (ash 1 23)) +(def!constant single-float-trapping-nan-bit (ash 1 22)) -(defconstant double-float-bias 1022) +(def!constant double-float-bias 1022) (defconstant-eqx double-float-exponent-byte (byte 11 20) #'equalp) (defconstant-eqx double-float-significand-byte (byte 20 0) #'equalp) -(defconstant double-float-normal-exponent-min 1) -(defconstant double-float-normal-exponent-max #x7FE) -(defconstant double-float-hidden-bit (ash 1 20)) -(defconstant double-float-trapping-nan-bit (ash 1 19)) +(def!constant double-float-normal-exponent-min 1) +(def!constant double-float-normal-exponent-max #x7FE) +(def!constant double-float-hidden-bit (ash 1 20)) +(def!constant double-float-trapping-nan-bit (ash 1 19)) -(defconstant long-float-bias 16382) +(def!constant long-float-bias 16382) (defconstant-eqx long-float-exponent-byte (byte 15 0) #'equalp) (defconstant-eqx long-float-significand-byte (byte 31 0) #'equalp) -(defconstant long-float-normal-exponent-min 1) -(defconstant long-float-normal-exponent-max #x7FFE) -(defconstant long-float-hidden-bit (ash 1 31)) ; actually not hidden -(defconstant long-float-trapping-nan-bit (ash 1 30)) +(def!constant long-float-normal-exponent-min 1) +(def!constant long-float-normal-exponent-max #x7FFE) +(def!constant long-float-hidden-bit (ash 1 31)) ; actually not hidden +(def!constant long-float-trapping-nan-bit (ash 1 30)) -(defconstant single-float-digits +(def!constant single-float-digits (+ (byte-size single-float-significand-byte) 1)) -(defconstant double-float-digits +(def!constant double-float-digits (+ (byte-size double-float-significand-byte) n-word-bits 1)) -(defconstant long-float-digits +(def!constant long-float-digits (+ (byte-size long-float-significand-byte) n-word-bits 1)) ;;; pfw -- from i486 microprocessor programmer's reference manual -(defconstant float-invalid-trap-bit (ash 1 0)) -(defconstant float-denormal-trap-bit (ash 1 1)) -(defconstant float-divide-by-zero-trap-bit (ash 1 2)) -(defconstant float-overflow-trap-bit (ash 1 3)) -(defconstant float-underflow-trap-bit (ash 1 4)) -(defconstant float-inexact-trap-bit (ash 1 5)) - -(defconstant float-round-to-nearest 0) -(defconstant float-round-to-negative 1) -(defconstant float-round-to-positive 2) -(defconstant float-round-to-zero 3) +(def!constant float-invalid-trap-bit (ash 1 0)) +(def!constant float-denormal-trap-bit (ash 1 1)) +(def!constant float-divide-by-zero-trap-bit (ash 1 2)) +(def!constant float-overflow-trap-bit (ash 1 3)) +(def!constant float-underflow-trap-bit (ash 1 4)) +(def!constant float-inexact-trap-bit (ash 1 5)) + +(def!constant float-round-to-nearest 0) +(def!constant float-round-to-negative 1) +(def!constant float-round-to-positive 2) +(def!constant float-round-to-zero 3) (defconstant-eqx float-rounding-mode (byte 2 10) #'equalp) (defconstant-eqx float-sticky-bits (byte 6 16) #'equalp) (defconstant-eqx float-traps-byte (byte 6 0) #'equalp) (defconstant-eqx float-exceptions-byte (byte 6 16) #'equalp) (defconstant-eqx float-precision-control (byte 2 8) #'equalp) -(defconstant float-fast-bit 0) ; no fast mode on x86 +(def!constant float-fast-bit 0) ; no fast mode on x86 ;;;; description of the target address space @@ -135,49 +135,49 @@ #!+linux (progn - (defconstant read-only-space-start #x01000000) - (defconstant read-only-space-end #x037ff000) + (def!constant read-only-space-start #x01000000) + (def!constant read-only-space-end #x037ff000) - (defconstant static-space-start #x05000000) - (defconstant static-space-end #x07fff000) + (def!constant static-space-start #x05000000) + (def!constant static-space-end #x07fff000) - (defconstant dynamic-space-start #x09000000) - (defconstant dynamic-space-end #x29000000) + (def!constant dynamic-space-start #x09000000) + (def!constant dynamic-space-end #x29000000) - (defconstant control-stack-start #x50000000) - (defconstant control-stack-end #x57fff000) + (def!constant control-stack-start #x50000000) + (def!constant control-stack-end #x57fff000) - (defconstant binding-stack-start #x60000000) - (defconstant binding-stack-end #x67fff000)) + (def!constant binding-stack-start #x60000000) + (def!constant binding-stack-end #x67fff000)) #!+bsd (progn - (defconstant read-only-space-start #x10000000) - (defconstant read-only-space-end #x1ffff000) + (def!constant read-only-space-start #x10000000) + (def!constant read-only-space-end #x1ffff000) - (defconstant static-space-start + (def!constant static-space-start #!+freebsd #x30000000 #!+openbsd #x28000000) - (defconstant static-space-end #x37fff000) + (def!constant static-space-end #x37fff000) - (defconstant binding-stack-start #x38000000) - (defconstant binding-stack-end #x3ffff000) + (def!constant binding-stack-start #x38000000) + (def!constant binding-stack-end #x3ffff000) - (defconstant control-stack-start + (def!constant control-stack-start #!+freebsd #x40000000 #!+openbsd #x48000000) - (defconstant control-stack-end + (def!constant control-stack-end #!+freebsd #x47fff000 #!+openbsd #x4ffff000) - (defconstant dynamic-space-start + (def!constant dynamic-space-start #!+freebsd #x48000000 #!+openbsd #x50000000) - (defconstant dynamic-space-end #x88000000)) + (def!constant dynamic-space-end #x88000000)) ;;; Given that NIL is the first thing allocated in static space, we ;;; know its value at compile time: -(defconstant nil-value (+ static-space-start #xb)) +(def!constant nil-value (+ static-space-start #xb)) ;;;; other miscellaneous constants diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 83d0d3c..f0c102e 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -31,7 +31,7 @@ ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET ;; (in the same file) depends on compile-time evaluation ;; of the DEFCONSTANT. -- AL 20010224 - (defconstant ,offset-sym ,offset)) + (def!constant ,offset-sym ,offset)) (setf (svref ,names-vector ,offset-sym) ,(symbol-name name))))) ;; FIXME: It looks to me as though DEFREGSET should also @@ -94,7 +94,7 @@ ;; registers used to pass arguments ;; ;; the number of arguments/return values passed in registers - (defconstant register-arg-count 3) + (def!constant register-arg-count 3) ;; names and offsets for registers used to pass arguments (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *register-arg-names* '(edx edi esi))) @@ -136,7 +136,7 @@ (constant-name (symbolicate sc-name "-SC-NUMBER"))) (forms `(define-storage-class ,sc-name ,index ,@(cdr class))) - (forms `(defconstant ,constant-name ,index)) + (forms `(def!constant ,constant-name ,index)) (incf index)))) `(progn ,@(forms)))) @@ -160,7 +160,7 @@ ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess ;;; has my gratitude.) (FIXME: Maybe this should be me..) (eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant kludge-nondeterministic-catch-block-size 6)) + (def!constant kludge-nondeterministic-catch-block-size 6)) (!define-storage-classes @@ -400,22 +400,22 @@ ;;;; miscellaneous function call parameters ;;; offsets of special stack frame locations -(defconstant ocfp-save-offset 0) -(defconstant return-pc-save-offset 1) -(defconstant code-save-offset 2) +(def!constant ocfp-save-offset 0) +(def!constant return-pc-save-offset 1) +(def!constant code-save-offset 2) ;;; FIXME: This is a bad comment (changed since when?) and there are others ;;; like it in this file. It'd be nice to clarify them. Failing that deleting ;;; them or flagging them with KLUDGE might be better than nothing. ;;; ;;; names of these things seem to have changed. these aliases by jrd -(defconstant lra-save-offset return-pc-save-offset) +(def!constant lra-save-offset return-pc-save-offset) -(defconstant cfp-offset ebp-offset) ; pfw - needed by stuff in /code +(def!constant cfp-offset ebp-offset) ; pfw - needed by stuff in /code ; related to signal context stuff ;;; This is used by the debugger. -(defconstant single-value-return-byte-offset 2) +(def!constant single-value-return-byte-offset 2) ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. diff --git a/version.lisp-expr b/version.lisp-expr index a53c45e..4a5b953 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.3.17" +"0.7.3.18"