("src/code/defbangtype")
("src/code/defbangmacro")
+ ("src/code/defbangconstant")
("src/code/primordial-extensions")
("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")
("src/compiler/globaldb")
("src/compiler/info-functions")
+ ("src/code/force-delayed-defbangconstants")
("src/code/defmacro")
("src/code/force-delayed-defbangmacros")
;; 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"
(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")
;;; 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")
\f
;;;; 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
;;; 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)
\f
;;;; compiled debug blocks
;;;;
;;;; 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*
--- /dev/null
+;;;; 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")
+\f
+;;;; 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."))))
\f
;;;; 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
(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")
;; 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
;;; 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)
\f
;;;; type-ish predicates
(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
;;; 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*.
--- /dev/null
+;;;; 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)
(setf ,place
(check-type-error ',place ,place-value ',type ,type-string)))))
\f
-;;;; 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)
-\f
;;;; DEFINE-SYMBOL-MACRO
(defmacro-mundanely define-symbol-macro (name expansion)
;;; 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
(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)))
;;; 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)
(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)
;;; 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)
\f
;;;; compiler constants
-(defconstant +backend-fasl-file-implementation+ :alpha)
+(def!constant +backend-fasl-file-implementation+ :alpha)
(setf *backend-register-save-penalty* 3)
(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)
: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
(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
;;; <machine/fpu.h>
;;; 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).
(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
#!+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
;;; 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
(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)
"-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
;;; 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
;;;; 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.)
*register-arg-offsets*))
;;; This is used by the debugger.
-(defconstant single-value-return-byte-offset 4)
+(def!constant single-value-return-byte-offset 4)
\f
;;; 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
,@(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)
,@(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)
(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))
--- /dev/null
+;;;; 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)
\f
;;; 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))
(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 ()
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))
;;; 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))
;;; 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))
(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.")
;;; 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")
'(: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
(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
(in-package "SB!C")
;;; the maximum number of SCs in any implementation
-(defconstant sc-number-limit 32)
+(def!constant sc-number-limit 32)
;;; 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
;;;; 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
;; 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.
;;; 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.
;;;
;;; 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"))
(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))
(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)
: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
(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
;;; 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))
\f
;;; 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)
(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)
"-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)))
;; 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
;;; 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.
;;;
;;;
;;; This is used by the debugger.
;;;
-(defconstant single-value-return-byte-offset 8)
+(def!constant single-value-return-byte-offset 8)
\f
;;; LOCATION-PRINT-NAME -- Interface
;;; 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
\f
;;;; compiler constants
-(defconstant +backend-fasl-file-implementation+ :sparc)
+(def!constant +backend-fasl-file-implementation+ :sparc)
(setf *backend-register-save-penalty* 3)
`(,(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
(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
(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)))
: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
;;;; 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
;;; 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
;;; 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))
\f
;;; 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))
\f
;;;; other random constants.
;;; 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)
(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)))))
"-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
;;; 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
;;;; 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.
;;
*register-arg-offsets*))
;;; This is used by the debugger.
-(defconstant single-value-return-byte-offset 8)
+(def!constant single-value-return-byte-offset 8)
\f
;;; This function is called by debug output routines that want a
(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))
;; -- 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)
(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))
;;; 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))
\f
;;;; compiler constants
-(defconstant +backend-fasl-file-implementation+ :x86)
+(def!constant +backend-fasl-file-implementation+ :x86)
(setf *backend-register-save-penalty* 3)
(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)))
(deftype reg () '(unsigned-byte 3))
-(defconstant +default-operand-size+ :dword)
+(def!constant +default-operand-size+ :dword)
\f
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
\f
;;;; 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+))
: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
;;;; 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
\f
;;;; description of the target address space
#!+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))
\f
;;;; other miscellaneous constants
;; 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
;; 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)))
(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))))
;;; (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
;;;; 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)
\f
;;; 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.
;;; 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"
projects / sbcl.git / commitdiff