From: William Harold Newman Date: Mon, 8 Oct 2001 21:39:51 +0000 (+0000) Subject: 0.pre7.56: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6fb6e66f531dfb6140ec3e0cc8f84f6ecd1927ca;p=sbcl.git 0.pre7.56: renamed the 3-bit lowtag codes from FOO-TYPE to FOO-LOWTAG, e.g. FUN-POINTER-LOWTAG, to make it clear that they're not parallel to the 8-bit codes like SIMPLE-FUN-HEADER-TYPE, or to things like FUN-TYPE used to represent (SPECIFIER-TYPE '(FUNCTION ..)) and in C, renamed 'em from type_FooBar to FOO_BAR_LOWTAG also renamed some tag- and low-level-type-related names in runtime.h to be less quirky: ALL_UPPERCASE for constants, inline functions instead of macros The TRACE-TABLE-FOO things no longer need to be copied into sbcl.h by GENESIS, because C code no longer uses them. -- Don't forget to update the DEFENUM in early-objdef.lisp. Don't forget to update the GENESIS code which copies them into sbcl.h. --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 2bd5b95..3ee012e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1710,7 +1710,7 @@ structure representations" "DOUBLE-FLOAT-TYPE" "DOUBLE-FLOAT-VALUE-SLOT" "DOUBLE-INT-CARG-REG-SC-NUMBER" "DOUBLE-REG-SC-NUMBER" "DOUBLE-STACK-SC-NUMBER" - "ERROR-TRAP" "EVEN-FIXNUM-TYPE" + "ERROR-TRAP" "EVEN-FIXNUM-LOWTAG" "EXPORTED-STATIC-SYMBOLS" "EXTERN-ALIEN-NAME" "FDEFN-FUN-SLOT" "FDEFN-NAME-SLOT" "FDEFN-RAW-ADDR-SLOT" "FDEFN-SIZE" "FDEFN-TYPE" "FIND-HOLES" "FIXNUMIZE" @@ -1734,7 +1734,7 @@ structure representations" "SIMPLE-FUN-HEADER-TYPE-SLOT" "SIMPLE-FUN-NAME-SLOT" "SIMPLE-FUN-NEXT-SLOT" - "FUN-POINTER-TYPE" + "FUN-POINTER-LOWTAG" "SIMPLE-FUN-SELF-SLOT" "SIMPLE-FUN-TYPE-SLOT" "FUNCALLABLE-INSTANCE-LAYOUT-SLOT" @@ -1742,10 +1742,10 @@ structure representations" "GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER" "IMMEDIATE-BASE-CHAR-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER" "IMMEDIATE-SC-NUMBER" "*INITIAL-DYNAMIC-SPACE-FREE-POINTER*" - "INSTANCE-HEADER-TYPE" "INSTANCE-POINTER-TYPE" + "INSTANCE-HEADER-TYPE" "INSTANCE-POINTER-LOWTAG" "INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE" "INTERIOR-REG-SC-NUMBER" "INTERNAL-ERROR-ARGUMENTS" - "INTERRUPTED-FLAG" "LIST-ALLOCATED-OBJECTS" "LIST-POINTER-TYPE" + "INTERRUPTED-FLAG" "LIST-ALLOCATED-OBJECTS" "LIST-POINTER-LOWTAG" "LONG-FLOAT-BIAS" "LONG-FLOAT-DIGITS" "LONG-FLOAT-EXPONENT-BYTE" "LONG-FLOAT-HIDDEN-BIT" "LONG-FLOAT-NORMAL-EXPONENT-MAX" "LONG-FLOAT-NORMAL-EXPONENT-MIN" "LONG-FLOAT-SIGNIFICAND-BYTE" @@ -1755,9 +1755,11 @@ structure representations" "LOWTAG-BITS" "LOWTAG-LIMIT" "LOWTAG-MASK" "MEMORY-USAGE" "MOST-POSITIVE-COST" "NEGATIVE-IMMEDIATE-SC-NUMBER" "NON-DESCRIPTOR-REG-SC-NUMBER" - "NULL-SC-NUMBER" "OBJECT-NOT-LIST-TRAP" "OBJECT-NOT-INSTANCE-TRAP" - "ODD-FIXNUM-TYPE" "OFFSET-STATIC-SYMBOL" "OTHER-IMMEDIATE-0-TYPE" - "OTHER-IMMEDIATE-1-TYPE" "OTHER-POINTER-TYPE" + "NULL-SC-NUMBER" + "OBJECT-NOT-LIST-TRAP" "OBJECT-NOT-INSTANCE-TRAP" + "ODD-FIXNUM-LOWTAG" + "OFFSET-STATIC-SYMBOL" "OTHER-IMMEDIATE-0-LOWTAG" + "OTHER-IMMEDIATE-1-LOWTAG" "OTHER-POINTER-LOWTAG" "PAD-DATA-BLOCK" "PENDING-INTERRUPT-TRAP" "PRIMITIVE-OBJECT" "PRIMITIVE-OBJECT-HEADER" "PRIMITIVE-OBJECT-LOWTAG" "PRIMITIVE-OBJECT-NAME" diff --git a/src/assembly/alpha/arith.lisp b/src/assembly/alpha/arith.lisp index 364e183..6a7cf0e 100644 --- a/src/assembly/alpha/arith.lisp +++ b/src/assembly/alpha/arith.lisp @@ -52,11 +52,11 @@ (inst bis temp2 bignum-type temp2) (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3))) - (inst bis alloc-tn other-pointer-type res) - (storew temp2 res 0 other-pointer-type) - (storew temp3 res bignum-digits-offset other-pointer-type) + (inst bis alloc-tn other-pointer-lowtag res) + (storew temp2 res 0 other-pointer-lowtag) + (storew temp3 res bignum-digits-offset other-pointer-lowtag) (inst srl temp3 32 temp) - (storew temp res (1+ bignum-digits-offset) other-pointer-type)) + (storew temp res (1+ bignum-digits-offset) other-pointer-lowtag)) DONE (lisp-return lra lip :offset 2) @@ -109,11 +109,11 @@ (inst bis temp2 bignum-type temp2) (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3))) - (inst bis alloc-tn other-pointer-type res) - (storew temp2 res 0 other-pointer-type) - (storew temp3 res bignum-digits-offset other-pointer-type) + (inst bis alloc-tn other-pointer-lowtag res) + (storew temp2 res 0 other-pointer-lowtag) + (storew temp3 res bignum-digits-offset other-pointer-lowtag) (inst srl temp3 32 temp) - (storew temp res (1+ bignum-digits-offset) other-pointer-type)) + (storew temp res (1+ bignum-digits-offset) other-pointer-lowtag)) DONE (lisp-return lra lip :offset 2) @@ -177,21 +177,21 @@ (inst li (logior (ash 1 type-bits) bignum-type) temp2) ;; Allocate one word. (pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset))) - (inst bis alloc-tn other-pointer-type res) - (storew temp2 res 0 other-pointer-type)) + (inst bis alloc-tn other-pointer-lowtag res) + (storew temp2 res 0 other-pointer-lowtag)) ;; Store one word - (storew lo res bignum-digits-offset other-pointer-type) + (storew lo res bignum-digits-offset other-pointer-lowtag) ;; Out of here (lisp-return lra lip :offset 2) TWO-WORDS ;; Allocate two words. (pseudo-atomic (:extra (pad-data-block (+ 2 bignum-digits-offset))) - (inst bis alloc-tn other-pointer-type res) - (storew temp2 res 0 other-pointer-type)) + (inst bis alloc-tn other-pointer-lowtag res) + (storew temp2 res 0 other-pointer-lowtag)) ;; Store two words. - (storew lo res bignum-digits-offset other-pointer-type) - (storew hi res (1+ bignum-digits-offset) other-pointer-type) + (storew lo res bignum-digits-offset other-pointer-lowtag) + (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag) ;; out of here (lisp-return lra lip :offset 2) diff --git a/src/assembly/alpha/array.lisp b/src/assembly/alpha/array.lisp index f6f2a70..1957774 100644 --- a/src/assembly/alpha/array.lisp +++ b/src/assembly/alpha/array.lisp @@ -34,10 +34,10 @@ (inst srl type word-shift ndescr) (pseudo-atomic () - (inst bis alloc-tn other-pointer-type result) + (inst bis alloc-tn other-pointer-lowtag result) (inst addq alloc-tn words alloc-tn) - (storew ndescr result 0 other-pointer-type) - (storew length result vector-length-slot other-pointer-type))) + (storew ndescr result 0 other-pointer-lowtag) + (storew length result vector-length-slot other-pointer-lowtag))) ;;;; hash primitives #| @@ -61,7 +61,7 @@ (progn result lip accum data byte retaddr) (inst li (make-fixup 'sxhash-simple-substring :assembly-routine) temp1) - (loadw length string vector-length-slot other-pointer-type) + (loadw length string vector-length-slot other-pointer-lowtag) (inst jmp zero-tn temp1 (make-fixup 'sxhash-simple-substring :assembly-routine))) @@ -85,7 +85,7 @@ ;; Get a pointer to the data. (inst addq string - (- (* vector-data-offset word-bytes) other-pointer-type) + (- (* vector-data-offset word-bytes) other-pointer-lowtag) lip) (move zero-tn accum) (inst br zero-tn test) diff --git a/src/assembly/alpha/assem-rtns.lisp b/src/assembly/alpha/assem-rtns.lisp index 3febb15..4f67ffc 100644 --- a/src/assembly/alpha/assem-rtns.lisp +++ b/src/assembly/alpha/assem-rtns.lisp @@ -153,7 +153,7 @@ DONE ;; We are done. Do the jump. (progn - (loadw temp lexenv closure-fun-slot fun-pointer-type) + (loadw temp lexenv closure-fun-slot fun-pointer-lowtag) (lisp-jump temp lip))) diff --git a/src/assembly/x86/alloc.lisp b/src/assembly/x86/alloc.lisp index e0558e7..b6e5a62 100644 --- a/src/assembly/x86/alloc.lisp +++ b/src/assembly/x86/alloc.lisp @@ -29,7 +29,7 @@ BIGNUM (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 1)) - (storew eax ebx bignum-digits-offset other-pointer-type)) + (storew eax ebx bignum-digits-offset other-pointer-lowtag)) (inst ret)) @@ -58,10 +58,10 @@ ;; Two word bignum (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 2)) - (storew eax ebx bignum-digits-offset other-pointer-type)) + (storew eax ebx bignum-digits-offset other-pointer-lowtag)) (inst ret) ONE-WORD-BIGNUM (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 1)) - (storew eax ebx bignum-digits-offset other-pointer-type)) + (storew eax ebx bignum-digits-offset other-pointer-lowtag)) (inst ret)) diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp index 68cdc1b..04e0861 100644 --- a/src/assembly/x86/arith.lisp +++ b/src/assembly/x86/arith.lisp @@ -66,7 +66,7 @@ (move ecx res) (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset)) - (storew ecx res bignum-digits-offset other-pointer-type)) + (storew ecx res bignum-digits-offset other-pointer-lowtag)) OKAY) @@ -86,7 +86,7 @@ (move ecx res) (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset)) - (storew ecx res bignum-digits-offset other-pointer-type)) + (storew ecx res bignum-digits-offset other-pointer-lowtag)) OKAY) (define-generic-arith-routine (* 30) @@ -107,14 +107,14 @@ (inst jmp :e SINGLE-WORD-BIGNUM) (with-fixed-allocation (res bignum-type (+ bignum-digits-offset 2)) - (storew eax res bignum-digits-offset other-pointer-type) - (storew ecx res (1+ bignum-digits-offset) other-pointer-type)) + (storew eax res bignum-digits-offset other-pointer-lowtag) + (storew ecx res (1+ bignum-digits-offset) other-pointer-lowtag)) (inst jmp DONE) SINGLE-WORD-BIGNUM (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset)) - (storew eax res bignum-digits-offset other-pointer-type)) + (storew eax res bignum-digits-offset other-pointer-lowtag)) (inst jmp DONE) OKAY @@ -154,7 +154,7 @@ (move ecx res) (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset)) - (storew ecx res bignum-digits-offset other-pointer-type)) + (storew ecx res bignum-digits-offset other-pointer-lowtag)) OKAY) @@ -335,11 +335,11 @@ (inst mov y (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst mov tmp (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 1 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst and y #x80000000) (inst and tmp #x7fffffff) (inst or y tmp) @@ -350,11 +350,11 @@ (inst xor y (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 397 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst mov (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type)) + sb!vm:other-pointer-lowtag)) y) (inst inc k) (inst cmp k (- 624 397)) @@ -363,11 +363,11 @@ (inst mov y (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst mov tmp (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 1 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst and y #x80000000) (inst and tmp #x7fffffff) (inst or y tmp) @@ -378,11 +378,11 @@ (inst xor y (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ (- 397 624) 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst mov (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type)) + sb!vm:other-pointer-lowtag)) y) (inst inc k) (inst cmp k (- 624 1)) @@ -391,11 +391,11 @@ (inst mov y (make-ea :dword :base state :disp (- (* (+ (- 624 1) 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst mov tmp (make-ea :dword :base state :disp (- (* (+ 0 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst and y #x80000000) (inst and tmp #x7fffffff) (inst or y tmp) @@ -406,11 +406,11 @@ (inst xor y (make-ea :dword :base state :disp (- (* (+ (- 397 1) 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst mov (make-ea :dword :base state :disp (- (* (+ (- 624 1) 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type)) + sb!vm:other-pointer-lowtag)) y) ;; Restore the temporary registers and return. diff --git a/src/assembly/x86/array.lisp b/src/assembly/x86/array.lisp index 677bffa..421eaa0 100644 --- a/src/assembly/x86/array.lisp +++ b/src/assembly/x86/array.lisp @@ -30,9 +30,9 @@ (inst and result (lognot sb!vm:lowtag-mask)) (pseudo-atomic (allocation result result) - (inst lea result (make-ea :byte :base result :disp other-pointer-type)) - (storew type result 0 other-pointer-type) - (storew length result vector-length-slot other-pointer-type)) + (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag)) + (storew type result 0 other-pointer-lowtag) + (storew length result vector-length-slot other-pointer-lowtag)) (inst ret)) ;;;; Note: CMU CL had assembly language primitives for hashing strings, diff --git a/src/assembly/x86/assem-rtns.lisp b/src/assembly/x86/assem-rtns.lisp index 1adceb5..ebb3917 100644 --- a/src/assembly/x86/assem-rtns.lisp +++ b/src/assembly/x86/assem-rtns.lisp @@ -166,7 +166,7 @@ (inst jmp (make-ea :byte :base eax :disp (- (* closure-fun-slot word-bytes) - fun-pointer-type))) + fun-pointer-lowtag))) ;; All the arguments fit in registers, so load them. REGISTER-ARGS @@ -184,7 +184,7 @@ ;; And away we go. (inst jmp (make-ea :byte :base eax :disp (- (* closure-fun-slot word-bytes) - fun-pointer-type)))) + fun-pointer-lowtag)))) (define-assembly-routine (throw (:return-style :none)) diff --git a/src/code/class.lisp b/src/code/class.lisp index 7661571..3475adf 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -1124,7 +1124,7 @@ :inherits (sequence mutable-sequence mutable-collection generic-sequence collection)) (cons - :codes (#.sb!vm:list-pointer-type) + :codes (#.sb!vm:list-pointer-lowtag) :translation cons :inherits (list sequence mutable-sequence mutable-collection @@ -1186,7 +1186,7 @@ #.sb!vm:*target-most-positive-fixnum*) :inherits (integer rational real number generic-number) - :codes (#.sb!vm:even-fixnum-type #.sb!vm:odd-fixnum-type)) + :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag)) (bignum :translation (and integer (not fixnum)) :inherits (integer rational real number diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 140e90d..05b323b 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -545,7 +545,7 @@ (defun component-from-component-ptr (component-ptr) (declare (type system-area-pointer component-ptr)) (make-lisp-obj (logior (sap-int component-ptr) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) ;;;; X86 support @@ -560,7 +560,7 @@ (code-header-len (* (get-header-data code) sb!vm:word-bytes)) (pc-offset (- (sap-int pc) (- (get-lisp-obj-address code) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) code-header-len))) ; (format t "c-lra-fpc ~A ~A ~A~%" pc code pc-offset) (values pc-offset code))))) @@ -906,7 +906,7 @@ (pc-offset (- (sap-int (sb!vm:context-pc context)) (- (get-lisp-obj-address code) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) code-header-len))) (/show "got PC-OFFSET") (unless (<= 0 pc-offset @@ -941,7 +941,7 @@ (pc-offset (- (sap-int (sb!vm:context-pc scp)) (- (get-lisp-obj-address code) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) code-header-len))) ;; Check to see whether we were executing in a branch ;; delay slot. @@ -976,7 +976,7 @@ (or (fun-code-header object) :undefined-function) (let ((lowtag (get-lowtag object))) - (if (= lowtag sb!vm:other-pointer-type) + (if (= lowtag sb!vm:other-pointer-lowtag) (let ((type (get-type object))) (cond ((= type sb!vm:code-header-type) object) @@ -1078,7 +1078,7 @@ #!+x86 (- (sap-int ra) (- (get-lisp-obj-address component) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) (* (get-header-data component) sb!vm:word-bytes)))) (push (cons #!-x86 (stack-ref catch sb!vm:catch-block-tag-slot) @@ -2545,7 +2545,7 @@ ;;; this to determine if the value stored is the actual value or an ;;; indirection cell. (defun indirect-value-cell-p (x) - (and (= (get-lowtag x) sb!vm:other-pointer-type) + (and (= (get-lowtag x) sb!vm:other-pointer-lowtag) (= (get-type x) sb!vm:value-cell-header-type))) ;;; Return three values reflecting the validity of DEBUG-VAR's value @@ -3296,7 +3296,7 @@ (values dst-start code-object (sap- trap-loc src-start)) #!-x86 (let ((new-lra (make-lisp-obj (+ (sap-int dst-start) - sb!vm:other-pointer-type)))) + sb!vm:other-pointer-lowtag)))) (set-header-data new-lra (logandc2 (+ sb!vm:code-constants-offset bogus-lra-constants 1) diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 12492c1..161fca0 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -73,7 +73,7 @@ ;;; meaning of FOP-FSET, and changed the layouts of various ;;; internal compiler structures (e.g. DEFSTRUCT CLAMBDA) ;;; 18 = sbcl-0.pre7.39 swapped FUNCTION-POINTER-TYPE and -;;; INSTANCE-POINTER-TYPE low-level type codes to help with +;;; INSTANCE-POINTER-LOWTAG low-level type codes to help with ;;; the PPC port ;;; (In 0.pre7.48, the low-level object layout of SYMBOL on the ;;; non-X86 ports changed. I forgot to bump the fasl version number: diff --git a/src/code/print.lisp b/src/code/print.lisp index eee9391..5fe79aa 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -1574,7 +1574,7 @@ (print-unreadable-object (object stream :identity t) (let ((lowtag (get-lowtag object))) (case lowtag - (#.sb!vm:other-pointer-type + (#.sb!vm:other-pointer-lowtag (let ((type (get-type object))) (case type (#.sb!vm:value-cell-header-type @@ -1584,9 +1584,9 @@ (write-string "unknown pointer object, type=" stream) (let ((*print-base* 16) (*print-radix* t)) (output-integer type stream)))))) - ((#.sb!vm:fun-pointer-type - #.sb!vm:instance-pointer-type - #.sb!vm:list-pointer-type) + ((#.sb!vm:fun-pointer-lowtag + #.sb!vm:instance-pointer-lowtag + #.sb!vm:list-pointer-lowtag) (write-string "unknown pointer object, type=" stream)) (t (case (get-type object) diff --git a/src/code/room.lisp b/src/code/room.lisp index ab96ff2..8fe1c79 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -179,13 +179,13 @@ (let ((size (* cons-size word-bytes))) (funcall fun (make-lisp-obj (logior (sap-int current) - list-pointer-type)) - list-pointer-type + list-pointer-lowtag)) + list-pointer-lowtag size) (setq current (sap+ current size)))) ((eql header-type closure-header-type) (let* ((obj (make-lisp-obj (logior (sap-int current) - fun-pointer-type))) + fun-pointer-lowtag))) (size (round-to-dualword (* (the fixnum (1+ (get-closure-length obj))) word-bytes)))) @@ -193,7 +193,7 @@ (setq current (sap+ current size)))) ((eq (room-info-kind info) :instance) (let* ((obj (make-lisp-obj - (logior (sap-int current) instance-pointer-type))) + (logior (sap-int current) instance-pointer-lowtag))) (size (round-to-dualword (* (+ (%instance-length obj) 1) word-bytes)))) (declare (fixnum size)) @@ -206,7 +206,7 @@ (setq current (sap+ current size)))) (t (let* ((obj (make-lisp-obj - (logior (sap-int current) other-pointer-type))) + (logior (sap-int current) other-pointer-lowtag))) (size (ecase (room-info-kind info) (:fixed (aver (or (eql (room-info-length info) @@ -446,8 +446,8 @@ #.simple-array-complex-double-float-type) (incf non-descriptor-headers) (incf non-descriptor-bytes (- size word-bytes))) - ((#.list-pointer-type - #.instance-pointer-type + ((#.list-pointer-lowtag + #.instance-pointer-lowtag #.ratio-type #.complex-type #.simple-array-type @@ -618,7 +618,7 @@ "No debug info.")))) (#.symbol-header-type (format stream "~&~S~%" obj)) - (#.list-pointer-type + (#.list-pointer-lowtag (unless (gethash obj printed-conses) (note-conses obj) (let ((*print-circle* t) diff --git a/src/compiler/alpha/alloc.lisp b/src/compiler/alpha/alloc.lisp index 71aa412..cf2ed1f 100644 --- a/src/compiler/alpha/alloc.lisp +++ b/src/compiler/alpha/alloc.lisp @@ -39,11 +39,11 @@ (control-stack (load-stack-tn temp ,tn) temp)))) - (storew reg ,list ,slot list-pointer-type)))) + (storew reg ,list ,slot list-pointer-lowtag)))) (let ((cons-cells (if star (1- num) num))) (pseudo-atomic (:extra (* (pad-data-block cons-size) cons-cells)) - (inst bis alloc-tn list-pointer-type res) + (inst bis alloc-tn list-pointer-lowtag res) (move res ptr) (dotimes (i (1- cons-cells)) (store-car (tn-ref-tn things) ptr) @@ -51,14 +51,14 @@ (inst lda ptr (pad-data-block cons-size) ptr) (storew ptr ptr (- cons-cdr-slot cons-size) - list-pointer-type)) + list-pointer-lowtag)) (store-car (tn-ref-tn things) ptr) (cond (star (setf things (tn-ref-across things)) (store-car (tn-ref-tn things) ptr cons-cdr-slot)) (t (storew null-tn ptr - cons-cdr-slot list-pointer-type))) + cons-cdr-slot list-pointer-lowtag))) (assert (null (tn-ref-across things))) (move res result)))))))) @@ -89,14 +89,14 @@ (inst bis ndescr code-header-type ndescr) (pseudo-atomic () - (inst bis alloc-tn other-pointer-type result) - (storew ndescr result 0 other-pointer-type) - (storew unboxed result code-code-size-slot other-pointer-type) - (storew null-tn result code-entry-points-slot other-pointer-type) + (inst bis alloc-tn other-pointer-lowtag result) + (storew ndescr result 0 other-pointer-lowtag) + (storew unboxed result code-code-size-slot other-pointer-lowtag) + (storew null-tn result code-entry-points-slot other-pointer-lowtag) (inst addq alloc-tn boxed alloc-tn) (inst addq alloc-tn unboxed alloc-tn)) - (storew null-tn result code-debug-info-slot other-pointer-type))) + (storew null-tn result code-debug-info-slot other-pointer-lowtag))) (define-vop (make-fdefn) (:policy :fast-safe) @@ -106,10 +106,10 @@ (:results (result :scs (descriptor-reg) :from :argument)) (:generator 37 (with-fixed-allocation (result temp fdefn-type fdefn-size) - (storew name result fdefn-name-slot other-pointer-type) - (storew null-tn result fdefn-fun-slot other-pointer-type) + (storew name result fdefn-name-slot other-pointer-lowtag) + (storew null-tn result fdefn-fun-slot other-pointer-lowtag) (inst li (make-fixup "undefined_tramp" :foreign) temp) - (storew temp result fdefn-raw-addr-slot other-pointer-type)))) + (storew temp result fdefn-raw-addr-slot other-pointer-lowtag)))) (define-vop (make-closure) (:args (function :to :save :scs (descriptor-reg))) @@ -120,9 +120,9 @@ (let ((size (+ length closure-info-offset))) (inst li (logior (ash (1- size) type-bits) closure-header-type) temp) (pseudo-atomic (:extra (pad-data-block size)) - (inst bis alloc-tn fun-pointer-type result) - (storew temp result 0 fun-pointer-type)) - (storew function result closure-fun-slot fun-pointer-type)))) + (inst bis alloc-tn fun-pointer-lowtag result) + (storew temp result 0 fun-pointer-lowtag)) + (storew function result closure-fun-slot fun-pointer-lowtag)))) ;;; The compiler likes to be able to directly make value cells. ;;; @@ -133,7 +133,7 @@ (:generator 10 (with-fixed-allocation (result temp value-cell-header-type value-cell-size)) - (storew value result value-cell-value-slot other-pointer-type))) + (storew value result value-cell-value-slot other-pointer-lowtag))) ;;;; automatic allocators for primitive objects diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index dff7ea4..4f5de2e 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -568,10 +568,10 @@ (:translate sb!bignum::%bignum-set-length) (:policy :fast-safe)) -(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-type +(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum::%bignum-ref) -(define-full-setter bignum-set * bignum-digits-offset other-pointer-type +(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum::%bignum-set #+gengc nil) (define-vop (digit-0-or-plus) diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp index 123ef77..0250c2b 100644 --- a/src/compiler/alpha/array.lisp +++ b/src/compiler/alpha/array.lisp @@ -33,8 +33,8 @@ (inst bis header type header) (inst srl header 2 header) (pseudo-atomic () - (inst bis alloc-tn other-pointer-type result) - (storew header result 0 other-pointer-type) + (inst bis alloc-tn other-pointer-lowtag result) + (storew header result 0 other-pointer-lowtag) (inst addq alloc-tn bytes alloc-tn)))) @@ -47,11 +47,11 @@ ()) (define-full-reffer %array-dimension * - array-dimensions-offset other-pointer-type + array-dimensions-offset other-pointer-lowtag (any-reg) positive-fixnum sb!impl::%array-dimension) (define-full-setter %set-array-dimension * - array-dimensions-offset other-pointer-type + array-dimensions-offset other-pointer-lowtag (any-reg) positive-fixnum sb!impl::%set-array-dimension #+gengc nil) @@ -64,7 +64,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:results (res :scs (any-reg descriptor-reg))) (:generator 6 - (loadw temp x 0 other-pointer-type) + (loadw temp x 0 other-pointer-lowtag) (inst sra temp type-bits temp) (inst subq temp (1- array-dimensions-offset) temp) (inst sll temp 2 res))) @@ -99,13 +99,13 @@ `(progn (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type - vector-data-offset other-pointer-type + vector-data-offset other-pointer-lowtag ,(remove-if #'(lambda (x) (member x '(null zero))) scs) ,element-type data-vector-ref) (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type - vector-data-offset other-pointer-type ,scs ,element-type + vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-set #+gengc ,(if (member 'descriptor-reg scs) t nil)))) @@ -115,11 +115,11 @@ `(progn (define-partial-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type - ,size ,signed vector-data-offset other-pointer-type ,scs + ,size ,signed vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-ref) (define-partial-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type - ,size vector-data-offset other-pointer-type ,scs + ,size vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-set))) (def-small-data-vector-frobs (type bits) (let* ((elements-per-word (floor word-bits bits)) @@ -143,7 +143,7 @@ (inst addq object temp lip) (inst ldl result (- (* vector-data-offset word-bytes) - other-pointer-type) + other-pointer-lowtag) lip) (inst and index ,(1- elements-per-word) temp) ,@(unless (= bits 1) @@ -160,7 +160,7 @@ (:constant (integer 0 ,(1- (* (1+ (- (floor (+ #x7fff - other-pointer-type) + other-pointer-lowtag) word-bytes) vector-data-offset)) elements-per-word))))) @@ -172,7 +172,7 @@ (floor index ,elements-per-word) (loadw result object (+ word vector-data-offset) - other-pointer-type) + other-pointer-lowtag) (unless (zerop extra) (inst srl result (* extra ,bits) result)) (unless (= extra ,(1- elements-per-word)) @@ -199,7 +199,7 @@ (inst addq object temp lip) (inst ldl old (- (* vector-data-offset word-bytes) - other-pointer-type) + other-pointer-lowtag) lip) (inst and index ,(1- elements-per-word) shift) ,@(unless (= bits 1) @@ -228,7 +228,7 @@ (inst bis old temp old)) (inst stl old (- (* vector-data-offset word-bytes) - other-pointer-type) + other-pointer-lowtag) lip) (sc-case value (immediate @@ -247,7 +247,7 @@ (:constant (integer 0 ,(1- (* (1+ (- (floor (+ #x7fff - other-pointer-type) + other-pointer-lowtag) word-bytes) vector-data-offset)) elements-per-word)))) @@ -262,7 +262,7 @@ (inst ldl object (- (* (+ word vector-data-offset) word-bytes) - other-pointer-type) + other-pointer-lowtag) old) (unless (and (sc-is value immediate) (= (tn-value value) @@ -299,7 +299,7 @@ (inst stl old (- (* (+ word vector-data-offset) word-bytes) - other-pointer-type) + other-pointer-lowtag) object) (sc-case value (immediate @@ -356,7 +356,7 @@ (inst addq object index lip) (inst lds value (- (* vector-data-offset word-bytes) - other-pointer-type) + other-pointer-lowtag) lip))) (define-vop (data-vector-set/simple-array-single-float) @@ -374,7 +374,7 @@ (inst addq object index lip) (inst sts value (- (* vector-data-offset word-bytes) - other-pointer-type) + other-pointer-lowtag) lip) (unless (location= result value) (inst fmove value result)))) @@ -394,7 +394,7 @@ (inst addq lip index lip) (inst ldt value (- (* vector-data-offset word-bytes) - other-pointer-type) + other-pointer-lowtag) lip))) (define-vop (data-vector-set/simple-array-double-float) @@ -413,7 +413,7 @@ (inst addq lip index lip) (inst stt value (- (* vector-data-offset word-bytes) - other-pointer-type) lip) + other-pointer-lowtag) lip) (unless (location= result value) (inst fmove value result)))) @@ -434,11 +434,11 @@ (inst addq object index lip) (inst addq lip index lip) (inst lds real-tn - (- (* vector-data-offset word-bytes) other-pointer-type) + (- (* vector-data-offset word-bytes) other-pointer-lowtag) lip)) (let ((imag-tn (complex-single-reg-imag-tn value))) (inst lds imag-tn - (- (* (1+ vector-data-offset) word-bytes) other-pointer-type) + (- (* (1+ vector-data-offset) word-bytes) other-pointer-lowtag) lip)))) (define-vop (data-vector-set/simple-array-complex-single-float) @@ -459,14 +459,14 @@ (inst addq object index lip) (inst addq lip index lip) (inst sts value-real - (- (* vector-data-offset word-bytes) other-pointer-type) + (- (* vector-data-offset word-bytes) other-pointer-lowtag) lip) (unless (location= result-real value-real) (inst fmove value-real result-real))) (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) (inst sts value-imag - (- (* (1+ vector-data-offset) word-bytes) other-pointer-type) + (- (* (1+ vector-data-offset) word-bytes) other-pointer-lowtag) lip) (unless (location= result-imag value-imag) (inst fmove value-imag result-imag))))) @@ -488,11 +488,11 @@ (inst addq lip index lip) (inst addq lip index lip) (inst ldt real-tn - (- (* vector-data-offset word-bytes) other-pointer-type) + (- (* vector-data-offset word-bytes) other-pointer-lowtag) lip)) (let ((imag-tn (complex-double-reg-imag-tn value))) (inst ldt imag-tn - (- (* (+ vector-data-offset 2) word-bytes) other-pointer-type) + (- (* (+ vector-data-offset 2) word-bytes) other-pointer-lowtag) lip)))) (define-vop (data-vector-set/simple-array-complex-double-float) @@ -515,14 +515,14 @@ (inst addq lip index lip) (inst addq lip index lip) (inst stt value-real - (- (* vector-data-offset word-bytes) other-pointer-type) + (- (* vector-data-offset word-bytes) other-pointer-lowtag) lip) (unless (location= result-real value-real) (inst fmove value-real result-real))) (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) (inst stt value-imag - (- (* (+ vector-data-offset 2) word-bytes) other-pointer-type) + (- (* (+ vector-data-offset 2) word-bytes) other-pointer-lowtag) lip) (unless (location= result-imag value-imag) (inst fmove value-imag result-imag))))) @@ -572,9 +572,9 @@ ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is. ;;; -(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num +(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) +(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num %set-raw-bits #+gengc nil) diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 9b402ae..371ea18 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -543,7 +543,7 @@ default-value-8 (when cur-nfp (inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame) nsp-tn))) - (inst subq return-pc-temp (- other-pointer-type word-bytes) lip) + (inst subq return-pc-temp (- other-pointer-lowtag word-bytes) lip) (move ocfp-temp cfp-tn) (inst ret zero-tn lip 1) (trace-table-entry trace-table-normal))) @@ -760,11 +760,11 @@ default-value-8 (constant (inst ldl name-pass (- (ash (tn-offset name) word-shift) - other-pointer-type) code-tn) + other-pointer-lowtag) code-tn) (do-next-filler))) (inst ldl entry-point (- (ash fdefn-raw-addr-slot word-shift) - other-pointer-type) name-pass) + other-pointer-lowtag) name-pass) (do-next-filler)) `((sc-case arg-fun (descriptor-reg (move arg-fun lexenv)) @@ -775,22 +775,22 @@ default-value-8 (constant (inst ldl lexenv (- (ash (tn-offset arg-fun) word-shift) - other-pointer-type) code-tn) + other-pointer-lowtag) code-tn) (do-next-filler))) #!-gengc (inst ldl function (- (ash closure-fun-slot word-shift) - fun-pointer-type) lexenv) + fun-pointer-lowtag) lexenv) #!-gengc (do-next-filler) #!-gengc (inst addq function (- (ash simple-fun-code-offset word-shift) - fun-pointer-type) entry-point) + fun-pointer-lowtag) entry-point) #!+gengc (inst ldl entry-point (- (ash closure-entry-point-slot word-shift) - fun-pointer-type) lexenv) + fun-pointer-lowtag) lexenv) #!+gengc (do-next-filler))) (loop @@ -1119,7 +1119,7 @@ default-value-8 ;; We need to do this atomically. (pseudo-atomic () ;; Allocate a cons (2 words) for each item. - (inst bis alloc-tn list-pointer-type result) + (inst bis alloc-tn list-pointer-lowtag result) (move result dst) (inst sll count 1 temp) (inst addq alloc-tn temp alloc-tn) @@ -1128,7 +1128,7 @@ default-value-8 ;; Store the current cons in the cdr of the previous cons. (emit-label loop) (inst addq dst (* 2 word-bytes) dst) - (storew dst dst -1 list-pointer-type) + (storew dst dst -1 list-pointer-lowtag) (emit-label enter) ;; Grab one value. @@ -1136,14 +1136,14 @@ default-value-8 (inst addq context word-bytes context) ;; Store the value in the car (in delay slot) - (storew temp dst 0 list-pointer-type) + (storew temp dst 0 list-pointer-lowtag) ;; Decrement count, and if != zero, go back for more. (inst subq count (fixnumize 1) count) (inst bne count loop) ;; NIL out the last cons. - (storew null-tn dst 1 list-pointer-type)) + (storew null-tn dst 1 list-pointer-lowtag)) (emit-label done)))) ;;; Return the location and size of the &MORE arg glob created by diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp index 6f6147a..10734f8 100644 --- a/src/compiler/alpha/cell.lisp +++ b/src/compiler/alpha/cell.lisp @@ -40,7 +40,7 @@ ;;; The compiler likes to be able to directly SET symbols. (define-vop (set cell-set) - (:variant symbol-value-slot other-pointer-type)) + (:variant symbol-value-slot other-pointer-lowtag)) ;;; Do a cell ref with an error check for being unbound. (define-vop (checked-cell-ref) @@ -58,7 +58,7 @@ (:translate symbol-value) (:generator 9 (move object obj-temp) - (loadw value obj-temp symbol-value-slot other-pointer-type) + (loadw value obj-temp symbol-value-slot other-pointer-lowtag) (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp))) (inst xor value unbound-marker-type temp) (inst beq temp err-lab)))) @@ -76,14 +76,14 @@ (define-vop (boundp boundp-frob) (:translate boundp) (:generator 9 - (loadw value object symbol-value-slot other-pointer-type) + (loadw value object symbol-value-slot other-pointer-lowtag) (inst xor value unbound-marker-type temp) (if not-p (inst beq temp target) (inst bne temp target)))) (define-vop (fast-symbol-value cell-ref) - (:variant symbol-value-slot other-pointer-type) + (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate symbol-value)) @@ -92,7 +92,7 @@ ;;;; fdefinition (FDEFN) objects (define-vop (fdefn-fun cell-ref) - (:variant fdefn-fun-slot other-pointer-type)) + (:variant fdefn-fun-slot other-pointer-lowtag)) (define-vop (safe-fdefn-fun) (:args (object :scs (descriptor-reg) :target obj-temp)) @@ -103,7 +103,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 10 (move object obj-temp) - (loadw value obj-temp fdefn-fun-slot other-pointer-type) + (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag) (let ((err-lab (generate-error-code vop undefined-symbol-error obj-temp))) (inst cmpeq value null-tn temp) (inst bne temp err-lab)))) @@ -118,16 +118,16 @@ (:results (result :scs (descriptor-reg))) (:generator 38 (let ((normal-fn (gen-label))) - (load-type type function (- fun-pointer-type)) + (load-type type function (- fun-pointer-lowtag)) (inst xor type simple-fun-header-type type) (inst addq function - (- (ash simple-fun-code-offset word-shift) fun-pointer-type) + (- (ash simple-fun-code-offset word-shift) fun-pointer-lowtag) lip) (inst beq type normal-fn) (inst li (make-fixup "closure_tramp" :foreign) lip) (emit-label normal-fn) - (storew lip fdefn fdefn-raw-addr-slot other-pointer-type) - (storew function fdefn fdefn-fun-slot other-pointer-type) + (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag) + (storew function fdefn fdefn-fun-slot other-pointer-lowtag) (move function result)))) @@ -138,10 +138,10 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:results (result :scs (descriptor-reg))) (:generator 38 - (storew null-tn fdefn fdefn-fun-slot other-pointer-type) + (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag) (inst li (make-fixup "undefined_tramp" :foreign) temp) (move fdefn result) - (storew temp fdefn fdefn-raw-addr-slot other-pointer-type))) + (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag))) ;;;; binding and Unbinding @@ -152,12 +152,12 @@ (symbol :scs (descriptor-reg))) (:temporary (:scs (descriptor-reg)) temp) (:generator 5 - (loadw temp symbol symbol-value-slot other-pointer-type) + (loadw temp symbol symbol-value-slot other-pointer-lowtag) (inst addq bsp-tn (* 2 word-bytes) bsp-tn) (storew temp bsp-tn (- binding-value-slot binding-size)) (storew symbol bsp-tn (- binding-symbol-slot binding-size)) (#+gengc storew-and-remember-slot #-gengc storew - val symbol symbol-value-slot other-pointer-type))) + val symbol symbol-value-slot other-pointer-lowtag))) (define-vop (unbind) @@ -166,7 +166,7 @@ (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (loadw value bsp-tn (- binding-value-slot binding-size)) (#+gengc storew-and-remember-slot #-gengc storew - value symbol symbol-value-slot other-pointer-type) + value symbol symbol-value-slot other-pointer-lowtag) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (inst subq bsp-tn (* 2 word-bytes) bsp-tn))) @@ -189,7 +189,7 @@ (loadw value bsp-tn (- binding-value-slot binding-size)) (inst beq symbol skip) (#+gengc storew-and-remember-slot #-gengc storew - value symbol symbol-value-slot other-pointer-type) + value symbol symbol-value-slot other-pointer-lowtag) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) @@ -202,33 +202,33 @@ ;;;; closure indexing (define-full-reffer closure-index-ref * - closure-info-offset fun-pointer-type + closure-info-offset fun-pointer-lowtag (descriptor-reg any-reg) * %closure-index-ref) (define-full-setter set-funcallable-instance-info * - funcallable-instance-info-offset fun-pointer-type + funcallable-instance-info-offset fun-pointer-lowtag (descriptor-reg any-reg null zero) * %set-funcallable-instance-info) (define-full-reffer funcallable-instance-info * - funcallable-instance-info-offset fun-pointer-type + funcallable-instance-info-offset fun-pointer-lowtag (descriptor-reg any-reg) * %funcallable-instance-info) (define-vop (funcallable-instance-lexenv cell-ref) - (:variant funcallable-instance-lexenv-slot fun-pointer-type)) + (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag)) (define-vop (closure-ref slot-ref) - (:variant closure-info-offset fun-pointer-type)) + (:variant closure-info-offset fun-pointer-lowtag)) (define-vop (closure-init slot-set) - (:variant closure-info-offset fun-pointer-type)) + (:variant closure-info-offset fun-pointer-lowtag)) ;;;; value cell hackery (define-vop (value-cell-ref cell-ref) - (:variant value-cell-value-slot other-pointer-type)) + (:variant value-cell-value-slot other-pointer-lowtag)) (define-vop (value-cell-set cell-set) - (:variant value-cell-value-slot other-pointer-type)) + (:variant value-cell-value-slot other-pointer-lowtag)) ;;;; instance hackery @@ -239,11 +239,11 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 4 - (loadw res struct 0 instance-pointer-type) + (loadw res struct 0 instance-pointer-lowtag) (inst srl res type-bits res))) (define-vop (instance-ref slot-ref) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:policy :fast-safe) (:translate %instance-ref) (:arg-types instance (:constant index))) @@ -251,21 +251,21 @@ (define-vop (instance-set slot-set) (:policy :fast-safe) (:translate %instance-set) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:arg-types instance (:constant index) *)) (define-full-reffer instance-index-ref * instance-slots-offset - instance-pointer-type (descriptor-reg any-reg) * %instance-ref) + instance-pointer-lowtag (descriptor-reg any-reg) * %instance-ref) (define-full-setter instance-index-set * instance-slots-offset - instance-pointer-type (descriptor-reg any-reg null zero) * %instance-set) + instance-pointer-lowtag (descriptor-reg any-reg null zero) * %instance-set) ;;;; code object frobbing -(define-full-reffer code-header-ref * 0 other-pointer-type +(define-full-reffer code-header-ref * 0 other-pointer-lowtag (descriptor-reg any-reg) * code-header-ref) -(define-full-setter code-header-set * 0 other-pointer-type +(define-full-setter code-header-set * 0 other-pointer-lowtag (descriptor-reg any-reg null zero) * code-header-set) ;;;; mutator accessing diff --git a/src/compiler/alpha/debug.lisp b/src/compiler/alpha/debug.lisp index 8e9df70..de8daea 100644 --- a/src/compiler/alpha/debug.lisp +++ b/src/compiler/alpha/debug.lisp @@ -93,8 +93,8 @@ (inst srl temp sb!vm:type-bits temp) (inst beq temp bogus) (inst sll temp (1- (integer-length sb!vm:word-bytes)) temp) - (unless (= lowtag sb!vm:other-pointer-type) - (inst subq temp (- sb!vm:other-pointer-type lowtag) temp)) + (unless (= lowtag sb!vm:other-pointer-lowtag) + (inst subq temp (- sb!vm:other-pointer-lowtag lowtag) temp)) (inst subq thing temp code) (emit-label done) (assemble (*elsewhere*) @@ -104,11 +104,11 @@ (define-vop (code-from-lra code-from-mumble) (:translate lra-code-header) - (:variant sb!vm:other-pointer-type)) + (:variant sb!vm:other-pointer-lowtag)) (define-vop (code-from-function code-from-mumble) (:translate fun-code-header) - (:variant sb!vm:fun-pointer-type)) + (:variant sb!vm:fun-pointer-lowtag)) (define-vop (make-lisp-obj) (:policy :fast-safe) @@ -135,7 +135,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 5 - (loadw res fun 0 fun-pointer-type) + (loadw res fun 0 fun-pointer-lowtag) (inst srl res sb!vm:type-bits res))) (defknown make-number-stack-pointer ((unsigned-byte 32)) system-area-pointer diff --git a/src/compiler/alpha/float.lisp b/src/compiler/alpha/float.lisp index 01b7fe9..fd42add 100644 --- a/src/compiler/alpha/float.lisp +++ b/src/compiler/alpha/float.lisp @@ -67,8 +67,8 @@ (:generator 13 (with-fixed-allocation (y ndescr type size) (if double-p - (inst stt x (- (* data word-bytes) other-pointer-type) y) - (inst sts x (- (* data word-bytes) other-pointer-type) y))))) + (inst stt x (- (* data word-bytes) other-pointer-lowtag) y) + (inst sts x (- (* data word-bytes) other-pointer-lowtag) y))))) (macrolet ((frob (name sc &rest args) `(progn @@ -91,10 +91,10 @@ (:generator 2 ,@(if double-p `((inst ldt y (- (* ,value word-bytes) - other-pointer-type) + other-pointer-lowtag) x)) `((inst lds y (- (* ,value word-bytes) - other-pointer-type) + other-pointer-lowtag) x))))) (define-move-vop ,name :move (descriptor-reg) (,sc))))) (frob move-to-single single-reg nil single-float-value-slot) @@ -234,12 +234,12 @@ (let ((real-tn (complex-single-reg-real-tn x))) (inst sts real-tn (- (* sb!vm:complex-single-float-real-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) y)) (let ((imag-tn (complex-single-reg-imag-tn x))) (inst sts imag-tn (- (* sb!vm:complex-single-float-imag-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) y))))) ;;; (define-move-vop move-from-complex-single :move @@ -256,12 +256,12 @@ (let ((real-tn (complex-double-reg-real-tn x))) (inst stt real-tn (- (* sb!vm:complex-double-float-real-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) y)) (let ((imag-tn (complex-double-reg-imag-tn x))) (inst stt imag-tn (- (* sb!vm:complex-double-float-imag-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) y))))) ;;; (define-move-vop move-from-complex-double :move @@ -277,11 +277,11 @@ (:generator 2 (let ((real-tn (complex-single-reg-real-tn y))) (inst lds real-tn (- (* complex-single-float-real-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) x)) (let ((imag-tn (complex-single-reg-imag-tn y))) (inst lds imag-tn (- (* complex-single-float-imag-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) x)))) (define-move-vop move-to-complex-single :move (descriptor-reg) (complex-single-reg)) @@ -293,11 +293,11 @@ (:generator 2 (let ((real-tn (complex-double-reg-real-tn y))) (inst ldt real-tn (- (* complex-double-float-real-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) x)) (let ((imag-tn (complex-double-reg-imag-tn y))) (inst ldt imag-tn (- (* complex-double-float-imag-slot sb!vm:word-bytes) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) x)))) (define-move-vop move-to-complex-double :move (descriptor-reg) (complex-double-reg)) @@ -661,7 +661,8 @@ (* (tn-offset float) sb!vm:word-bytes) (current-nfp-tn vop))) (descriptor-reg - (loadw bits float sb!vm:single-float-value-slot sb!vm:other-pointer-type)))) + (loadw bits float sb!vm:single-float-value-slot + sb!vm:other-pointer-lowtag)))) (signed-stack (sc-case float (single-reg @@ -694,7 +695,7 @@ (current-nfp-tn vop))) (descriptor-reg (loadw hi-bits float (1+ sb!vm:double-float-value-slot) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (define-vop (double-float-low-bits) (:args (float :scs (double-reg descriptor-reg) @@ -721,7 +722,7 @@ (current-nfp-tn vop))) (descriptor-reg (loadw lo-bits float sb!vm:double-float-value-slot - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst mskll lo-bits 4 lo-bits))) diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index 098dfaa..4f6ef0f 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -592,7 +592,7 @@ (:emitter (emit-compute-inst segment vop dst src label temp #'(lambda (label posn delta-if-after) - (- other-pointer-type + (- other-pointer-lowtag (label-position label posn delta-if-after) (component-header-length)))))) diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index d898045..84179d9 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -61,14 +61,14 @@ `(inst ldl ,reg (+ (static-symbol-offset ',symbol) (ash symbol-value-slot word-shift) - (- other-pointer-type)) + (- other-pointer-lowtag)) null-tn)) (defmacro store-symbol-value (reg symbol) `(inst stl ,reg (+ (static-symbol-offset ',symbol) (ash symbol-value-slot word-shift) - (- other-pointer-type)) + (- other-pointer-lowtag)) null-tn)) (defmacro load-type (target source &optional (offset 0)) @@ -88,7 +88,7 @@ "Jump to the lisp function FUNCTION. LIP is an interior-reg temporary." `(progn (inst lda ,lip (- (ash sb!vm:simple-fun-code-offset sb!vm:word-shift) - sb!vm:fun-pointer-type) + sb!vm:fun-pointer-lowtag) ,function) (move ,function code-tn) (inst jsr zero-tn ,lip 1))) @@ -97,7 +97,7 @@ "Return to RETURN-PC. LIP is an interior-reg temporary." `(progn (inst lda ,lip - (- (* (1+ ,offset) word-bytes) other-pointer-type) + (- (* (1+ ,offset) word-bytes) other-pointer-lowtag) ,return-pc) ,@(when frob-code `((move ,return-pc code-tn))) @@ -170,9 +170,9 @@ (defmacro with-fixed-allocation ((result-tn temp-tn type-code size) &body body) `(pseudo-atomic (:extra (pad-data-block ,size)) - (inst bis alloc-tn other-pointer-type ,result-tn) + (inst bis alloc-tn other-pointer-lowtag ,result-tn) (inst li (logior (ash (1- ,size) type-bits) ,type-code) ,temp-tn) - (storew ,temp-tn ,result-tn 0 other-pointer-type) + (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) ,@body)) diff --git a/src/compiler/alpha/move.lisp b/src/compiler/alpha/move.lisp index 3367260..bd413a3 100644 --- a/src/compiler/alpha/move.lisp +++ b/src/compiler/alpha/move.lisp @@ -41,7 +41,7 @@ (define-move-function (load-constant 5) (vop x y) ((constant) (descriptor-reg any-reg)) - (loadw y code-tn (tn-offset x) other-pointer-type)) + (loadw y code-tn (tn-offset x) other-pointer-lowtag)) (define-move-function (load-stack 5) (vop x y) ((control-stack) (any-reg descriptor-reg)) @@ -179,12 +179,12 @@ (inst sra x 2 y) (inst beq temp done) - (loadw header x 0 other-pointer-type) + (loadw header x 0 other-pointer-lowtag) (inst srl header (1+ type-bits) header) - (loadw y x bignum-digits-offset other-pointer-type) + (loadw y x bignum-digits-offset other-pointer-lowtag) (inst beq header one) - (loadw header x (1+ bignum-digits-offset) other-pointer-type) + (loadw header x (1+ bignum-digits-offset) other-pointer-lowtag) (inst sll header 32 header) (inst mskll y 4 y) (inst bis header y y) @@ -236,11 +236,11 @@ (inst bis header bignum-type header) (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3))) - (inst bis alloc-tn other-pointer-type y) - (storew header y 0 other-pointer-type) - (storew x y bignum-digits-offset other-pointer-type) + (inst bis alloc-tn other-pointer-lowtag y) + (storew header y 0 other-pointer-lowtag) + (storew x y bignum-digits-offset other-pointer-lowtag) (inst srl x 32 temp) - (storew temp y (1+ bignum-digits-offset) other-pointer-type)) + (storew temp y (1+ bignum-digits-offset) other-pointer-lowtag)) DONE)) ;;; @@ -270,11 +270,11 @@ (inst bis temp bignum-type temp) (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3))) - (inst bis alloc-tn other-pointer-type y) - (storew temp y 0 other-pointer-type) - (storew x y bignum-digits-offset other-pointer-type) + (inst bis alloc-tn other-pointer-lowtag y) + (storew temp y 0 other-pointer-lowtag) + (storew x y bignum-digits-offset other-pointer-lowtag) (inst srl x 32 temp) - (storew temp y (1+ bignum-digits-offset) other-pointer-type)) + (storew temp y (1+ bignum-digits-offset) other-pointer-lowtag)) DONE)) ;;; diff --git a/src/compiler/alpha/sap.lisp b/src/compiler/alpha/sap.lisp index 655c03e..e0cd614 100644 --- a/src/compiler/alpha/sap.lisp +++ b/src/compiler/alpha/sap.lisp @@ -19,7 +19,7 @@ (:results (y :scs (sap-reg))) (:note "system area pointer indirection") (:generator 1 - (loadq y x sap-pointer-slot other-pointer-type))) + (loadq y x sap-pointer-slot other-pointer-lowtag))) (define-move-vop move-to-sap :move (descriptor-reg) (sap-reg)) @@ -33,7 +33,7 @@ (:generator 20 (move x sap) (with-fixed-allocation (y ndescr sap-type sap-size) - (storeq sap y sap-pointer-slot other-pointer-type)))) + (storeq sap y sap-pointer-slot other-pointer-lowtag)))) (define-move-vop move-from-sap :move (sap-reg) (descriptor-reg)) @@ -351,5 +351,5 @@ (:result-types system-area-pointer) (:generator 2 (inst lda sap - (- (* vector-data-offset word-bytes) other-pointer-type) + (- (* vector-data-offset word-bytes) other-pointer-lowtag) vector))) diff --git a/src/compiler/alpha/subprim.lisp b/src/compiler/alpha/subprim.lisp index 6473c83..66e9ef8 100644 --- a/src/compiler/alpha/subprim.lisp +++ b/src/compiler/alpha/subprim.lisp @@ -35,10 +35,10 @@ (inst bne temp done) (inst and ptr lowtag-mask temp) - (inst xor temp list-pointer-type temp) + (inst xor temp list-pointer-lowtag temp) (inst bne temp not-list) - (loadw ptr ptr cons-cdr-slot list-pointer-type) + (loadw ptr ptr cons-cdr-slot list-pointer-lowtag) (inst addq count (fixnumize 1) count) (inst br zero-tn loop) diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp index 539ef59..e3d31c3 100644 --- a/src/compiler/alpha/system.lisp +++ b/src/compiler/alpha/system.lisp @@ -32,9 +32,9 @@ (:generator 6 ;; Pick off objects with headers. (inst and object lowtag-mask result) - (inst cmpeq result other-pointer-type ndescr) + (inst cmpeq result other-pointer-lowtag ndescr) (inst bne ndescr other-ptr) - (inst cmpeq result fun-pointer-type ndescr) + (inst cmpeq result fun-pointer-lowtag ndescr) (inst bne ndescr function-ptr) ;; Pick off structure and list pointers. @@ -49,11 +49,11 @@ (inst br zero-tn done) FUNCTION-PTR - (load-type result object (- fun-pointer-type)) + (load-type result object (- fun-pointer-lowtag)) (inst br zero-tn done) OTHER-PTR - (load-type result object (- other-pointer-type)) + (load-type result object (- other-pointer-lowtag)) DONE)) @@ -64,7 +64,7 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (load-type result function (- fun-pointer-type)))) + (load-type result function (- fun-pointer-lowtag)))) (define-vop (set-function-subtype) (:translate (setf function-subtype)) @@ -76,10 +76,10 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (inst ldl temp (- fun-pointer-type) function) + (inst ldl temp (- fun-pointer-lowtag) function) (inst and temp #xff temp) (inst bis type temp temp) - (inst stl temp (- fun-pointer-type) function) + (inst stl temp (- fun-pointer-lowtag) function) (move type result))) @@ -90,7 +90,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 other-pointer-type) + (loadw res x 0 other-pointer-lowtag) (inst srl res type-bits res))) (define-vop (get-closure-length) @@ -100,7 +100,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 fun-pointer-type) + (loadw res x 0 fun-pointer-lowtag) (inst srl res type-bits res))) (define-vop (set-header-data) @@ -112,7 +112,7 @@ (:results (res :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) t1 t2) (:generator 6 - (loadw t1 x 0 other-pointer-type) + (loadw t1 x 0 other-pointer-lowtag) (inst and t1 type-mask t1) (sc-case data (any-reg @@ -126,7 +126,7 @@ (inst li c t2) (inst bis t1 t2 t1))))) (zero)) - (storew t1 x 0 other-pointer-type) + (storew t1 x 0 other-pointer-lowtag) (move x res))) (define-vop (make-fixnum) @@ -193,10 +193,10 @@ (:results (sap :scs (sap-reg))) (:result-types system-area-pointer) (:generator 10 - (loadw ndescr code 0 other-pointer-type) + (loadw ndescr code 0 other-pointer-lowtag) (inst srl ndescr type-bits ndescr) (inst sll ndescr word-shift ndescr) - (inst subq ndescr other-pointer-type ndescr) + (inst subq ndescr other-pointer-lowtag ndescr) (inst addq code ndescr sap))) (define-vop (compute-function) @@ -206,11 +206,11 @@ (:results (func :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 10 - (loadw ndescr code 0 other-pointer-type) + (loadw ndescr code 0 other-pointer-lowtag) (inst srl ndescr type-bits ndescr) (inst sll ndescr word-shift ndescr) (inst addq ndescr offset ndescr) - (inst subq ndescr (- other-pointer-type fun-pointer-type) ndescr) + (inst subq ndescr (- other-pointer-lowtag fun-pointer-lowtag) ndescr) (inst addq code ndescr func))) ;;;; other random VOPs. @@ -235,7 +235,7 @@ (:temporary (:scs (non-descriptor-reg)) count) (:generator 1 (let ((offset - (- (* (+ index vector-data-offset) word-bytes) other-pointer-type))) + (- (* (+ index vector-data-offset) word-bytes) other-pointer-lowtag))) (inst ldl count offset count-vector) (inst addq count 1 count) (inst stl count offset count-vector)))) diff --git a/src/compiler/alpha/type-vops.lisp b/src/compiler/alpha/type-vops.lisp index e5a4535..a65c6f2 100644 --- a/src/compiler/alpha/type-vops.lisp +++ b/src/compiler/alpha/type-vops.lisp @@ -28,7 +28,7 @@ (collect ((results)) (let ((start nil) (prev nil) - (delta (- other-immediate-1-type other-immediate-0-type))) + (delta (- other-immediate-1-lowtag other-immediate-0-lowtag))) (flet ((emit-test () (results (if (= start prev) start @@ -51,8 +51,8 @@ (macrolet ((test-type (value temp target not-p &rest type-codes) ;; Determine what interesting combinations we need to test for. (let* ((type-codes (mapcar #'eval type-codes)) - (fixnump (and (member even-fixnum-type type-codes) - (member odd-fixnum-type type-codes) + (fixnump (and (member even-fixnum-lowtag type-codes) + (member odd-fixnum-lowtag type-codes) t)) (lowtags (remove lowtag-limit type-codes :test #'<)) (extended (remove lowtag-limit type-codes :test #'>)) @@ -69,8 +69,8 @@ (cond (fixnump (when (remove-if #'(lambda (x) - (or (= x even-fixnum-type) - (= x odd-fixnum-type))) + (or (= x even-fixnum-lowtag) + (= x odd-fixnum-lowtag))) lowtags) (error "Can't mix fixnum testing with other lowtags.")) (when function-p @@ -141,7 +141,7 @@ (defun %test-headers (value temp target not-p function-p headers &optional (drop-through (gen-label))) - (let ((lowtag (if function-p fun-pointer-type other-pointer-type))) + (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag))) (multiple-value-bind (when-true when-false) ;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when @@ -231,16 +231,16 @@ (def-type-vops fixnump check-fixnum fixnum object-not-fixnum-error - even-fixnum-type odd-fixnum-type) + even-fixnum-lowtag odd-fixnum-lowtag) (def-type-vops functionp check-function function - object-not-function-error fun-pointer-type) + object-not-function-error fun-pointer-lowtag) (def-type-vops listp check-list list object-not-list-error - list-pointer-type) + list-pointer-lowtag) (def-type-vops %instancep check-instance instance object-not-instance-error - instance-pointer-type) + instance-pointer-lowtag) (def-type-vops bignump check-bignum bignum object-not-bignum-error bignum-type) @@ -436,21 +436,21 @@ complex-array-type) (def-type-vops numberp check-number nil object-not-number-error - even-fixnum-type odd-fixnum-type bignum-type ratio-type + even-fixnum-lowtag odd-fixnum-lowtag bignum-type ratio-type single-float-type double-float-type complex-type complex-single-float-type complex-double-float-type) (def-type-vops rationalp check-rational nil object-not-rational-error - even-fixnum-type odd-fixnum-type ratio-type bignum-type) + even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type) (def-type-vops integerp check-integer nil object-not-integer-error - even-fixnum-type odd-fixnum-type bignum-type) + even-fixnum-lowtag odd-fixnum-lowtag bignum-type) (def-type-vops floatp check-float nil object-not-float-error single-float-type double-float-type) (def-type-vops realp check-real nil object-not-real-error - even-fixnum-type odd-fixnum-type ratio-type bignum-type + even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type single-float-type double-float-type) @@ -470,9 +470,9 @@ (inst and value 3 temp) (inst beq temp yep) (inst and value lowtag-mask temp) - (inst xor temp other-pointer-type temp) + (inst xor temp other-pointer-lowtag temp) (inst bne temp nope) - (loadw temp value 0 other-pointer-type) + (loadw temp value 0 other-pointer-lowtag) (inst li (+ (ash 1 type-bits) bignum-type) temp1) (inst xor temp temp1 temp) (if not-p @@ -513,10 +513,10 @@ ;; If not, is it an other pointer? (inst and value lowtag-mask temp) - (inst xor temp other-pointer-type temp) + (inst xor temp other-pointer-lowtag temp) (inst bne temp nope) ;; Get the header. - (loadw temp value 0 other-pointer-type) + (loadw temp value 0 other-pointer-lowtag) ;; Is it one? (inst li (+ (ash 1 type-bits) bignum-type) temp1) (inst xor temp temp1 temp) @@ -528,14 +528,14 @@ (inst xor temp temp1 temp) (inst bne temp nope) ;; Get the second digit. - (loadw temp value (1+ bignum-digits-offset) other-pointer-type) + (loadw temp value (1+ bignum-digits-offset) other-pointer-lowtag) ;; All zeros, its an (unsigned-byte 32). (inst beq temp yep) (inst br zero-tn nope) SINGLE-WORD ;; Get the single digit. - (loadw temp value bignum-digits-offset other-pointer-type) + (loadw temp value bignum-digits-offset other-pointer-lowtag) ;; positive implies (unsigned-byte 32). FIXNUM @@ -592,7 +592,7 @@ (:generator 8 (inst cmpeq value null-tn temp) (inst bne temp (if not-p target drop-thru)) - (test-type value temp target not-p list-pointer-type) + (test-type value temp target not-p list-pointer-lowtag) DROP-THRU)) (define-vop (check-cons check-type) @@ -601,7 +601,7 @@ (let ((error (generate-error-code vop object-not-cons-error value))) (inst cmpeq value null-tn temp) (inst bne temp error) - (test-type value temp error t list-pointer-type)) + (test-type value temp error t list-pointer-lowtag)) (move value result))) ) ; MACROLET \ No newline at end of file diff --git a/src/compiler/alpha/values.lisp b/src/compiler/alpha/values.lisp index 6e5043e..99d5460 100644 --- a/src/compiler/alpha/values.lisp +++ b/src/compiler/alpha/values.lisp @@ -73,12 +73,12 @@ LOOP (inst cmpeq list null-tn temp) (inst bne temp done) - (loadw temp list cons-car-slot list-pointer-type) - (loadw list list cons-cdr-slot list-pointer-type) + (loadw temp list cons-car-slot list-pointer-lowtag) + (loadw list list cons-cdr-slot list-pointer-lowtag) (inst lda csp-tn word-bytes csp-tn) (storew temp csp-tn -1) (inst and list lowtag-mask ndescr) - (inst xor ndescr list-pointer-type ndescr) + (inst xor ndescr list-pointer-lowtag ndescr) (inst beq ndescr loop) (error-call vop bogus-argument-to-values-list-error list) diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index b40ee3a..be69981 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -14,21 +14,21 @@ ;;; FIXME: It's clever using :SUFFIX -TYPE for these things, but it's ;;; a pain for people just learning to find their way around the code ;;; who want to use lexical search to figure out where things like -;;; EVEN-FIXNUM-TYPE are defined. Remove the :SUFFIXes and just expand -;;; out the full names. Or even define them in DEF-FROB EVEN-FIXNUM-TYPE -;;; style so searches like 'def.*even-fixnum-type' can find them. +;;; EVEN-FIXNUM-LOWTAG are defined. Remove the :SUFFIXes and just expand +;;; out the full names. Or even define them in DEF-FROB EVEN-FIXNUM-LOWTAG +;;; style so searches like 'def.*even-fixnum-lowtag' can find them. -;;; the main types. These types are represented by the low three bits -;;; of the pointer or immediate object. +;;; tags for the main low-level types, to be stored in the low three +;;; bits to identify the type of a machine word (eval-when (:compile-toplevel :load-toplevel :execute) ;; The EVAL-WHEN is necessary (at least for Lispworks), because the - ;; second DEFENUM uses the value of OTHER-IMMEDIATE-0-TYPE, which is + ;; second DEFENUM uses the value of OTHER-IMMEDIATE-0-LOWTAG, which is ;; defined in the first DEFENUM. -- AL 20000216 - (defenum (:suffix -type) + (defenum (:suffix -lowtag) even-fixnum - ;; Note: CMU CL, and SBCL < 0.pre7.39, had FUN-POINTER-TYPE - ;; here. We swapped FUN-POINTER-TYPE and - ;; INSTANCE-POINTER-TYPE in sbcl-0.pre7.39 in order to help with a + ;; Note: CMU CL, and SBCL < 0.pre7.39, had FUN-POINTER-LOWTAG + ;; here. We swapped FUN-POINTER-LOWTAG and + ;; INSTANCE-POINTER-LOWTAG in sbcl-0.pre7.39 in order to help with a ;; low-level pun in the function call sequence on the PPC port. ;; For more information, see the PPC port code. -- WHN 2001-10-03 instance-pointer @@ -39,10 +39,11 @@ other-immediate-1 other-pointer)) -;;; the heap types. Each of these types is in the header of objects in -;;; the heap. +;;; the heap types, stored in 8 bits of the header of an object on the +;;; heap, to identify the type of the heap object (which'll be at +;;; least two machine words, often more) (defenum (:suffix -type - :start (+ (ash 1 lowtag-bits) other-immediate-0-type) + :start (+ (ash 1 lowtag-bits) other-immediate-0-lowtag) :step (ash 1 (1- lowtag-bits))) bignum ratio diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 89b6be2..228dad2 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -152,8 +152,8 @@ (def!method print-object ((des descriptor) stream) (let ((lowtag (descriptor-lowtag des))) (print-unreadable-object (des stream :type t) - (cond ((or (= lowtag sb!vm:even-fixnum-type) - (= lowtag sb!vm:odd-fixnum-type)) + (cond ((or (= lowtag sb!vm:even-fixnum-lowtag) + (= lowtag sb!vm:odd-fixnum-lowtag)) (let ((unsigned (logior (ash (descriptor-high des) (1+ (- descriptor-low-bits sb!vm:lowtag-bits))) @@ -164,8 +164,8 @@ (if (> unsigned #x1FFFFFFF) (- unsigned #x40000000) unsigned)))) - ((or (= lowtag sb!vm:other-immediate-0-type) - (= lowtag sb!vm:other-immediate-1-type)) + ((or (= lowtag sb!vm:other-immediate-0-lowtag) + (= lowtag sb!vm:other-immediate-1-lowtag)) (format stream "for other immediate: #X~X, type #b~8,'0B" (ash (descriptor-bits des) (- sb!vm:type-bits)) @@ -251,14 +251,14 @@ (let ((lowtag (descriptor-lowtag des)) (high (descriptor-high des)) (low (descriptor-low des))) - (if (or (eql lowtag sb!vm:fun-pointer-type) - (eql lowtag sb!vm:instance-pointer-type) - (eql lowtag sb!vm:list-pointer-type) - (eql lowtag sb!vm:other-pointer-type)) + (if (or (eql lowtag sb!vm:fun-pointer-lowtag) + (eql lowtag sb!vm:instance-pointer-lowtag) + (eql lowtag sb!vm:list-pointer-lowtag) + (eql lowtag sb!vm:other-pointer-lowtag)) (dolist (gspace (list *dynamic* *static* *read-only*) (error "couldn't find a GSPACE for ~S" des)) - ;; This code relies on the fact that GSPACEs are aligned such that - ;; the descriptor-low-bits low bits are zero. + ;; This code relies on the fact that GSPACEs are aligned + ;; such that the descriptor-low-bits low bits are zero. (when (and (>= high (ash (gspace-word-address gspace) (- sb!vm:word-shift descriptor-low-bits))) (<= high (ash (+ (gspace-word-address gspace) @@ -523,7 +523,7 @@ (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits)) (des (allocate-cold-descriptor gspace (+ bytes sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (write-memory des (make-other-immediate-descriptor (ash bytes (- sb!vm:word-shift)) @@ -539,7 +539,7 @@ (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits)) (des (allocate-cold-descriptor gspace (+ bytes (* 2 sb!vm:word-bytes)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (write-memory des (make-other-immediate-descriptor 0 type)) (write-wordindexed des sb!vm:vector-length-slot @@ -725,7 +725,7 @@ ;;; Allocate a cons cell in GSPACE and fill it in with CAR and CDR. (defun cold-cons (car cdr &optional (gspace *dynamic*)) - (let ((dest (allocate-boxed-object gspace 2 sb!vm:list-pointer-type))) + (let ((dest (allocate-boxed-object gspace 2 sb!vm:list-pointer-lowtag))) (write-memory dest car) (write-wordindexed dest 1 cdr) dest)) @@ -830,7 +830,7 @@ (let ((result (allocate-boxed-object *dynamic* ;; KLUDGE: Why 1+? -- WHN 19990901 (1+ target-layout-length) - sb!vm:instance-pointer-type))) + sb!vm:instance-pointer-lowtag))) (write-memory result (make-other-immediate-descriptor target-layout-length sb!vm:instance-header-type)) @@ -1062,8 +1062,8 @@ (result (make-descriptor (descriptor-high des) (+ (descriptor-low des) (* 2 sb!vm:word-bytes) - (- sb!vm:list-pointer-type - sb!vm:other-pointer-type))))) + (- sb!vm:list-pointer-lowtag + sb!vm:other-pointer-lowtag))))) (write-wordindexed des 1 (make-other-immediate-descriptor @@ -1324,10 +1324,10 @@ ;;; like CL:CAR, CL:CDR, and CL:NULL but for cold values (defun cold-car (des) - (aver (= (descriptor-lowtag des) sb!vm:list-pointer-type)) + (aver (= (descriptor-lowtag des) sb!vm:list-pointer-lowtag)) (read-wordindexed des sb!vm:cons-car-slot)) (defun cold-cdr (des) - (aver (= (descriptor-lowtag des) sb!vm:list-pointer-type)) + (aver (= (descriptor-lowtag des) sb!vm:list-pointer-lowtag)) (read-wordindexed des sb!vm:cons-cdr-slot)) (defun cold-null (des) (= (descriptor-bits des) @@ -1339,7 +1339,7 @@ (defun warm-fun-name (des) (let ((result (ecase (descriptor-lowtag des) - (#.sb!vm:list-pointer-type + (#.sb!vm:list-pointer-lowtag (aver (not (cold-null des))) ; function named NIL? please no.. ;; Do cold (DESTRUCTURING-BIND (COLD-CAR COLD-CADR) DES ..). (let* ((car-des (cold-car des)) @@ -1349,7 +1349,7 @@ (aver (cold-null cddr-des)) (list (warm-symbol car-des) (warm-symbol cadr-des)))) - (#.sb!vm:other-pointer-type + (#.sb!vm:other-pointer-lowtag (warm-symbol des))))) (unless (legal-function-name-p result) (error "not a legal function name: ~S" result)) @@ -1361,7 +1361,7 @@ (or (gethash warm-name *cold-fdefn-objects*) (let ((fdefn (allocate-boxed-object (or *cold-fdefn-gspace* *dynamic*) (1- sb!vm:fdefn-size) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (setf (gethash warm-name *cold-fdefn-objects*) fdefn) (write-memory fdefn (make-other-immediate-descriptor @@ -1406,7 +1406,7 @@ (dolist (sym sb!vm:*static-functions*) (let* ((fdefn (cold-fdefinition-object (cold-intern sym))) (offset (- (+ (- (descriptor-low fdefn) - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) (* sb!vm:fdefn-raw-addr-slot sb!vm:word-bytes)) (descriptor-low *nil-descriptor*))) (desired (sb!vm:static-function-offset sym))) @@ -1765,7 +1765,7 @@ (let* ((size (clone-arg)) (result (allocate-boxed-object *dynamic* (1+ size) - sb!vm:instance-pointer-type))) + sb!vm:instance-pointer-lowtag))) (write-memory result (make-other-immediate-descriptor size sb!vm:instance-header-type)) @@ -1986,7 +1986,7 @@ (data-vector (pop-stack)) (result (allocate-boxed-object *dynamic* (+ sb!vm:array-dimensions-offset rank) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (write-memory result (make-other-immediate-descriptor rank sb!vm:simple-array-type)) @@ -1997,8 +1997,8 @@ (let ((total-elements 1)) (dotimes (axis rank) (let ((dim (pop-stack))) - (unless (or (= (descriptor-lowtag dim) sb!vm:even-fixnum-type) - (= (descriptor-lowtag dim) sb!vm:odd-fixnum-type)) + (unless (or (= (descriptor-lowtag dim) sb!vm:even-fixnum-lowtag) + (= (descriptor-lowtag dim) sb!vm:odd-fixnum-lowtag)) (error "non-fixnum dimension? (~S)" dim)) (setf total-elements (* total-elements @@ -2208,8 +2208,8 @@ (write-wordindexed obj (+ idx (ecase (descriptor-lowtag obj) - (#.sb!vm:instance-pointer-type 1) - (#.sb!vm:other-pointer-type 2))) + (#.sb!vm:instance-pointer-lowtag 1) + (#.sb!vm:other-pointer-lowtag 2))) (pop-stack)))) (define-cold-fop (fop-structset nil) @@ -2272,7 +2272,7 @@ (+ (ash header-n-words sb!vm:word-shift) code-size) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (write-memory des (make-other-immediate-descriptor header-n-words sb!vm:code-header-type)) @@ -2330,7 +2330,7 @@ (offset (calc-offset code-object (read-arg 4))) (fn (descriptor-beyond code-object offset - sb!vm:fun-pointer-type)) + sb!vm:fun-pointer-lowtag)) (next (read-wordindexed code-object sb!vm:code-entry-points-slot))) (unless (zerop (logand offset sb!vm:lowtag-mask)) ;; FIXME: This should probably become a fatal error. @@ -2377,7 +2377,7 @@ ;; FIXME: We should mask out the type ;; bits, not assume we know what they ;; are and subtract them out this way. - sb!vm:fun-pointer-type)))) + sb!vm:fun-pointer-lowtag)))) (write-wordindexed fn sb!vm:simple-fun-next-slot next) (write-wordindexed fn sb!vm:simple-fun-name-slot name) (write-wordindexed fn sb!vm:simple-fun-arglist-slot arglist) @@ -2405,7 +2405,7 @@ (+ (ash header-n-words sb!vm:word-shift) length) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (write-memory des (make-other-immediate-descriptor header-n-words sb!vm:code-header-type)) @@ -2453,14 +2453,10 @@ ;;;; emitting C header file -(defun tail-comp (string tail) +(defun tailwise-equal (string tail) (and (>= (length string) (length tail)) (string= string tail :start1 (- (length string) (length tail))))) -(defun head-comp (string head) - (and (>= (length string) (length head)) - (string= string head :end1 (length head)))) - (defun write-c-header () ;; writing beginning boilerplate @@ -2521,42 +2517,40 @@ (symbol-value symbol) (documentation symbol 'variable)) constants)) - ;; machinery for old-style CMU CL Lisp-to-C naming + ;; machinery for old-style CMU CL Lisp-to-C + ;; arbitrary renaming, being phased out in favor of + ;; the newer systematic RECORD-WITH-TRANSLATED-NAME + ;; renaming (record-with-munged-name (prefix string priority) (record (concatenate 'simple-string prefix (delete #\- (string-capitalize string))) priority)) - (test-tail (tail prefix priority) - (when (tail-comp name tail) + (maybe-record-with-munged-name (tail prefix priority) + (when (tailwise-equal name tail) (record-with-munged-name prefix (subseq name 0 (- (length name) (length tail))) priority))) - (test-head (head prefix priority) - (when (head-comp name head) - (record-with-munged-name prefix - (subseq name (length head)) - priority))) ;; machinery for new-style SBCL Lisp-to-C naming (record-with-translated-name (priority) (record (substitute #\_ #\- name) - priority))) - ;; This style of munging of names is used in the code - ;; inherited from CMU CL. - (test-tail "-TYPE" "type_" 0) - (test-tail "-FLAG" "flag_" 1) - (test-tail "-TRAP" "trap_" 2) - (test-tail "-SUBTYPE" "subtype_" 3) - (test-head "TRACE-TABLE-" "tracetab_" 4) - (test-tail "-SC-NUMBER" "sc_" 5) - ;; This simpler style of translation of names seems less - ;; confusing, and is used for newer code. - (when (some (lambda (suffix) (tail-comp name suffix)) - #("-START" "-END")) - (record-with-translated-name 6)))))) + priority)) + (maybe-record-with-translated-name (suffixes priority) + (when (some (lambda (suffix) + (tailwise-equal name suffix)) + suffixes) + (record-with-translated-name priority)))) + + (maybe-record-with-translated-name '("-LOWTAG") 0) + (maybe-record-with-munged-name "-TYPE" "type_" 1) + (maybe-record-with-munged-name "-FLAG" "flag_" 2) + (maybe-record-with-munged-name "-TRAP" "trap_" 3) + (maybe-record-with-munged-name "-SUBTYPE" "subtype_" 4) + (maybe-record-with-munged-name "-SC-NUMBER" "sc_" 5) + (maybe-record-with-translated-name '("-START" "-END") 6))))) (setf constants (sort constants #'(lambda (const1 const2) @@ -2658,7 +2652,7 @@ ;; We didn't run GENESIS, so guess at the address. (+ sb!vm:static-space-start sb!vm:word-bytes - sb!vm:other-pointer-type + sb!vm:other-pointer-lowtag (if symbol (sb!vm:static-symbol-offset symbol) 0))))) ;; Voila. @@ -3044,15 +3038,15 @@ initially undefined function references:~2%") (cold-set 'sb!vm:*read-only-space-free-pointer* (allocate-cold-descriptor *read-only* 0 - sb!vm:even-fixnum-type)) + sb!vm:even-fixnum-lowtag)) (cold-set 'sb!vm:*static-space-free-pointer* (allocate-cold-descriptor *static* 0 - sb!vm:even-fixnum-type)) + sb!vm:even-fixnum-lowtag)) (cold-set 'sb!vm:*initial-dynamic-space-free-pointer* (allocate-cold-descriptor *dynamic* 0 - sb!vm:even-fixnum-type)) + sb!vm:even-fixnum-lowtag)) (/show "done setting free pointers") ;; Write results to files. diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index e2303d2..f0a6660 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -13,23 +13,23 @@ ;;;; the primitive objects themselves -(define-primitive-object (cons :lowtag list-pointer-type +(define-primitive-object (cons :lowtag list-pointer-lowtag :alloc-trans cons) (car :ref-trans car :set-trans sb!c::%rplaca :init :arg) (cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg)) -(define-primitive-object (instance :lowtag instance-pointer-type +(define-primitive-object (instance :lowtag instance-pointer-lowtag :header instance-header-type :alloc-trans %make-instance) (slots :rest-p t)) -(define-primitive-object (bignum :lowtag other-pointer-type +(define-primitive-object (bignum :lowtag other-pointer-lowtag :header bignum-type :alloc-trans sb!bignum::%allocate-bignum) (digits :rest-p t :c-type #!-alpha "long" #!+alpha "u32")) (define-primitive-object (ratio :type ratio - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header ratio-type :alloc-trans %make-ratio) (numerator :type integer @@ -41,23 +41,23 @@ :ref-trans %denominator :init :arg)) -(define-primitive-object (single-float :lowtag other-pointer-type +(define-primitive-object (single-float :lowtag other-pointer-lowtag :header single-float-type) (value :c-type "float")) -(define-primitive-object (double-float :lowtag other-pointer-type +(define-primitive-object (double-float :lowtag other-pointer-lowtag :header double-float-type) (filler) (value :c-type "double" :length 2)) #!+long-float -(define-primitive-object (long-float :lowtag other-pointer-type +(define-primitive-object (long-float :lowtag other-pointer-lowtag :header long-float-type) #!+sparc (filler) (value :c-type "long double" :length #!+x86 3 #!+sparc 4)) (define-primitive-object (complex :type complex - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header complex-type :alloc-trans %make-complex) (real :type real @@ -69,7 +69,7 @@ :ref-trans %imagpart :init :arg)) -(define-primitive-object (array :lowtag other-pointer-type +(define-primitive-object (array :lowtag other-pointer-lowtag :header t) (fill-pointer :type index :ref-trans %array-fill-pointer @@ -104,14 +104,14 @@ (dimensions :rest-p t)) (define-primitive-object (vector :type vector - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header t) (length :ref-trans sb!c::vector-length :type index) (data :rest-p t :c-type #!-alpha "unsigned long" #!+alpha "u32")) (define-primitive-object (code :type code-component - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header t) (code-size :type index :ref-known (flushable movable) @@ -130,7 +130,7 @@ (constants :rest-p t)) (define-primitive-object (fdefn :type fdefn - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header fdefn-type) (name :ref-trans fdefn-name) (fun :type (or function null) :ref-trans fdefn-fun) @@ -139,7 +139,7 @@ ;;; a simple function (as opposed to hairier things like closures ;;; which are also subtypes of Common Lisp's FUNCTION type) (define-primitive-object (simple-fun :type function - :lowtag fun-pointer-type + :lowtag fun-pointer-lowtag :header simple-fun-header-type) #!-x86 (self :ref-trans %simple-fun-self :set-trans (setf %simple-fun-self)) @@ -178,16 +178,16 @@ :set-trans (setf %simple-fun-type)) (code :rest-p t :c-type "unsigned char")) -(define-primitive-object (return-pc :lowtag other-pointer-type :header t) +(define-primitive-object (return-pc :lowtag other-pointer-lowtag :header t) (return-point :c-type "unsigned char" :rest-p t)) -(define-primitive-object (closure :lowtag fun-pointer-type +(define-primitive-object (closure :lowtag fun-pointer-lowtag :header closure-header-type) (fun :init :arg :ref-trans %closure-fun) (info :rest-p t)) (define-primitive-object (funcallable-instance - :lowtag fun-pointer-type + :lowtag fun-pointer-lowtag :header funcallable-instance-header-type :alloc-trans %make-funcallable-instance) #!-x86 @@ -218,7 +218,7 @@ :set-known (unsafe) :set-trans (setf %funcallable-instance-layout)) (info :rest-p t)) -(define-primitive-object (value-cell :lowtag other-pointer-type +(define-primitive-object (value-cell :lowtag other-pointer-lowtag :header value-cell-header-type :alloc-trans make-value-cell) (value :set-trans value-cell-set @@ -228,19 +228,19 @@ :init :arg)) #!+alpha -(define-primitive-object (sap :lowtag other-pointer-type +(define-primitive-object (sap :lowtag other-pointer-lowtag :header sap-type) (padding) (pointer :c-type "char *" :length 2)) #!-alpha -(define-primitive-object (sap :lowtag other-pointer-type +(define-primitive-object (sap :lowtag other-pointer-lowtag :header sap-type) (pointer :c-type "char *")) (define-primitive-object (weak-pointer :type weak-pointer - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header weak-pointer-type :alloc-trans make-weak-pointer) (value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable) @@ -281,7 +281,7 @@ (defknown symbol-hash (symbol) (integer 0 #.*target-most-positive-fixnum*) (flushable movable)) -(define-primitive-object (symbol :lowtag other-pointer-type +(define-primitive-object (symbol :lowtag other-pointer-lowtag :header symbol-header-type #!-x86 :alloc-trans #!-x86 make-symbol) (value :set-trans %set-symbol-value @@ -296,13 +296,13 @@ :init :null)) (define-primitive-object (complex-single-float - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header complex-single-float-type) (real :c-type "float") (imag :c-type "float")) (define-primitive-object (complex-double-float - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header complex-double-float-type) (filler) (real :c-type "double" :length 2) @@ -310,7 +310,7 @@ #!+long-float (define-primitive-object (complex-long-float - :lowtag other-pointer-type + :lowtag other-pointer-lowtag :header complex-long-float-type) #!+sparc (filler) (real :c-type "long double" :length #!+x86 3 #!+sparc 4) diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp index 5df590b..3e1f6c7 100644 --- a/src/compiler/generic/utils.lisp +++ b/src/compiler/generic/utils.lisp @@ -32,8 +32,8 @@ (unless posn (error "~S is not a static symbol." symbol)) (+ (* posn (pad-data-block symbol-size)) (pad-data-block (1- symbol-size)) - other-pointer-type - (- list-pointer-type))) + other-pointer-lowtag + (- list-pointer-lowtag))) 0)) (defun offset-static-symbol (offset) @@ -42,7 +42,7 @@ (if (zerop offset) nil (multiple-value-bind (n rem) - (truncate (+ offset list-pointer-type (- other-pointer-type) + (truncate (+ offset list-pointer-lowtag (- other-pointer-lowtag) (- (pad-data-block (1- symbol-size)))) (pad-data-block symbol-size)) (unless (and (zerop rem) (<= 0 n (1- (length *static-symbols*)))) @@ -59,6 +59,6 @@ (error "~S isn't a static function." name)) (+ (* static-syms (pad-data-block symbol-size)) (pad-data-block (1- symbol-size)) - (- list-pointer-type) + (- list-pointer-lowtag) (* static-function-index (pad-data-block fdefn-size)) (* fdefn-raw-addr-slot word-bytes)))) diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index 56b5924..d7e60e7 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -351,7 +351,7 @@ (defun fun-address (function) (declare (type compiled-function function)) - (- (sb!kernel:get-lisp-obj-address function) sb!vm:fun-pointer-type)) + (- (sb!kernel:get-lisp-obj-address function) sb!vm:fun-pointer-lowtag)) ;;; the offset of FUNCTION from the start of its code-component's ;;; instruction area @@ -1752,7 +1752,7 @@ (maybe-symbol-addr (- address slot-offset)) (maybe-symbol (sb!kernel:make-lisp-obj - (+ maybe-symbol-addr sb!vm:other-pointer-type)))) + (+ maybe-symbol-addr sb!vm:other-pointer-lowtag)))) (when (symbolp maybe-symbol) (return (values maybe-symbol (cdr field)))))))) @@ -1783,7 +1783,7 @@ (values (sb!kernel:code-header-ref code (ash (+ byte-offset - sb!vm:other-pointer-type) + sb!vm:other-pointer-lowtag) (- sb!vm:word-shift))) t) (values nil nil)))) @@ -1797,7 +1797,7 @@ (let ((code-size (ash (sb!kernel:get-header-data code) sb!vm:word-shift))) (sb!sys:without-gcing (let ((code-addr (- (sb!kernel:get-lisp-obj-address code) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (if (or (< addr code-addr) (>= addr (+ code-addr code-size))) (values nil nil) (values (sb!kernel:code-header-ref diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index dcf4727..10e5150 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -37,26 +37,26 @@ ((control-stack) (move temp ,tn) temp)))) - (storew reg ,list ,slot sb!vm:list-pointer-type)))) + (storew reg ,list ,slot sb!vm:list-pointer-lowtag)))) (let ((cons-cells (if star (1- num) num))) (pseudo-atomic (allocation res (* (pad-data-block cons-size) cons-cells) node) (inst lea res - (make-ea :byte :base res :disp list-pointer-type)) + (make-ea :byte :base res :disp list-pointer-lowtag)) (move ptr res) (dotimes (i (1- cons-cells)) (store-car (tn-ref-tn things) ptr) (setf things (tn-ref-across things)) (inst add ptr (pad-data-block cons-size)) (storew ptr ptr (- cons-cdr-slot cons-size) - list-pointer-type)) + list-pointer-lowtag)) (store-car (tn-ref-tn things) ptr) (cond (star (setf things (tn-ref-across things)) (store-car (tn-ref-tn things) ptr cons-cdr-slot)) (t (storew nil-value ptr cons-cdr-slot - list-pointer-type))) + list-pointer-lowtag))) (aver (null (tn-ref-across things))))) (move result res)))))) @@ -99,17 +99,17 @@ ;; ;; FIXME: should have a check for overflow of static space (load-symbol-value temp sb!vm:*static-space-free-pointer*) - (inst lea result (make-ea :byte :base temp :disp other-pointer-type)) + (inst lea result (make-ea :byte :base temp :disp other-pointer-lowtag)) (inst add temp boxed) (inst add temp unboxed) (store-symbol-value temp sb!vm:*static-space-free-pointer*) (inst shl boxed (- type-bits word-shift)) (inst or boxed code-header-type) - (storew boxed result 0 other-pointer-type) - (storew unboxed result code-code-size-slot other-pointer-type) + (storew boxed result 0 other-pointer-lowtag) + (storew unboxed result code-code-size-slot other-pointer-lowtag) (inst mov temp nil-value) - (storew temp result code-entry-points-slot other-pointer-type)) - (storew temp result code-debug-info-slot other-pointer-type))) + (storew temp result code-entry-points-slot other-pointer-lowtag)) + (storew temp result code-debug-info-slot other-pointer-lowtag))) (define-vop (allocate-dynamic-code-object) (:args (boxed-arg :scs (any-reg) :target boxed) @@ -130,13 +130,13 @@ (inst add result unboxed) (pseudo-atomic (allocation result result node) - (inst lea result (make-ea :byte :base result :disp other-pointer-type)) + (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag)) (inst shl boxed (- type-bits word-shift)) (inst or boxed code-header-type) - (storew boxed result 0 other-pointer-type) - (storew unboxed result code-code-size-slot other-pointer-type) - (storew nil-value result code-entry-points-slot other-pointer-type)) - (storew nil-value result code-debug-info-slot other-pointer-type))) + (storew boxed result 0 other-pointer-lowtag) + (storew unboxed result code-code-size-slot other-pointer-lowtag) + (storew nil-value result code-entry-points-slot other-pointer-lowtag)) + (storew nil-value result code-debug-info-slot other-pointer-lowtag))) (define-vop (make-fdefn) (:policy :fast-safe) @@ -146,10 +146,10 @@ (:node-var node) (:generator 37 (with-fixed-allocation (result fdefn-type fdefn-size node) - (storew name result fdefn-name-slot other-pointer-type) - (storew nil-value result fdefn-fun-slot other-pointer-type) + (storew name result fdefn-name-slot other-pointer-lowtag) + (storew nil-value result fdefn-fun-slot other-pointer-lowtag) (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) - result fdefn-raw-addr-slot other-pointer-type)))) + result fdefn-raw-addr-slot other-pointer-lowtag)))) (define-vop (make-closure) (:args (function :to :save :scs (descriptor-reg))) @@ -162,11 +162,11 @@ (let ((size (+ length closure-info-offset))) (allocation result (pad-data-block size) node) (inst lea result - (make-ea :byte :base result :disp fun-pointer-type)) + (make-ea :byte :base result :disp fun-pointer-lowtag)) (storew (logior (ash (1- size) type-bits) closure-header-type) - result 0 fun-pointer-type)) - (loadw temp function closure-fun-slot fun-pointer-type) - (storew temp result closure-fun-slot fun-pointer-type)))) + result 0 fun-pointer-lowtag)) + (loadw temp function closure-fun-slot fun-pointer-lowtag) + (storew temp result closure-fun-slot fun-pointer-lowtag)))) ;;; The compiler likes to be able to directly make value cells. (define-vop (make-value-cell) @@ -176,7 +176,7 @@ (:generator 10 (with-fixed-allocation (result value-cell-header-type value-cell-size node)) - (storew value result value-cell-value-slot other-pointer-type))) + (storew value result value-cell-value-slot other-pointer-lowtag))) ;;;; automatic allocators for primitive objects @@ -231,8 +231,8 @@ (:node-var node) (:generator 37 (with-fixed-allocation (result symbol-header-type symbol-size node) - (storew name result symbol-name-slot other-pointer-type) - (storew unbound-marker-type result symbol-value-slot other-pointer-type) + (storew name result symbol-name-slot other-pointer-lowtag) + (storew unbound-marker-type result symbol-value-slot other-pointer-lowtag) ;; Set up a random hash value for the symbol. Perhaps the object ;; address could be used for even faster and smaller code! ;; FIXME: We don't mind the symbol hash not being repeatable, so @@ -247,6 +247,6 @@ ;; We want a positive fixnum for the hash value, so discard the LS bits. (inst shr temp 1) (inst and temp #xfffffffc) - (storew temp result symbol-hash-slot other-pointer-type) - (storew nil-value result symbol-plist-slot other-pointer-type) - (storew nil-value result symbol-package-slot other-pointer-type)))) + (storew temp result symbol-hash-slot other-pointer-lowtag) + (storew nil-value result symbol-plist-slot other-pointer-lowtag) + (storew nil-value result symbol-package-slot other-pointer-lowtag)))) diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index cdadbb2..e8234cb 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1073,10 +1073,10 @@ (:translate sb!bignum::%bignum-set-length) (:policy :fast-safe)) -(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-type +(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum::%bignum-ref) -(define-full-setter bignum-set * bignum-digits-offset other-pointer-type +(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum::%bignum-set) (define-vop (digit-0-or-plus) @@ -1334,7 +1334,7 @@ (inst mov k (make-ea :dword :base state :disp (- (* (+ 2 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (inst cmp k 624) (inst jmp :ne no-update) (inst mov tmp state) ; The state is passed in EAX. @@ -1346,13 +1346,13 @@ (inst mov y (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) ;; y ^= (y >> 11); (inst shr y 11) (inst xor y (make-ea :dword :base state :index k :scale 4 :disp (- (* (+ 3 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) ;; y ^= (y << 7) & #x9d2c5680 (inst mov tmp y) (inst inc k) @@ -1360,7 +1360,7 @@ (inst mov (make-ea :dword :base state :disp (- (* (+ 2 sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type)) + sb!vm:other-pointer-lowtag)) k) (inst and tmp #x9d2c5680) (inst xor y tmp) diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp index 2666d4d..670910f 100644 --- a/src/compiler/x86/array.lisp +++ b/src/compiler/x86/array.lisp @@ -36,8 +36,8 @@ (inst shr header 2) (pseudo-atomic (allocation result bytes node) - (inst lea result (make-ea :dword :base result :disp other-pointer-type)) - (storew header result 0 other-pointer-type)))) + (inst lea result (make-ea :dword :base result :disp other-pointer-lowtag)) + (storew header result 0 other-pointer-lowtag)))) ;;;; additional accessors and setters for the array header @@ -47,11 +47,11 @@ ()) (define-full-reffer %array-dimension * - array-dimensions-offset other-pointer-type + array-dimensions-offset other-pointer-lowtag (any-reg) positive-fixnum sb!impl::%array-dimension) (define-full-setter %set-array-dimension * - array-dimensions-offset other-pointer-type + array-dimensions-offset other-pointer-lowtag (any-reg) positive-fixnum sb!impl::%set-array-dimension) (defknown sb!impl::%array-rank (t) index (flushable)) @@ -63,7 +63,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 other-pointer-type) + (loadw res x 0 other-pointer-lowtag) (inst shr res type-bits) (inst sub res (1- array-dimensions-offset)))) @@ -105,10 +105,10 @@ (macrolet ((def-full-data-vector-frobs (type element-type &rest scs) `(progn (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) - ,type vector-data-offset other-pointer-type ,scs + ,type vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-ref) (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) - ,type vector-data-offset other-pointer-type ,scs + ,type vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-set)))) (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg) (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num @@ -140,7 +140,7 @@ (inst mov result (make-ea :dword :base object :index ecx :scale 4 :disp (- (* vector-data-offset word-bytes) - other-pointer-type))) + other-pointer-lowtag))) (move ecx index) (inst and ecx ,(1- elements-per-word)) ,@(unless (= bits 1) @@ -158,7 +158,7 @@ (:generator 15 (multiple-value-bind (word extra) (floor index ,elements-per-word) (loadw result object (+ word vector-data-offset) - other-pointer-type) + other-pointer-lowtag) (unless (zerop extra) (inst shr result (* extra ,bits))) (unless (= extra ,(1- elements-per-word)) @@ -183,7 +183,7 @@ (inst lea ptr (make-ea :dword :base object :index word-index :scale 4 :disp (- (* vector-data-offset word-bytes) - other-pointer-type))) + other-pointer-lowtag))) (loadw old ptr) (move ecx index) (inst and ecx ,(1- elements-per-word)) @@ -221,7 +221,7 @@ (inst mov old (make-ea :dword :base object :disp (- (* (+ word vector-data-offset) word-bytes) - other-pointer-type))) + other-pointer-lowtag))) (sc-case value (immediate (let* ((value (tn-value value)) @@ -241,7 +241,7 @@ (inst mov (make-ea :dword :base object :disp (- (* (+ word vector-data-offset) word-bytes) - other-pointer-type)) + other-pointer-lowtag)) old) (sc-case value (immediate @@ -267,7 +267,7 @@ (with-empty-tn@fp-top(value) (inst fld (make-ea :dword :base object :index index :scale 1 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)))))) + sb!vm:other-pointer-lowtag)))))) (define-vop (data-vector-ref-c/simple-array-single-float) (:note "inline array access") @@ -284,7 +284,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 4 index)) - sb!vm:other-pointer-type)))))) + sb!vm:other-pointer-lowtag)))))) (define-vop (data-vector-set/simple-array-single-float) (:note "inline array store") @@ -302,7 +302,7 @@ (inst fst (make-ea :dword :base object :index index :scale 1 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fst result))) @@ -312,7 +312,7 @@ (inst fst (make-ea :dword :base object :index index :scale 1 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fst value)) @@ -340,7 +340,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 4 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fst result))) @@ -351,7 +351,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 4 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fst value)) @@ -374,7 +374,7 @@ (with-empty-tn@fp-top(value) (inst fldd (make-ea :dword :base object :index index :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)))))) + sb!vm:other-pointer-lowtag)))))) (define-vop (data-vector-ref-c/simple-array-double-float) (:note "inline array access") @@ -391,7 +391,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index)) - sb!vm:other-pointer-type)))))) + sb!vm:other-pointer-lowtag)))))) (define-vop (data-vector-set/simple-array-double-float) (:note "inline array store") @@ -409,7 +409,7 @@ (inst fstd (make-ea :dword :base object :index index :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -419,7 +419,7 @@ (inst fstd (make-ea :dword :base object :index index :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -447,7 +447,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -458,7 +458,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -486,7 +486,7 @@ (inst fldl (make-ea :dword :base object :index temp :scale 1 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)))))) + sb!vm:other-pointer-lowtag)))))) #!+long-float (define-vop (data-vector-ref-c/simple-array-long-float) @@ -504,7 +504,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 12 index)) - sb!vm:other-pointer-type)))))) + sb!vm:other-pointer-lowtag)))))) #!+long-float (define-vop (data-vector-set/simple-array-long-float) @@ -526,7 +526,7 @@ (store-long-float (make-ea :dword :base object :index temp :scale 1 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -536,7 +536,7 @@ (store-long-float (make-ea :dword :base object :index temp :scale 1 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -564,7 +564,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 12 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -575,7 +575,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 12 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -602,13 +602,13 @@ (inst fld (make-ea :dword :base object :index index :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (let ((imag-tn (complex-single-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fld (make-ea :dword :base object :index index :scale 2 :disp (- (* (1+ sb!vm:vector-data-offset) sb!vm:word-bytes) - sb!vm:other-pointer-type))))))) + sb!vm:other-pointer-lowtag))))))) (define-vop (data-vector-ref-c/simple-array-complex-single-float) (:note "inline array access") @@ -626,14 +626,14 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index)) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (let ((imag-tn (complex-single-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fld (make-ea :dword :base object :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index) 4) - sb!vm:other-pointer-type))))))) + sb!vm:other-pointer-lowtag))))))) (define-vop (data-vector-set/simple-array-complex-single-float) (:note "inline array store") @@ -654,7 +654,7 @@ (inst fst (make-ea :dword :base object :index index :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fst result-real))) @@ -664,7 +664,7 @@ (inst fst (make-ea :dword :base object :index index :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fst value-real)) @@ -680,7 +680,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 4) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fst result-imag)) (inst fxch value-imag)))) @@ -705,7 +705,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fst result-real))) @@ -716,7 +716,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fst value-real)) @@ -732,7 +732,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 8 index) 4) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fst result-imag)) (inst fxch value-imag)))) @@ -753,14 +753,14 @@ (inst fldd (make-ea :dword :base object :index index :scale 4 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (let ((imag-tn (complex-double-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldd (make-ea :dword :base object :index index :scale 4 :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 8) - sb!vm:other-pointer-type))))))) + sb!vm:other-pointer-lowtag))))))) (define-vop (data-vector-ref-c/simple-array-complex-double-float) (:note "inline array access") @@ -778,14 +778,14 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 16 index)) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (let ((imag-tn (complex-double-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldd (make-ea :dword :base object :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 16 index) 8) - sb!vm:other-pointer-type))))))) + sb!vm:other-pointer-lowtag))))))) (define-vop (data-vector-set/simple-array-complex-double-float) (:note "inline array store") @@ -806,7 +806,7 @@ (inst fstd (make-ea :dword :base object :index index :scale 4 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -816,7 +816,7 @@ (inst fstd (make-ea :dword :base object :index index :scale 4 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -832,7 +832,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 8) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) @@ -857,7 +857,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 16 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -868,7 +868,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 16 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -884,7 +884,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 16 index) 8) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) @@ -909,14 +909,14 @@ (inst fldl (make-ea :dword :base object :index temp :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (let ((imag-tn (complex-long-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldl (make-ea :dword :base object :index temp :scale 2 :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 12) - sb!vm:other-pointer-type))))))) + sb!vm:other-pointer-lowtag))))))) #!+long-float (define-vop (data-vector-ref-c/simple-array-complex-long-float) @@ -935,14 +935,14 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 24 index)) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (let ((imag-tn (complex-long-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldl (make-ea :dword :base object :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 24 index) 12) - sb!vm:other-pointer-type))))))) + sb!vm:other-pointer-lowtag))))))) #!+long-float (define-vop (data-vector-set/simple-array-complex-long-float) @@ -967,7 +967,7 @@ (store-long-float (make-ea :dword :base object :index temp :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -977,7 +977,7 @@ (store-long-float (make-ea :dword :base object :index temp :scale 2 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -992,7 +992,7 @@ (store-long-float (make-ea :dword :base object :index temp :scale 2 :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 12) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) @@ -1019,7 +1019,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 24 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -1031,7 +1031,7 @@ :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) (* 24 index)) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -1053,7 +1053,7 @@ ;; instead of appearing to flirt with supporting ;; this maintenance nightmare. (* 24 index) 12) - sb!vm:other-pointer-type))) + sb!vm:other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) @@ -1072,7 +1072,7 @@ (inst movzx value (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-ref-c/simple-array-unsigned-byte-8) (:translate data-vector-ref) @@ -1086,7 +1086,7 @@ (inst movzx value (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-set/simple-array-unsigned-byte-8) (:translate data-vector-set) @@ -1104,7 +1104,7 @@ (move eax value) (inst mov (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) + other-pointer-lowtag)) al-tn) (move result eax))) @@ -1125,7 +1125,7 @@ (move eax value) (inst mov (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type)) + other-pointer-lowtag)) al-tn) (move result eax))) @@ -1143,7 +1143,7 @@ (inst movzx value (make-ea :word :base object :index index :scale 2 :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-ref-c/simple-array-unsigned-byte-16) (:translate data-vector-ref) @@ -1157,7 +1157,7 @@ (inst movzx value (make-ea :word :base object :disp (- (+ (* vector-data-offset word-bytes) (* 2 index)) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-set/simple-array-unsigned-byte-16) (:translate data-vector-set) @@ -1175,7 +1175,7 @@ (move eax value) (inst mov (make-ea :word :base object :index index :scale 2 :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) + other-pointer-lowtag)) ax-tn) (move result eax))) @@ -1197,7 +1197,7 @@ (inst mov (make-ea :word :base object :disp (- (+ (* vector-data-offset word-bytes) (* 2 index)) - other-pointer-type)) + other-pointer-lowtag)) ax-tn) (move result eax))) @@ -1221,7 +1221,7 @@ (inst mov al-tn (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) - other-pointer-type))) + other-pointer-lowtag))) (move value al-tn))) (define-vop (data-vector-ref-c/simple-string) @@ -1240,7 +1240,7 @@ (inst mov al-tn (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type))) + other-pointer-lowtag))) (move value al-tn))) (define-vop (data-vector-set/simple-string) @@ -1255,7 +1255,7 @@ (:generator 5 (inst mov (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) + other-pointer-lowtag)) value) (move result value))) @@ -1271,7 +1271,7 @@ (:generator 4 (inst mov (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type)) + other-pointer-lowtag)) value) (move result value))) @@ -1289,7 +1289,7 @@ (inst movsx value (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-ref-c/simple-array-signed-byte-8) (:translate data-vector-ref) @@ -1303,7 +1303,7 @@ (inst movsx value (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-set/simple-array-signed-byte-8) (:translate data-vector-set) @@ -1321,7 +1321,7 @@ (move eax value) (inst mov (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) + other-pointer-lowtag)) al-tn) (move result eax))) @@ -1342,7 +1342,7 @@ (move eax value) (inst mov (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) - other-pointer-type)) + other-pointer-lowtag)) al-tn) (move result eax))) @@ -1360,7 +1360,7 @@ (inst movsx value (make-ea :word :base object :index index :scale 2 :disp (- (* vector-data-offset word-bytes) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-ref-c/simple-array-signed-byte-16) (:translate data-vector-ref) @@ -1375,7 +1375,7 @@ (make-ea :word :base object :disp (- (+ (* vector-data-offset word-bytes) (* 2 index)) - other-pointer-type))))) + other-pointer-lowtag))))) (define-vop (data-vector-set/simple-array-signed-byte-16) (:translate data-vector-set) @@ -1393,7 +1393,7 @@ (move eax value) (inst mov (make-ea :word :base object :index index :scale 2 :disp (- (* vector-data-offset word-bytes) - other-pointer-type)) + other-pointer-lowtag)) ax-tn) (move result eax))) @@ -1415,7 +1415,7 @@ (make-ea :word :base object :disp (- (+ (* vector-data-offset word-bytes) (* 2 index)) - other-pointer-type)) + other-pointer-lowtag)) ax-tn) (move result eax))) @@ -1527,9 +1527,9 @@ ;;; These vops are useful for accessing the bits of a vector ;;; irrespective of what type of vector it is. -(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) +(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) +(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num %set-raw-bits) ;;;; miscellaneous array VOPs diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index ac142f2..0db8dd1 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -218,7 +218,7 @@ :disp (+ nil-value (static-symbol-offset '*alien-stack*) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) delta))) (load-symbol-value result *alien-stack*))) @@ -231,5 +231,5 @@ :disp (+ nil-value (static-symbol-offset '*alien-stack*) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) delta))))) diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index a393bd4..f63ec9b 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -911,9 +911,9 @@ (make-ea :dword :base eax :disp ,(if named '(- (* fdefn-raw-addr-slot word-bytes) - other-pointer-type) + other-pointer-lowtag) '(- (* closure-fun-slot word-bytes) - fun-pointer-type)))) + fun-pointer-lowtag)))) ,@(ecase return (:fixed '((default-unknown-values vop values nvals))) @@ -1305,7 +1305,7 @@ (inst lea dst (make-ea :dword :index ecx :scale 2)) (pseudo-atomic (allocation dst dst node) - (inst lea dst (make-ea :byte :base dst :disp list-pointer-type)) + (inst lea dst (make-ea :byte :base dst :disp list-pointer-lowtag)) ;; Convert the count into a raw value, so that we can use the LOOP inst. (inst shr ecx 2) ;; Set decrement mode (successive args at lower addresses) @@ -1319,26 +1319,27 @@ ;; Compute a pointer to the next cons. (inst add dst (* cons-size word-bytes)) ;; Store a pointer to this cons in the CDR of the previous cons. - (storew dst dst -1 list-pointer-type) + (storew dst dst -1 list-pointer-lowtag) (emit-label enter) ;; Grab one value and stash it in the car of this cons. (inst lods eax) - (storew eax dst 0 list-pointer-type) + (storew eax dst 0 list-pointer-lowtag) ;; Go back for more. (inst loop loop) ;; NIL out the last cons. - (storew nil-value dst 1 sb!vm:list-pointer-type)) + (storew nil-value dst 1 sb!vm:list-pointer-lowtag)) (emit-label done)))) -;;; Return the location and size of the more arg glob created by Copy-More-Arg. -;;; Supplied is the total number of arguments supplied (originally passed in -;;; ECX.) Fixed is the number of non-rest arguments. +;;; Return the location and size of the &MORE arg glob created by +;;; COPY-MORE-Arg. SUPPLIED is the total number of arguments supplied +;;; (originally passed in ECX). FIXED is the number of non-rest +;;; arguments. ;;; -;;; We must duplicate some of the work done by Copy-More-Arg, since at that -;;; time the environment is in a pretty brain-damaged state, preventing this -;;; info from being returned as values. What we do is compute -;;; supplied - fixed, and return a pointer that many words below the current -;;; stack top. +;;; We must duplicate some of the work done by COPY-MORE-ARG, since at +;;; that time the environment is in a pretty brain-damaged state, +;;; preventing this info from being returned as values. What we do is +;;; compute supplied - fixed, and return a pointer that many words +;;; below the current stack top. (define-vop (more-arg-context) (:policy :fast-safe) (:translate sb!c::%more-arg-context) @@ -1359,7 +1360,7 @@ (unless (zerop fixed) (inst sub count (fixnumize fixed))))) -;;; Signal wrong argument count error if Nargs isn't = to Count. +;;; Signal wrong argument count error if NARGS isn't equal to COUNT. (define-vop (verify-argument-count) (:policy :fast-safe) (:translate sb!c::%verify-argument-count) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 34e6f72..4ecdedf 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -57,7 +57,7 @@ ;;; The compiler likes to be able to directly SET symbols. (define-vop (set cell-set) - (:variant symbol-value-slot other-pointer-type)) + (:variant symbol-value-slot other-pointer-lowtag)) ;;; Do a cell ref with an error check for being unbound. (define-vop (checked-cell-ref) @@ -79,18 +79,18 @@ (:save-p :compute-only) (:generator 9 (let ((err-lab (generate-error-code vop unbound-symbol-error object))) - (loadw value object symbol-value-slot other-pointer-type) + (loadw value object symbol-value-slot other-pointer-lowtag) (inst cmp value unbound-marker-type) (inst jmp :e err-lab)))) (define-vop (fast-symbol-value cell-ref) - (:variant symbol-value-slot other-pointer-type) + (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate symbol-value)) (defknown fast-symbol-value-xadd (symbol fixnum) fixnum ()) (define-vop (fast-symbol-value-xadd cell-xadd) - (:variant symbol-value-slot other-pointer-type) + (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate fast-symbol-value-xadd) (:arg-types * tagged-num)) @@ -103,7 +103,7 @@ (:info target not-p) (:temporary (:sc descriptor-reg :from (:argument 0)) value) (:generator 9 - (loadw value object symbol-value-slot other-pointer-type) + (loadw value object symbol-value-slot other-pointer-lowtag) (inst cmp value unbound-marker-type) (inst jmp (if not-p :e :ne) target))) @@ -123,13 +123,13 @@ ;; is the second slot, and offset 0 = tags and stuff (and CAR slot in ;; a CONS), offset 1 = value slot (and CDR slot in a CONS), and ;; offset 2 = hash slot. - (loadw res symbol symbol-hash-slot other-pointer-type) + (loadw res symbol symbol-hash-slot other-pointer-lowtag) (inst and res (lognot #b11)))) ;;;; fdefinition (FDEFN) objects (define-vop (fdefn-fun cell-ref) ; /pfw - alpha - (:variant fdefn-fun-slot other-pointer-type)) + (:variant fdefn-fun-slot other-pointer-lowtag)) (define-vop (safe-fdefn-fun) (:args (object :scs (descriptor-reg) :to (:result 1))) @@ -137,7 +137,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 10 - (loadw value object fdefn-fun-slot other-pointer-type) + (loadw value object fdefn-fun-slot other-pointer-lowtag) (inst cmp value nil-value) ;; FIXME: UNDEFINED-SYMBOL-ERROR seems to actually be for symbols with no ;; function value, not, as the name might suggest, symbols with no ordinary @@ -154,17 +154,17 @@ (:temporary (:sc byte-reg) type) (:results (result :scs (descriptor-reg))) (:generator 38 - (load-type type function (- fun-pointer-type)) + (load-type type function (- fun-pointer-lowtag)) (inst lea raw (make-ea :byte :base function :disp (- (* simple-fun-code-offset word-bytes) - fun-pointer-type))) + fun-pointer-lowtag))) (inst cmp type simple-fun-header-type) (inst jmp :e normal-fn) (inst lea raw (make-fixup (extern-alien-name "closure_tramp") :foreign)) NORMAL-FN - (storew function fdefn fdefn-fun-slot other-pointer-type) - (storew raw fdefn fdefn-raw-addr-slot other-pointer-type) + (storew function fdefn fdefn-fun-slot other-pointer-lowtag) + (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag) (move result function))) (define-vop (fdefn-makunbound) @@ -173,9 +173,9 @@ (:args (fdefn :scs (descriptor-reg) :target result)) (:results (result :scs (descriptor-reg))) (:generator 38 - (storew nil-value fdefn fdefn-fun-slot other-pointer-type) + (storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag) (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) - fdefn fdefn-raw-addr-slot other-pointer-type) + fdefn fdefn-raw-addr-slot other-pointer-lowtag) (move result fdefn))) ;;;; binding and unbinding @@ -190,12 +190,12 @@ (:temporary (:sc unsigned-reg) temp bsp) (:generator 5 (load-symbol-value bsp *binding-stack-pointer*) - (loadw temp symbol symbol-value-slot other-pointer-type) + (loadw temp symbol symbol-value-slot other-pointer-lowtag) (inst add bsp (* binding-size word-bytes)) (store-symbol-value bsp *binding-stack-pointer*) (storew temp bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) - (storew val symbol symbol-value-slot other-pointer-type))) + (storew val symbol symbol-value-slot other-pointer-lowtag))) (define-vop (unbind) (:temporary (:sc unsigned-reg) symbol value bsp) @@ -203,7 +203,7 @@ (load-symbol-value bsp *binding-stack-pointer*) (loadw symbol bsp (- binding-symbol-slot binding-size)) (loadw value bsp (- binding-value-slot binding-size)) - (storew value symbol symbol-value-slot other-pointer-type) + (storew value symbol symbol-value-slot other-pointer-lowtag) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) @@ -221,7 +221,7 @@ (inst or symbol symbol) (inst jmp :z skip) (loadw value bsp (- binding-value-slot binding-size)) - (storew value symbol symbol-value-slot other-pointer-type) + (storew value symbol symbol-value-slot other-pointer-lowtag) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP @@ -235,33 +235,33 @@ ;;;; closure indexing (define-full-reffer closure-index-ref * - closure-info-offset fun-pointer-type + closure-info-offset fun-pointer-lowtag (any-reg descriptor-reg) * %closure-index-ref) (define-full-setter set-funcallable-instance-info * - funcallable-instance-info-offset fun-pointer-type + funcallable-instance-info-offset fun-pointer-lowtag (any-reg descriptor-reg) * %set-funcallable-instance-info) (define-full-reffer funcallable-instance-info * - funcallable-instance-info-offset fun-pointer-type + funcallable-instance-info-offset fun-pointer-lowtag (descriptor-reg any-reg) * %funcallable-instance-info) (define-vop (funcallable-instance-lexenv cell-ref) - (:variant funcallable-instance-lexenv-slot fun-pointer-type)) + (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag)) (define-vop (closure-ref slot-ref) - (:variant closure-info-offset fun-pointer-type)) + (:variant closure-info-offset fun-pointer-lowtag)) (define-vop (closure-init slot-set) - (:variant closure-info-offset fun-pointer-type)) + (:variant closure-info-offset fun-pointer-lowtag)) ;;;; value cell hackery (define-vop (value-cell-ref cell-ref) - (:variant value-cell-value-slot other-pointer-type)) + (:variant value-cell-value-slot other-pointer-lowtag)) (define-vop (value-cell-set cell-set) - (:variant value-cell-value-slot other-pointer-type)) + (:variant value-cell-value-slot other-pointer-lowtag)) ;;;; structure hackery @@ -272,11 +272,11 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 4 - (loadw res struct 0 instance-pointer-type) + (loadw res struct 0 instance-pointer-lowtag) (inst shr res type-bits))) (define-vop (instance-ref slot-ref) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:policy :fast-safe) (:translate %instance-ref) (:arg-types instance (:constant index))) @@ -284,14 +284,14 @@ (define-vop (instance-set slot-set) (:policy :fast-safe) (:translate %instance-set) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:arg-types instance (:constant index) *)) (define-full-reffer instance-index-ref * instance-slots-offset - instance-pointer-type (any-reg descriptor-reg) * %instance-ref) + instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref) (define-full-setter instance-index-set * instance-slots-offset - instance-pointer-type (any-reg descriptor-reg) * %instance-set) + instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set) (defknown sb!kernel::%instance-set-conditional (instance index t t) t (unsafe)) @@ -299,7 +299,7 @@ (define-vop (instance-set-conditional-c slot-set-conditional) (:policy :fast-safe) (:translate sb!kernel::%instance-set-conditional) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:arg-types instance (:constant index) * *)) (define-vop (instance-set-conditional) @@ -319,7 +319,7 @@ (move temp new-value) (inst cmpxchg (make-ea :dword :base object :index slot :scale 1 :disp (- (* instance-slots-offset word-bytes) - instance-pointer-type)) + instance-pointer-lowtag)) temp) (move result eax))) @@ -327,13 +327,13 @@ (define-vop (instance-xadd-c slot-xadd) (:policy :fast-safe) (:translate %instance-xadd) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:arg-types instance (:constant index) tagged-num)) ;;;; code object frobbing -(define-full-reffer code-header-ref * 0 other-pointer-type +(define-full-reffer code-header-ref * 0 other-pointer-lowtag (any-reg descriptor-reg) * code-header-ref) -(define-full-setter code-header-set * 0 other-pointer-type +(define-full-setter code-header-set * 0 other-pointer-lowtag (any-reg descriptor-reg) * code-header-set) diff --git a/src/compiler/x86/debug.lisp b/src/compiler/x86/debug.lisp index e3c405b..5d49b9f 100644 --- a/src/compiler/x86/debug.lisp +++ b/src/compiler/x86/debug.lisp @@ -102,8 +102,8 @@ (inst shr temp type-bits) (inst jmp :z bogus) (inst shl temp (1- (integer-length word-bytes))) - (unless (= lowtag other-pointer-type) - (inst add temp (- lowtag other-pointer-type))) + (unless (= lowtag other-pointer-lowtag) + (inst add temp (- lowtag other-pointer-lowtag))) (move code thing) (inst sub code temp) (emit-label done) @@ -114,11 +114,11 @@ (define-vop (code-from-lra code-from-mumble) (:translate sb!di::lra-code-header) - (:variant other-pointer-type)) + (:variant other-pointer-lowtag)) (define-vop (code-from-function code-from-mumble) (:translate sb!di::fun-code-header) - (:variant fun-pointer-type)) + (:variant fun-pointer-lowtag)) (define-vop (make-lisp-obj) (:policy :fast-safe) @@ -150,5 +150,5 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 5 - (loadw res fun 0 fun-pointer-type) + (loadw res fun 0 fun-pointer-lowtag) (inst shr res type-bits))) diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index de09877..6c02f92 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -14,7 +14,8 @@ (macrolet ((ea-for-xf-desc (tn slot) `(make-ea :dword :base ,tn - :disp (- (* ,slot sb!vm:word-bytes) sb!vm:other-pointer-type)))) + :disp (- (* ,slot sb!vm:word-bytes) + sb!vm:other-pointer-lowtag)))) (defun ea-for-sf-desc (tn) (ea-for-xf-desc tn sb!vm:single-float-value-slot)) (defun ea-for-df-desc (tn) @@ -1895,7 +1896,7 @@ (descriptor-reg (loadw bits float sb!vm:single-float-value-slot - sb!vm:other-pointer-type)))) + sb!vm:other-pointer-lowtag)))) (signed-stack (sc-case float (single-reg @@ -1925,7 +1926,7 @@ (loadw hi-bits ebp-tn (- (1+ (tn-offset float))))) (descriptor-reg (loadw hi-bits float (1+ sb!vm:double-float-value-slot) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) (define-vop (double-float-low-bits) (:args (float :scs (double-reg descriptor-reg) @@ -1950,7 +1951,7 @@ (loadw lo-bits ebp-tn (- (+ 2 (tn-offset float))))) (descriptor-reg (loadw lo-bits float sb!vm:double-float-value-slot - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) #!+long-float (define-vop (long-float-exp-bits) @@ -1983,7 +1984,7 @@ (make-ea :word :base float :disp (- (* (+ 2 sb!vm:long-float-value-slot) word-bytes) - sb!vm:other-pointer-type))))))) + sb!vm:other-pointer-lowtag))))))) #!+long-float (define-vop (long-float-high-bits) @@ -2009,7 +2010,7 @@ (loadw hi-bits ebp-tn (- (+ (tn-offset float) 2)))) (descriptor-reg (loadw hi-bits float (1+ sb!vm:long-float-value-slot) - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) #!+long-float (define-vop (long-float-low-bits) @@ -2035,7 +2036,7 @@ (loadw lo-bits ebp-tn (- (+ (tn-offset float) 3)))) (descriptor-reg (loadw lo-bits float sb!vm:long-float-value-slot - sb!vm:other-pointer-type))))) + sb!vm:other-pointer-lowtag))))) ;;;; float mode hackery diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 36d91bc..ce3d4ae 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -618,7 +618,7 @@ (- (+ (component-header-length) (or (label-position offset) 0)) - other-pointer-type)))) + other-pointer-lowtag)))) (emit-dword segment (or offset 0))))) (defun emit-relative-fixup (segment fixup) @@ -694,7 +694,7 @@ (make-fixup nil :code-object (- (* (tn-offset thing) word-bytes) - other-pointer-type)))))) + other-pointer-lowtag)))))) (ea (let* ((base (ea-base thing)) (index (ea-index thing)) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index b82ca88..f58e94a 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -73,7 +73,7 @@ :disp (+ nil-value (static-symbol-offset ',symbol) (ash symbol-value-slot word-shift) - (- other-pointer-type))))) + (- other-pointer-lowtag))))) (defmacro store-symbol-value (reg symbol) `(inst mov @@ -81,7 +81,7 @@ :disp (+ nil-value (static-symbol-offset ',symbol) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) ,reg)) @@ -267,7 +267,7 @@ (allocation ,result-tn (pad-data-block ,size) ,inline) (storew (logior (ash (1- ,size) sb!vm:type-bits) ,type-code) ,result-tn) (inst lea ,result-tn - (make-ea :byte :base ,result-tn :disp other-pointer-type)) + (make-ea :byte :base ,result-tn :disp other-pointer-lowtag)) ,@forms)) ;;;; error code @@ -386,13 +386,13 @@ (ash symbol-value-slot word-shift) ;; FIXME: Use mask, not minus, to ;; take out type bits. - (- other-pointer-type))) + (- other-pointer-lowtag))) 0) (inst mov (make-ea :byte :disp (+ nil-value (static-symbol-offset '*pseudo-atomic-atomic*) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) (fixnumize 1))) ,@forms (when *enable-pseudo-atomic* @@ -400,7 +400,7 @@ (static-symbol-offset '*pseudo-atomic-atomic*) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) 0) ;; KLUDGE: Is there any requirement for interrupts to be ;; handled in order? It seems as though an interrupt coming @@ -413,7 +413,7 @@ (static-symbol-offset '*pseudo-atomic-interrupted*) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) 0) (inst jmp :eq ,label) (inst break pending-interrupt-trap) diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 6edc3fc..e18721d 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -218,7 +218,7 @@ (move eax x) (inst test al-tn 3) (inst jmp :z fixnum) - (loadw y eax bignum-digits-offset other-pointer-type) + (loadw y eax bignum-digits-offset other-pointer-lowtag) (inst jmp done) FIXNUM (inst sar eax 2) @@ -307,7 +307,7 @@ (emit-label bignum) (with-fixed-allocation (y bignum-type (+ bignum-digits-offset 1) node) - (storew x y bignum-digits-offset other-pointer-type)) + (storew x y bignum-digits-offset other-pointer-lowtag)) (inst jmp done))))) (define-move-vop move-from-signed :move (signed-reg) (descriptor-reg)) @@ -376,8 +376,8 @@ (pseudo-atomic (allocation alloc (pad-data-block (+ bignum-digits-offset 2)) node) (storew y alloc) - (inst lea y (make-ea :byte :base alloc :disp other-pointer-type)) - (storew x y bignum-digits-offset other-pointer-type)) + (inst lea y (make-ea :byte :base alloc :disp other-pointer-lowtag)) + (storew x y bignum-digits-offset other-pointer-lowtag)) (inst jmp done))))) (define-move-vop move-from-unsigned :move (unsigned-reg) (descriptor-reg)) diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index b9e6bcd..dda9c16 100644 --- a/src/compiler/x86/sap.lisp +++ b/src/compiler/x86/sap.lisp @@ -19,7 +19,7 @@ (:results (y :scs (sap-reg))) (:note "pointer to SAP coercion") (:generator 1 - (loadw y x sap-pointer-slot other-pointer-type))) + (loadw y x sap-pointer-slot other-pointer-lowtag))) (define-move-vop move-to-sap :move (descriptor-reg) (sap-reg)) @@ -31,7 +31,7 @@ (:node-var node) (:generator 20 (with-fixed-allocation (res sap-type sap-size node) - (storew sap res sap-pointer-slot other-pointer-type)))) + (storew sap res sap-pointer-slot other-pointer-lowtag)))) (define-move-vop move-from-sap :move (sap-reg) (descriptor-reg)) @@ -496,4 +496,4 @@ (:result-types system-area-pointer) (:generator 2 (move sap vector) - (inst add sap (- (* vector-data-offset word-bytes) other-pointer-type)))) + (inst add sap (- (* vector-data-offset word-bytes) other-pointer-lowtag)))) diff --git a/src/compiler/x86/subprim.lisp b/src/compiler/x86/subprim.lisp index da3d809..1dbdc40 100644 --- a/src/compiler/x86/subprim.lisp +++ b/src/compiler/x86/subprim.lisp @@ -36,7 +36,7 @@ ;; list, because this is a :fast-safe vop. LOOP ;; Get the CDR and boost the count. - (loadw ptr ptr cons-cdr-slot list-pointer-type) + (loadw ptr ptr cons-cdr-slot list-pointer-lowtag) (inst add count (fixnumize 1)) ;; If we hit NIL, then we are done. (inst cmp ptr nil-value) @@ -45,7 +45,7 @@ ;; not, loop back for more. (move eax ptr) (inst and al-tn lowtag-mask) - (inst cmp al-tn list-pointer-type) + (inst cmp al-tn list-pointer-lowtag) (inst jmp :e loop) ;; It's dotted all right. Flame out. (error-call vop object-not-list-error ptr) @@ -72,7 +72,7 @@ (inst jmp :e done) ;; Indirect the next cons cell, and boost the count. LOOP - (loadw ptr ptr cons-cdr-slot list-pointer-type) + (loadw ptr ptr cons-cdr-slot list-pointer-lowtag) (inst add count (fixnumize 1)) ;; If we aren't done, go back for more. (inst cmp ptr nil-value) diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index b6e5884..3b17ce6 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -34,9 +34,9 @@ (:generator 6 (inst mov eax object) (inst and al-tn lowtag-mask) - (inst cmp al-tn other-pointer-type) + (inst cmp al-tn other-pointer-lowtag) (inst jmp :e other-ptr) - (inst cmp al-tn fun-pointer-type) + (inst cmp al-tn fun-pointer-lowtag) (inst jmp :e function-ptr) ;; Pick off structures and list pointers. @@ -52,11 +52,11 @@ (inst jmp done) FUNCTION-PTR - (load-type al-tn object (- sb!vm:fun-pointer-type)) + (load-type al-tn object (- sb!vm:fun-pointer-lowtag)) (inst jmp done) OTHER-PTR - (load-type al-tn object (- sb!vm:other-pointer-type)) + (load-type al-tn object (- sb!vm:other-pointer-lowtag)) DONE (inst movzx result al-tn))) @@ -69,7 +69,7 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (load-type temp function (- sb!vm:fun-pointer-type)) + (load-type temp function (- sb!vm:fun-pointer-lowtag)) (inst movzx result temp))) (define-vop (set-function-subtype) @@ -86,7 +86,7 @@ (:generator 6 (move eax type) (inst mov - (make-ea :byte :base function :disp (- fun-pointer-type)) + (make-ea :byte :base function :disp (- fun-pointer-lowtag)) al-tn) (move result eax))) @@ -97,7 +97,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 other-pointer-type) + (loadw res x 0 other-pointer-lowtag) (inst shr res type-bits))) (define-vop (get-closure-length) @@ -107,7 +107,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 fun-pointer-type) + (loadw res x 0 fun-pointer-lowtag) (inst shr res type-bits))) (define-vop (set-header-data) @@ -122,8 +122,8 @@ (:generator 6 (move eax data) (inst shl eax (- type-bits 2)) - (inst mov al-tn (make-ea :byte :base x :disp (- other-pointer-type))) - (storew eax x 0 other-pointer-type) + (inst mov al-tn (make-ea :byte :base x :disp (- other-pointer-lowtag))) + (storew eax x 0 other-pointer-lowtag) (move res x))) (define-vop (make-fixnum) @@ -196,10 +196,10 @@ (:results (sap :scs (sap-reg) :from (:argument 0))) (:result-types system-area-pointer) (:generator 10 - (loadw sap code 0 other-pointer-type) + (loadw sap code 0 other-pointer-lowtag) (inst shr sap type-bits) (inst lea sap (make-ea :byte :base code :index sap :scale 4 - :disp (- other-pointer-type))))) + :disp (- other-pointer-lowtag))))) (define-vop (compute-function) (:args (code :scs (descriptor-reg) :to (:result 0)) @@ -207,11 +207,11 @@ (:arg-types * positive-fixnum) (:results (func :scs (descriptor-reg) :from (:argument 0))) (:generator 10 - (loadw func code 0 other-pointer-type) + (loadw func code 0 other-pointer-lowtag) (inst shr func type-bits) (inst lea func (make-ea :byte :base offset :index func :scale 4 - :disp (- fun-pointer-type other-pointer-type))) + :disp (- fun-pointer-lowtag other-pointer-lowtag))) (inst add func code))) (define-vop (%simple-fun-self) @@ -220,10 +220,10 @@ (:args (function :scs (descriptor-reg))) (:results (result :scs (descriptor-reg))) (:generator 3 - (loadw result function simple-fun-self-slot fun-pointer-type) + (loadw result function simple-fun-self-slot fun-pointer-lowtag) (inst lea result (make-ea :byte :base result - :disp (- fun-pointer-type + :disp (- fun-pointer-lowtag (* simple-fun-code-offset word-bytes)))))) ;;; The closure function slot is a pointer to raw code on X86 instead @@ -246,8 +246,8 @@ (inst lea temp (make-ea :byte :base new-self :disp (- (ash simple-fun-code-offset word-shift) - fun-pointer-type))) - (storew temp function simple-fun-self-slot fun-pointer-type) + fun-pointer-lowtag))) + (storew temp function simple-fun-self-slot fun-pointer-lowtag) (move result new-self))) ;;; KLUDGE: This seems to be some kind of weird override of the way @@ -296,4 +296,4 @@ (:generator 0 (inst inc (make-ea :dword :base count-vector :disp (- (* (+ vector-data-offset index) word-bytes) - other-pointer-type))))) + other-pointer-lowtag))))) diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp index b0067e6..d028373 100644 --- a/src/compiler/x86/type-vops.lisp +++ b/src/compiler/x86/type-vops.lisp @@ -28,7 +28,7 @@ (collect ((results)) (let ((start nil) (prev nil) - (delta (- other-immediate-1-type other-immediate-0-type))) + (delta (- other-immediate-1-lowtag other-immediate-0-lowtag))) (flet ((emit-test () (results (if (= start prev) start @@ -51,8 +51,8 @@ (macrolet ((test-type (value target not-p &rest type-codes) ;; Determine what interesting combinations we need to test for. (let* ((type-codes (mapcar #'eval type-codes)) - (fixnump (and (member even-fixnum-type type-codes) - (member odd-fixnum-type type-codes) + (fixnump (and (member even-fixnum-lowtag type-codes) + (member odd-fixnum-lowtag type-codes) t)) (lowtags (remove lowtag-limit type-codes :test #'<)) (extended (remove lowtag-limit type-codes :test #'>)) @@ -69,8 +69,8 @@ (cond (fixnump (when (remove-if #'(lambda (x) - (or (= x even-fixnum-type) - (= x odd-fixnum-type))) + (or (= x even-fixnum-lowtag) + (= x odd-fixnum-lowtag))) lowtags) (error "can't mix fixnum testing with other lowtags")) (when function-p @@ -163,7 +163,7 @@ (defun %test-headers (value target not-p function-p headers &optional (drop-through (gen-label)) al-loaded) - (let ((lowtag (if function-p fun-pointer-type other-pointer-type))) + (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag))) (multiple-value-bind (equal less-or-equal when-true when-false) ;; EQUAL and LESS-OR-EQUAL are the conditions for branching to TARGET. ;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when we know @@ -201,7 +201,7 @@ #+nil (defun %test-headers (value target not-p function-p headers &optional (drop-through (gen-label)) al-loaded) - (let ((lowtag (if function-p fun-pointer-type other-pointer-type))) + (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag))) (multiple-value-bind (equal less-or-equal when-true when-false) ;; EQUAL and LESS-OR-EQUAL are the conditions for branching to TARGET. ;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when we know @@ -321,16 +321,16 @@ `((primitive-type-vop ,check-name (:check) ,ptype)))))) (def-simple-type-vops fixnump check-fixnum fixnum object-not-fixnum-error - even-fixnum-type odd-fixnum-type) + even-fixnum-lowtag odd-fixnum-lowtag) (def-type-vops functionp check-function function - object-not-function-error fun-pointer-type) + object-not-function-error fun-pointer-lowtag) (def-type-vops listp check-list list object-not-list-error - list-pointer-type) + list-pointer-lowtag) (def-type-vops %instancep check-instance instance object-not-instance-error - instance-pointer-type) + instance-pointer-lowtag) (def-type-vops bignump check-bignum bignum object-not-bignum-error bignum-type) @@ -555,22 +555,22 @@ complex-array-type) (def-type-vops numberp check-number nil object-not-number-error - even-fixnum-type odd-fixnum-type bignum-type ratio-type + even-fixnum-lowtag odd-fixnum-lowtag bignum-type ratio-type single-float-type double-float-type #!+long-float long-float-type complex-type complex-single-float-type complex-double-float-type #!+long-float complex-long-float-type) (def-type-vops rationalp check-rational nil object-not-rational-error - even-fixnum-type odd-fixnum-type ratio-type bignum-type) + even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type) (def-type-vops integerp check-integer nil object-not-integer-error - even-fixnum-type odd-fixnum-type bignum-type) + even-fixnum-lowtag odd-fixnum-lowtag bignum-type) (def-type-vops floatp check-float nil object-not-float-error single-float-type double-float-type #!+long-float long-float-type) (def-type-vops realp check-real nil object-not-real-error - even-fixnum-type odd-fixnum-type ratio-type bignum-type + even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type single-float-type double-float-type #!+long-float long-float-type) ;;;; other integer ranges @@ -589,9 +589,9 @@ (inst jmp :e yep) (move eax-tn value) (inst and al-tn lowtag-mask) - (inst cmp al-tn other-pointer-type) + (inst cmp al-tn other-pointer-lowtag) (inst jmp :ne nope) - (loadw eax-tn value 0 other-pointer-type) + (loadw eax-tn value 0 other-pointer-lowtag) (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type)) (inst jmp (if not-p :ne :e) target)) NOT-TARGET)) @@ -605,9 +605,9 @@ (inst jmp :e yep) (move eax-tn value) (inst and al-tn lowtag-mask) - (inst cmp al-tn other-pointer-type) + (inst cmp al-tn other-pointer-lowtag) (inst jmp :ne nope) - (loadw eax-tn value 0 other-pointer-type) + (loadw eax-tn value 0 other-pointer-lowtag) (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type)) (inst jmp :ne nope)) YEP @@ -633,10 +633,10 @@ ;; If not, is it an other pointer? (inst and al-tn lowtag-mask) - (inst cmp al-tn other-pointer-type) + (inst cmp al-tn other-pointer-lowtag) (inst jmp :ne nope) ;; Get the header. - (loadw eax-tn value 0 other-pointer-type) + (loadw eax-tn value 0 other-pointer-lowtag) ;; Is it one? (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type)) (inst jmp :e single-word) @@ -644,7 +644,7 @@ (inst cmp eax-tn (+ (ash 2 type-bits) bignum-type)) (inst jmp :ne nope) ;; Get the second digit. - (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-type) + (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag) ;; All zeros, its an (unsigned-byte 32). (inst or eax-tn eax-tn) (inst jmp :z yep) @@ -652,7 +652,7 @@ (emit-label single-word) ;; Get the single digit. - (loadw eax-tn value bignum-digits-offset other-pointer-type) + (loadw eax-tn value bignum-digits-offset other-pointer-lowtag) ;; positive implies (unsigned-byte 32). (emit-label fixnum) @@ -676,10 +676,10 @@ ;; If not, is it an other pointer? (inst and al-tn lowtag-mask) - (inst cmp al-tn other-pointer-type) + (inst cmp al-tn other-pointer-lowtag) (inst jmp :ne nope) ;; Get the header. - (loadw eax-tn value 0 other-pointer-type) + (loadw eax-tn value 0 other-pointer-lowtag) ;; Is it one? (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type)) (inst jmp :e single-word) @@ -687,7 +687,7 @@ (inst cmp eax-tn (+ (ash 2 type-bits) bignum-type)) (inst jmp :ne nope) ;; Get the second digit. - (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-type) + (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag) ;; All zeros, its an (unsigned-byte 32). (inst or eax-tn eax-tn) (inst jmp :z yep) @@ -695,7 +695,7 @@ (emit-label single-word) ;; Get the single digit. - (loadw eax-tn value bignum-digits-offset other-pointer-type) + (loadw eax-tn value bignum-digits-offset other-pointer-lowtag) ;; positive implies (unsigned-byte 32). (emit-label fixnum) @@ -734,7 +734,7 @@ (let ((is-not-cons-label (if not-p target drop-thru))) (inst cmp value nil-value) (inst jmp :e is-not-cons-label) - (test-type value target not-p list-pointer-type)) + (test-type value target not-p list-pointer-lowtag)) DROP-THRU)) (define-vop (check-cons check-type) @@ -742,7 +742,7 @@ (let ((error (generate-error-code vop object-not-cons-error value))) (inst cmp value nil-value) (inst jmp :e error) - (test-type value error t list-pointer-type) + (test-type value error t list-pointer-lowtag) (move result value)))) ) ; MACROLET diff --git a/src/compiler/x86/values.lisp b/src/compiler/x86/values.lisp index 6c68c32..d4f4e00 100644 --- a/src/compiler/x86/values.lisp +++ b/src/compiler/x86/values.lisp @@ -57,11 +57,11 @@ LOOP (inst cmp list nil-temp) (inst jmp :e done) - (pushw list cons-car-slot list-pointer-type) - (loadw list list cons-cdr-slot list-pointer-type) + (pushw list cons-car-slot list-pointer-lowtag) + (loadw list list cons-cdr-slot list-pointer-lowtag) (inst mov eax list) (inst and al-tn lowtag-mask) - (inst cmp al-tn list-pointer-type) + (inst cmp al-tn list-pointer-lowtag) (inst jmp :e loop) (error-call vop bogus-argument-to-values-list-error list) diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index d40c272..557eba5 100644 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@ -27,7 +27,7 @@ #define SET_GC_TRIGGER(new_value) \ clear_auto_gc_trigger(); set_auto_gc_trigger(new_value); -#define ALIGNED_SIZE(n) (n+lowtag_Mask) & ~lowtag_Mask +#define ALIGNED_SIZE(n) (n+LOWTAG_MASK) & ~LOWTAG_MASK #if defined GENCGC extern lispobj *alloc(int bytes); @@ -38,7 +38,7 @@ alloc(int bytes) lispobj *result; /* Round to dual word boundary. */ - bytes = (bytes + lowtag_Mask) & ~lowtag_Mask; + bytes = (bytes + LOWTAG_MASK) & ~LOWTAG_MASK; result = GET_FREE_POINTER(); @@ -58,7 +58,7 @@ alloc_unboxed(int type, int words) lispobj *result; result = alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj))); - *result = (lispobj) (words << type_Bits) | type; + *result = (lispobj) (words << N_TYPE_BITS) | type; return result; } @@ -73,7 +73,7 @@ alloc_vector(int type, int length, int size) result->header = type; result->length = make_fixnum(length); - return ((lispobj)result)|type_OtherPointer; + return ((lispobj)result)|OTHER_POINTER_LOWTAG; } lispobj @@ -84,7 +84,7 @@ alloc_cons(lispobj car, lispobj cdr) ptr->car = car; ptr->cdr = cdr; - return (lispobj)ptr | type_ListPointer; + return (lispobj)ptr | LIST_POINTER_LOWTAG; } lispobj @@ -99,7 +99,7 @@ alloc_number(long n) ptr->digits[0] = n; - return (lispobj) ptr | type_OtherPointer; + return (lispobj) ptr | OTHER_POINTER_LOWTAG; } } @@ -124,5 +124,5 @@ alloc_sap(void *ptr) struct sap *sap = (struct sap *)alloc_unboxed((int)type_Sap, n_words_to_alloc); sap->pointer = ptr; - return (lispobj) sap | type_OtherPointer; + return (lispobj) sap | OTHER_POINTER_LOWTAG; } diff --git a/src/runtime/alpha-assem.S b/src/runtime/alpha-assem.S index b2be715..c636fe3 100644 --- a/src/runtime/alpha-assem.S +++ b/src/runtime/alpha-assem.S @@ -82,11 +82,11 @@ call_into_lisp: ldl reg_A5,20(reg_CFP) /* This call will 'return' into the LRA page below */ - lda reg_LRA,call_into_lisp_LRA_page+type_OtherPointer + lda reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG /* Indirect the closure */ ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV) - addl reg_CODE,6*4-type_FunPointer, reg_LIP + addl reg_CODE,6*4-FUN_POINTER_LOWTAG, reg_LIP /* And into lisp we go. */ jsr reg_ZERO,(reg_LIP) @@ -157,7 +157,7 @@ call_into_c: addq reg_CFP, 32, reg_CSP stl reg_OCFP, 0(reg_CFP) subl reg_LIP, reg_CODE, reg_L1 - addl reg_L1, type_OtherPointer, reg_L1 + addl reg_L1, OTHER_POINTER_LOWTAG, reg_L1 stl reg_L1, 4(reg_CFP) stl reg_CODE, 8(reg_CFP) stl reg_NULL, 12(reg_CFP) @@ -233,7 +233,7 @@ call_into_c: /* can you see anything here which touches LRA? I can't ...*/ ldl reg_CODE, 8(reg_CFP) ldl reg_NL0, 4(reg_CFP) - subq reg_NL0, type_OtherPointer, reg_NL0 + subq reg_NL0, OTHER_POINTER_LOWTAG, reg_NL0 addq reg_CODE, reg_NL0, reg_NL0 mov reg_CFP, reg_CSP diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index e43f96d..c0c615b 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -113,8 +113,8 @@ call_info_from_context(struct call_info *info, os_context_t *context) unsigned long pc; info->interrupted = 1; - if (LowtagOf(*os_context_register_addr(context, reg_CODE)) - == type_FunPointer) { + if (lowtagof(*os_context_register_addr(context, reg_CODE)) + == FUN_POINTER_LOWTAG) { /* We tried to call a function, but crapped out before $CODE could * be fixed up. Probably an undefined function. */ info->frame = @@ -207,7 +207,7 @@ backtrace(int nframes) if (info.code != (struct code *) 0) { lispobj function; - printf("CODE: 0x%08X, ", (unsigned long) info.code | type_OtherPointer); + printf("CODE: 0x%08X, ", (unsigned long) info.code | OTHER_POINTER_LOWTAG); #ifndef alpha function = info.code->entry_points; @@ -221,7 +221,7 @@ backtrace(int nframes) header = (struct simple_fun *) native_pointer(function); name = header->name; - if (LowtagOf(name) == type_OtherPointer) { + if (lowtagof(name) == OTHER_POINTER_LOWTAG) { lispobj *object; object = (lispobj *) native_pointer(name); diff --git a/src/runtime/breakpoint.c b/src/runtime/breakpoint.c index 34a2bdf..44d75f9 100644 --- a/src/runtime/breakpoint.c +++ b/src/runtime/breakpoint.c @@ -75,10 +75,10 @@ static lispobj find_code(os_context_t *context) lispobj code = *os_context_register_addr(context, reg_CODE); lispobj header; - if (LowtagOf(code) != type_OtherPointer) + if (lowtagof(code) != OTHER_POINTER_LOWTAG) return NIL; - header = *(lispobj *)(code-type_OtherPointer); + header = *(lispobj *)(code-OTHER_POINTER_LOWTAG); if (TypeOf(header) == type_CodeHeader) return code; @@ -99,7 +99,7 @@ static lispobj find_code(os_context_t *context) if (codeptr == 0) { return NIL; } else { - return codeptr + type_OtherPointer; + return codeptr + OTHER_POINTER_LOWTAG; } } #endif @@ -196,7 +196,7 @@ void *handle_fun_end_breakpoint(int signal, siginfo_t *info, } #endif undo_fake_foreign_function_call(context); - return (void *)(lra-type_OtherPointer+sizeof(lispobj)); + return (void *)(lra-OTHER_POINTER_LOWTAG+sizeof(lispobj)); } #else void *handle_fun_end_breakpoint(int signal, siginfo_t *info, diff --git a/src/runtime/gc.c b/src/runtime/gc.c index b335682..e8061a3 100644 --- a/src/runtime/gc.c +++ b/src/runtime/gc.c @@ -127,7 +127,7 @@ copy_object(lispobj object, int nwords) gc_assert((nwords & 0x01) == 0); /* get tag of object */ - tag = LowtagOf(object); + tag = lowtagof(object); /* allocate space */ new = new_space_free_pointer; @@ -495,7 +495,7 @@ scavenge_interrupt_context(os_context_t *context) index = boxed_registers[i]; reg = *os_context_register_addr(context, index); /* would be using PTR if not for integer length issues */ - if ((reg & ~((1L<code_size); nheader_words = HeaderValue(code->header); @@ -806,7 +804,7 @@ trans_code_header(lispobj object) struct code *ncode; ncode = trans_code((struct code *) native_pointer(object)); - return (lispobj) LOW_WORD(ncode) | type_OtherPointer; + return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG; } static int @@ -855,7 +853,7 @@ trans_return_pc_header(lispobj object) if(object==0x304748d7) { /* monitor_or_something(); */ } - ret= ((lispobj) LOW_WORD(ncode) + offset) | type_OtherPointer; + ret= ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG; #ifdef DEBUG_CODE_GC printf("trans_return_pc_header returning %x\n",ret); #endif @@ -908,7 +906,7 @@ trans_fun_header(lispobj object) code = (struct code *) ((unsigned long) fheader - offset); ncode = trans_code(code); - return ((lispobj) LOW_WORD(ncode) + offset) | type_FunPointer; + return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG; } @@ -975,7 +973,7 @@ trans_list(lispobj object) cdr = cons->cdr; - if (LowtagOf(cdr) != type_ListPointer || + if (lowtagof(cdr) != LIST_POINTER_LOWTAG || !from_space_p(cdr) || (is_lisp_pointer(first = *(lispobj *)native_pointer(cdr)) && new_space_p(first))) @@ -1208,7 +1206,7 @@ static int scav_vector(lispobj *where, lispobj object) { if (HeaderValue(object) == subtype_VectorValidHashing) - *where = (subtype_VectorMustRehash<header) == type_CodeHeader); /* Prepare to transport the code vector. */ - l_code = (lispobj) code | type_OtherPointer; + l_code = (lispobj) code | OTHER_POINTER_LOWTAG; ncode_words = fixnum_value(code->code_size); nheader_words = HeaderValue(code->header); @@ -2241,7 +2239,7 @@ trans_code_header(lispobj object) struct code *ncode; ncode = trans_code((struct code *) native_pointer(object)); - return (lispobj) ncode | type_OtherPointer; + return (lispobj) ncode | OTHER_POINTER_LOWTAG; } static int @@ -2285,7 +2283,7 @@ trans_return_pc_header(lispobj object) code = (struct code *) ((unsigned long) return_pc - offset); ncode = trans_code(code); - return ((lispobj) ncode + offset) | type_OtherPointer; + return ((lispobj) ncode + offset) | OTHER_POINTER_LOWTAG; } /* On the 386, closures hold a pointer to the raw address instead of the @@ -2332,7 +2330,7 @@ trans_fun_header(lispobj object) code = (struct code *) ((unsigned long) fheader - offset); ncode = trans_code(code); - return ((lispobj) ncode + offset) | type_FunPointer; + return ((lispobj) ncode + offset) | FUN_POINTER_LOWTAG; } /* @@ -2404,7 +2402,7 @@ trans_list(lispobj object) new_cons = (struct cons *) gc_quick_alloc(sizeof(struct cons)); new_cons->car = cons->car; new_cons->cdr = cons->cdr; /* updated later */ - new_list_pointer = (lispobj)new_cons | LowtagOf(object); + new_list_pointer = (lispobj)new_cons | lowtagof(object); /* Grab the cdr before it is clobbered. */ cdr = cons->cdr; @@ -2419,7 +2417,7 @@ trans_list(lispobj object) lispobj new_cdr; struct cons *cdr_cons, *new_cdr_cons; - if (LowtagOf(cdr) != type_ListPointer || !from_space_p(cdr) + if (lowtagof(cdr) != LIST_POINTER_LOWTAG || !from_space_p(cdr) || (*((lispobj *)native_pointer(cdr)) == 0x01)) break; @@ -2429,7 +2427,7 @@ trans_list(lispobj object) new_cdr_cons = (struct cons*) gc_quick_alloc(sizeof(struct cons)); new_cdr_cons->car = cdr_cons->car; new_cdr_cons->cdr = cdr_cons->cdr; - new_cdr = (lispobj)new_cdr_cons | LowtagOf(cdr); + new_cdr = (lispobj)new_cdr_cons | lowtagof(cdr); /* Grab the cdr before it is clobbered. */ cdr = cdr_cons->cdr; @@ -2720,7 +2718,7 @@ scav_vector(lispobj *where, lispobj object) if (!gencgc_hash) { /* This is set for backward compatibility. FIXME: Do we need * this any more? */ - *where = (subtype_VectorMustRehash << type_Bits) | type_SimpleVector; + *where = (subtype_VectorMustRehash << N_TYPE_BITS) | type_SimpleVector; return 1; } @@ -3572,14 +3570,14 @@ gc_init_tables(void) * alone, set multiple entries in our 8-bit scavenge table (one for each * possible value of the high 5 bits). */ for (i = 0; i < 32; i++) { /* FIXME: bare constant length, ick! */ - scavtab[type_EvenFixnum|(i<<3)] = scav_immediate; - scavtab[type_FunPointer|(i<<3)] = scav_fun_pointer; - /* OtherImmediate0 */ - scavtab[type_ListPointer|(i<<3)] = scav_list_pointer; - scavtab[type_OddFixnum|(i<<3)] = scav_immediate; - scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer; - /* OtherImmediate1 */ - scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer; + scavtab[EVEN_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; + scavtab[FUN_POINTER_LOWTAG|(i<<3)] = scav_fun_pointer; + /* skipping OTHER_IMMEDIATE_0_LOWTAG */ + scavtab[LIST_POINTER_LOWTAG|(i<<3)] = scav_list_pointer; + scavtab[ODD_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; + scavtab[INSTANCE_POINTER_LOWTAG|(i<<3)] = scav_instance_pointer; + /* skipping OTHER_IMMEDIATE_1_LOWTAG */ + scavtab[OTHER_POINTER_LOWTAG|(i<<3)] = scav_other_pointer; } /* Other-pointer types (those selected by all eight bits of the tag) get @@ -3738,14 +3736,14 @@ gc_init_tables(void) for (i = 0; i < 256; i++) sizetab[i] = size_lose; for (i = 0; i < 32; i++) { - sizetab[type_EvenFixnum|(i<<3)] = size_immediate; - sizetab[type_FunPointer|(i<<3)] = size_pointer; - /* OtherImmediate0 */ - sizetab[type_ListPointer|(i<<3)] = size_pointer; - sizetab[type_OddFixnum|(i<<3)] = size_immediate; - sizetab[type_InstancePointer|(i<<3)] = size_pointer; - /* OtherImmediate1 */ - sizetab[type_OtherPointer|(i<<3)] = size_pointer; + sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate; + sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer; + /* skipping OTHER_IMMEDIATE_0_LOWTAG */ + sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer; + sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate; + sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer; + /* skipping OTHER_IMMEDIATE_1_LOWTAG */ + sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer; } sizetab[type_Bignum] = size_unboxed; sizetab[type_Ratio] = size_boxed; @@ -3936,8 +3934,8 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) * recording the result of the last call to allocate-lisp-memory, * and returning true from this function when *pointer is * a reference to that result. */ - switch (LowtagOf((lispobj)pointer)) { - case type_FunPointer: + switch (lowtagof((lispobj)pointer)) { + case FUN_POINTER_LOWTAG: /* Start_addr should be the enclosing code object, or a closure * header. */ switch (TypeOf(*start_addr)) { @@ -3947,7 +3945,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) case type_ClosureHeader: case type_FuncallableInstanceHeader: if ((unsigned)pointer != - ((unsigned)start_addr+type_FunPointer)) { + ((unsigned)start_addr+FUN_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wf2: %x %x %x\n", @@ -3963,9 +3961,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; } break; - case type_ListPointer: + case LIST_POINTER_LOWTAG: if ((unsigned)pointer != - ((unsigned)start_addr+type_ListPointer)) { + ((unsigned)start_addr+LIST_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wl1: %x %x %x\n", @@ -3989,9 +3987,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) pointer, start_addr, *start_addr)); return 0; } - case type_InstancePointer: + case INSTANCE_POINTER_LOWTAG: if ((unsigned)pointer != - ((unsigned)start_addr+type_InstancePointer)) { + ((unsigned)start_addr+INSTANCE_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wi1: %x %x %x\n", @@ -4006,9 +4004,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; } break; - case type_OtherPointer: + case OTHER_POINTER_LOWTAG: if ((unsigned)pointer != - ((int)start_addr+type_OtherPointer)) { + ((int)start_addr+OTHER_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wo1: %x %x %x\n", diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 590050a..24538f9 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -140,8 +140,8 @@ fake_foreign_function_call(os_context_t *context) == current_control_frame_pointer) { /* There is a small window during call where the callee's * frame isn't built yet. */ - if (LowtagOf(*os_context_register_addr(context, reg_CODE)) - == type_FunPointer) { + if (lowtagof(*os_context_register_addr(context, reg_CODE)) + == FUN_POINTER_LOWTAG) { /* We have called, but not built the new frame, so * build it for them. */ current_control_frame_pointer[0] = @@ -391,7 +391,7 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) * support decides to pass on it. */ lose("no handler for signal %d in interrupt_handle_now(..)", signal); - } else if (LowtagOf(handler.lisp) == type_FunPointer) { + } else if (lowtagof(handler.lisp) == FUN_POINTER_LOWTAG) { /* Allocate the SAPs while the interrupts are still disabled. * (FIXME: Why? This is the way it was done in CMU CL, and it diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c index f8a0778..14d1d43 100644 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@ -247,10 +247,10 @@ search_cmd(char **ptr) addr = end; end += 2; if (TypeOf(obj) == type_SimpleFunHeader) { - print((long)addr | type_FunPointer); - } else if (LowtagOf(obj) == type_OtherImmediate0 || - LowtagOf(obj) == type_OtherImmediate1) { - print((lispobj)addr | type_OtherPointer); + print((long)addr | FUN_POINTER_LOWTAG); + } else if (lowtagof(obj) == OTHER_IMMEDIATE_0_LOWTAG || + lowtagof(obj) == OTHER_IMMEDIATE_1_LOWTAG) { + print((lispobj)addr | OTHER_POINTER_LOWTAG); } else { print((lispobj)addr); } if (count == -1) { @@ -265,8 +265,8 @@ call_cmd(char **ptr) lispobj thing = parse_lispobj(ptr), function, result = 0, cons, args[3]; int numargs; - if (LowtagOf(thing) == type_OtherPointer) { - switch (TypeOf(*(lispobj *)(thing-type_OtherPointer))) { + if (lowtagof(thing) == OTHER_POINTER_LOWTAG) { + switch (TypeOf(*(lispobj *)(thing-OTHER_POINTER_LOWTAG))) { case type_SymbolHeader: for (cons = SymbolValue(INITIAL_FDEFN_OBJECTS); cons != NIL; @@ -294,7 +294,7 @@ call_cmd(char **ptr) return; } } - else if (LowtagOf(thing) != type_FunPointer) { + else if (lowtagof(thing) != FUN_POINTER_LOWTAG) { printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n", (long unsigned)thing); return; @@ -459,7 +459,7 @@ catchers_cmd(char **ptr) (unsigned long)catch, (unsigned long)(catch->current_uwp), (unsigned long)(catch->current_cont), (unsigned long)component_ptr_from_pc((void*)catch->entry_pc) + - type_OtherPointer, + OTHER_POINTER_LOWTAG, (unsigned long)catch->entry_pc); #endif brief_print((lispobj)catch->tag); diff --git a/src/runtime/parse.c b/src/runtime/parse.c index 4038f51..01e4381 100644 --- a/src/runtime/parse.c +++ b/src/runtime/parse.c @@ -246,7 +246,7 @@ static boolean lookup_symbol(char *name, lispobj *result) (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) - (lispobj *)STATIC_SPACE_START; if (search_for_symbol(name, &headerptr, &count)) { - *result = (lispobj)headerptr | type_OtherPointer; + *result = (lispobj)headerptr | OTHER_POINTER_LOWTAG; return 1; } @@ -262,7 +262,7 @@ static boolean lookup_symbol(char *name, lispobj *result) (lispobj *)DYNAMIC_SPACE_START; #endif if (search_for_symbol(name, &headerptr, &count)) { - *result = (lispobj)headerptr | type_OtherPointer; + *result = (lispobj)headerptr | OTHER_POINTER_LOWTAG; return 1; } diff --git a/src/runtime/print.c b/src/runtime/print.c index 525f250..1097d71 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -294,7 +294,7 @@ static void brief_list(lispobj obj) printf("NIL"); else { putchar('('); - while (LowtagOf(obj) == type_ListPointer) { + while (lowtagof(obj) == LIST_POINTER_LOWTAG) { struct cons *cons = (struct cons *)native_pointer(obj); if (space) @@ -450,7 +450,8 @@ static void print_otherptr(lispobj obj) type = TypeOf(header); print_obj("header: ", header); - if (LowtagOf(header) != type_OtherImmediate0 && LowtagOf(header) != type_OtherImmediate1) { + if (lowtagof(header) != OTHER_IMMEDIATE_0_LOWTAG && + lowtagof(header) != OTHER_IMMEDIATE_1_LOWTAG) { NEWLINE_OR_RETURN; printf("(invalid header object)"); return; @@ -654,7 +655,7 @@ static void print_obj(char *prefix, lispobj obj) static void (*brief_fns[])(lispobj obj) = {brief_fixnum, brief_otherptr, brief_otherimm, brief_list, brief_fixnum, brief_struct, brief_otherimm, brief_otherptr}; - int type = LowtagOf(obj); + int type = lowtagof(obj); struct var *var = lookup_by_obj(obj); char buffer[256]; boolean verbose = cur_depth < brief_depth; @@ -667,7 +668,7 @@ static void print_obj(char *prefix, lispobj obj) if (var == NULL && /* FIXME: What does this "x & y & z & .." expression mean? */ - (obj & type_FunPointer & type_ListPointer & type_InstancePointer & type_OtherPointer) != 0) + (obj & FUN_POINTER_LOWTAG & LIST_POINTER_LOWTAG & INSTANCE_POINTER_LOWTAG & OTHER_POINTER_LOWTAG) != 0) var = define_var(NULL, obj, 0); if (var != NULL) diff --git a/src/runtime/purify.c b/src/runtime/purify.c index a24767f..eca889c 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -75,13 +75,11 @@ static int later_count = 0; #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) #define NWORDS(x,y) (CEILING((x),(y)) / (y)) -/* FIXME: (1) Shouldn't this be defined in sbcl.h? (2) Shouldn't it - * be in the same units as FDEFN_RAW_ADDR_OFFSET? (This is measured - * in words, that's measured in bytes. Gotta love CMU CL..) */ +/* FIXME: (1) Shouldn't this be defined in sbcl.h? */ #ifdef sparc #define FUN_RAW_ADDR_OFFSET 0 #else -#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunPointer) +#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG) #endif static boolean @@ -149,8 +147,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) /* Check that the object pointed to is consistent with the pointer * low tag. */ - switch (LowtagOf((lispobj)pointer)) { - case type_FunPointer: + switch (lowtagof((lispobj)pointer)) { + case FUN_POINTER_LOWTAG: /* Start_addr should be the enclosing code object, or a closure * header. */ switch (TypeOf(*start_addr)) { @@ -159,7 +157,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) break; case type_ClosureHeader: case type_FuncallableInstanceHeader: - if ((int)pointer != ((int)start_addr+type_FunPointer)) { + if ((int)pointer != ((int)start_addr+FUN_POINTER_LOWTAG)) { if (pointer_filter_verbose) { fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -175,8 +173,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) return 0; } break; - case type_ListPointer: - if ((int)pointer != ((int)start_addr+type_ListPointer)) { + case LIST_POINTER_LOWTAG: + if ((int)pointer != ((int)start_addr+LIST_POINTER_LOWTAG)) { if (pointer_filter_verbose) fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -199,8 +197,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) } return 0; } - case type_InstancePointer: - if ((int)pointer != ((int)start_addr+type_InstancePointer)) { + case INSTANCE_POINTER_LOWTAG: + if ((int)pointer != ((int)start_addr+INSTANCE_POINTER_LOWTAG)) { if (pointer_filter_verbose) { fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -215,8 +213,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) return 0; } break; - case type_OtherPointer: - if ((int)pointer != ((int)start_addr+type_OtherPointer)) { + case OTHER_POINTER_LOWTAG: + if ((int)pointer != ((int)start_addr+OTHER_POINTER_LOWTAG)) { if (pointer_filter_verbose) { fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -370,7 +368,7 @@ setup_i386_stack_scav(lispobj *lowaddr, lispobj *base) MAX_STACK_RETURN_ADDRESSES); valid_stack_ra_locations[num_valid_stack_ra_locations] = sp; valid_stack_ra_code_objects[num_valid_stack_ra_locations++] = - (lispobj *)((int)start_addr + type_OtherPointer); + (lispobj *)((int)start_addr + OTHER_POINTER_LOWTAG); } else { if (valid_dynamic_space_pointer((void *)thing, start_addr)) { gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS); @@ -466,7 +464,7 @@ ptrans_boxed(lispobj thing, lispobj header, boolean constant) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj)new | lowtagof(thing); *old = result; /* Scavenge it. */ @@ -510,7 +508,7 @@ ptrans_instance(lispobj thing, lispobj header, boolean constant) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj)new | lowtagof(thing); *old = result; /* Scavenge it. */ @@ -542,7 +540,7 @@ ptrans_fdefn(lispobj thing, lispobj header) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj)new | lowtagof(thing); *old = result; /* Scavenge the function. */ @@ -572,7 +570,7 @@ ptrans_unboxed(lispobj thing, lispobj header) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj)new | lowtagof(thing); *old = result; return result; @@ -600,7 +598,7 @@ ptrans_vector(lispobj thing, int bits, int extra, bcopy(vector, new, nwords * sizeof(lispobj)); - result = (lispobj)new | LowtagOf(thing); + result = (lispobj)new | lowtagof(thing); vector->header = result; if (boxed) @@ -709,7 +707,7 @@ ptrans_code(lispobj thing) apply_code_fixups_during_purify(code,new); #endif - result = (lispobj)new | type_OtherPointer; + result = (lispobj)new | OTHER_POINTER_LOWTAG; /* Stick in a forwarding pointer for the code object. */ *(lispobj *)code = result; @@ -719,7 +717,7 @@ ptrans_code(lispobj thing) func != NIL; func = ((struct simple_fun *)native_pointer(func))->next) { - gc_assert(LowtagOf(func) == type_FunPointer); + gc_assert(lowtagof(func) == FUN_POINTER_LOWTAG); *(lispobj *)native_pointer(func) = result + (func - thing); } @@ -742,7 +740,7 @@ ptrans_code(lispobj thing) for (func = new->entry_points; func != NIL; func = ((struct simple_fun *)native_pointer(func))->next) { - gc_assert(LowtagOf(func) == type_FunPointer); + gc_assert(lowtagof(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); #ifdef __i386__ @@ -785,7 +783,7 @@ ptrans_func(lispobj thing, lispobj header) code = (native_pointer(thing) - (HeaderValue(function->header)*sizeof(lispobj))) | - type_OtherPointer; + OTHER_POINTER_LOWTAG; /* This will cause the function's header to be replaced with a * forwarding pointer. */ @@ -816,7 +814,7 @@ ptrans_func(lispobj thing, lispobj header) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj)new | lowtagof(thing); *old = result; /* Scavenge it. */ @@ -874,18 +872,18 @@ ptrans_list(lispobj thing, boolean constant) thing = new->cdr = old->cdr; /* Set up the forwarding pointer. */ - *(lispobj *)old = ((lispobj)new) | type_ListPointer; + *(lispobj *)old = ((lispobj)new) | LIST_POINTER_LOWTAG; /* And count this cell. */ length++; - } while (LowtagOf(thing) == type_ListPointer && + } while (lowtagof(thing) == LIST_POINTER_LOWTAG && dynamic_pointer_p(thing) && !(forwarding_pointer_p(*(lispobj *)native_pointer(thing)))); /* Scavenge the list we just copied. */ pscav((lispobj *)orig, length * WORDS_PER_CONS, constant); - return ((lispobj)orig) | type_ListPointer; + return ((lispobj)orig) | LIST_POINTER_LOWTAG; } static lispobj @@ -1046,7 +1044,7 @@ pscav_code(struct code*code) for (func = code->entry_points; func != NIL; func = ((struct simple_fun *)native_pointer(func))->next) { - gc_assert(LowtagOf(func) == type_FunPointer); + gc_assert(lowtagof(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); #ifdef __i386__ @@ -1087,20 +1085,20 @@ pscav(lispobj *addr, int nwords, boolean constant) thing = header; else { /* Nope, copy the object. */ - switch (LowtagOf(thing)) { - case type_FunPointer: + switch (lowtagof(thing)) { + case FUN_POINTER_LOWTAG: thing = ptrans_func(thing, header); break; - case type_ListPointer: + case LIST_POINTER_LOWTAG: thing = ptrans_list(thing, constant); break; - case type_InstancePointer: + case INSTANCE_POINTER_LOWTAG: thing = ptrans_instance(thing, header, constant); break; - case type_OtherPointer: + case OTHER_POINTER_LOWTAG: thing = ptrans_otherptr(thing, header, constant); break; @@ -1130,7 +1128,7 @@ pscav(lispobj *addr, int nwords, boolean constant) case type_SimpleVector: if (HeaderValue(thing) == subtype_VectorValidHashing) - *addr = (subtype_VectorMustRehash<>type_Bits)) +#define TypeOf(obj) ((obj)&TYPE_MASK) +#define HeaderValue(obj) ((unsigned long) ((obj)>>N_TYPE_BITS)) -#define CONS(obj) ((struct cons *)((obj)-type_ListPointer)) -#define SYMBOL(obj) ((struct symbol *)((obj)-type_OtherPointer)) -#define FDEFN(obj) ((struct fdefn *)((obj)-type_OtherPointer)) +#define CONS(obj) ((struct cons *)((obj)-LIST_POINTER_LOWTAG)) +#define SYMBOL(obj) ((struct symbol *)((obj)-OTHER_POINTER_LOWTAG)) +#define FDEFN(obj) ((struct fdefn *)((obj)-OTHER_POINTER_LOWTAG)) /* KLUDGE: These are in theory machine-dependent and OS-dependent, but * in practice the "foo int" definitions work for all the machines @@ -73,6 +68,11 @@ typedef signed int s32; typedef u32 lispobj; +static inline int +lowtagof(lispobj obj) { + return obj & LOWTAG_MASK; +} + /* Is the Lisp object obj something with pointer nature (as opposed to * e.g. a fixnum or character or unbound marker)? */ static inline int @@ -86,7 +86,7 @@ is_lisp_pointer(lispobj obj) static inline lispobj native_pointer(lispobj obj) { - return obj & ~lowtag_Mask; + return obj & ~LOWTAG_MASK; } /* FIXME: There seems to be no reason that make_fixnum and fixnum_value @@ -102,14 +102,14 @@ typedef int boolean; * instead of macros. */ #define SymbolValue(sym) \ - (((struct symbol *)((sym)-type_OtherPointer))->value) + (((struct symbol *)((sym)-OTHER_POINTER_LOWTAG))->value) #define SetSymbolValue(sym,val) \ - (((struct symbol *)((sym)-type_OtherPointer))->value = (val)) + (((struct symbol *)((sym)-OTHER_POINTER_LOWTAG))->value = (val)) /* This only works for static symbols. */ /* FIXME: should be called StaticSymbolFunction, right? */ #define SymbolFunction(sym) \ - (((struct fdefn *)(SymbolValue(sym)-type_OtherPointer))->fun) + (((struct fdefn *)(SymbolValue(sym)-OTHER_POINTER_LOWTAG))->fun) /* KLUDGE: As far as I can tell there's no ANSI C way of saying * "this function never returns". This is the way that you do it diff --git a/src/runtime/search.c b/src/runtime/search.c index 7639ed1..030d183 100644 --- a/src/runtime/search.c +++ b/src/runtime/search.c @@ -40,7 +40,7 @@ boolean search_for_symbol(char *name, lispobj **start, int *count) while (search_for_type(type_SymbolHeader, start, count)) { symbol = (struct symbol *)native_pointer((lispobj)*start); - if (LowtagOf(symbol->name) == type_OtherPointer) { + if (lowtagof(symbol->name) == OTHER_POINTER_LOWTAG) { symbol_name = (struct vector *)native_pointer(symbol->name); if (is_valid_lisp_addr((os_vm_address_t)symbol_name) && TypeOf(symbol_name->header) == type_SimpleString && diff --git a/version.lisp-expr b/version.lisp-expr index 9ac5126..03b965a 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.pre7.55" +"0.pre7.56"