;;; the size of an INTEGER representation of a SYSTEM-AREA-POINTER, i.e.
;;; size of a native memory address
-(deftype sap-int-type () '(unsigned-byte 32))
-;;; FIXME: This should just named be SAP-INT, not SAP-INT-TYPE. And
-;;; grep for SAPINT in the code and replace it with SAP-INT as
-;;; appropriate.
+(deftype sap-int () '(unsigned-byte 32))
\f
;;;; register specs
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar *byte-register-names* (make-array 8 :initial-element nil))
+ (defvar *word-register-names* (make-array 16 :initial-element nil))
+ (defvar *dword-register-names* (make-array 16 :initial-element nil))
+ (defvar *float-register-names* (make-array 8 :initial-element nil)))
+
(macrolet ((defreg (name offset size)
(let ((offset-sym (symbolicate name "-OFFSET"))
(names-vector (symbolicate "*" size "-REGISTER-NAMES*")))
`(progn
- (eval-when (:compile-toplevel :execute :load-toplevel)
- (defconstant ,offset-sym ,offset))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET
+ ;; (in the same file) depends on compile-time evaluation
+ ;; of the DEFCONSTANT. -- AL 20010224
+ (def!constant ,offset-sym ,offset))
(setf (svref ,names-vector ,offset-sym)
,(symbol-name name)))))
- ;; FIXME: It looks to me as though DEFREGSET should also define the
- ;; *FOO-REGISTER-NAMES* variable.
+ ;; FIXME: It looks to me as though DEFREGSET should also
+ ;; define the related *FOO-REGISTER-NAMES* variable.
(defregset (name &rest regs)
- `(eval-when (:compile-toplevel :execute :load-toplevel)
- (defconstant ,name
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter ,name
(list ,@(mapcar (lambda (name)
(symbolicate name "-OFFSET"))
regs))))))
;; byte registers
;;
- ;; Note: the encoding here is different then that used by the chip. We
- ;; use this encoding so that the compiler thinks that AX (and EAX) overlap
- ;; AL and AH instead of AL and CL.
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *byte-register-names* (make-array 8 :initial-element nil)))
+ ;; Note: the encoding here is different than that used by the chip.
+ ;; We use this encoding so that the compiler thinks that AX (and
+ ;; EAX) overlap AL and AH instead of AL and CL.
(defreg al 0 :byte)
(defreg ah 1 :byte)
(defreg cl 2 :byte)
(defreg dh 5 :byte)
(defreg bl 6 :byte)
(defreg bh 7 :byte)
- (defregset byte-regs al ah cl ch dl dh bl bh)
+ (defregset *byte-regs* al ah cl ch dl dh bl bh)
;; word registers
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *word-register-names* (make-array 16 :initial-element nil)))
(defreg ax 0 :word)
(defreg cx 2 :word)
(defreg dx 4 :word)
(defreg bp 10 :word)
(defreg si 12 :word)
(defreg di 14 :word)
- (defregset word-regs ax cx dx bx si di)
+ (defregset *word-regs* ax cx dx bx si di)
;; double word registers
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *dword-register-names* (make-array 16 :initial-element nil)))
(defreg eax 0 :dword)
(defreg ecx 2 :dword)
(defreg edx 4 :dword)
(defreg ebp 10 :dword)
(defreg esi 12 :dword)
(defreg edi 14 :dword)
- (defregset dword-regs eax ecx edx ebx esi edi)
+ (defregset *dword-regs* eax ecx edx ebx esi edi)
;; floating point registers
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *float-register-names* (make-array 8 :initial-element nil)))
(defreg fr0 0 :float)
(defreg fr1 1 :float)
(defreg fr2 2 :float)
(defreg fr5 5 :float)
(defreg fr6 6 :float)
(defreg fr7 7 :float)
- (defregset float-regs fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
+ (defregset *float-regs* fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
;; 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
- (defconstant register-arg-names '(edx edi esi))
- (defregset register-arg-offsets edx edi esi))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *register-arg-names* '(edx edi esi)))
+ (defregset *register-arg-offsets* edx edi esi))
\f
;;;; SB definitions
;;; a handy macro so we don't have to keep changing all the numbers whenever
;;; we insert a new storage class
;;;
-;;; FIXME: This macro is not needed in the runtime target.
-(defmacro define-storage-classes (&rest classes)
+(defmacro !define-storage-classes (&rest classes)
(collect ((forms))
(let ((index 0))
(dolist (class classes)
(constant-name (symbolicate sc-name "-SC-NUMBER")))
(forms `(define-storage-class ,sc-name ,index
,@(cdr class)))
- (forms `(defconstant ,constant-name ,index))
- (forms `(let ((sb!int::*rogue-export* "DEFINE-STORAGE-CLASSES"))
- (export ',constant-name)))
+ (forms `(def!constant ,constant-name ,index))
(incf index))))
`(progn
,@(forms))))
-;;; The DEFINE-STORAGE-CLASS call for CATCH-BLOCK refers to the size of
-;;; CATCH-BLOCK. The size of CATCH-BLOCK isn't calculated until later in
-;;; the build process, and the calculation is entangled with code which has
-;;; lots of predependencies, including dependencies on the prior call of
-;;; DEFINE-STORAGE-CLASS. The proper way to unscramble this would be to
-;;; untangle the code, so that the code which calculates the size of
-;;; CATCH-BLOCK can be separated from the other lots-of-dependencies code, so
-;;; that the code which calculates the size of CATCH-BLOCK can be executed
-;;; early, so that this value is known properly at this point in compilation.
-;;; However, that would be a lot of editing of code that I (WHN 19990131) can't
-;;; test until the project is complete. So instead, I set the correct value by
-;;; hand here (a sort of nondeterministic guess of the right answer:-) and add
-;;; an assertion later, after the value is calculated, that the original guess
-;;; was correct.
+;;; The DEFINE-STORAGE-CLASS call for CATCH-BLOCK refers to the size
+;;; of CATCH-BLOCK. The size of CATCH-BLOCK isn't calculated until
+;;; later in the build process, and the calculation is entangled with
+;;; code which has lots of predependencies, including dependencies on
+;;; the prior call of DEFINE-STORAGE-CLASS. The proper way to
+;;; unscramble this would be to untangle the code, so that the code
+;;; which calculates the size of CATCH-BLOCK can be separated from the
+;;; other lots-of-dependencies code, so that the code which calculates
+;;; the size of CATCH-BLOCK can be executed early, so that this value
+;;; is known properly at this point in compilation. However, that
+;;; would be a lot of editing of code that I (WHN 19990131) can't test
+;;; until the project is complete. So instead, I set the correct value
+;;; by hand here (a sort of nondeterministic guess of the right
+;;; answer:-) and add an assertion later, after the value is
+;;; calculated, that the original guess was correct.
;;;
-;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess has my
-;;; gratitude.) (FIXME: Maybe this should be me..)
-(defconstant sb!vm::kludge-nondeterministic-catch-block-size 6)
+;;; (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)
+ (def!constant kludge-nondeterministic-catch-block-size 6))
-(define-storage-classes
+(!define-storage-classes
- ;; non-immediate contstants in the constant pool
+ ;; non-immediate constants in the constant pool
(constant constant)
;; some FP constants can be generated in the i387 silicon
;; the non-descriptor stacks
(signed-stack stack) ; (signed-byte 32)
(unsigned-stack stack) ; (unsigned-byte 32)
- (base-char-stack stack) ; non-descriptor characters.
+ (character-stack stack) ; non-descriptor characters.
(sap-stack stack) ; System area pointers.
(single-stack stack) ; single-floats
(double-stack stack :element-size 2) ; double-floats.
;; immediate descriptor objects. Don't have to be seen by GC, but nothing
;; bad will happen if they are. (fixnums, characters, header values, etc).
(any-reg registers
- :locations #.dword-regs
+ :locations #.*dword-regs*
:element-size 2
; :reserve-locations (#.eax-offset)
:constant-scs (immediate)
;; pointer descriptor objects -- must be seen by GC
(descriptor-reg registers
- :locations #.dword-regs
+ :locations #.*dword-regs*
:element-size 2
; :reserve-locations (#.eax-offset)
:constant-scs (constant immediate)
:alternate-scs (control-stack))
;; non-descriptor characters
- (base-char-reg registers
- :locations #.byte-regs
+ (character-reg registers
+ :locations #!-sb-unicode #.*byte-regs*
+ #!+sb-unicode #.*dword-regs*
+ #!-sb-unicode #!-sb-unicode
:reserve-locations (#.ah-offset #.al-offset)
:constant-scs (immediate)
:save-p t
- :alternate-scs (base-char-stack))
+ :alternate-scs (character-stack))
;; non-descriptor SAPs (arbitrary pointers into address space)
(sap-reg registers
- :locations #.dword-regs
+ :locations #.*dword-regs*
:element-size 2
; :reserve-locations (#.eax-offset)
:constant-scs (immediate)
;; non-descriptor (signed or unsigned) numbers
(signed-reg registers
- :locations #.dword-regs
+ :locations #.*dword-regs*
:element-size 2
; :reserve-locations (#.eax-offset)
:constant-scs (immediate)
:save-p t
:alternate-scs (signed-stack))
(unsigned-reg registers
- :locations #.dword-regs
+ :locations #.*dword-regs*
:element-size 2
; :reserve-locations (#.eax-offset)
:constant-scs (immediate)
;; miscellaneous objects that must not be seen by GC. Used only as
;; temporaries.
(word-reg registers
- :locations #.word-regs
+ :locations #.*word-regs*
:element-size 2
; :reserve-locations (#.ax-offset)
)
(byte-reg registers
- :locations #.byte-regs
+ :locations #.*byte-regs*
; :reserve-locations (#.al-offset #.ah-offset)
)
:alternate-scs (complex-long-stack))
;; a catch or unwind block
- (catch-block stack
- :element-size sb!vm::kludge-nondeterministic-catch-block-size))
+ (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
(eval-when (:compile-toplevel :load-toplevel :execute)
-
-(defconstant byte-sc-names '(base-char-reg byte-reg base-char-stack))
-(defconstant word-sc-names '(word-reg))
-(defconstant dword-sc-names
+(defparameter *byte-sc-names*
+ '(#!-sb-unicode character-reg byte-reg #!-sb-unicode character-stack))
+(defparameter *word-sc-names* '(word-reg))
+(defparameter *dword-sc-names*
'(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
- signed-stack unsigned-stack sap-stack single-stack constant))
-
+ signed-stack unsigned-stack sap-stack single-stack
+ #!+sb-unicode character-reg #!+sb-unicode character-stack constant))
;;; added by jrd. I guess the right thing to do is to treat floats
;;; as a separate size...
;;;
;;; These are used to (at least) determine operand size.
-(defconstant float-sc-names '(single-reg))
-(defconstant double-sc-names '(double-reg double-stack))
-
+(defparameter *float-sc-names* '(single-reg))
+(defparameter *double-sc-names* '(double-reg double-stack))
) ; EVAL-WHEN
\f
;;;; miscellaneous TNs for the various registers
(dolist (reg-name reg-names)
(let ((tn-name (symbolicate reg-name "-TN"))
(offset-name (symbolicate reg-name "-OFFSET")))
- ;; FIXME: Couldn't shouldn't this be DEFCONSTANT
- ;; instead of DEFPARAMETER?
+ ;; FIXME: It'd be good to have the special
+ ;; variables here be named with the *FOO*
+ ;; convention.
(forms `(defparameter ,tn-name
(make-random-tn :kind :normal
:sc (sc-or-lose ',sc-name)
(defparameter *register-arg-tns*
(mapcar (lambda (register-arg-name)
(symbol-value (symbolicate register-arg-name "-TN")))
- register-arg-names))
+ *register-arg-names*))
;;; FIXME: doesn't seem to be used in SBCL
#|
:offset 31)) ; Offset doesn't get used.
|#
\f
-;;; IMMEDIATE-CONSTANT-SC
-;;;
-;;; If value can be represented as an immediate constant, then return the
-;;; appropriate SC number, otherwise return NIL.
-(def-vm-support-routine immediate-constant-sc (value)
+;;; If value can be represented as an immediate constant, then return
+;;; the appropriate SC number, otherwise return NIL.
+(!def-vm-support-routine immediate-constant-sc (value)
(typecase value
- ((or fixnum #-sb-xc-host system-area-pointer character)
+ ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
+ #-sb-xc-host system-area-pointer character)
(sc-number-or-lose 'immediate))
(symbol
(when (static-symbol-p value)
;;;; 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
-;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
-;;;
;;; 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.
-(def-vm-support-routine location-print-name (tn)
+(!def-vm-support-routine location-print-name (tn)
(declare (type tn tn))
(let* ((sc (tn-sc tn))
(sb (sb-name (sc-sb sc)))
(ecase sb
(registers
(let* ((sc-name (sc-name sc))
- (name-vec (cond ((member sc-name byte-sc-names)
+ (name-vec (cond ((member sc-name *byte-sc-names*)
*byte-register-names*)
- ((member sc-name word-sc-names)
+ ((member sc-name *word-sc-names*)
*word-register-names*)
- ((member sc-name dword-sc-names)
+ ((member sc-name *dword-sc-names*)
*dword-register-names*))))
(or (and name-vec
(< -1 offset (length name-vec))
(svref name-vec offset))
;; FIXME: Shouldn't this be an ERROR?
- (format nil "<unknown reg: off=~D, sc=~A>" offset sc-name))))
+ (format nil "<unknown reg: off=~W, sc=~A>" offset sc-name))))
(float-registers (format nil "FR~D" offset))
(stack (format nil "S~D" offset))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed")
(noise (symbol-name (sc-name sc))))))
;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
+
\f
;;; The loader uses this to convert alien names to the form they need in
;;; the symbol table (for example, prepending an underscore).
(defun extern-alien-name (name)
- (declare (type simple-string name))
- name)
+ (declare (type string name))
+ ;; ELF ports currently don't need any prefix
+ (typecase name
+ (simple-base-string name)
+ (base-string (coerce name 'simple-base-string))
+ (t (handler-case (coerce name 'simple-base-string)
+ (type-error () (error "invalid external alien name: ~S" name))))))
projects / sbcl.git / blobdiff