(aside: I screwed up CVS checkin somehow on the last version.
My local backend.lisp was modified by CR's patch but
for some reason didn't make it into the CVS repository.
Hopefully this checkin will take care of the problem.)
renamed the 8-bit tag codes from FOO-TYPE to FOO-WIDETAG,
and from type_FooBar to FOO_BAR_WIDETAG. (I used
WIDETAG instead of just TAG because I figure as long
as I'm trying to reduce the ambiguities of TYPE in old
names, I might as well minimize the ambiguity of TAG
(in the sense of THROW/CATCH) in the new names too.)
also s/fun-header-types/fun-header-widetags/
renamed TYPE-BITS to N-WIDETAG-BITS, and TYPE-MASK to
WIDETAG-MASK
renamed TypeOf to widetag_of
renamed lowtagof to lowtag_of
renamed LOWTAG-BITS to N-LOWTAG-BITS
renamed TYPE_MASK to WIDETAG_MASK
renamed N_TYPE_BITS to N_WIDETAG_BIGS
"ARRAY-DISPLACED-P-SLOT" "ARRAY-DISPLACEMENT-SLOT"
"ARRAY-ELEMENTS-SLOT" "ARRAY-FILL-POINTER-P-SLOT"
"ARRAY-FILL-POINTER-SLOT" "ATOMIC-FLAG" "BASE-CHAR-REG-SC-NUMBER"
- "BASE-CHAR-STACK-SC-NUMBER" "BASE-CHAR-TYPE"
- "BIGNUM-DIGITS-OFFSET" "BIGNUM-TYPE" "BINDING-SIZE"
+ "BASE-CHAR-STACK-SC-NUMBER" "BASE-CHAR-WIDETAG"
+ "BIGNUM-DIGITS-OFFSET" "BIGNUM-WIDETAG" "BINDING-SIZE"
"BINDING-SYMBOL-SLOT" "BINDING-VALUE-SLOT" "BREAKPOINT-TRAP"
"BYTE-BITS" "BYTE-REG-SC-NUMBER"
"CATCH-BLOCK-CURRENT-CODE-SLOT"
"CATCH-BLOCK-ENTRY-PC-SLOT" "CATCH-BLOCK-PREVIOUS-CATCH-SLOT"
"CATCH-BLOCK-SC-NUMBER" "CATCH-BLOCK-SIZE" "CATCH-BLOCK-SIZE-SLOT"
"CATCH-BLOCK-TAG-SLOT" "CERROR-TRAP"
- "CLOSURE-FUN-HEADER-TYPE" "CLOSURE-FUN-SLOT"
- "CLOSURE-HEADER-TYPE" "CLOSURE-INFO-OFFSET"
+ "CLOSURE-FUN-HEADER-WIDETAG" "CLOSURE-FUN-SLOT"
+ "CLOSURE-HEADER-WIDETAG" "CLOSURE-INFO-OFFSET"
"CODE-CODE-SIZE-SLOT" "CODE-CONSTANTS-OFFSET"
- "CODE-DEBUG-INFO-SLOT" "CODE-ENTRY-POINTS-SLOT" "CODE-HEADER-TYPE"
- "CODE-TRACE-TABLE-OFFSET-SLOT" "COMPLEX-ARRAY-TYPE"
- "COMPLEX-BIT-VECTOR-TYPE" "COMPLEX-DOUBLE-FLOAT-FILLER-SLOT"
+ "CODE-DEBUG-INFO-SLOT" "CODE-ENTRY-POINTS-SLOT"
+ "CODE-HEADER-WIDETAG"
+ "CODE-TRACE-TABLE-OFFSET-SLOT" "COMPLEX-ARRAY-WIDETAG"
+ "COMPLEX-BIT-VECTOR-WIDETAG" "COMPLEX-DOUBLE-FLOAT-FILLER-SLOT"
"COMPLEX-DOUBLE-FLOAT-IMAG-SLOT" "COMPLEX-DOUBLE-FLOAT-REAL-SLOT"
- "COMPLEX-DOUBLE-FLOAT-SIZE" "COMPLEX-DOUBLE-FLOAT-TYPE"
+ "COMPLEX-DOUBLE-FLOAT-SIZE" "COMPLEX-DOUBLE-FLOAT-WIDETAG"
"COMPLEX-DOUBLE-REG-SC-NUMBER" "COMPLEX-DOUBLE-STACK-SC-NUMBER"
"COMPLEX-IMAG-SLOT" "COMPLEX-REAL-SLOT"
"COMPLEX-LONG-FLOAT-IMAG-SLOT" "COMPLEX-LONG-FLOAT-REAL-SLOT"
- "COMPLEX-LONG-FLOAT-SIZE" "COMPLEX-LONG-FLOAT-TYPE"
+ "COMPLEX-LONG-FLOAT-SIZE" "COMPLEX-LONG-FLOAT-WIDETAG"
"COMPLEX-LONG-REG-SC-NUMBER" "COMPLEX-LONG-STACK-SC-NUMBER"
"COMPLEX-SINGLE-FLOAT-IMAG-SLOT" "COMPLEX-SINGLE-FLOAT-REAL-SLOT"
- "COMPLEX-SINGLE-FLOAT-SIZE" "COMPLEX-SINGLE-FLOAT-TYPE"
+ "COMPLEX-SINGLE-FLOAT-SIZE" "COMPLEX-SINGLE-FLOAT-WIDETAG"
"COMPLEX-SINGLE-REG-SC-NUMBER" "COMPLEX-SINGLE-STACK-SC-NUMBER"
- "COMPLEX-SIZE" "COMPLEX-STRING-TYPE" "COMPLEX-TYPE"
- "COMPLEX-VECTOR-TYPE" "CONS-CAR-SLOT" "CONS-CDR-SLOT"
+ "COMPLEX-SIZE" "COMPLEX-STRING-WIDETAG" "COMPLEX-WIDETAG"
+ "COMPLEX-VECTOR-WIDETAG" "CONS-CAR-SLOT" "CONS-CDR-SLOT"
"CONS-SIZE" "CONSTANT-SC-NUMBER"
"CONTEXT-FLOATING-POINT-MODES" "CONTEXT-FLOAT-REGISTER"
"CONTEXT-PC" "CONTEXT-REGISTER"
"DOUBLE-FLOAT-NORMAL-EXPONENT-MAX"
"DOUBLE-FLOAT-NORMAL-EXPONENT-MIN" "DOUBLE-FLOAT-SIGNIFICAND-BYTE"
"DOUBLE-FLOAT-SIZE" "DOUBLE-FLOAT-TRAPPING-NAN-BIT"
- "DOUBLE-FLOAT-TYPE" "DOUBLE-FLOAT-VALUE-SLOT"
+ "DOUBLE-FLOAT-WIDETAG" "DOUBLE-FLOAT-VALUE-SLOT"
"DOUBLE-INT-CARG-REG-SC-NUMBER" "DOUBLE-REG-SC-NUMBER"
"DOUBLE-STACK-SC-NUMBER"
"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"
+ "FDEFN-SIZE" "FDEFN-WIDETAG" "FIND-HOLES" "FIXNUMIZE"
"FIXUP-CODE-OBJECT" "FLOAT-DENORMAL-TRAP-BIT"
"FLOAT-DIVIDE-BY-ZERO-TRAP-BIT"
"FLOAT-IMPRECISE-TRAP-BIT" "FLOAT-INVALID-TRAP-BIT"
"FP-CONSTANT-SC-NUMBER"
"FP-DOUBLE-ZERO-SC-NUMBER" "FP-SINGLE-ZERO-SC-NUMBER"
"FUNCALLABLE-INSTANCE-FUN-SLOT"
- "FUNCALLABLE-INSTANCE-HEADER-TYPE"
+ "FUNCALLABLE-INSTANCE-HEADER-WIDETAG"
"FUNCALLABLE-INSTANCE-INFO-OFFSET"
"SIMPLE-FUN-ARGLIST-SLOT" "SIMPLE-FUN-CODE-OFFSET"
"FUN-END-BREAKPOINT-TRAP"
"SIMPLE-FUN-HEADER-CODE-OFFSET"
"SIMPLE-FUN-HEADER-NEXT-SLOT"
"SIMPLE-FUN-HEADER-SELF-SLOT"
- "SIMPLE-FUN-HEADER-TYPE"
+ "SIMPLE-FUN-HEADER-WIDETAG"
"SIMPLE-FUN-HEADER-TYPE-SLOT"
"SIMPLE-FUN-NAME-SLOT"
"SIMPLE-FUN-NEXT-SLOT"
"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-LOWTAG"
+ "INSTANCE-HEADER-WIDETAG" "INSTANCE-POINTER-LOWTAG"
"INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE"
"INTERIOR-REG-SC-NUMBER" "INTERNAL-ERROR-ARGUMENTS"
"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"
- "LONG-FLOAT-SIZE" "LONG-FLOAT-TRAPPING-NAN-BIT" "LONG-FLOAT-TYPE"
+ "LONG-FLOAT-SIZE" "LONG-FLOAT-TRAPPING-NAN-BIT"
+ "LONG-FLOAT-WIDETAG"
"LONG-FLOAT-VALUE-SLOT" "LONG-REG-SC-NUMBER"
"LONG-STACK-SC-NUMBER"
- "LOWTAG-BITS" "LOWTAG-LIMIT" "LOWTAG-MASK"
+ "N-LOWTAG-BITS" "LOWTAG-LIMIT" "LOWTAG-MASK"
"MEMORY-USAGE" "MOST-POSITIVE-COST"
"NEGATIVE-IMMEDIATE-SC-NUMBER" "NON-DESCRIPTOR-REG-SC-NUMBER"
"NULL-SC-NUMBER"
"PRIMITIVE-OBJECT-SIZE" "PRIMITIVE-OBJECT-SLOTS"
"PRIMITIVE-OBJECT-VARIABLE-LENGTH" "PRINT-ALLOCATED-OBJECTS"
"RANDOM-IMMEDIATE-SC-NUMBER" "RATIO-DENOMINATOR-SLOT"
- "RATIO-NUMERATOR-SLOT" "RATIO-SIZE" "RATIO-TYPE"
+ "RATIO-NUMERATOR-SLOT" "RATIO-SIZE" "RATIO-WIDETAG"
"*READ-ONLY-SPACE-FREE-POINTER*"
- "REGISTER-SAVE-PENALTY" "RETURN-PC-HEADER-TYPE"
+ "REGISTER-SAVE-PENALTY" "RETURN-PC-HEADER-WIDETAG"
"RETURN-PC-RETURN-POINT-OFFSET" "SANCTIFY-FOR-EXECUTION"
"SAP-POINTER-SLOT" "SAP-REG-SC-NUMBER" "SAP-SIZE"
- "SAP-STACK-SC-NUMBER" "SAP-TYPE"
+ "SAP-STACK-SC-NUMBER" "SAP-WIDETAG"
"SIGFPE-HANDLER" "SIGNED-REG-SC-NUMBER" "SIGNED-STACK-SC-NUMBER"
- "SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE"
- "SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE"
- "SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE"
- "SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE"
- "SIMPLE-ARRAY-LONG-FLOAT-TYPE"
- "SIMPLE-ARRAY-SINGLE-FLOAT-TYPE"
- "SIMPLE-ARRAY-TYPE" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE"
- "SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE"
- "SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE"
- "SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE"
- "SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE"
- "SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE"
- "SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE"
- "SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE"
- "SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE"
- "SIMPLE-BIT-VECTOR-TYPE"
- "SIMPLE-STRING-TYPE" "SIMPLE-VECTOR-TYPE" "SINGLE-FLOAT-BIAS"
+ "SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-WIDETAG"
+ "SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-WIDETAG"
+ "SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-WIDETAG"
+ "SIMPLE-ARRAY-DOUBLE-FLOAT-WIDETAG"
+ "SIMPLE-ARRAY-LONG-FLOAT-WIDETAG"
+ "SIMPLE-ARRAY-SINGLE-FLOAT-WIDETAG"
+ "SIMPLE-ARRAY-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-WIDETAG"
+ "SIMPLE-ARRAY-UNSIGNED-BYTE-2-WIDETAG"
+ "SIMPLE-ARRAY-UNSIGNED-BYTE-32-WIDETAG"
+ "SIMPLE-ARRAY-UNSIGNED-BYTE-4-WIDETAG"
+ "SIMPLE-ARRAY-UNSIGNED-BYTE-8-WIDETAG"
+ "SIMPLE-ARRAY-SIGNED-BYTE-16-WIDETAG"
+ "SIMPLE-ARRAY-SIGNED-BYTE-30-WIDETAG"
+ "SIMPLE-ARRAY-SIGNED-BYTE-32-WIDETAG"
+ "SIMPLE-ARRAY-SIGNED-BYTE-8-WIDETAG"
+ "SIMPLE-BIT-VECTOR-WIDETAG"
+ "SIMPLE-STRING-WIDETAG"
+ "SIMPLE-VECTOR-WIDETAG" "SINGLE-FLOAT-BIAS"
"SINGLE-FLOAT-DIGITS" "SINGLE-FLOAT-EXPONENT-BYTE"
"SINGLE-FLOAT-HIDDEN-BIT" "SINGLE-FLOAT-NORMAL-EXPONENT-MAX"
"SINGLE-FLOAT-NORMAL-EXPONENT-MIN" "SINGLE-FLOAT-SIGNIFICAND-BYTE"
"SINGLE-FLOAT-SIZE" "SINGLE-FLOAT-TRAPPING-NAN-BIT"
- "SINGLE-FLOAT-TYPE" "SINGLE-FLOAT-VALUE-SLOT"
+ "SINGLE-FLOAT-WIDETAG" "SINGLE-FLOAT-VALUE-SLOT"
"SINGLE-INT-CARG-REG-SC-NUMBER"
"SINGLE-REG-SC-NUMBER" "SINGLE-STACK-SC-NUMBER"
"SINGLE-STEP-BREAKPOINT-TRAP"
"STATIC-SYMBOL-OFFSET" "STATIC-SYMBOL-P"
"*STATIC-SPACE-FREE-POINTER*" "*STATIC-SYMBOLS*"
"STRUCTURE-USAGE"
- "SYMBOL-HASH-SLOT" "SYMBOL-HEADER-TYPE" "SYMBOL-NAME-SLOT"
+ "SYMBOL-HASH-SLOT" "SYMBOL-HEADER-WIDETAG" "SYMBOL-NAME-SLOT"
"SYMBOL-PACKAGE-SLOT" "SYMBOL-PLIST-SLOT"
"SYMBOL-SIZE" "SYMBOL-UNUSED-SLOT" "SYMBOL-VALUE-SLOT"
"BINDING-STACK-START" "BINDING-STACK-END"
"STATIC-SPACE-START" "STATIC-SPACE-END"
"TRACE-TABLE-CALL-SITE"
"TRACE-TABLE-FUNCTION-EPILOGUE" "TRACE-TABLE-FUNCTION-PROLOGUE"
- "TRACE-TABLE-NORMAL" "TYPE-BITS" "TYPE-MASK" "UNBOUND-MARKER-TYPE"
+ "TRACE-TABLE-NORMAL" "N-WIDETAG-BITS" "WIDETAG-MASK"
+ "UNBOUND-MARKER-WIDETAG"
"UNSIGNED-IMMEDIATE-SC-NUMBER"
"UNSIGNED-REG-SC-NUMBER" "UNSIGNED-STACK-SC-NUMBER"
"UNWIND-BLOCK-CURRENT-CODE-SLOT" "UNWIND-BLOCK-CURRENT-CONT-SLOT"
"UNWIND-BLOCK-CURRENT-UWP-SLOT" "UNWIND-BLOCK-ENTRY-PC-SLOT"
- "UNWIND-BLOCK-SIZE" "VALUE-CELL-HEADER-TYPE" "VALUE-CELL-SIZE"
+ "UNWIND-BLOCK-SIZE" "VALUE-CELL-HEADER-WIDETAG" "VALUE-CELL-SIZE"
"VALUE-CELL-VALUE-SLOT" "VECTOR-DATA-OFFSET" "VECTOR-LENGTH-SLOT"
"VECTOR-MUST-REHASH-SUBTYPE" "VECTOR-NORMAL-SUBTYPE"
"VECTOR-VALID-HASHING-SUBTYPE"
"WEAK-POINTER-BROKEN-SLOT" "WEAK-POINTER-NEXT-SLOT"
- "WEAK-POINTER-SIZE" "WEAK-POINTER-TYPE" "WEAK-POINTER-VALUE-SLOT"
+ "WEAK-POINTER-SIZE" "WEAK-POINTER-WIDETAG"
+ "WEAK-POINTER-VALUE-SLOT"
"WORD" "WORD-BITS" "WORD-BYTES" "WORD-REG-SC-NUMBER" "WORD-SHIFT"
"ZERO-SC-NUMBER"))
(inst cmoveq temp 1 temp2)
(inst not temp temp)
(inst cmoveq temp 1 temp2)
- (inst sll temp2 type-bits temp2)
- (inst bis temp2 bignum-type temp2)
+ (inst sll temp2 n-widetag-bits temp2)
+ (inst bis temp2 bignum-widetag temp2)
(pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
(inst bis alloc-tn other-pointer-lowtag res)
(inst cmoveq temp 1 temp2)
(inst not temp temp)
(inst cmoveq temp 1 temp2)
- (inst sll temp2 type-bits temp2)
- (inst bis temp2 bignum-type temp2)
+ (inst sll temp2 n-widetag-bits temp2)
+ (inst bis temp2 bignum-widetag temp2)
(pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
(inst bis alloc-tn other-pointer-lowtag res)
(inst sra lo 32 hi)
;; Do we need one word or two? Assume two.
- (inst li (logior (ash 2 type-bits) bignum-type) temp2)
+ (inst li (logior (ash 2 n-widetag-bits) bignum-widetag) temp2)
(inst sra lo 31 temp)
(inst xor temp hi temp)
(inst bne temp two-words)
;; Only need one word, fix the header.
- (inst li (logior (ash 1 type-bits) bignum-type) temp2)
+ (inst li (logior (ash 1 n-widetag-bits) bignum-widetag) temp2)
;; Allocate one word.
(pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset)))
(inst bis alloc-tn other-pointer-lowtag res)
(:temp ndescr non-descriptor-reg nl0-offset))
;; This is kinda sleezy, changing words like this. But we can because
;; the vop thinks it is temporary.
- (inst addq words (+ (1- (ash 1 lowtag-bits))
+ (inst addq words (+ (1- (ash 1 n-lowtag-bits))
(* vector-data-offset word-bytes))
words)
(inst li (lognot lowtag-mask) ndescr)
(inst ret)
BIGNUM
- (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 1))
+ (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 1))
(storew eax ebx bignum-digits-offset other-pointer-lowtag))
(inst ret))
(inst mov ebx eax)
;; Two word bignum
- (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 2))
+ (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 2))
(storew eax ebx bignum-digits-offset other-pointer-lowtag))
(inst ret)
ONE-WORD-BIGNUM
- (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 1))
+ (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 1))
(storew eax ebx bignum-digits-offset other-pointer-lowtag))
(inst ret))
(move ecx res)
- (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
(storew ecx res bignum-digits-offset other-pointer-lowtag))
OKAY)
(move ecx res)
- (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
(storew ecx res bignum-digits-offset other-pointer-lowtag))
OKAY)
(inst cmp x ecx)
(inst jmp :e SINGLE-WORD-BIGNUM)
- (with-fixed-allocation (res bignum-type (+ bignum-digits-offset 2))
+ (with-fixed-allocation (res bignum-widetag (+ bignum-digits-offset 2))
(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))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
(storew eax res bignum-digits-offset other-pointer-lowtag))
(inst jmp DONE)
(inst shr res 2) ; sign bit is data - remove type bits
(move ecx res)
- (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
(storew ecx res bignum-digits-offset other-pointer-lowtag))
OKAY)
(:arg length any-reg ebx-offset)
(:arg words any-reg ecx-offset)
(:res result descriptor-reg edx-offset))
- (inst mov result (+ (1- (ash 1 lowtag-bits))
+ (inst mov result (+ (1- (ash 1 n-lowtag-bits))
(* vector-data-offset word-bytes)))
(inst add result words)
(inst and result (lognot sb!vm:lowtag-mask))
;; on smarter compiler transforms which do the calculation once
;; and for all in any reasonable user programs.)
((t)
- (values #.sb!vm:simple-vector-type #.sb!vm:word-bits))
+ (values #.sb!vm:simple-vector-widetag #.sb!vm:word-bits))
((character base-char standard-char)
- (values #.sb!vm:simple-string-type #.sb!vm:byte-bits))
+ (values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
((bit)
- (values #.sb!vm:simple-bit-vector-type 1))
+ (values #.sb!vm:simple-bit-vector-widetag 1))
;; OK, we have to wade into SUBTYPEPing after all.
(t
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-vector-type type
- (base-char (values #.sb!vm:simple-string-type #.sb!vm:byte-bits))
- (bit (values #.sb!vm:simple-bit-vector-type 1))
+ (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
+ (bit (values #.sb!vm:simple-bit-vector-widetag 1))
((unsigned-byte 2)
- (values #.sb!vm:simple-array-unsigned-byte-2-type 2))
+ (values #.sb!vm:simple-array-unsigned-byte-2-widetag 2))
((unsigned-byte 4)
- (values #.sb!vm:simple-array-unsigned-byte-4-type 4))
+ (values #.sb!vm:simple-array-unsigned-byte-4-widetag 4))
((unsigned-byte 8)
- (values #.sb!vm:simple-array-unsigned-byte-8-type 8))
+ (values #.sb!vm:simple-array-unsigned-byte-8-widetag 8))
((unsigned-byte 16)
- (values #.sb!vm:simple-array-unsigned-byte-16-type 16))
+ (values #.sb!vm:simple-array-unsigned-byte-16-widetag 16))
((unsigned-byte 32)
- (values #.sb!vm:simple-array-unsigned-byte-32-type 32))
+ (values #.sb!vm:simple-array-unsigned-byte-32-widetag 32))
((signed-byte 8)
- (values #.sb!vm:simple-array-signed-byte-8-type 8))
+ (values #.sb!vm:simple-array-signed-byte-8-widetag 8))
((signed-byte 16)
- (values #.sb!vm:simple-array-signed-byte-16-type 16))
+ (values #.sb!vm:simple-array-signed-byte-16-widetag 16))
((signed-byte 30)
- (values #.sb!vm:simple-array-signed-byte-30-type 32))
+ (values #.sb!vm:simple-array-signed-byte-30-widetag 32))
((signed-byte 32)
- (values #.sb!vm:simple-array-signed-byte-32-type 32))
- (single-float (values #.sb!vm:simple-array-single-float-type 32))
- (double-float (values #.sb!vm:simple-array-double-float-type 64))
+ (values #.sb!vm:simple-array-signed-byte-32-widetag 32))
+ (single-float (values #.sb!vm:simple-array-single-float-widetag 32))
+ (double-float (values #.sb!vm:simple-array-double-float-widetag 64))
#!+long-float
(long-float
- (values #.sb!vm:simple-array-long-float-type #!+x86 96 #!+sparc 128))
+ (values #.sb!vm:simple-array-long-float-widetag
+ #!+x86 96 #!+sparc 128))
((complex single-float)
- (values #.sb!vm:simple-array-complex-single-float-type 64))
+ (values #.sb!vm:simple-array-complex-single-float-widetag 64))
((complex double-float)
- (values #.sb!vm:simple-array-complex-double-float-type 128))
+ (values #.sb!vm:simple-array-complex-double-float-widetag 128))
#!+long-float
((complex long-float)
- (values #.sb!vm:simple-array-complex-long-float-type
+ (values #.sb!vm:simple-array-complex-long-float-widetag
#!+x86 192
#!+sparc 256))
- (t (values #.sb!vm:simple-vector-type #.sb!vm:word-bits))))))
+ (t (values #.sb!vm:simple-vector-widetag #.sb!vm:word-bits))))))
(defun %complex-vector-type-code (type)
(case type
;; Pick off some easy common cases.
((t)
- #.sb!vm:complex-vector-type)
+ #.sb!vm:complex-vector-widetag)
((character base-char)
- #.sb!vm:complex-string-type)
+ #.sb!vm:complex-string-widetag)
((bit)
- #.sb!vm:complex-bit-vector-type)
+ #.sb!vm:complex-bit-vector-widetag)
;; OK, we have to wade into SUBTYPEPing after all.
(t
(pick-vector-type type
- (base-char #.sb!vm:complex-string-type)
- (bit #.sb!vm:complex-bit-vector-type)
- (t #.sb!vm:complex-vector-type)))))
+ (base-char #.sb!vm:complex-string-widetag)
+ (bit #.sb!vm:complex-bit-vector-widetag)
+ (t #.sb!vm:complex-vector-widetag)))))
(defun make-array (dimensions &key
(element-type t)
(array (allocate-vector
type
length
- (ceiling (* (if (= type sb!vm:simple-string-type)
+ (ceiling (* (if (= type sb!vm:simple-string-widetag)
(1+ length)
length)
bits)
(array (make-array-header
(cond ((= array-rank 1)
(%complex-vector-type-code element-type))
- (simple sb!vm:simple-array-type)
- (t sb!vm:complex-array-type))
+ (simple sb!vm:simple-array-widetag)
+ (t sb!vm:complex-array-widetag))
array-rank)))
(cond (fill-pointer
(unless (= array-rank 1)
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-element-type
- ((sb!vm:simple-string-type sb!vm:complex-string-type) 'base-char)
- ((sb!vm:simple-bit-vector-type sb!vm:complex-bit-vector-type) 'bit)
- (sb!vm:simple-vector-type t)
- (sb!vm:simple-array-unsigned-byte-2-type '(unsigned-byte 2))
- (sb!vm:simple-array-unsigned-byte-4-type '(unsigned-byte 4))
- (sb!vm:simple-array-unsigned-byte-8-type '(unsigned-byte 8))
- (sb!vm:simple-array-unsigned-byte-16-type '(unsigned-byte 16))
- (sb!vm:simple-array-unsigned-byte-32-type '(unsigned-byte 32))
- (sb!vm:simple-array-signed-byte-8-type '(signed-byte 8))
- (sb!vm:simple-array-signed-byte-16-type '(signed-byte 16))
- (sb!vm:simple-array-signed-byte-30-type '(signed-byte 30))
- (sb!vm:simple-array-signed-byte-32-type '(signed-byte 32))
- (sb!vm:simple-array-single-float-type 'single-float)
- (sb!vm:simple-array-double-float-type 'double-float)
+ ((sb!vm:simple-string-widetag sb!vm:complex-string-widetag) 'base-char)
+ ((sb!vm:simple-bit-vector-widetag
+ sb!vm:complex-bit-vector-widetag) 'bit)
+ (sb!vm:simple-vector-widetag t)
+ (sb!vm:simple-array-unsigned-byte-2-widetag '(unsigned-byte 2))
+ (sb!vm:simple-array-unsigned-byte-4-widetag '(unsigned-byte 4))
+ (sb!vm:simple-array-unsigned-byte-8-widetag '(unsigned-byte 8))
+ (sb!vm:simple-array-unsigned-byte-16-widetag '(unsigned-byte 16))
+ (sb!vm:simple-array-unsigned-byte-32-widetag '(unsigned-byte 32))
+ (sb!vm:simple-array-signed-byte-8-widetag '(signed-byte 8))
+ (sb!vm:simple-array-signed-byte-16-widetag '(signed-byte 16))
+ (sb!vm:simple-array-signed-byte-30-widetag '(signed-byte 30))
+ (sb!vm:simple-array-signed-byte-32-widetag '(signed-byte 32))
+ (sb!vm:simple-array-single-float-widetag 'single-float)
+ (sb!vm:simple-array-double-float-widetag 'double-float)
#!+long-float
- (sb!vm:simple-array-long-float-type 'long-float)
- (sb!vm:simple-array-complex-single-float-type '(complex single-float))
- (sb!vm:simple-array-complex-double-float-type '(complex double-float))
+ (sb!vm:simple-array-long-float-widetag 'long-float)
+ (sb!vm:simple-array-complex-single-float-widetag
+ '(complex single-float))
+ (sb!vm:simple-array-complex-double-float-widetag
+ '(complex double-float))
#!+long-float
- (sb!vm:simple-array-complex-long-float-type '(complex long-float))
- ((sb!vm:simple-array-type sb!vm:complex-vector-type
- sb!vm:complex-array-type)
+ (sb!vm:simple-array-complex-long-float-widetag '(complex long-float))
+ ((sb!vm:simple-array-widetag
+ sb!vm:complex-vector-widetag
+ sb!vm:complex-array-widetag)
(with-array-data ((array array) (start) (end))
(declare (ignore start end))
(array-element-type array)))
(defconstant digit-size 32)
-(defconstant maximum-bignum-length (1- (ash 1 (- 32 sb!vm:type-bits))))
+(defconstant maximum-bignum-length (1- (ash 1 (- 32 sb!vm:n-widetag-bits))))
\f
;;;; internal inline routines
(character :enumerable t :translation base-char)
(base-char :enumerable t
:inherits (character)
- :codes (#.sb!vm:base-char-type))
- (symbol :codes (#.sb!vm:symbol-header-type))
+ :codes (#.sb!vm:base-char-widetag))
+ (symbol :codes (#.sb!vm:symbol-header-widetag))
(instance :state :read-only)
- (system-area-pointer :codes (#.sb!vm:sap-type))
- (weak-pointer :codes (#.sb!vm:weak-pointer-type))
- (code-component :codes (#.sb!vm:code-header-type))
- (lra :codes (#.sb!vm:return-pc-header-type))
- (fdefn :codes (#.sb!vm:fdefn-type))
+ (system-area-pointer :codes (#.sb!vm:sap-widetag))
+ (weak-pointer :codes (#.sb!vm:weak-pointer-widetag))
+ (code-component :codes (#.sb!vm:code-header-widetag))
+ (lra :codes (#.sb!vm:return-pc-header-widetag))
+ (fdefn :codes (#.sb!vm:fdefn-widetag))
(random-class) ; used for unknown type codes
(function
- :codes (#.sb!vm:closure-header-type
- #.sb!vm:simple-fun-header-type)
+ :codes (#.sb!vm:closure-header-widetag
+ #.sb!vm:simple-fun-header-widetag)
:state :read-only)
(funcallable-instance
:inherits (function)
:inherits (generic-array
mutable-sequence mutable-collection
generic-sequence collection))
- (array :translation array :codes (#.sb!vm:complex-array-type)
+ (array :translation array :codes (#.sb!vm:complex-array-widetag)
:inherits (generic-array mutable-sequence mutable-collection
generic-sequence collection))
(simple-array
- :translation simple-array :codes (#.sb!vm:simple-array-type)
+ :translation simple-array :codes (#.sb!vm:simple-array-widetag)
:inherits (array generic-array mutable-sequence mutable-collection
generic-sequence collection))
(sequence
:inherits (mutable-sequence mutable-collection generic-sequence
collection))
(vector
- :translation vector :codes (#.sb!vm:complex-vector-type)
+ :translation vector :codes (#.sb!vm:complex-vector-widetag)
:direct-superclasses (array sequence generic-vector)
:inherits (array sequence generic-vector generic-array
mutable-sequence mutable-collection generic-sequence
collection))
(simple-vector
- :translation simple-vector :codes (#.sb!vm:simple-vector-type)
+ :translation simple-vector :codes (#.sb!vm:simple-vector-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array
sequence generic-vector generic-array
mutable-sequence mutable-collection
generic-sequence collection))
(bit-vector
- :translation bit-vector :codes (#.sb!vm:complex-bit-vector-type)
+ :translation bit-vector :codes (#.sb!vm:complex-bit-vector-widetag)
:inherits (vector array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-bit-vector
- :translation simple-bit-vector :codes (#.sb!vm:simple-bit-vector-type)
+ :translation simple-bit-vector :codes (#.sb!vm:simple-bit-vector-widetag)
:direct-superclasses (bit-vector simple-array)
:inherits (bit-vector vector simple-array
array sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-2
:translation (simple-array (unsigned-byte 2) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-2-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-2-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-4
:translation (simple-array (unsigned-byte 4) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-4-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-4-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-8
:translation (simple-array (unsigned-byte 8) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-8-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-8-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-16
:translation (simple-array (unsigned-byte 16) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-16-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-32
:translation (simple-array (unsigned-byte 32) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-32-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-8
:translation (simple-array (signed-byte 8) (*))
- :codes (#.sb!vm:simple-array-signed-byte-8-type)
+ :codes (#.sb!vm:simple-array-signed-byte-8-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-16
:translation (simple-array (signed-byte 16) (*))
- :codes (#.sb!vm:simple-array-signed-byte-16-type)
+ :codes (#.sb!vm:simple-array-signed-byte-16-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-30
:translation (simple-array (signed-byte 30) (*))
- :codes (#.sb!vm:simple-array-signed-byte-30-type)
+ :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-32
:translation (simple-array (signed-byte 32) (*))
- :codes (#.sb!vm:simple-array-signed-byte-32-type)
+ :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-single-float
:translation (simple-array single-float (*))
- :codes (#.sb!vm:simple-array-single-float-type)
+ :codes (#.sb!vm:simple-array-single-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-double-float
:translation (simple-array double-float (*))
- :codes (#.sb!vm:simple-array-double-float-type)
+ :codes (#.sb!vm:simple-array-double-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
#!+long-float
(simple-array-long-float
:translation (simple-array long-float (*))
- :codes (#.sb!vm:simple-array-long-float-type)
+ :codes (#.sb!vm:simple-array-long-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-complex-single-float
:translation (simple-array (complex single-float) (*))
- :codes (#.sb!vm:simple-array-complex-single-float-type)
+ :codes (#.sb!vm:simple-array-complex-single-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-complex-double-float
:translation (simple-array (complex double-float) (*))
- :codes (#.sb!vm:simple-array-complex-double-float-type)
+ :codes (#.sb!vm:simple-array-complex-double-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
#!+long-float
(simple-array-complex-long-float
:translation (simple-array (complex long-float) (*))
- :codes (#.sb!vm:simple-array-complex-long-float-type)
+ :codes (#.sb!vm:simple-array-complex-long-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
collection))
(string
:translation string
- :codes (#.sb!vm:complex-string-type)
+ :codes (#.sb!vm:complex-string-widetag)
:direct-superclasses (vector generic-string)
:inherits (vector array sequence
generic-vector generic-array generic-string
generic-sequence collection))
(simple-string
:translation simple-string
- :codes (#.sb!vm:simple-string-type)
+ :codes (#.sb!vm:simple-string-widetag)
:direct-superclasses (string simple-array)
:inherits (string vector simple-array
array sequence
(complex
:translation complex
:inherits (number generic-number)
- :codes (#.sb!vm:complex-type))
+ :codes (#.sb!vm:complex-widetag))
(complex-single-float
:translation (complex single-float)
:inherits (complex number generic-number)
- :codes (#.sb!vm:complex-single-float-type))
+ :codes (#.sb!vm:complex-single-float-widetag))
(complex-double-float
:translation (complex double-float)
:inherits (complex number generic-number)
- :codes (#.sb!vm:complex-double-float-type))
+ :codes (#.sb!vm:complex-double-float-widetag))
#!+long-float
(complex-long-float
:translation (complex long-float)
:inherits (complex number generic-number)
- :codes (#.sb!vm:complex-long-float-type))
+ :codes (#.sb!vm:complex-long-float-widetag))
(real :translation real :inherits (number generic-number))
(float
:translation float
(single-float
:translation single-float
:inherits (float real number generic-number)
- :codes (#.sb!vm:single-float-type))
+ :codes (#.sb!vm:single-float-widetag))
(double-float
:translation double-float
:inherits (float real number generic-number)
- :codes (#.sb!vm:double-float-type))
+ :codes (#.sb!vm:double-float-widetag))
#!+long-float
(long-float
:translation long-float
:inherits (float real number generic-number)
- :codes (#.sb!vm:long-float-type))
+ :codes (#.sb!vm:long-float-widetag))
(rational
:translation rational
:inherits (real number generic-number))
(ratio
:translation (and rational (not integer))
:inherits (rational real number generic-number)
- :codes (#.sb!vm:ratio-type))
+ :codes (#.sb!vm:ratio-widetag))
(integer
:translation integer
:inherits (rational real number generic-number))
:translation (and integer (not fixnum))
:inherits (integer rational real number
generic-number)
- :codes (#.sb!vm:bignum-type))
+ :codes (#.sb!vm:bignum-widetag))
(stream
:state :read-only
:depth 3
(let ((lowtag (get-lowtag object)))
(if (= lowtag sb!vm:other-pointer-lowtag)
(let ((type (get-type object)))
- (cond ((= type sb!vm:code-header-type)
+ (cond ((= type sb!vm:code-header-widetag)
object)
- ((= type sb!vm:return-pc-header-type)
+ ((= type sb!vm:return-pc-header-widetag)
(lra-code-header object))
(t
nil))))))))
(defun fun-debug-fun (fun)
(declare (type function fun))
(ecase (get-type fun)
- (#.sb!vm:closure-header-type
+ (#.sb!vm:closure-header-widetag
(fun-debug-fun (%closure-fun fun)))
- (#.sb!vm:funcallable-instance-header-type
+ (#.sb!vm:funcallable-instance-header-widetag
(fun-debug-fun (funcallable-instance-fun fun)))
- ((#.sb!vm:simple-fun-header-type
- #.sb!vm:closure-fun-header-type)
+ ((#.sb!vm:simple-fun-header-widetag
+ #.sb!vm:closure-fun-header-widetag)
(let* ((name (%simple-fun-name fun))
(component (fun-code-header fun))
(res (find-if
(zerop (logand val 3))
;; character
(and (zerop (logand val #xffff0000)) ; Top bits zero
- (= (logand val #xff) sb!vm:base-char-type)) ; Char tag
+ (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag
;; unbound marker
- (= val sb!vm:unbound-marker-type)
+ (= val sb!vm:unbound-marker-widetag)
;; pointer
(and (logand val 1)
;; Check that the pointer is valid. XXX Could do a better
;;; indirection cell.
(defun indirect-value-cell-p (x)
(and (= (get-lowtag x) sb!vm:other-pointer-lowtag)
- (= (get-type x) sb!vm:value-cell-header-type)))
+ (= (get-type x) sb!vm:value-cell-header-widetag)))
;;; Return three values reflecting the validity of DEBUG-VAR's value
;;; at BASIC-CODE-LOCATION:
(:function (format s "Function: ~S" x))
((nil) (format s "~S is a function." x)))
(case (get-type x)
- (#.sb-vm:closure-header-type
+ (#.sb-vm:closure-header-widetag
(%describe-function-compiled (%closure-fun x) s kind name)
(format s "~@:_Its closure environment is:")
(pprint-logical-block (s nil)
(pprint-indent :current 8)
(dotimes (i (- (get-closure-length x) (1- sb-vm:closure-info-offset)))
(format s "~@:_~S: ~S" i (%closure-index-ref x i)))))
- ((#.sb-vm:simple-fun-header-type #.sb-vm:closure-fun-header-type)
+ ((#.sb-vm:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag)
(%describe-function-compiled x s kind name))
- (#.sb-vm:funcallable-instance-header-type
+ (#.sb-vm:funcallable-instance-header-widetag
(typecase x
(standard-generic-function
;; There should be a special method for this case; we'll
;;; Find the encapsulation info that has been closed over.
(defun encapsulation-info (fun)
(and (functionp fun)
- (= (get-type fun) sb!vm:closure-header-type)
+ (= (get-type fun) sb!vm:closure-header-widetag)
(find-if-in-closure #'encapsulation-info-p fun)))
;;; When removing an encapsulation, we must remember that
#+sb-xc-host ; since xc host doesn't know how to compile %PRIMITIVE
(error "FOP-MISC-TRAP can't be defined without %PRIMITIVE.")
#-sb-xc-host
- (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-type))
+ (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-widetag))
(define-fop (fop-character 68)
(code-char (read-arg 3)))
(let* ((rank (read-arg 4))
(vec (pop-stack))
(length (length vec))
- (res (make-array-header sb!vm:simple-array-type rank)))
+ (res (make-array-header sb!vm:simple-array-widetag rank)))
(declare (simple-array vec)
(type (unsigned-byte 24) rank))
(set-array-header res vec length length 0
(defmethod inspected-parts ((object function))
(let* ((type (sb-kernel:get-type object))
- (object (if (= type sb-vm:closure-header-type)
+ (object (if (= type sb-vm:closure-header-widetag)
(sb-kernel:%closure-fun object)
object)))
(values (format nil "FUNCTION ~S.~@[~%Argument List: ~A~]." object
#-(or linux hpux) #.(/ (asinh most-positive-double-float) 4d0)
;; This is more accurate under linux.
#+(or linux hpux) #.(/ (+ (log 2.0d0)
- (log most-positive-double-float)) 4d0))
+ (log most-positive-double-float))
+ 4d0))
(coerce-to-complex-type (float-sign x)
(float-sign y) z))
(t
(function x)
(t (values (fdefinition x) t)))
(case (sb-kernel:get-type res)
- (#.sb-vm:closure-header-type
+ (#.sb-vm:closure-header-widetag
(values (sb-kernel:%closure-fun res)
named-p
:compiled-closure))
- (#.sb-vm:funcallable-instance-header-type
+ (#.sb-vm:funcallable-instance-header-widetag
(values res named-p :funcallable-instance))
(t (values res named-p :compiled)))))
(defun complex (realpart &optional (imagpart 0))
#!+sb-doc
- "Builds a complex number from the specified components."
+ "Return a complex number with the specified real and imaginary components."
(flet ((%%make-complex (realpart imagpart)
(cond #!+long-float
((and (typep realpart 'long-float)
(defun realpart (number)
#!+sb-doc
- "Extracts the real part of a number."
+ "Extract the real part of a number."
(typecase number
#!+long-float
((complex long-float)
(defun imagpart (number)
#!+sb-doc
- "Extracts the imaginary part of a number."
+ "Extract the imaginary part of a number."
(typecase number
#!+long-float
((complex long-float)
(defun - (number &rest more-numbers)
#!+sb-doc
- "Subtracts the second and all subsequent arguments from the first.
- With one arg, negates it."
+ "Subtract the second and all subsequent arguments from the first;
+ or with one argument, negate the first argument."
(if more-numbers
(do ((nlist more-numbers (cdr nlist))
(result number))
;; FIXME: This find-the-function-name idiom ought to be
;; pulled out in a function somewhere.
(name (case (function-subtype object)
- (#.sb!vm:closure-header-type "CLOSURE")
- (#.sb!vm:simple-fun-header-type (%simple-fun-name object))
+ (#.sb!vm:closure-header-widetag "CLOSURE")
+ (#.sb!vm:simple-fun-header-widetag (%simple-fun-name object))
(t 'no-name-available)))
(identified-by-name-p (and (symbolp name)
(fboundp name)
(#.sb!vm:other-pointer-lowtag
(let ((type (get-type object)))
(case type
- (#.sb!vm:value-cell-header-type
+ (#.sb!vm:value-cell-header-widetag
(write-string "value cell " stream)
(output-object (value-cell-ref object) stream))
(t
(write-string "unknown pointer object, type=" stream))
(t
(case (get-type object)
- (#.sb!vm:unbound-marker-type
+ (#.sb!vm:unbound-marker-widetag
(write-string "unbound marker" stream))
(t
(write-string "unknown immediate object, lowtag=" stream)
:kind :fixed
:length size))))))
-(dolist (code (list complex-string-type simple-array-type
- complex-bit-vector-type complex-vector-type
- complex-array-type))
+(dolist (code (list complex-string-widetag simple-array-widetag
+ complex-bit-vector-widetag complex-vector-widetag
+ complex-array-widetag))
(setf (svref *meta-room-info* code)
(make-room-info :name 'array-header
:kind :header)))
-(setf (svref *meta-room-info* bignum-type)
+(setf (svref *meta-room-info* bignum-widetag)
(make-room-info :name 'bignum
:kind :header))
-(setf (svref *meta-room-info* closure-header-type)
+(setf (svref *meta-room-info* closure-header-widetag)
(make-room-info :name 'closure
:kind :closure))
-(dolist (stuff '((simple-bit-vector-type . -3)
- (simple-vector-type . 2)
- (simple-array-unsigned-byte-2-type . -2)
- (simple-array-unsigned-byte-4-type . -1)
- (simple-array-unsigned-byte-8-type . 0)
- (simple-array-unsigned-byte-16-type . 1)
- (simple-array-unsigned-byte-32-type . 2)
- (simple-array-signed-byte-8-type . 0)
- (simple-array-signed-byte-16-type . 1)
- (simple-array-signed-byte-30-type . 2)
- (simple-array-signed-byte-32-type . 2)
- (simple-array-single-float-type . 2)
- (simple-array-double-float-type . 3)
- (simple-array-complex-single-float-type . 3)
- (simple-array-complex-double-float-type . 4)))
+(dolist (stuff '((simple-bit-vector-widetag . -3)
+ (simple-vector-widetag . 2)
+ (simple-array-unsigned-byte-2-widetag . -2)
+ (simple-array-unsigned-byte-4-widetag . -1)
+ (simple-array-unsigned-byte-8-widetag . 0)
+ (simple-array-unsigned-byte-16-widetag . 1)
+ (simple-array-unsigned-byte-32-widetag . 2)
+ (simple-array-signed-byte-8-widetag . 0)
+ (simple-array-signed-byte-16-widetag . 1)
+ (simple-array-signed-byte-30-widetag . 2)
+ (simple-array-signed-byte-32-widetag . 2)
+ (simple-array-single-float-widetag . 2)
+ (simple-array-double-float-widetag . 3)
+ (simple-array-complex-single-float-widetag . 3)
+ (simple-array-complex-double-float-widetag . 4)))
(let ((name (car stuff))
(size (cdr stuff)))
(setf (svref *meta-room-info* (symbol-value name))
:kind :vector
:length size))))
-(setf (svref *meta-room-info* simple-string-type)
- (make-room-info :name 'simple-string-type
+(setf (svref *meta-room-info* simple-string-widetag)
+ (make-room-info :name 'simple-string-widetag
:kind :string
:length 0))
-(setf (svref *meta-room-info* code-header-type)
+(setf (svref *meta-room-info* code-header-widetag)
(make-room-info :name 'code
:kind :code))
-(setf (svref *meta-room-info* instance-header-type)
+(setf (svref *meta-room-info* instance-header-widetag)
(make-room-info :name 'instance
:kind :instance))
(prev nil))
(loop
(let* ((header (sap-ref-32 current 0))
- (header-type (logand header #xFF))
- (info (svref *room-info* header-type)))
+ (header-widetag (logand header #xFF))
+ (info (svref *room-info* header-widetag)))
(cond
((or (not info)
(eq (room-info-kind info) :lowtag))
list-pointer-lowtag
size)
(setq current (sap+ current size))))
- ((eql header-type closure-header-type)
+ ((eql header-widetag closure-header-widetag)
(let* ((obj (make-lisp-obj (logior (sap-int current)
fun-pointer-lowtag)))
(size (round-to-dualword
(* (the fixnum (1+ (get-closure-length obj)))
word-bytes))))
- (funcall fun obj header-type size)
+ (funcall fun obj header-widetag size)
(setq current (sap+ current size))))
((eq (room-info-kind info) :instance)
(let* ((obj (make-lisp-obj
(size (round-to-dualword
(* (+ (%instance-length obj) 1) word-bytes))))
(declare (fixnum size))
- (funcall fun obj header-type size)
+ (funcall fun obj header-widetag size)
(aver (zerop (logand size lowtag-mask)))
#+nil
(when (> size 200000) (break "implausible size, prev ~S" prev))
(* (the fixnum (%code-code-size obj))
word-bytes)))))))
(declare (fixnum size))
- (funcall fun obj header-type size)
+ (funcall fun obj header-widetag size)
(aver (zerop (logand size lowtag-mask)))
#+nil
(when (> size 200000)
(map-allocated-objects
#'(lambda (obj type size)
(declare (fixnum size) (optimize (safety 0)))
- (when (eql type code-header-type)
+ (when (eql type code-header-widetag)
(incf total-bytes size)
(let ((words (truly-the fixnum (%code-code-size obj)))
(sap (truly-the system-area-pointer
#'(lambda (obj type size)
(declare (fixnum size) (optimize (safety 0)))
(case type
- (#.code-header-type
+ (#.code-header-widetag
(let ((inst-words (truly-the fixnum (%code-code-size obj))))
(declare (type fixnum inst-words))
(incf non-descriptor-bytes (* inst-words word-bytes))
(incf descriptor-words
(- (truncate size word-bytes) inst-words))))
- ((#.bignum-type
- #.single-float-type
- #.double-float-type
- #.simple-string-type
- #.simple-bit-vector-type
- #.simple-array-unsigned-byte-2-type
- #.simple-array-unsigned-byte-4-type
- #.simple-array-unsigned-byte-8-type
- #.simple-array-unsigned-byte-16-type
- #.simple-array-unsigned-byte-32-type
- #.simple-array-signed-byte-8-type
- #.simple-array-signed-byte-16-type
- #.simple-array-signed-byte-30-type
- #.simple-array-signed-byte-32-type
- #.simple-array-single-float-type
- #.simple-array-double-float-type
- #.simple-array-complex-single-float-type
- #.simple-array-complex-double-float-type)
+ ((#.bignum-widetag
+ #.single-float-widetag
+ #.double-float-widetag
+ #.simple-string-widetag
+ #.simple-bit-vector-widetag
+ #.simple-array-unsigned-byte-2-widetag
+ #.simple-array-unsigned-byte-4-widetag
+ #.simple-array-unsigned-byte-8-widetag
+ #.simple-array-unsigned-byte-16-widetag
+ #.simple-array-unsigned-byte-32-widetag
+ #.simple-array-signed-byte-8-widetag
+ #.simple-array-signed-byte-16-widetag
+ #.simple-array-signed-byte-30-widetag
+ #.simple-array-signed-byte-32-widetag
+ #.simple-array-single-float-widetag
+ #.simple-array-double-float-widetag
+ #.simple-array-complex-single-float-widetag
+ #.simple-array-complex-double-float-widetag)
(incf non-descriptor-headers)
(incf non-descriptor-bytes (- size word-bytes)))
((#.list-pointer-lowtag
#.instance-pointer-lowtag
- #.ratio-type
- #.complex-type
- #.simple-array-type
- #.simple-vector-type
- #.complex-string-type
- #.complex-bit-vector-type
- #.complex-vector-type
- #.complex-array-type
- #.closure-header-type
- #.funcallable-instance-header-type
- #.value-cell-header-type
- #.symbol-header-type
- #.sap-type
- #.weak-pointer-type
- #.instance-header-type)
+ #.ratio-widetag
+ #.complex-widetag
+ #.simple-array-widetag
+ #.simple-vector-widetag
+ #.complex-string-widetag
+ #.complex-bit-vector-widetag
+ #.complex-vector-widetag
+ #.complex-array-widetag
+ #.closure-header-widetag
+ #.funcallable-instance-header-widetag
+ #.value-cell-header-widetag
+ #.symbol-header-widetag
+ #.sap-widetag
+ #.weak-pointer-widetag
+ #.instance-header-widetag)
(incf descriptor-words (truncate size word-bytes)))
(t
(error "Bogus type: ~D" type))))
(map-allocated-objects
#'(lambda (obj type size)
(declare (fixnum size) (optimize (speed 3) (safety 0)))
- (when (eql type instance-header-type)
+ (when (eql type instance-header-widetag)
(incf total-objects)
(incf total-bytes size)
(let* ((class (layout-class (%instance-ref obj 0)))
(or (not larger) (>= size larger)))
(incf count-so-far)
(case type
- (#.code-header-type
+ (#.code-header-widetag
(let ((dinfo (%code-debug-info obj)))
(format stream "~&Code object: ~S~%"
(if dinfo
(sb!c::compiled-debug-info-name dinfo)
"No debug info."))))
- (#.symbol-header-type
+ (#.symbol-header-widetag
(format stream "~&~S~%" obj))
(#.list-pointer-lowtag
(unless (gethash obj printed-conses)
(fresh-line stream)
(let ((str (write-to-string obj :level 5 :length 10
:pretty nil)))
- (unless (eql type instance-header-type)
+ (unless (eql type instance-header-widetag)
(format stream "~S: " (type-of obj)))
(format stream "~A~%"
(subseq str 0 (min (length str) 60))))))))))
"VARIABLE must evaluate to a symbol. This symbol is made unbound,
removing any value it may currently have."
(set variable
- (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-type))
+ (%primitive sb!c:make-other-immediate-type
+ 0
+ sb!vm:unbound-marker-widetag))
variable)
#!+(or x86 mips) ;; only backends for which a symbol-hash vop exists
(defun function-doc (x)
(let ((name
(case (get-type x)
- (#.sb!vm:closure-header-type
+ (#.sb!vm:closure-header-widetag
(%simple-fun-name (%closure-fun x)))
- ((#.sb!vm:simple-fun-header-type #.sb!vm:closure-fun-header-type)
+ ((#.sb!vm:simple-fun-header-widetag
+ #.sb!vm:closure-fun-header-widetag)
(%simple-fun-name x))
- (#.sb!vm:funcallable-instance-header-type
+ (#.sb!vm:funcallable-instance-header-widetag
(%simple-fun-name
(funcallable-instance-fun x))))))
(when (and name (typep name '(or symbol cons)))
new-fixups)))
(t
(unless (or (eq (get-type fixups)
- sb!vm:unbound-marker-type)
+ sb!vm:unbound-marker-widetag)
(zerop fixups))
(format t "** Init. code FU = ~S~%" fixups)) ; FIXME
(setf (code-header-ref code code-constants-offset)
new-fixups)))
(t
(unless (or (eq (get-type fixups)
- sb!vm:unbound-marker-type)
+ sb!vm:unbound-marker-widetag)
(zerop fixups))
(sb!impl::!cold-lose "Argh! can't process fixup"))
(setf (code-header-ref code sb!vm:code-constants-offset)
(inst srl unboxed-arg word-shift unboxed)
(inst lda unboxed lowtag-mask unboxed)
(inst and unboxed ndescr unboxed)
- (inst sll boxed (- type-bits word-shift) ndescr)
- (inst bis ndescr code-header-type ndescr)
+ (inst sll boxed (- n-widetag-bits word-shift) ndescr)
+ (inst bis ndescr code-header-widetag ndescr)
(pseudo-atomic ()
(inst bis alloc-tn other-pointer-lowtag result)
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (result :scs (descriptor-reg) :from :argument))
(:generator 37
- (with-fixed-allocation (result temp fdefn-type fdefn-size)
+ (with-fixed-allocation (result temp fdefn-widetag fdefn-size)
(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)
(:results (result :scs (descriptor-reg)))
(:generator 10
(let ((size (+ length closure-info-offset)))
- (inst li (logior (ash (1- size) type-bits) closure-header-type) temp)
+ (inst li
+ (logior (ash (1- size) n-widetag-bits) closure-header-widetag)
+ temp)
(pseudo-atomic (:extra (pad-data-block size))
(inst bis alloc-tn fun-pointer-lowtag result)
(storew temp result 0 fun-pointer-lowtag))
(:results (result :scs (descriptor-reg)))
(:generator 10
(with-fixed-allocation
- (result temp value-cell-header-type value-cell-size))
+ (result temp value-cell-header-widetag value-cell-size))
(storew value result value-cell-value-slot other-pointer-lowtag)))
\f
(:args)
(:results (result :scs (any-reg)))
(:generator 1
- (inst li unbound-marker-type result)))
+ (inst li unbound-marker-widetag result)))
(define-vop (fixed-alloc)
(:args)
(pseudo-atomic (:extra (pad-data-block words))
(inst bis alloc-tn lowtag result)
(when type
- (inst li (logior (ash (1- words) type-bits) type) temp)
+ (inst li (logior (ash (1- words) n-widetag-bits) type) temp)
(storew temp result 0 lowtag)))))
(define-vop (var-alloc)
(:temporary (:scs (non-descriptor-reg)) bytes)
(:generator 6
(inst lda bytes (* (1+ words) word-bytes) extra)
- (inst sll bytes (- type-bits 2) header)
- (inst lda header (+ (ash -2 type-bits) type) header)
- (inst srl bytes lowtag-bits bytes)
- (inst sll bytes lowtag-bits bytes)
+ (inst sll bytes (- n-widetag-bits 2) header)
+ (inst lda header (+ (ash -2 n-widetag-bits) type) header)
+ (inst srl bytes n-lowtag-bits bytes)
+ (inst sll bytes n-lowtag-bits bytes)
(pseudo-atomic ()
(inst bis alloc-tn lowtag result)
(storew header result 0 lowtag)
(inst li (lognot lowtag-mask) header)
(inst and bytes header bytes)
(inst addq rank (fixnumize (1- array-dimensions-offset)) header)
- (inst sll header type-bits header)
+ (inst sll header n-widetag-bits header)
(inst bis header type header)
(inst srl header 2 header)
(pseudo-atomic ()
(:results (res :scs (any-reg descriptor-reg)))
(:generator 6
(loadw temp x 0 other-pointer-lowtag)
- (inst sra temp type-bits temp)
+ (inst sra temp n-widetag-bits temp)
(inst subq temp (1- array-dimensions-offset) temp)
(inst sll temp 2 res)))
(:generator 1
;; Make sure the function is aligned, and drop a label pointing to
;; this function header.
- (align lowtag-bits)
+ (align n-lowtag-bits)
(trace-table-entry trace-table-function-prologue)
(emit-label start-lab)
;; Allocate function header.
(move object obj-temp)
(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 xor value unbound-marker-widetag temp)
(inst beq temp err-lab))))
;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell
(:translate boundp)
(:generator 9
(loadw value object symbol-value-slot other-pointer-lowtag)
- (inst xor value unbound-marker-type temp)
+ (inst xor value unbound-marker-widetag temp)
(if not-p
(inst beq temp target)
(inst bne temp target))))
(:generator 38
(let ((normal-fn (gen-label)))
(load-type type function (- fun-pointer-lowtag))
- (inst xor type simple-fun-header-type type)
+ (inst xor type simple-fun-header-widetag type)
(inst addq function
(- (ash simple-fun-code-offset word-shift) fun-pointer-lowtag)
lip)
(:result-types positive-fixnum)
(:generator 4
(loadw res struct 0 instance-pointer-lowtag)
- (inst srl res type-bits res)))
+ (inst srl res n-widetag-bits res)))
(define-vop (instance-ref slot-ref)
(:variant instance-slots-offset instance-pointer-lowtag)
(:args (x :scs (any-reg descriptor-reg)))
(:results (y :scs (base-char-reg)))
(:generator 1
- (inst srl x sb!vm:type-bits y)))
+ (inst srl x sb!vm:n-widetag-bits y)))
;;;
(define-move-vop move-to-base-char :move
(any-reg descriptor-reg) (base-char-reg))
(:args (x :scs (base-char-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:generator 1
- (inst sll x sb!vm:type-bits y)
- (inst bis y sb!vm:base-char-type y)))
+ (inst sll x sb!vm:n-widetag-bits y)
+ (inst bis y sb!vm:base-char-widetag y)))
;;;
(define-move-vop move-from-base-char :move
(base-char-reg) (any-reg descriptor-reg))
(let ((bogus (gen-label))
(done (gen-label)))
(loadw temp thing 0 lowtag)
- (inst srl temp sb!vm:type-bits temp)
+ (inst srl temp sb!vm:n-widetag-bits temp)
(inst beq temp bogus)
(inst sll temp (1- (integer-length sb!vm:word-bytes)) temp)
(unless (= lowtag sb!vm:other-pointer-lowtag)
(:result-types positive-fixnum)
(:generator 5
(loadw res fun 0 fun-pointer-lowtag)
- (inst srl res sb!vm:type-bits res)))
+ (inst srl res sb!vm:n-widetag-bits res)))
(defknown make-number-stack-pointer ((unsigned-byte 32)) system-area-pointer
(movable foldable flushable))
(:variant ,@args))
(define-move-vop ,name :move (,sc) (descriptor-reg)))))
(frob move-from-single single-reg
- nil single-float-size single-float-type single-float-value-slot)
+ nil single-float-size single-float-widetag single-float-value-slot)
(frob move-from-double double-reg
- t double-float-size double-float-type double-float-value-slot))
+ t double-float-size double-float-widetag double-float-value-slot))
(macrolet ((frob (name sc double-p value)
`(progn
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:note "complex single float to pointer coercion")
(:generator 13
- (with-fixed-allocation (y ndescr sb!vm:complex-single-float-type
+ (with-fixed-allocation (y ndescr sb!vm:complex-single-float-widetag
sb!vm:complex-single-float-size)
(let ((real-tn (complex-single-reg-real-tn x)))
(inst sts real-tn (- (* sb!vm:complex-single-float-real-slot
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:note "complex double float to pointer coercion")
(:generator 13
- (with-fixed-allocation (y ndescr sb!vm:complex-double-float-type
+ (with-fixed-allocation (y ndescr sb!vm:complex-double-float-widetag
sb!vm:complex-double-float-size)
(let ((real-tn (complex-double-reg-real-tn x)))
(inst stt real-tn (- (* sb!vm:complex-double-float-real-slot
(emit-lword segment
(logior type
(ash (+ posn (component-header-length))
- (- type-bits word-shift)))))))
+ (- n-widetag-bits word-shift)))))))
(define-instruction simple-fun-header-word (segment)
(:cost 0)
(:emitter
- (emit-header-data segment simple-fun-header-type)))
+ (emit-header-data segment simple-fun-header-widetag)))
(define-instruction lra-header-word (segment)
(:cost 0)
(:emitter
- (emit-header-data segment return-pc-header-type)))
+ (emit-header-data segment return-pc-header-widetag)))
(defun emit-compute-inst (segment vop dst src label temp calc)
(declare (ignore temp))
"Emit a return-pc header word. LABEL is the label to use for this
return-pc."
`(progn
- (align lowtag-bits)
+ (align n-lowtag-bits)
(emit-label ,label)
(inst lra-header-word)))
\f
;;;; storage allocation
-;;; Do stuff to allocate an other-pointer object of fixed Size with a
-;;; single word header having the specified Type-Code. The result is
-;;; placed in Result-TN, Flag-Tn must be wired to NL3-OFFSET, and
+;;; Do stuff to allocate an other-pointer object of fixed SIZE with a
+;;; single word header having the specified WIDETAG value. The result is
+;;; placed in RESULT-TN, Flag-Tn must be wired to NL3-OFFSET, and
;;; Temp-TN is a non- descriptor temp (which may be randomly used by
;;; the body.) The body is placed inside the PSEUDO-ATOMIC, and
;;; presumably initializes the object.
-(defmacro with-fixed-allocation ((result-tn temp-tn type-code size)
+(defmacro with-fixed-allocation ((result-tn temp-tn widetagsize)
&body body)
`(pseudo-atomic (:extra (pad-data-block ,size))
(inst bis alloc-tn other-pointer-lowtag ,result-tn)
- (inst li (logior (ash (1- ,size) type-bits) ,type-code) ,temp-tn)
+ (inst li (logior (ash (1- ,size) n-widetag-bits) ,widetag) ,temp-tn)
(storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
,@body))
-
-
\f
-;;;; Error Code
-
+;;;; error code
(defvar *adjustable-vectors* nil)
(symbol
(load-symbol y val))
(character
- (inst li (logior (ash (char-code val) type-bits) base-char-type)
+ (inst li (logior (ash (char-code val) n-widetag-bits) base-char-widetag)
y)))))
(define-move-function (load-number 1) (vop x y)
(inst beq temp done)
(loadw header x 0 other-pointer-lowtag)
- (inst srl header (1+ type-bits) header)
+ (inst srl header (1+ n-widetag-bits) header)
(loadw y x bignum-digits-offset other-pointer-lowtag)
(inst beq header one)
(inst cmoveq temp 1 header)
(inst not temp temp)
(inst cmoveq temp 1 header)
- (inst sll header type-bits header)
- (inst bis header bignum-type header)
+ (inst sll header n-widetag-bits header)
+ (inst bis header bignum-widetag header)
(pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
(inst bis alloc-tn other-pointer-lowtag y)
(inst cmovge x 2 temp)
(inst srl x 31 temp1)
(inst cmoveq temp1 1 temp)
- (inst sll temp type-bits temp)
- (inst bis temp bignum-type temp)
+ (inst sll temp n-widetag-bits temp)
+ (inst bis temp bignum-widetag temp)
(pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
(inst bis alloc-tn other-pointer-lowtag y)
(:note "system area pointer allocation")
(:generator 20
(move x sap)
- (with-fixed-allocation (y ndescr sap-type sap-size)
+ (with-fixed-allocation (y ndescr sap-widetag sap-size)
(storeq sap y sap-pointer-slot other-pointer-lowtag))))
(define-move-vop move-from-sap :move
(sap-reg) (descriptor-reg))
(inst beq result done)
;; Must be an other immediate.
- (inst and object type-mask result)
+ (inst and object widetag-mask result)
(inst br zero-tn done)
FUNCTION-PTR
(:result-types positive-fixnum)
(:generator 6
(loadw res x 0 other-pointer-lowtag)
- (inst srl res type-bits res)))
+ (inst srl res n-widetag-bits res)))
(define-vop (get-closure-length)
(:translate get-closure-length)
(:result-types positive-fixnum)
(:generator 6
(loadw res x 0 fun-pointer-lowtag)
- (inst srl res type-bits res)))
+ (inst srl res n-widetag-bits res)))
(define-vop (set-header-data)
(:translate set-header-data)
(:temporary (:scs (non-descriptor-reg)) t1 t2)
(:generator 6
(loadw t1 x 0 other-pointer-lowtag)
- (inst and t1 type-mask t1)
+ (inst and t1 widetag-mask t1)
(sc-case data
(any-reg
- (inst sll data (- type-bits 2) t2)
+ (inst sll data (- n-widetag-bits 2) t2)
(inst bis t1 t2 t1))
(immediate
- (let ((c (ash (tn-value data) type-bits)))
+ (let ((c (ash (tn-value data) n-widetag-bits)))
(cond ((<= 0 c (1- (ash 1 8)))
(inst bis t1 c t1))
(t
(:generator 2
(sc-case type
((immediate)
- (inst sll val type-bits temp)
+ (inst sll val n-widetag-bits temp)
(inst bis temp (tn-value type) res))
(t
(inst sra type 2 temp)
- (inst sll val (- type-bits 2) res)
+ (inst sll val (- n-widetag-bits 2) res)
(inst bis res temp res)))))
\f
(:result-types system-area-pointer)
(:generator 10
(loadw ndescr code 0 other-pointer-lowtag)
- (inst srl ndescr type-bits ndescr)
+ (inst srl ndescr n-widetag-bits ndescr)
(inst sll ndescr word-shift ndescr)
(inst subq ndescr other-pointer-lowtag ndescr)
(inst addq code ndescr sap)))
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:generator 10
(loadw ndescr code 0 other-pointer-lowtag)
- (inst srl ndescr type-bits ndescr)
+ (inst srl ndescr n-widetag-bits ndescr)
(inst sll ndescr word-shift ndescr)
(inst addq ndescr offset ndescr)
(inst subq ndescr (- other-pointer-lowtag fun-pointer-lowtag) ndescr)
(eval-when (:compile-toplevel :execute)
(defparameter *immediate-types*
- (list unbound-marker-type base-char-type))
+ (list unbound-marker-widetag base-char-widetag))
-(defparameter *fun-header-types*
- (list funcallable-instance-header-type
- simple-fun-header-type
- closure-fun-header-type
- closure-header-type))
+(defparameter *fun-header-widetags*
+ (list funcallable-instance-header-widetag
+ simple-fun-header-widetag
+ closure-fun-header-widetag
+ closure-header-widetag))
(defun canonicalize-headers (headers)
(collect ((results))
(extended (remove lowtag-limit type-codes :test #'>))
(immediates (intersection extended *immediate-types* :test #'eql))
(headers (set-difference extended *immediate-types* :test #'eql))
- (function-p (if (intersection headers *fun-header-types*)
- (if (subsetp headers *fun-header-types*)
+ (function-p (if (intersection headers *fun-header-widetags*)
+ (if (subsetp headers *fun-header-widetags*)
t
(error "Can't test for mix of function subtypes ~
and normal header types."))
(t
(let ((start (car header))
(end (cdr header)))
- (unless (= start bignum-type)
+ (unless (= start bignum-widetag)
(inst subq temp (- start delta) temp)
(setf delta start)
(inst blt temp when-false))
instance-pointer-lowtag)
(def-type-vops bignump check-bignum bignum
- object-not-bignum-error bignum-type)
+ object-not-bignum-error bignum-widetag)
(def-type-vops ratiop check-ratio ratio
- object-not-ratio-error ratio-type)
+ object-not-ratio-error ratio-widetag)
(def-type-vops complexp check-complex complex
- object-not-complex-error complex-type
- complex-single-float-type complex-double-float-type)
+ object-not-complex-error complex-widetag
+ complex-single-float-widetag complex-double-float-widetag)
(def-type-vops complex-rational-p check-complex-rational nil
- object-not-complex-rational-error complex-type)
+ object-not-complex-rational-error complex-widetag)
(def-type-vops complex-float-p check-complex-float nil
object-not-complex-float-error
- complex-single-float-type complex-double-float-type)
+ complex-single-float-widetag complex-double-float-widetag)
(def-type-vops complex-single-float-p check-complex-single-float
complex-single-float object-not-complex-single-float-error
- complex-single-float-type)
+ complex-single-float-widetag)
(def-type-vops complex-double-float-p check-complex-double-float
complex-double-float object-not-complex-double-float-error
- complex-double-float-type)
+ complex-double-float-widetag)
(def-type-vops single-float-p check-single-float single-float
- object-not-single-float-error single-float-type)
+ object-not-single-float-error single-float-widetag)
(def-type-vops double-float-p check-double-float double-float
- object-not-double-float-error double-float-type)
+ object-not-double-float-error double-float-widetag)
(def-type-vops simple-string-p check-simple-string simple-string
- object-not-simple-string-error simple-string-type)
+ object-not-simple-string-error simple-string-widetag)
(def-type-vops simple-bit-vector-p check-simple-bit-vector simple-bit-vector
- object-not-simple-bit-vector-error simple-bit-vector-type)
+ object-not-simple-bit-vector-error simple-bit-vector-widetag)
(def-type-vops simple-vector-p check-simple-vector simple-vector
- object-not-simple-vector-error simple-vector-type)
+ object-not-simple-vector-error simple-vector-widetag)
(def-type-vops simple-array-unsigned-byte-2-p
check-simple-array-unsigned-byte-2
simple-array-unsigned-byte-2
object-not-simple-array-unsigned-byte-2-error
- simple-array-unsigned-byte-2-type)
+ simple-array-unsigned-byte-2-widetag)
(def-type-vops simple-array-unsigned-byte-4-p
check-simple-array-unsigned-byte-4
simple-array-unsigned-byte-4
object-not-simple-array-unsigned-byte-4-error
- simple-array-unsigned-byte-4-type)
+ simple-array-unsigned-byte-4-widetag)
(def-type-vops simple-array-unsigned-byte-8-p
check-simple-array-unsigned-byte-8
simple-array-unsigned-byte-8
object-not-simple-array-unsigned-byte-8-error
- simple-array-unsigned-byte-8-type)
+ simple-array-unsigned-byte-8-widetag)
(def-type-vops simple-array-unsigned-byte-16-p
check-simple-array-unsigned-byte-16
simple-array-unsigned-byte-16
object-not-simple-array-unsigned-byte-16-error
- simple-array-unsigned-byte-16-type)
+ simple-array-unsigned-byte-16-widetag)
(def-type-vops simple-array-unsigned-byte-32-p
check-simple-array-unsigned-byte-32
simple-array-unsigned-byte-32
object-not-simple-array-unsigned-byte-32-error
- simple-array-unsigned-byte-32-type)
+ simple-array-unsigned-byte-32-widetag)
(def-type-vops simple-array-signed-byte-8-p
check-simple-array-signed-byte-8
simple-array-signed-byte-8
object-not-simple-array-signed-byte-8-error
- simple-array-signed-byte-8-type)
+ simple-array-signed-byte-8-widetag)
(def-type-vops simple-array-signed-byte-16-p
check-simple-array-signed-byte-16
simple-array-signed-byte-16
object-not-simple-array-signed-byte-16-error
- simple-array-signed-byte-16-type)
+ simple-array-signed-byte-16-widetag)
(def-type-vops simple-array-signed-byte-30-p
check-simple-array-signed-byte-30
simple-array-signed-byte-30
object-not-simple-array-signed-byte-30-error
- simple-array-signed-byte-30-type)
+ simple-array-signed-byte-30-widetag)
(def-type-vops simple-array-signed-byte-32-p
check-simple-array-signed-byte-32
simple-array-signed-byte-32
object-not-simple-array-signed-byte-32-error
- simple-array-signed-byte-32-type)
+ simple-array-signed-byte-32-widetag)
(def-type-vops simple-array-single-float-p check-simple-array-single-float
simple-array-single-float object-not-simple-array-single-float-error
- simple-array-single-float-type)
+ simple-array-single-float-widetag)
(def-type-vops simple-array-double-float-p check-simple-array-double-float
simple-array-double-float object-not-simple-array-double-float-error
- simple-array-double-float-type)
+ simple-array-double-float-widetag)
(def-type-vops simple-array-complex-single-float-p
check-simple-array-complex-single-float
simple-array-complex-single-float
object-not-simple-array-complex-single-float-error
- simple-array-complex-single-float-type)
+ simple-array-complex-single-float-widetag)
(def-type-vops simple-array-complex-double-float-p
check-simple-array-complex-double-float
simple-array-complex-double-float
object-not-simple-array-complex-double-float-error
- simple-array-complex-double-float-type)
+ simple-array-complex-double-float-widetag)
(def-type-vops base-char-p check-base-char base-char
- object-not-base-char-error base-char-type)
+ object-not-base-char-error base-char-widetag)
(def-type-vops system-area-pointer-p check-system-area-pointer
- system-area-pointer object-not-sap-error sap-type)
+ system-area-pointer object-not-sap-error sap-widetag)
(def-type-vops weak-pointer-p check-weak-pointer weak-pointer
- object-not-weak-pointer-error weak-pointer-type)
+ object-not-weak-pointer-error weak-pointer-widetag)
;;; XXX
|#
(def-type-vops code-component-p nil nil nil
- code-header-type)
+ code-header-widetag)
(def-type-vops lra-p nil nil nil
- #-gengc return-pc-header-type #+gengc 0)
+ #-gengc return-pc-header-widetag #+gengc 0)
(def-type-vops fdefn-p nil nil nil
- fdefn-type)
+ fdefn-widetag)
(def-type-vops funcallable-instance-p nil nil nil
- funcallable-instance-header-type)
+ funcallable-instance-header-widetag)
(def-type-vops array-header-p nil nil nil
- simple-array-type complex-string-type complex-bit-vector-type
- complex-vector-type complex-array-type)
+ simple-array-widetag complex-string-widetag complex-bit-vector-widetag
+ complex-vector-widetag complex-array-widetag)
(def-type-vops stringp check-string nil object-not-string-error
- simple-string-type complex-string-type)
+ simple-string-widetag complex-string-widetag)
;;; XXX surely just sticking this in here is not all that's required
;;; to create the vop? But I can't find out any other info
(def-type-vops complex-vector-p check-complex-vector nil
- object-not-complex-vector-error complex-vector-type)
+ object-not-complex-vector-error complex-vector-widetag)
(def-type-vops bit-vector-p check-bit-vector nil object-not-bit-vector-error
- simple-bit-vector-type complex-bit-vector-type)
+ simple-bit-vector-widetag complex-bit-vector-widetag)
(def-type-vops vectorp check-vector nil object-not-vector-error
- simple-string-type simple-bit-vector-type simple-vector-type
- simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type
- simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type
- simple-array-unsigned-byte-32-type
- simple-array-signed-byte-8-type simple-array-signed-byte-16-type
- simple-array-signed-byte-30-type simple-array-signed-byte-32-type
- simple-array-single-float-type simple-array-double-float-type
- simple-array-complex-single-float-type
- simple-array-complex-double-float-type
- complex-string-type complex-bit-vector-type complex-vector-type)
+ simple-string-widetag simple-bit-vector-widetag simple-vector-widetag
+ simple-array-unsigned-byte-2-widetag simple-array-unsigned-byte-4-widetag
+ simple-array-unsigned-byte-8-widetag simple-array-unsigned-byte-16-widetag
+ simple-array-unsigned-byte-32-widetag
+ simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
+ simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
+ simple-array-single-float-widetag simple-array-double-float-widetag
+ simple-array-complex-single-float-widetag
+ simple-array-complex-double-float-widetag
+ complex-string-widetag complex-bit-vector-widetag complex-vector-widetag)
(def-type-vops simple-array-p check-simple-array nil object-not-simple-array-error
- simple-array-type simple-string-type simple-bit-vector-type
- simple-vector-type simple-array-unsigned-byte-2-type
- simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
- simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
- simple-array-signed-byte-8-type simple-array-signed-byte-16-type
- simple-array-signed-byte-30-type simple-array-signed-byte-32-type
- simple-array-single-float-type simple-array-double-float-type
- simple-array-complex-single-float-type
- simple-array-complex-double-float-type)
+ simple-array-widetag simple-string-widetag simple-bit-vector-widetag
+ simple-vector-widetag simple-array-unsigned-byte-2-widetag
+ simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
+ simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
+ simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
+ simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
+ simple-array-single-float-widetag simple-array-double-float-widetag
+ simple-array-complex-single-float-widetag
+ simple-array-complex-double-float-widetag)
(def-type-vops arrayp check-array nil object-not-array-error
- simple-array-type simple-string-type simple-bit-vector-type
- simple-vector-type simple-array-unsigned-byte-2-type
- simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
- simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
- simple-array-signed-byte-8-type simple-array-signed-byte-16-type
- simple-array-signed-byte-30-type simple-array-signed-byte-32-type
- simple-array-single-float-type simple-array-double-float-type
- simple-array-complex-single-float-type
- simple-array-complex-double-float-type
- complex-string-type complex-bit-vector-type complex-vector-type
- complex-array-type)
+ simple-array-widetag simple-string-widetag simple-bit-vector-widetag
+ simple-vector-widetag simple-array-unsigned-byte-2-widetag
+ simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
+ simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
+ simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
+ simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
+ simple-array-single-float-widetag simple-array-double-float-widetag
+ simple-array-complex-single-float-widetag
+ simple-array-complex-double-float-widetag
+ complex-string-widetag complex-bit-vector-widetag complex-vector-widetag
+ complex-array-widetag)
(def-type-vops numberp check-number nil object-not-number-error
- 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)
+ even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag ratio-widetag
+ single-float-widetag double-float-widetag complex-widetag
+ complex-single-float-widetag complex-double-float-widetag)
(def-type-vops rationalp check-rational nil object-not-rational-error
- even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type)
+ even-fixnum-lowtag odd-fixnum-lowtag ratio-widetag bignum-widetag)
(def-type-vops integerp check-integer nil object-not-integer-error
- even-fixnum-lowtag odd-fixnum-lowtag bignum-type)
+ even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag)
(def-type-vops floatp check-float nil object-not-float-error
- single-float-type double-float-type)
+ single-float-widetag double-float-widetag)
(def-type-vops realp check-real nil object-not-real-error
- even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type
- single-float-type double-float-type)
+ even-fixnum-lowtag odd-fixnum-lowtag ratio-widetag bignum-widetag
+ single-float-widetag double-float-widetag)
\f
;;;; Other integer ranges.
(inst xor temp other-pointer-lowtag temp)
(inst bne temp nope)
(loadw temp value 0 other-pointer-lowtag)
- (inst li (+ (ash 1 type-bits) bignum-type) temp1)
+ (inst li (+ (ash 1 n-widetag-bits) bignum-widetag) temp1)
(inst xor temp temp1 temp)
(if not-p
(inst bne temp target)
;; Get the header.
(loadw temp value 0 other-pointer-lowtag)
;; Is it one?
- (inst li (+ (ash 1 type-bits) bignum-type) temp1)
+ (inst li (+ (ash 1 n-widetag-bits) bignum-widetag) temp1)
(inst xor temp temp1 temp)
(inst beq temp single-word)
;; If it's other than two, we can't be an (unsigned-byte 32)
- (inst li (logxor (+ (ash 1 type-bits) bignum-type)
- (+ (ash 2 type-bits) bignum-type))
+ (inst li (logxor (+ (ash 1 n-widetag-bits) bignum-widetag)
+ (+ (ash 2 n-widetag-bits) bignum-widetag))
temp1)
(inst xor temp temp1 temp)
(inst bne temp nope)
(:generator 12
(inst cmpeq value null-tn temp)
(inst bne temp (if not-p drop-thru target))
- (test-type value temp target not-p symbol-header-type)
+ (test-type value temp target not-p symbol-header-widetag)
DROP-THRU))
(define-vop (check-symbol check-type)
(inst cmpeq value null-tn temp)
(inst bne temp drop-thru)
(let ((error (generate-error-code vop object-not-symbol-error value)))
- (test-type value temp error t symbol-header-type))
+ (test-type value temp error t symbol-header-widetag))
DROP-THRU
(move value result)))
(destructuring-bind (type-spec &rest rest) args
(let ((ctype (specifier-type type-spec)))
(apply #'!make-saetp ctype rest))))
- `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-type
+ `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
;; (SIMPLE-STRINGs are stored with an extra trailing
;; #\NULL for convenience in calling out to C.)
:n-pad-elements 1)
- (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-type)
- (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-type)
+ (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-widetag)
+ (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-widetag)
#!+long-float (long-float 0.0L0 #!+x86 96 #!+sparc 128
- ,sb!vm:simple-array-long-float-type)
- (bit 0 1 ,sb!vm:simple-bit-vector-type)
- ((unsigned-byte 2) 0 2 ,sb!vm:simple-array-unsigned-byte-2-type)
- ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-type)
- ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-type)
- ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-type)
- ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-type)
- ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-type)
- ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-type)
- ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-type)
- ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-type)
+ ,sb!vm:simple-array-long-float-widetag)
+ (bit 0 1 ,sb!vm:simple-bit-vector-widetag)
+ ((unsigned-byte 2) 0 2 ,sb!vm:simple-array-unsigned-byte-2-widetag)
+ ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-widetag)
+ ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-widetag)
+ ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-widetag)
+ ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-widetag)
+ ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-widetag)
+ ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-widetag)
+ ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-widetag)
+ ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-widetag)
((complex single-float) #C(0.0s0 0.0s0) 64
- ,sb!vm:simple-array-complex-single-float-type)
+ ,sb!vm:simple-array-complex-single-float-widetag)
((complex double-float) #C(0.0d0 0.0d0) 128
- ,sb!vm:simple-array-complex-double-float-type)
+ ,sb!vm:simple-array-complex-double-float-widetag)
#!+long-float ((complex long-float) #C(0.0L0 0.0L0)
#!+x86 192 #!+sparc 256
- ,sb!vm:simple-array-complex-long-float-type)
- (t 0 32 ,sb!vm:simple-vector-type))))
+ ,sb!vm:simple-array-complex-long-float-widetag)
+ (t 0 32 ,sb!vm:simple-vector-widetag))))
;;; The integer type restriction on the length ensures that it will be
;;; a vector. The lack of :ADJUSTABLE, :FILL-POINTER, and
(continuation-value element-type))
(t '*))
,(make-list rank :initial-element '*))))
- `(let ((header (make-array-header sb!vm:simple-array-type ,rank)))
+ `(let ((header (make-array-header sb!vm:simple-array-widetag ,rank)))
(setf (%array-fill-pointer header) ,total-size)
(setf (%array-fill-pointer-p header) nil)
(setf (%array-available-elements header) ,total-size)
;;; the VM support routines
(defvar *backend-support-routines* (make-vm-support-routines))
(declaim (type vm-support-routines *backend-support-routines*))
+
+;;; This is a prototype interface to support Christophe Rhodes' new
+;;; (sbcl-0.pre7.57) VOP :GUARD clauses for implementations which
+;;; depend on CPU variants, e.g. the differences between I486,
+;;; Pentium, and Pentium Pro, or the differences between different
+;;; SPARC versions.
+;;;
+;;; The default value of NIL means use only unguarded VOPs.
+(defvar *backend-subfeatures* nil)
;;; 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-lowtag)
- :step (ash 1 (1- lowtag-bits)))
+(defenum (:suffix -widetag
+ :start (+ (ash 1 n-lowtag-bits) other-immediate-0-lowtag)
+ :step (ash 1 (1- n-lowtag-bits)))
bignum
ratio
single-float
;;; the number of bits at the low end of a pointer used for type
;;; information
-(defconstant lowtag-bits 3)
+(defconstant n-lowtag-bits 3)
;;; a mask to extract the low tag bits from a pointer
-(defconstant lowtag-mask (1- (ash 1 lowtag-bits)))
+(defconstant lowtag-mask (1- (ash 1 n-lowtag-bits)))
;;; the exclusive upper bound on the value of the low tag bits from a
;;; pointer
-(defconstant lowtag-limit (ash 1 lowtag-bits))
+(defconstant lowtag-limit (ash 1 n-lowtag-bits))
;;; the number of bits used in the header word of a data block to store
;;; the type
-(defconstant type-bits 8)
+(defconstant n-widetag-bits 8)
;;; a mask to extract the type from a data block header word
-(defconstant type-mask (1- (ash 1 type-bits)))
+(defconstant widetag-mask (1- (ash 1 n-widetag-bits)))
;;; FIXME: Couldn't/shouldn't these be DEFCONSTANT instead of
;;; DEFPARAMETER? (It might seem even more tempting to make them
(= lowtag sb!vm:odd-fixnum-lowtag))
(let ((unsigned (logior (ash (descriptor-high des)
(1+ (- descriptor-low-bits
- sb!vm:lowtag-bits)))
+ sb!vm:n-lowtag-bits)))
(ash (descriptor-low des)
- (- 1 sb!vm:lowtag-bits)))))
+ (- 1 sb!vm:n-lowtag-bits)))))
(format stream
"for fixnum: ~D"
(if (> unsigned #x1FFFFFFF)
(= 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))
- (logand (descriptor-low des) sb!vm:type-mask)))
+ (ash (descriptor-bits des) (- sb!vm:n-widetag-bits))
+ (logand (descriptor-low des) sb!vm:widetag-mask)))
(t
(format stream
"for pointer: #X~X, lowtag #b~3,'0B, ~A"
;;; is needed, we grow the GSPACE. The descriptor returned is a
;;; pointer of type LOWTAG.
(defun allocate-cold-descriptor (gspace length lowtag)
- (let* ((bytes (round-up length (ash 1 sb!vm:lowtag-bits)))
+ (let* ((bytes (round-up length (ash 1 sb!vm:n-lowtag-bits)))
(old-free-word-index (gspace-free-word-index gspace))
(new-free-word-index (+ old-free-word-index
(ash bytes (- sb!vm:word-shift)))))
(defun make-fixnum-descriptor (num)
(when (>= (integer-length num)
- (1+ (- sb!vm:word-bits sb!vm:lowtag-bits)))
+ (1+ (- sb!vm:word-bits sb!vm:n-lowtag-bits)))
(error "~D is too big for a fixnum." num))
- (make-random-descriptor (ash num (1- sb!vm:lowtag-bits))))
+ (make-random-descriptor (ash num (1- sb!vm:n-lowtag-bits))))
(defun make-other-immediate-descriptor (data type)
- (make-descriptor (ash data (- sb!vm:type-bits descriptor-low-bits))
+ (make-descriptor (ash data (- sb!vm:n-widetag-bits descriptor-low-bits))
(logior (logand (ash data (- descriptor-low-bits
- sb!vm:type-bits))
+ sb!vm:n-widetag-bits))
(1- (ash 1 descriptor-low-bits)))
type)))
(defun make-character-descriptor (data)
- (make-other-immediate-descriptor data sb!vm:base-char-type))
+ (make-other-immediate-descriptor data sb!vm:base-char-widetag))
(defun descriptor-beyond (des offset type)
(let* ((low (logior (+ (logandc2 (descriptor-low des) sb!vm:lowtag-mask)
;;; a handle on the trap object
(defvar *unbound-marker*)
-;; was: (make-other-immediate-descriptor 0 sb!vm:unbound-marker-type)
+;; was: (make-other-immediate-descriptor 0 sb!vm:unbound-marker-widetag)
;;; a handle on the NIL object
(defvar *nil-descriptor*)
(des (allocate-vector-object gspace
sb!vm:byte-bits
(1+ length)
- sb!vm:simple-string-type))
+ sb!vm:simple-string-widetag))
(bytes (gspace-bytes gspace))
(offset (+ (* sb!vm:vector-data-offset sb!vm:word-bytes)
(descriptor-byte-offset des))))
(handle (allocate-unboxed-object *dynamic*
sb!vm:word-bits
words
- sb!vm:bignum-type)))
+ sb!vm:bignum-widetag)))
(declare (fixnum words))
(do ((index 1 (1+ index))
(remainder n (ash remainder (- sb!vm:word-bits))))
(let ((des (allocate-unboxed-object *dynamic*
sb!vm:word-bits
(1- sb!vm:single-float-size)
- sb!vm:single-float-type)))
+ sb!vm:single-float-widetag)))
(write-wordindexed des
sb!vm:single-float-value-slot
(make-random-descriptor (single-float-bits x)))
(let ((des (allocate-unboxed-object *dynamic*
sb!vm:word-bits
(1- sb!vm:double-float-size)
- sb!vm:double-float-type))
+ sb!vm:double-float-widetag))
(high-bits (make-random-descriptor (double-float-high-bits x)))
(low-bits (make-random-descriptor (double-float-low-bits x))))
(ecase sb!c:*backend-byte-order*
(let ((des (allocate-unboxed-object *dynamic*
sb!vm:word-bits
(1- sb!vm:long-float-size)
- sb!vm:long-float-type))
+ sb!vm:long-float-widetag))
(exp-bits (make-random-descriptor (long-float-exp-bits x)))
(high-bits (make-random-descriptor (long-float-high-bits x)))
(low-bits (make-random-descriptor (long-float-low-bits x))))
(declare (type (complex single-float) num))
(let ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
(1- sb!vm:complex-single-float-size)
- sb!vm:complex-single-float-type)))
+ sb!vm:complex-single-float-widetag)))
(write-wordindexed des sb!vm:complex-single-float-real-slot
(make-random-descriptor (single-float-bits (realpart num))))
(write-wordindexed des sb!vm:complex-single-float-imag-slot
(declare (type (complex double-float) num))
(let ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
(1- sb!vm:complex-double-float-size)
- sb!vm:complex-double-float-type)))
+ sb!vm:complex-double-float-widetag)))
(let* ((real (realpart num))
(high-bits (make-random-descriptor (double-float-high-bits real)))
(low-bits (make-random-descriptor (double-float-low-bits real))))
(bignum-to-core number)))
(ratio (number-pair-to-core (number-to-core (numerator number))
(number-to-core (denominator number))
- sb!vm:ratio-type))
+ sb!vm:ratio-widetag))
((complex single-float) (complex-single-float-to-core number))
((complex double-float) (complex-double-float-to-core number))
#!+long-float
(error "~S isn't a cold-loadable number at all!" number))
(complex (number-pair-to-core (number-to-core (realpart number))
(number-to-core (imagpart number))
- sb!vm:complex-type))
+ sb!vm:complex-widetag))
(float (float-to-core number))
(t (error "~S isn't a cold-loadable number at all!" number))))
(let ((des (allocate-unboxed-object *dynamic*
sb!vm:word-bits
(1- sb!vm:sap-size)
- sb!vm:sap-type)))
+ sb!vm:sap-widetag)))
(write-wordindexed des
sb!vm:sap-pointer-slot
(make-random-descriptor sapint))
(defun vector-in-core (&rest objects)
(let* ((size (length objects))
(result (allocate-vector-object *dynamic* sb!vm:word-bits size
- sb!vm:simple-vector-type)))
+ sb!vm:simple-vector-widetag)))
(dotimes (index size)
(write-wordindexed result (+ index sb!vm:vector-data-offset)
(pop objects)))
*dynamic*)
sb!vm:word-bits
(1- sb!vm:symbol-size)
- sb!vm:symbol-header-type)))
+ sb!vm:symbol-header-widetag)))
(write-wordindexed symbol sb!vm:symbol-value-slot *unbound-marker*)
#!+x86
(write-wordindexed symbol
(1+ target-layout-length)
sb!vm:instance-pointer-lowtag)))
(write-memory result
- (make-other-immediate-descriptor target-layout-length
- sb!vm:instance-header-type))
+ (make-other-immediate-descriptor
+ target-layout-length sb!vm:instance-header-widetag))
;; KLUDGE: The offsets into LAYOUT below should probably be pulled out
;; of the cross-compiler's tables at genesis time instead of inserted
1
(make-other-immediate-descriptor
0
- sb!vm:symbol-header-type))
+ sb!vm:symbol-header-widetag))
(write-wordindexed des
(+ 1 sb!vm:symbol-value-slot)
result)
(setf (gethash warm-name *cold-fdefn-objects*) fdefn)
(write-memory fdefn (make-other-immediate-descriptor
- (1- sb!vm:fdefn-size) sb!vm:fdefn-type))
+ (1- sb!vm:fdefn-size) sb!vm:fdefn-widetag))
(write-wordindexed fdefn sb!vm:fdefn-name-slot cold-name)
(unless leave-fn-raw
(write-wordindexed fdefn sb!vm:fdefn-fun-slot
(defun static-fset (cold-name defn)
(declare (type descriptor cold-name))
(let ((fdefn (cold-fdefinition-object cold-name t))
- (type (logand (descriptor-low (read-memory defn)) sb!vm:type-mask)))
+ (type (logand (descriptor-low (read-memory defn)) sb!vm:widetag-mask)))
(write-wordindexed fdefn sb!vm:fdefn-fun-slot defn)
(write-wordindexed fdefn
sb!vm:fdefn-raw-addr-slot
(ecase type
- (#.sb!vm:simple-fun-header-type
+ (#.sb!vm:simple-fun-header-widetag
#!+sparc
defn
#!-sparc
sb!vm:lowtag-mask)
(ash sb!vm:simple-fun-code-offset
sb!vm:word-shift))))
- (#.sb!vm:closure-header-type
+ (#.sb!vm:closure-header-widetag
(make-random-descriptor
(cold-foreign-symbol-address-as-integer "closure_tramp")))))
fdefn))
(declaim (ftype (function (descriptor sb!vm:word)) calc-offset))
(defun calc-offset (code-object offset-from-tail-of-header)
(let* ((header (read-memory code-object))
- (header-n-words (ash (descriptor-bits header) (- sb!vm:type-bits)))
+ (header-n-words (ash (descriptor-bits header)
+ (- sb!vm:n-widetag-bits)))
(header-n-bytes (ash header-n-words sb!vm:word-shift))
(result (+ offset-from-tail-of-header header-n-bytes)))
result))
(1+ size)
sb!vm:instance-pointer-lowtag)))
(write-memory result (make-other-immediate-descriptor
- size
- sb!vm:instance-header-type))
+ size sb!vm:instance-header-widetag))
(do ((index (1- size) (1- index)))
((minusp index))
(declare (fixnum index))
(result (allocate-vector-object *dynamic*
sb!vm:word-bits
size
- sb!vm:simple-vector-type)))
+ sb!vm:simple-vector-widetag)))
(do ((index (1- size) (1- index)))
((minusp index))
(declare (fixnum index))
(let* ((len (read-arg 4))
(sizebits (read-arg 1))
(type (case sizebits
- (1 sb!vm:simple-bit-vector-type)
- (2 sb!vm:simple-array-unsigned-byte-2-type)
- (4 sb!vm:simple-array-unsigned-byte-4-type)
- (8 sb!vm:simple-array-unsigned-byte-8-type)
- (16 sb!vm:simple-array-unsigned-byte-16-type)
- (32 sb!vm:simple-array-unsigned-byte-32-type)
+ (1 sb!vm:simple-bit-vector-widetag)
+ (2 sb!vm:simple-array-unsigned-byte-2-widetag)
+ (4 sb!vm:simple-array-unsigned-byte-4-widetag)
+ (8 sb!vm:simple-array-unsigned-byte-8-widetag)
+ (16 sb!vm:simple-array-unsigned-byte-16-widetag)
+ (32 sb!vm:simple-array-unsigned-byte-32-widetag)
(t (error "losing element size: ~D" sizebits))))
(result (allocate-vector-object *dynamic* sizebits len type))
(start (+ (descriptor-byte-offset result)
(define-cold-fop (fop-single-float-vector)
(let* ((len (read-arg 4))
- (result (allocate-vector-object *dynamic*
- sb!vm:word-bits
- len
- sb!vm:simple-array-single-float-type))
+ (result (allocate-vector-object
+ *dynamic*
+ sb!vm:word-bits
+ len
+ sb!vm:simple-array-single-float-widetag))
(start (+ (descriptor-byte-offset result)
(ash sb!vm:vector-data-offset sb!vm:word-shift)))
(end (+ start (* len sb!vm:word-bytes))))
sb!vm:other-pointer-lowtag)))
(write-memory result
(make-other-immediate-descriptor rank
- sb!vm:simple-array-type))
+ sb!vm:simple-array-widetag))
(write-wordindexed result sb!vm:array-fill-pointer-slot *nil-descriptor*)
(write-wordindexed result sb!vm:array-data-slot data-vector)
(write-wordindexed result sb!vm:array-displacement-slot *nil-descriptor*)
(setf total-elements
(* total-elements
(logior (ash (descriptor-high dim)
- (- descriptor-low-bits (1- sb!vm:lowtag-bits)))
+ (- descriptor-low-bits
+ (1- sb!vm:n-lowtag-bits)))
(ash (descriptor-low dim)
- (- 1 sb!vm:lowtag-bits)))))
+ (- 1 sb!vm:n-lowtag-bits)))))
(write-wordindexed result
(+ sb!vm:array-dimensions-offset axis)
dim)))
(prepare-for-fast-read-byte *fasl-input-stream*
(let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
(1- sb!vm:long-float-size)
- sb!vm:long-float-type))
+ sb!vm:long-float-widetag))
(low-bits (make-random-descriptor (fast-read-u-integer 4)))
(high-bits (make-random-descriptor (fast-read-u-integer 4)))
(exp-bits (make-random-descriptor (fast-read-s-integer 2))))
(prepare-for-fast-read-byte *fasl-input-stream*
(let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
(1- sb!vm:long-float-size)
- sb!vm:long-float-type))
+ sb!vm:long-float-widetag))
(low-bits (make-random-descriptor (fast-read-u-integer 4)))
(mid-bits (make-random-descriptor (fast-read-u-integer 4)))
(high-bits (make-random-descriptor (fast-read-u-integer 4)))
(prepare-for-fast-read-byte *fasl-input-stream*
(let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
(1- sb!vm:complex-long-float-size)
- sb!vm:complex-long-float-type))
+ sb!vm:complex-long-float-widetag))
(real-low-bits (make-random-descriptor (fast-read-u-integer 4)))
(real-high-bits (make-random-descriptor (fast-read-u-integer 4)))
(real-exp-bits (make-random-descriptor (fast-read-s-integer 2)))
(prepare-for-fast-read-byte *fasl-input-stream*
(let* ((des (allocate-unboxed-object *dynamic* sb!vm:word-bits
(1- sb!vm:complex-long-float-size)
- sb!vm:complex-long-float-type))
+ sb!vm:complex-long-float-widetag))
(real-low-bits (make-random-descriptor (fast-read-u-integer 4)))
(real-mid-bits (make-random-descriptor (fast-read-u-integer 4)))
(real-high-bits (make-random-descriptor (fast-read-u-integer 4)))
(define-cold-fop (fop-ratio)
(let ((den (pop-stack)))
- (number-pair-to-core (pop-stack) den sb!vm:ratio-type)))
+ (number-pair-to-core (pop-stack) den sb!vm:ratio-widetag)))
(define-cold-fop (fop-complex)
(let ((im (pop-stack)))
- (number-pair-to-core (pop-stack) im sb!vm:complex-type)))
+ (number-pair-to-core (pop-stack) im sb!vm:complex-widetag)))
\f
;;;; cold fops for calling (or not calling)
(allocate-vector-object *dynamic*
sb!vm:word-bits
*load-time-value-counter*
- sb!vm:simple-vector-type)))
+ sb!vm:simple-vector-widetag)))
(define-cold-fop (fop-funcall-for-effect nil)
(if (= (read-arg 1) 0)
code-size)
sb!vm:other-pointer-lowtag)))
(write-memory des
- (make-other-immediate-descriptor header-n-words
- sb!vm:code-header-type))
+ (make-other-immediate-descriptor
+ header-n-words sb!vm:code-header-widetag))
(write-wordindexed des
sb!vm:code-code-size-slot
(make-fixnum-descriptor
(write-memory fn
(make-other-immediate-descriptor
(ash offset (- sb!vm:word-shift))
- sb!vm:simple-fun-header-type))
+ sb!vm:simple-fun-header-widetag))
(write-wordindexed fn
sb!vm:simple-fun-self-slot
;; KLUDGE: Wiring decisions like this in at
length)
sb!vm:other-pointer-lowtag)))
(write-memory des
- (make-other-immediate-descriptor header-n-words
- sb!vm:code-header-type))
+ (make-other-immediate-descriptor
+ header-n-words sb!vm:code-header-widetag))
(write-wordindexed des
sb!vm:code-code-size-slot
(make-fixnum-descriptor
(record-with-translated-name priority))))
(maybe-record-with-translated-name '("-LOWTAG") 0)
- (maybe-record-with-munged-name "-TYPE" "type_" 1)
+ (maybe-record-with-translated-name '("-WIDETAG") 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)
(*current-reversed-cold-toplevels* *nil-descriptor*)
(*unbound-marker* (make-other-immediate-descriptor
0
- sb!vm:unbound-marker-type))
+ sb!vm:unbound-marker-widetag))
*cold-assembler-fixups*
*cold-assembler-routines*
#!+x86 *load-time-code-fixups*)
(cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg))
(define-primitive-object (instance :lowtag instance-pointer-lowtag
- :header instance-header-type
+ :header instance-header-widetag
:alloc-trans %make-instance)
(slots :rest-p t))
(define-primitive-object (bignum :lowtag other-pointer-lowtag
- :header bignum-type
+ :header bignum-widetag
: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-lowtag
- :header ratio-type
+ :header ratio-widetag
:alloc-trans %make-ratio)
(numerator :type integer
:ref-known (flushable movable)
:init :arg))
(define-primitive-object (single-float :lowtag other-pointer-lowtag
- :header single-float-type)
+ :header single-float-widetag)
(value :c-type "float"))
(define-primitive-object (double-float :lowtag other-pointer-lowtag
- :header double-float-type)
+ :header double-float-widetag)
(filler)
(value :c-type "double" :length 2))
#!+long-float
(define-primitive-object (long-float :lowtag other-pointer-lowtag
- :header long-float-type)
+ :header long-float-widetag)
#!+sparc (filler)
(value :c-type "long double" :length #!+x86 3 #!+sparc 4))
(define-primitive-object (complex :type complex
:lowtag other-pointer-lowtag
- :header complex-type
+ :header complex-widetag
:alloc-trans %make-complex)
(real :type real
:ref-known (flushable movable)
(define-primitive-object (fdefn :type fdefn
:lowtag other-pointer-lowtag
- :header fdefn-type)
+ :header fdefn-widetag)
(name :ref-trans fdefn-name)
(fun :type (or function null) :ref-trans fdefn-fun)
(raw-addr :c-type #!-alpha "char *" #!+alpha "u32"))
;;; which are also subtypes of Common Lisp's FUNCTION type)
(define-primitive-object (simple-fun :type function
:lowtag fun-pointer-lowtag
- :header simple-fun-header-type)
+ :header simple-fun-header-widetag)
#!-x86 (self :ref-trans %simple-fun-self
:set-trans (setf %simple-fun-self))
#!+x86 (self
(return-point :c-type "unsigned char" :rest-p t))
(define-primitive-object (closure :lowtag fun-pointer-lowtag
- :header closure-header-type)
+ :header closure-header-widetag)
(fun :init :arg :ref-trans %closure-fun)
(info :rest-p t))
(define-primitive-object (funcallable-instance
:lowtag fun-pointer-lowtag
- :header funcallable-instance-header-type
+ :header funcallable-instance-header-widetag
:alloc-trans %make-funcallable-instance)
#!-x86
(fun
(info :rest-p t))
(define-primitive-object (value-cell :lowtag other-pointer-lowtag
- :header value-cell-header-type
+ :header value-cell-header-widetag
:alloc-trans make-value-cell)
(value :set-trans value-cell-set
:set-known (unsafe)
#!+alpha
(define-primitive-object (sap :lowtag other-pointer-lowtag
- :header sap-type)
+ :header sap-widetag)
(padding)
(pointer :c-type "char *" :length 2))
#!-alpha
(define-primitive-object (sap :lowtag other-pointer-lowtag
- :header sap-type)
+ :header sap-widetag)
(pointer :c-type "char *"))
(define-primitive-object (weak-pointer :type weak-pointer
:lowtag other-pointer-lowtag
- :header weak-pointer-type
+ :header weak-pointer-widetag
:alloc-trans make-weak-pointer)
(value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable)
:init :arg)
(flushable movable))
(define-primitive-object (symbol :lowtag other-pointer-lowtag
- :header symbol-header-type
+ :header symbol-header-widetag
#!-x86 :alloc-trans #!-x86 make-symbol)
(value :set-trans %set-symbol-value
:init :unbound)
(define-primitive-object (complex-single-float
:lowtag other-pointer-lowtag
- :header complex-single-float-type)
+ :header complex-single-float-widetag)
(real :c-type "float")
(imag :c-type "float"))
(define-primitive-object (complex-double-float
:lowtag other-pointer-lowtag
- :header complex-double-float-type)
+ :header complex-double-float-widetag)
(filler)
(real :c-type "double" :length 2)
(imag :c-type "double" :length 2))
#!+long-float
(define-primitive-object (complex-long-float
:lowtag other-pointer-lowtag
- :header complex-long-float-type)
+ :header complex-long-float-widetag)
#!+sparc (filler)
(real :c-type "long double" :length #!+x86 3 #!+sparc 4)
(imag :c-type "long double" :length #!+x86 3 #!+sparc 4))
(defknown vector-sap ((simple-unboxed-array (*))) system-area-pointer
(flushable))
-(defknown get-lowtag (t) (unsigned-byte #.sb!vm:lowtag-bits)
+(defknown get-lowtag (t) (unsigned-byte #.sb!vm:n-lowtag-bits)
(flushable movable))
-(defknown get-type (t) (unsigned-byte #.sb!vm:type-bits)
+(defknown get-type (t) (unsigned-byte #.sb!vm:n-widetag-bits)
(flushable movable))
(defknown (get-header-data get-closure-length) (t) (unsigned-byte 24)
\f
;;;; bignum operations
-(defknown %allocate-bignum (bignum-index) bignum-type
+(defknown %allocate-bignum (bignum-index) bignum-widetag
(flushable))
-(defknown %bignum-length (bignum-type) bignum-index
+(defknown %bignum-length (bignum-widetag) bignum-index
(foldable flushable movable))
-(defknown %bignum-set-length (bignum-type bignum-index) bignum-type
+(defknown %bignum-set-length (bignum-widetag bignum-index) bignum-widetag
(unsafe))
-(defknown %bignum-ref (bignum-type bignum-index) bignum-element-type
+(defknown %bignum-ref (bignum-widetag bignum-index) bignum-element-type
(flushable))
-(defknown %bignum-set (bignum-type bignum-index bignum-element-type)
+(defknown %bignum-set (bignum-widetag bignum-index bignum-element-type)
bignum-element-type
(unsafe))
(defknown code-header-ref (t index) t (flushable))
(defknown code-header-set (t index t) t ())
-(defknown function-subtype (function) (unsigned-byte #.sb!vm:type-bits)
+(defknown function-subtype (function) (unsigned-byte #.sb!vm:n-widetag-bits)
(flushable))
(defknown ((setf function-subtype))
- ((unsigned-byte #.sb!vm:type-bits) function)
- (unsigned-byte #.sb!vm:type-bits)
+ ((unsigned-byte #.sb!vm:n-widetag-bits) function)
+ (unsigned-byte #.sb!vm:n-widetag-bits)
())
(defknown make-fdefn (t) fdefn (flushable movable))
(dstate-cur-offs dstate)
(+ (dstate-cur-offs dstate)
(1- lra-size))))
- sb!vm:return-pc-header-type))
+ sb!vm:return-pc-header-widetag))
(unless (null stream)
(princ '.lra stream))
(incf (dstate-next-offs dstate) lra-size))
(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)
+ (inst shl boxed (- n-widetag-bits word-shift))
+ (inst or boxed code-header-widetag)
(storew boxed result 0 other-pointer-lowtag)
(storew unboxed result code-code-size-slot other-pointer-lowtag)
(inst mov temp nil-value)
(pseudo-atomic
(allocation result result node)
(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)
+ (inst shl boxed (- n-widetag-bits word-shift))
+ (inst or boxed code-header-widetag)
(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))
(:results (result :scs (descriptor-reg) :from :argument))
(:node-var node)
(:generator 37
- (with-fixed-allocation (result fdefn-type fdefn-size node)
+ (with-fixed-allocation (result fdefn-widetag fdefn-size node)
(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)
(allocation result (pad-data-block size) node)
(inst lea result
(make-ea :byte :base result :disp fun-pointer-lowtag))
- (storew (logior (ash (1- size) type-bits) closure-header-type)
+ (storew (logior (ash (1- size) n-widetag-bits) closure-header-widetag)
result 0 fun-pointer-lowtag))
(loadw temp function closure-fun-slot fun-pointer-lowtag)
(storew temp result closure-fun-slot fun-pointer-lowtag))))
(:node-var node)
(:generator 10
(with-fixed-allocation
- (result value-cell-header-type value-cell-size node))
+ (result value-cell-header-widetag value-cell-size node))
(storew value result value-cell-value-slot other-pointer-lowtag)))
\f
;;;; automatic allocators for primitive objects
(:args)
(:results (result :scs (any-reg)))
(:generator 1
- (inst mov result unbound-marker-type)))
+ (inst mov result unbound-marker-widetag)))
(define-vop (fixed-alloc)
(:args)
(allocation result (pad-data-block words) node)
(inst lea result (make-ea :byte :base result :disp lowtag))
(when type
- (storew (logior (ash (1- words) type-bits) type) result 0 lowtag)))))
+ (storew (logior (ash (1- words) n-widetag-bits) type)
+ result
+ 0
+ lowtag)))))
(define-vop (var-alloc)
(:args (extra :scs (any-reg)))
(inst lea bytes
(make-ea :dword :base extra :disp (* (1+ words) word-bytes)))
(inst mov header bytes)
- (inst shl header (- type-bits 2)) ; w+1 to length field
-
+ (inst shl header (- n-widetag-bits 2)) ; w+1 to length field
(inst lea header ; (w-1 << 8) | type
- (make-ea :dword :base header :disp (+ (ash -2 type-bits) type)))
+ (make-ea :dword :base header :disp (+ (ash -2 n-widetag-bits) type)))
(inst and bytes (lognot lowtag-mask))
(pseudo-atomic
(allocation result bytes node)
(:results (result :scs (descriptor-reg) :from :argument))
(:node-var node)
(:generator 37
- (with-fixed-allocation (result symbol-header-type symbol-size node)
+ (with-fixed-allocation (result symbol-header-widetag symbol-size node)
(storew name result symbol-name-slot other-pointer-lowtag)
- (storew unbound-marker-type result symbol-value-slot other-pointer-lowtag)
+ (storew unbound-marker-widetag
+ 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
(inst and bytes (lognot lowtag-mask))
(inst lea header (make-ea :dword :base rank
:disp (fixnumize (1- array-dimensions-offset))))
- (inst shl header type-bits)
+ (inst shl header n-widetag-bits)
(inst or header type)
(inst shr header 2)
(pseudo-atomic
(:result-types positive-fixnum)
(:generator 6
(loadw res x 0 other-pointer-lowtag)
- (inst shr res type-bits)
+ (inst shr res n-widetag-bits)
(inst sub res (1- array-dimensions-offset))))
\f
;;;; bounds checking routine
;;;
;;; Always wire the return PC location to the stack in its standard
;;; location.
-;;;
-;;; No problems.
-;#+nil
(!def-vm-support-routine make-return-pc-passing-location (standard)
(declare (ignore standard))
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset))
-;;; If STANDARD is true, then use the standard (full call) location,
-;;; otherwise use any legal location.
-;;;
-;;; No problems.
-#+nil
-(!def-vm-support-routine make-return-pc-passing-location (standard)
- (let ((ptype (primitive-type-or-lose 'system-area-pointer)))
- (if standard
- (make-wired-tn ptype sap-stack-sc-number return-pc-save-offset)
- (make-normal-tn ptype))))
-;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass
-;;; Old-FP in.
-;;;
-;;; This is wired in both the standard and the local-call
-;;; conventions, because we want to be able to assume it's always there.
-;;; Besides, the x86 doesn't have enough registers to really make it
-;;; profitable to pass it in a register.
+;;; Similar to Make-Return-PC-Passing-Location, but makes a location
+;;; to pass Old-FP in.
;;;
-;;; No problems
-;#+nil
+;;; This is wired in both the standard and the local-call conventions,
+;;; because we want to be able to assume it's always there. Besides,
+;;; the x86 doesn't have enough registers to really make it profitable
+;;; to pass it in a register.
(!def-vm-support-routine make-old-fp-passing-location (standard)
(declare (ignore standard))
(make-wired-tn *fixnum-primitive-type* control-stack-sc-number
ocfp-save-offset))
-;;; If standard is true, then use the standard (full call) location,
-;;; otherwise use any legal location.
-;;;
-;;; No problems.
-#+nil
-(!def-vm-support-routine make-old-fp-passing-location (standard)
- (if standard
- (make-wired-tn *fixnum-primitive-type* control-stack-sc-number
- ocfp-save-offset)
- (make-normal-tn *fixnum-primitive-type*)))
;;; Make the TNs used to hold Old-FP and Return-PC within the current
;;; function. We treat these specially so that the debugger can find
;;; them at a known location.
;;;
;;; Without using a save-tn - which does not make much sense if it is
-;;; wire to the stack? No problems.
+;;; wire to the stack?
(!def-vm-support-routine make-old-fp-save-location (env)
(physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type*
control-stack-sc-number
ocfp-save-offset)
env))
-;;; Using a save-tn. No problems.
-#+nil
-(!def-vm-support-routine make-old-fp-save-location (env)
- (specify-save-tn
- (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
- (make-wired-tn *fixnum-primitive-type* control-stack-sc-number
- ocfp-save-offset)))
-;;; Without using a save-tn - which does not make much sense if it is
-;;; wire to the stack? No problems.
(!def-vm-support-routine make-return-pc-save-location (env)
(physenv-debug-live-tn
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset)
env))
-;;; Using a save-tn. No problems.
-#+nil
-(!def-vm-support-routine make-return-pc-save-location (env)
- (let ((ptype (primitive-type-or-lose 'system-area-pointer)))
- (specify-save-tn
- (physenv-debug-live-tn (make-normal-tn ptype) env)
- (make-wired-tn ptype sap-stack-sc-number return-pc-save-offset))))
;;; Make a TN for the standard argument count passing location. We only
;;; need to make the standard location, since a count is never passed when we
(!def-vm-support-routine make-argument-count-location ()
(make-wired-tn *fixnum-primitive-type* any-reg-sc-number ecx-offset))
-
;;; Make a TN to hold the number-stack frame pointer. This is allocated
;;; once per component, and is component-live.
(!def-vm-support-routine make-nfp-tn ()
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
-
;;; This function is called by the Entry-Analyze phase, allowing
-;;; VM-dependent initialization of the IR2-Component structure. We push
-;;; placeholder entries in the Constants to leave room for additional
-;;; noise in the code object header.
+;;; VM-dependent initialization of the IR2-COMPONENT structure. We
+;;; push placeholder entries in the Constants to leave room for
+;;; additional noise in the code object header.
;;;
;;; For the x86 the first constant is a pointer to a list of fixups,
-;;; or nil if the code object has none.
+;;; or NIL if the code object has none.
(!def-vm-support-routine select-component-format (component)
(declare (type component component))
(dotimes (i (1+ code-constants-offset))
\f
;;;; frame hackery
-;;; Used for setting up the Old-FP in local call.
+;;; This is used for setting up the Old-FP in local call.
(define-vop (current-fp)
(:results (val :scs (any-reg control-stack)))
(:generator 1
(:generator 1
nil))
-
(define-vop (xep-allocate-frame)
(:info start-lab copy-more-arg-follows)
(:vop-var vop)
(:generator 1
- ;; Make sure the function is aligned, and drop a label pointing to this
- ;; function header.
- (align lowtag-bits)
+ (align n-lowtag-bits)
(trace-table-entry trace-table-function-prologue)
(emit-label start-lab)
;; Skip space for the function header.
(move res esp-tn)
(inst sub esp-tn (* sb!vm:word-bytes (sb-allocated-size 'stack)))))
-;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
-;;; is the number of arguments passed. We allocate at least 3 slots, because
-;;; the XEP noise is going to want to use them before it can extend the stack.
+;;; Allocate a partial frame for passing stack arguments in a full
+;;; call. NARGS is the number of arguments passed. We allocate at
+;;; least 3 slots, because the XEP noise is going to want to use them
+;;; before it can extend the stack.
(define-vop (allocate-full-call-frame)
(:info nargs)
(:results (res :scs (any-reg control-stack)))
(:generator 2
(move res esp-tn)
(inst sub esp-tn (* (max nargs 3) sb!vm:word-bytes))))
-
-
\f
-;;; Emit code needed at the return-point from an unknown-values call for a
-;;; fixed number of values. Values is the head of the TN-Ref list for the
-;;; locations that the values are to be received into. Nvals is the number of
-;;; values that are to be received (should equal the length of Values).
+;;; Emit code needed at the return-point from an unknown-values call
+;;; for a fixed number of values. Values is the head of the TN-Ref
+;;; list for the locations that the values are to be received into.
+;;; Nvals is the number of values that are to be received (should
+;;; equal the length of Values).
;;;
;;; Move-Temp is a Descriptor-Reg TN used as a temporary.
;;;
-;;; This code exploits the fact that in the unknown-values convention, a
-;;; single value return returns at the return PC + 2, whereas a return of other
-;;; than one value returns directly at the return PC.
+;;; This code exploits the fact that in the unknown-values convention,
+;;; a single value return returns at the return PC + 2, whereas a
+;;; return of other than one value returns directly at the return PC.
;;;
-;;; If 0 or 1 values are expected, then we just emit an instruction to reset
-;;; the SP (which will only be executed when other than 1 value is returned.)
+;;; If 0 or 1 values are expected, then we just emit an instruction to
+;;; reset the SP (which will only be executed when other than 1 value
+;;; is returned.)
;;;
;;; In the general case we have to do three things:
-;;; -- Default unsupplied register values. This need only be done when a
-;;; single value is returned, since register values are defaulted by the
-;;; called in the non-single case.
-;;; -- Default unsupplied stack values. This needs to be done whenever there
-;;; are stack values.
-;;; -- Reset SP. This must be done whenever other than 1 value is returned,
-;;; regardless of the number of values desired.
+;;; -- Default unsupplied register values. This need only be done
+;;; when a single value is returned, since register values are
+;;; defaulted by the called in the non-single case.
+;;; -- Default unsupplied stack values. This needs to be done whenever
+;;; there are stack values.
+;;; -- Reset SP. This must be done whenever other than 1 value is
+;;; returned, regardless of the number of values desired.
(defun default-unknown-values (vop values nvals)
(declare (type (or tn-ref null) values)
(type unsigned-byte nvals))
(emit-label regs-defaulted)
(inst mov esp-tn ebx-tn)))
((<= nvals 7)
- ;; Number of bytes depends on the relative jump instructions. Best
- ;; case is 31+(n-3)*14, worst case is 35+(n-3)*18. For nvals=6
- ;; that is 73/89 bytes, and for nvals=7 that is 87/107 bytes which
- ;; is likely better than using the blt below.
+ ;; The number of bytes depends on the relative jump instructions.
+ ;; Best case is 31+(n-3)*14, worst case is 35+(n-3)*18. For
+ ;; NVALS=6 that is 73/89 bytes, and for NVALS=7 that is 87/107
+ ;; bytes which is likely better than using the blt below.
(let ((regs-defaulted (gen-label))
(defaulting-done (gen-label))
(default-stack-slots (gen-label)))
;; Branch off to the MV case.
(inst jmp-short regs-defaulted)
- ;; Default the register args, and set up the stack as if we entered
- ;; the MV return point.
+ ;; Default the register args, and set up the stack as if we
+ ;; entered the MV return point.
(inst mov ebx-tn esp-tn)
(inst push edx-tn)
(inst mov edi-tn nil-value)
(inst lea edi-tn
(make-ea :dword :base ebp-tn
:disp (* (- (1+ register-arg-count)) word-bytes)))
- ;; Load EAX with NIL so we can quickly store it, and set up stuff
- ;; for the loop.
+ ;; Load EAX with NIL so we can quickly store it, and set up
+ ;; stuff for the loop.
(inst mov eax-tn nil-value)
(inst std)
(inst mov ecx-tn (- nvals register-arg-count))
(emit-label regs-defaulted)
;; Save EDI.
(storew edi-tn ebx-tn (- (1+ 1)))
- ;; Compute the number of stack arguments, and if it's zero or less,
- ;; don't copy any stack arguments.
+ ;; Compute the number of stack arguments, and if it's zero or
+ ;; less, don't copy any stack arguments.
(inst sub ecx-tn (fixnumize register-arg-count))
(inst jmp :le no-stack-args)
\f
;;;; unknown values receiving
-;;; Emit code needed at the return point for an unknown-values call for an
-;;; arbitrary number of values.
+;;; Emit code needed at the return point for an unknown-values call
+;;; for an arbitrary number of values.
;;;
-;;; We do the single and non-single cases with no shared code: there doesn't
-;;; seem to be any potential overlap, and receiving a single value is more
-;;; important efficiency-wise.
+;;; We do the single and non-single cases with no shared code: there
+;;; doesn't seem to be any potential overlap, and receiving a single
+;;; value is more important efficiency-wise.
;;;
-;;; When there is a single value, we just push it on the stack, returning
-;;; the old SP and 1.
+;;; When there is a single value, we just push it on the stack,
+;;; returning the old SP and 1.
;;;
-;;; When there is a variable number of values, we move all of the argument
-;;; registers onto the stack, and return Args and Nargs.
+;;; When there is a variable number of values, we move all of the
+;;; argument registers onto the stack, and return ARGS and NARGS.
;;;
-;;; Args and Nargs are TNs wired to the named locations. We must
-;;; explicitly allocate these TNs, since their lifetimes overlap with the
-;;; results Start and Count (also, it's nice to be able to target them).
+;;; ARGS and NARGS are TNs wired to the named locations. We must
+;;; explicitly allocate these TNs, since their lifetimes overlap with
+;;; the results start and count. (Also, it's nice to be able to target
+;;; them.)
(defun receive-unknown-values (args nargs start count)
(declare (type tn args nargs start count))
(let ((variable-values (gen-label))
\f
;;;; local call with unknown values convention return
-;;; Non-TR local call for a fixed number of values passed according to the
-;;; unknown values convention.
+;;; Non-TR local call for a fixed number of values passed according to
+;;; the unknown values convention.
;;;
;;; FP is the frame pointer in install before doing the call.
;;;
-;;; NFP would be the number-stack frame pointer if we had a separate number
-;;; stack.
+;;; NFP would be the number-stack frame pointer if we had a separate
+;;; number stack.
;;;
-;;; Args are the argument passing locations, which are specified only to
-;;; terminate their lifetimes in the caller.
+;;; Args are the argument passing locations, which are specified only
+;;; to terminate their lifetimes in the caller.
;;;
-;;; Values are the return value locations (wired to the standard passing
-;;; locations).
-;;; Nvals is the number of values received.
+;;; VALUES are the return value locations (wired to the standard
+;;; passing locations). NVALS is the number of values received.
;;;
-;;; Save is the save info, which we can ignore since saving has been done.
+;;; Save is the save info, which we can ignore since saving has been
+;;; done.
;;;
-;;; Target is a continuation pointing to the start of the called function.
+;;; TARGET is a continuation pointing to the start of the called
+;;; function.
(define-vop (call-local)
(:args (fp)
(nfp)
\f
;;;; local call with known values return
-;;; Non-TR local call with known return locations. Known-value return works
-;;; just like argument passing in local call.
+;;; Non-TR local call with known return locations. Known-value return
+;;; works just like argument passing in local call.
;;;
-;;; Note: we can't use normal load-tn allocation for the fixed args, since all
-;;; registers may be tied up by the more operand. Instead, we use
-;;; MAYBE-LOAD-STACK-TN.
+;;; Note: we can't use normal load-tn allocation for the fixed args,
+;;; since all registers may be tied up by the more operand. Instead,
+;;; we use MAYBE-LOAD-STACK-TN.
(define-vop (known-call-local)
(:args (fp)
(nfp)
(:vop-var vop)
(:generator 6
(trace-table-entry trace-table-function-epilogue)
- ;; Save the return-pc in a register 'cause the frame-pointer is going away.
- ;; Note this not in the usual stack location so we can't use RET
+ ;; Save the return-pc in a register 'cause the frame-pointer is
+ ;; going away. Note this not in the usual stack location so we
+ ;; can't use RET
(move rpc return-pc)
;; Restore the stack.
(move esp-tn ebp-tn)
\f
;;;; full call
;;;
-;;; There is something of a cross-product effect with full calls. Different
-;;; versions are used depending on whether we know the number of arguments or
-;;; the name of the called function, and whether we want fixed values, unknown
-;;; values, or a tail call.
+;;; There is something of a cross-product effect with full calls.
+;;; Different versions are used depending on whether we know the
+;;; number of arguments or the name of the called function, and
+;;; whether we want fixed values, unknown values, or a tail call.
;;;
-;;; In full call, the arguments are passed creating a partial frame on the
-;;; stack top and storing stack arguments into that frame. On entry to the
-;;; callee, this partial frame is pointed to by FP.
+;;; In full call, the arguments are passed creating a partial frame on
+;;; the stack top and storing stack arguments into that frame. On
+;;; entry to the callee, this partial frame is pointed to by FP.
-;;; This macro helps in the definition of full call VOPs by avoiding code
-;;; replication in defining the cross-product VOPs.
+;;; This macro helps in the definition of full call VOPs by avoiding
+;;; code replication in defining the cross-product VOPs.
;;;
-;;; Name is the name of the VOP to define.
+;;; NAME is the name of the VOP to define.
;;;
-;;; Named is true if the first argument is an fdefinition object whose
+;;; NAMED is true if the first argument is an fdefinition object whose
;;; definition is to be called.
;;;
-;;; Return is either :Fixed, :Unknown or :Tail:
-;;; -- If :Fixed, then the call is for a fixed number of values, returned in
+;;; RETURN is either :FIXED, :UNKNOWN or :TAIL:
+;;; -- If :FIXED, then the call is for a fixed number of values, returned in
;;; the standard passing locations (passed as result operands).
-;;; -- If :Unknown, then the result values are pushed on the stack, and the
+;;; -- If :UNKNOWN, then the result values are pushed on the stack, and the
;;; result values are specified by the Start and Count as in the
;;; unknown-values continuation representation.
-;;; -- If :Tail, then do a tail-recursive call. No values are returned.
+;;; -- If :TAIL, then do a tail-recursive call. No values are returned.
;;; The Old-Fp and Return-PC are passed as the second and third arguments.
;;;
-;;; In non-tail calls, the pointer to the stack arguments is passed as the last
-;;; fixed argument. If Variable is false, then the passing locations are
-;;; passed as a more arg. Variable is true if there are a variable number of
-;;; arguments passed on the stack. Variable cannot be specified with :Tail
-;;; return. TR variable argument call is implemented separately.
+;;; In non-tail calls, the pointer to the stack arguments is passed as
+;;; the last fixed argument. If Variable is false, then the passing
+;;; locations are passed as a more arg. Variable is true if there are
+;;; a variable number of arguments passed on the stack. Variable
+;;; cannot be specified with :Tail return. TR variable argument call
+;;; is implemented separately.
;;;
-;;; In tail call with fixed arguments, the passing locations are passed as a
-;;; more arg, but there is no new-FP, since the arguments have been set up in
-;;; the current frame.
+;;; In tail call with fixed arguments, the passing locations are
+;;; passed as a more arg, but there is no new-FP, since the arguments
+;;; have been set up in the current frame.
(macrolet ((define-full-call (name named return variable)
(aver (not (and variable (eq return :tail))))
`(define-vop (,name
,@(unless (or variable (eq return :tail)) '(arg-locs))
,@(unless variable '(args)))
- ;; We pass either the fdefn object (for named call) or the actual
- ;; function object (for unnamed call) in EAX. With named call,
- ;; closure-tramp will replace it with the real function and invoke
- ;; the real function for closures. Non-closures do not need this
- ;; value, so don't care what shows up in it.
+ ;; We pass either the fdefn object (for named call) or
+ ;; the actual function object (for unnamed call) in
+ ;; EAX. With named call, closure-tramp will replace it
+ ;; with the real function and invoke the real function
+ ;; for closures. Non-closures do not need this value,
+ ;; so don't care what shows up in it.
(:temporary
- (:sc descriptor-reg :offset eax-offset :from (:argument 0) :to :eval)
+ (:sc descriptor-reg
+ :offset eax-offset
+ :from (:argument 0)
+ :to :eval)
eax)
;; We pass the number of arguments in ECX.
(:temporary (:sc unsigned-reg :offset ecx-offset :to :eval) ecx)
- ;; With variable call, we have to load the register-args out
- ;; of the (new) stack frame before doing the call. Therefore,
- ;; we have to tell the lifetime stuff that we need to use them.
+ ;; With variable call, we have to load the
+ ;; register-args out of the (new) stack frame before
+ ;; doing the call. Therefore, we have to tell the
+ ;; lifetime stuff that we need to use them.
,@(when variable
(mapcar #'(lambda (name offset)
`(:temporary (:sc descriptor-reg
(if (eq return :unknown) 25 0))
(trace-table-entry trace-table-call-site)
- ;; This has to be done before the frame pointer is changed!
- ;; eax stores the 'lexical environment' needed for closures
+ ;; This has to be done before the frame pointer is
+ ;; changed! EAX stores the 'lexical environment' needed
+ ;; for closures.
(move eax fun)
(define-full-call call-variable nil :fixed t)
(define-full-call multiple-call-variable nil :unknown t))
-;;; This is defined separately, since it needs special code that BLT's the
-;;; arguments down. All the real work is done in the assembly routine. We just
-;;; set things up so that it can find what it needs.
+;;; This is defined separately, since it needs special code that BLT's
+;;; the arguments down. All the real work is done in the assembly
+;;; routine. We just set things up so that it can find what it needs.
(define-vop (tail-call-variable)
(:args (args :scs (any-reg control-stack) :target esi)
(function :scs (descriptor-reg control-stack) :target eax)
;; Out of here.
(inst jmp ret)))
-;;; Do unknown-values return of a fixed (other than 1) number of values. The
-;;; Values are required to be set up in the standard passing locations. Nvals
-;;; is the number of values returned.
+;;; Do unknown-values return of a fixed (other than 1) number of
+;;; values. The VALUES are required to be set up in the standard
+;;; passing locations. NVALS is the number of values returned.
;;;
-;;; Basically, we just load ECX with the number of values returned and EBX
-;;; with a pointer to the values, set ESP to point to the end of the values,
-;;; and jump directly to return-pc.
+;;; Basically, we just load ECX with the number of values returned and
+;;; EBX with a pointer to the values, set ESP to point to the end of
+;;; the values, and jump directly to return-pc.
(define-vop (return)
(:args (old-fp)
(return-pc :to (:eval 1))
(:ignore values)
(:info nvals)
- ;; In the case of other than one value, we need these registers to tell
- ;; the caller where they are and how many there are.
+ ;; In the case of other than one value, we need these registers to
+ ;; tell the caller where they are and how many there are.
(:temporary (:sc unsigned-reg :offset ebx-offset) ebx)
(:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
(trace-table-entry trace-table-normal)))
-;;; Do unknown-values return of an arbitrary number of values (passed on the
-;;; stack.) We check for the common case of a single return value, and do that
-;;; inline using the normal single value return convention. Otherwise, we
-;;; branch off to code that calls an assembly-routine.
+;;; Do unknown-values return of an arbitrary number of values (passed
+;;; on the stack.) We check for the common case of a single return
+;;; value, and do that inline using the normal single value return
+;;; convention. Otherwise, we branch off to code that calls an
+;;; assembly-routine.
;;;
;;; The assembly routine takes the following args:
;;; EAX -- the return-pc to finally jump to.
;; Get result.
(move closure eax-tn)))
-;;; Copy a more arg from the argument area to the end of the current frame.
-;;; Fixed is the number of non-more arguments.
+;;; Copy a &MORE arg from the argument area to the end of the current
+;;; frame. FIXED is the number of non-&MORE arguments.
;;;
;;; The tricky part is doing this without trashing any of the calling
-;;; convention registers that are still needed. This vop is emitted directly
-;;; after the xep-allocate frame. That means the registers are in use as
-;;; follows:
+;;; convention registers that are still needed. This vop is emitted
+;;; directly after the xep-allocate frame. That means the registers
+;;; are in use as follows:
;;;
;;; EAX -- The lexenv.
;;; EBX -- Available.
;;;
;;; So basically, we have one register available for our use: EBX.
;;;
-;;; What we can do is push the other regs onto the stack, and then restore
-;;; their values by looking directly below where we put the more-args.
+;;; What we can do is push the other regs onto the stack, and then
+;;; restore their values by looking directly below where we put the
+;;; more-args.
(define-vop (copy-more-arg)
(:info fixed)
(:generator 20
DONE))
-;;; More args are stored contiguously on the stack, starting immediately at the
-;;; context pointer. The context pointer is not typed, so the lowtag is 0.
+;;; &MORE args are stored contiguously on the stack, starting
+;;; immediately at the context pointer. The context pointer is not
+;;; typed, so the lowtag is 0.
(define-vop (more-arg)
(:translate %more-arg)
(:policy :fast-safe)
(pseudo-atomic
(allocation dst dst node)
(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.
+ ;; Convert the count into a raw value, so that we can use the
+ ;; LOOP instruction.
(inst shr ecx 2)
;; Set decrement mode (successive args at lower addresses)
(inst std)
(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
+;;; COPY-MORE-ARG. SUPPLIED is the total number of arguments supplied
;;; (originally passed in ECX). FIXED is the number of non-rest
;;; arguments.
;;;
(inst mov
(make-ea :dword :base object
:disp (- (* offset word-bytes) lowtag))
- (logior (ash (char-code val) type-bits)
- base-char-type)))))
+ (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag)))))
;; Else, value not immediate.
(storew value object offset lowtag))))
\f
(:generator 9
(let ((err-lab (generate-error-code vop unbound-symbol-error object)))
(loadw value object symbol-value-slot other-pointer-lowtag)
- (inst cmp value unbound-marker-type)
+ (inst cmp value unbound-marker-widetag)
(inst jmp :e err-lab))))
(define-vop (fast-symbol-value cell-ref)
(:temporary (:sc descriptor-reg :from (:argument 0)) value)
(:generator 9
(loadw value object symbol-value-slot other-pointer-lowtag)
- (inst cmp value unbound-marker-type)
+ (inst cmp value unbound-marker-widetag)
(inst jmp (if not-p :e :ne) target)))
(define-vop (symbol-hash)
(make-ea :byte :base function
:disp (- (* simple-fun-code-offset word-bytes)
fun-pointer-lowtag)))
- (inst cmp type simple-fun-header-type)
+ (inst cmp type simple-fun-header-widetag)
(inst jmp :e normal-fn)
(inst lea raw (make-fixup (extern-alien-name "closure_tramp") :foreign))
NORMAL-FN
(:result-types positive-fixnum)
(:generator 4
(loadw res struct 0 instance-pointer-lowtag)
- (inst shr res type-bits)))
+ (inst shr res n-widetag-bits)))
(define-vop (instance-ref slot-ref)
(:variant instance-slots-offset instance-pointer-lowtag)
(:note "character tagging")
(:generator 1
(move ah x) ; Maybe move char byte.
- (inst mov al base-char-type) ; x86 to type bits
+ (inst mov al base-char-widetag) ; x86 to type bits
(inst and eax-tn #xffff) ; Remove any junk bits.
(move y eax-tn)))
(define-move-vop move-from-base-char :move
(let ((bogus (gen-label))
(done (gen-label)))
(loadw temp thing 0 lowtag)
- (inst shr temp type-bits)
+ (inst shr temp n-widetag-bits)
(inst jmp :z bogus)
(inst shl temp (1- (integer-length word-bytes)))
(unless (= lowtag other-pointer-lowtag)
(:result-types positive-fixnum)
(:generator 5
(loadw res fun 0 fun-pointer-lowtag)
- (inst shr res type-bits)))
+ (inst shr res n-widetag-bits)))
(:note "float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:single-float-type
+ sb!vm:single-float-widetag
sb!vm:single-float-size node)
(with-tn@fp-top(x)
(inst fst (ea-for-sf-desc y))))))
(:note "float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:double-float-type
+ sb!vm:double-float-widetag
sb!vm:double-float-size
node)
(with-tn@fp-top(x)
(:note "float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:long-float-type
+ sb!vm:long-float-widetag
sb!vm:long-float-size
node)
(with-tn@fp-top(x)
(:note "complex float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:complex-single-float-type
- sb!vm:complex-single-float-size node)
+ sb!vm:complex-single-float-widetag
+ sb!vm:complex-single-float-size
+ node)
(let ((real-tn (complex-single-reg-real-tn x)))
(with-tn@fp-top(real-tn)
(inst fst (ea-for-csf-real-desc y))))
(:note "complex float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:complex-double-float-type
+ sb!vm:complex-double-float-widetag
sb!vm:complex-double-float-size
node)
(let ((real-tn (complex-double-reg-real-tn x)))
(:note "complex float to pointer coercion")
(:generator 13
(with-fixed-allocation (y
- sb!vm:complex-long-float-type
+ sb!vm:complex-long-float-widetag
sb!vm:complex-long-float-size
node)
(let ((real-tn (complex-long-reg-real-tn x)))
(logior type
(ash (+ posn
(component-header-length))
- (- type-bits
+ (- n-widetag-bits
word-shift)))))))
(define-instruction simple-fun-header-word (segment)
(:emitter
- (emit-header-data segment simple-fun-header-type)))
+ (emit-header-data segment simple-fun-header-widetag)))
(define-instruction lra-header-word (segment)
(:emitter
- (emit-header-data segment return-pc-header-type)))
+ (emit-header-data segment return-pc-header-widetag)))
\f
;;;; fp instructions
;;;;
:foreign)))))))))
(values))
-(defmacro with-fixed-allocation ((result-tn type-code size &optional inline)
+;;; Allocate an other-pointer object of fixed SIZE with a single word
+;;; header having the specified WIDETAG value. The result is placed in
+;;; RESULT-TN.
+(defmacro with-fixed-allocation ((result-tn widetag size &optional inline)
&rest forms)
- #!+sb-doc
- "Allocate an other-pointer object of fixed Size with a single
- word header having the specified Type-Code. The result is placed in
- Result-TN."
`(pseudo-atomic
(allocation ,result-tn (pad-data-block ,size) ,inline)
- (storew (logior (ash (1- ,size) sb!vm:type-bits) ,type-code) ,result-tn)
+ (storew (logior (ash (1- ,size) sb!vm:n-widetag-bits) ,widetag)
+ ,result-tn)
(inst lea ,result-tn
(make-ea :byte :base ,result-tn :disp other-pointer-lowtag))
,@forms))
(inst mov
(make-ea :dword :base object
:disp (- (* (+ base offset) word-bytes) lowtag))
- (logior (ash (char-code val) type-bits)
- base-char-type)))))
+ (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag)))))
;; Else, value not immediate.
(storew value object (+ base offset) lowtag))))
(symbol
(load-symbol y val))
(character
- (inst mov y (logior (ash (char-code val) type-bits)
- base-char-type))))))
+ (inst mov y (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag))))))
(define-move-function (load-number 1) (vop x y)
((immediate) (signed-reg unsigned-reg))
(symbol
(inst mov y (+ nil-value (static-symbol-offset val))))
(character
- (inst mov y (logior (ash (char-code val) type-bits)
- base-char-type)))))
+ (inst mov y (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag)))))
(move y x))))
(define-move-vop move :move
(symbol
(load-symbol y val))
(character
- (inst mov y (logior (ash (char-code val) type-bits)
- base-char-type)))))
+ (inst mov y (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag)))))
(move y x)))
((control-stack)
(if (sc-is x immediate)
(storew (+ nil-value (static-symbol-offset val))
fp (tn-offset y)))
(character
- (storew (logior (ash (char-code val) type-bits)
- base-char-type)
+ (storew (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag)
fp (tn-offset y))))
;; Lisp stack
(etypecase val
(storew (+ nil-value (static-symbol-offset val))
fp (- (1+ (tn-offset y)))))
(character
- (storew (logior (ash (char-code val) type-bits)
- base-char-type)
+ (storew (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag)
fp (- (1+ (tn-offset y))))))))
(if (= (tn-offset fp) esp-offset)
;; C-call
(assemble (*elsewhere*)
(emit-label bignum)
(with-fixed-allocation
- (y bignum-type (+ bignum-digits-offset 1) node)
+ (y bignum-widetag (+ bignum-digits-offset 1) node)
(storew x y bignum-digits-offset other-pointer-lowtag))
(inst jmp done)))))
(define-move-vop move-from-signed :move
;; always allocated and the header size is set to either one
;; or two words as appropriate.
(inst jmp :ns one-word-bignum)
- ;; Two word bignum.
+ ;; two word bignum
(inst mov y (logior (ash (1- (+ bignum-digits-offset 2))
- sb!vm:type-bits)
- bignum-type))
+ sb!vm:n-widetag-bits)
+ bignum-widetag))
(inst jmp L1)
(emit-label one-word-bignum)
(inst mov y (logior (ash (1- (+ bignum-digits-offset 1))
- sb!vm:type-bits)
- bignum-type))
+ sb!vm:n-widetag-bits)
+ bignum-widetag))
(emit-label L1)
(pseudo-atomic
(allocation alloc (pad-data-block (+ bignum-digits-offset 2)) node)
(symbol
(inst cmp x (+ nil-value (static-symbol-offset val))))
(character
- (inst cmp x (logior (ash (char-code val) type-bits)
- base-char-type))))))
+ (inst cmp x (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag))))))
((sc-is x immediate) ; and y not immediate
;; Swap the order to fit the compare instruction.
(let ((val (tn-value x)))
(symbol
(inst cmp y (+ nil-value (static-symbol-offset val))))
(character
- (inst cmp y (logior (ash (char-code val) type-bits)
- base-char-type))))))
+ (inst cmp y (logior (ash (char-code val) n-widetag-bits)
+ base-char-widetag))))))
(t
(inst cmp x y)))
(:note "SAP to pointer coercion")
(:node-var node)
(:generator 20
- (with-fixed-allocation (res sap-type sap-size node)
+ (with-fixed-allocation (res sap-widetag sap-size node)
(storew sap res sap-pointer-slot other-pointer-lowtag))))
(define-move-vop move-from-sap :move
(sap-reg) (descriptor-reg))
(:result-types positive-fixnum)
(:generator 6
(loadw res x 0 other-pointer-lowtag)
- (inst shr res type-bits)))
+ (inst shr res n-widetag-bits)))
(define-vop (get-closure-length)
(:translate get-closure-length)
(:result-types positive-fixnum)
(:generator 6
(loadw res x 0 fun-pointer-lowtag)
- (inst shr res type-bits)))
+ (inst shr res n-widetag-bits)))
(define-vop (set-header-data)
(:translate set-header-data)
:from (:argument 1) :to (:result 0)) eax)
(:generator 6
(move eax data)
- (inst shl eax (- type-bits 2))
+ (inst shl eax (- n-widetag-bits 2))
(inst mov al-tn (make-ea :byte :base x :disp (- other-pointer-lowtag)))
(storew eax x 0 other-pointer-lowtag)
(move res x)))
(:results (res :scs (any-reg descriptor-reg) :from (:argument 0)))
(:generator 2
(move res val)
- (inst shl res (- type-bits 2))
+ (inst shl res (- n-widetag-bits 2))
(inst or res (sc-case type
(unsigned-reg type)
(immediate (tn-value type))))))
(:result-types system-area-pointer)
(:generator 10
(loadw sap code 0 other-pointer-lowtag)
- (inst shr sap type-bits)
+ (inst shr sap n-widetag-bits)
(inst lea sap (make-ea :byte :base code :index sap :scale 4
:disp (- other-pointer-lowtag)))))
(:results (func :scs (descriptor-reg) :from (:argument 0)))
(:generator 10
(loadw func code 0 other-pointer-lowtag)
- (inst shr func type-bits)
+ (inst shr func n-widetag-bits)
(inst lea func
(make-ea :byte :base offset :index func :scale 4
:disp (- fun-pointer-lowtag other-pointer-lowtag)))
(eval-when (:compile-toplevel :execute)
(defparameter *immediate-types*
- (list unbound-marker-type base-char-type))
+ (list unbound-marker-widetag base-char-widetag))
-(defparameter *fun-header-types*
- (list funcallable-instance-header-type
- simple-fun-header-type
- closure-fun-header-type
- closure-header-type))
+(defparameter *fun-header-widetags*
+ (list funcallable-instance-header-widetag
+ simple-fun-header-widetag
+ closure-fun-header-widetag
+ closure-header-widetag))
(defun canonicalize-headers (headers)
(collect ((results))
(extended (remove lowtag-limit type-codes :test #'>))
(immediates (intersection extended *immediate-types* :test #'eql))
(headers (set-difference extended *immediate-types* :test #'eql))
- (function-p (if (intersection headers *fun-header-types*)
- (if (subsetp headers *fun-header-types*)
+ (function-p (if (intersection headers *fun-header-widetags*)
+ (if (subsetp headers *fun-header-widetags*)
t
(error "can't test for mix of function subtypes ~
and normal header types"))
(t
(let ((start (car header))
(end (cdr header)))
- (unless (= start bignum-type)
+ (unless (= start bignum-widetag)
(inst cmp al-tn start)
(inst jmp :b when-false)) ; was :l
(inst cmp al-tn end)
(t
(let ((start (car header))
(end (cdr header)))
- (unless (= start bignum-type)
+ (unless (= start bignum-widetag)
(inst sub al-tn (- start delta))
(setf delta start)
(inst jmp :l when-false))
instance-pointer-lowtag)
(def-type-vops bignump check-bignum bignum
- object-not-bignum-error bignum-type)
+ object-not-bignum-error bignum-widetag)
(def-type-vops ratiop check-ratio ratio
- object-not-ratio-error ratio-type)
+ object-not-ratio-error ratio-widetag)
(def-type-vops complexp check-complex complex object-not-complex-error
- complex-type complex-single-float-type complex-double-float-type
- #!+long-float complex-long-float-type)
+ complex-widetag complex-single-float-widetag complex-double-float-widetag
+ #!+long-float complex-long-float-widetag)
(def-type-vops complex-rational-p check-complex-rational nil
- object-not-complex-rational-error complex-type)
+ object-not-complex-rational-error complex-widetag)
(def-type-vops complex-float-p check-complex-float nil
object-not-complex-float-error
- complex-single-float-type complex-double-float-type
- #!+long-float complex-long-float-type)
+ complex-single-float-widetag complex-double-float-widetag
+ #!+long-float complex-long-float-widetag)
(def-type-vops complex-single-float-p check-complex-single-float
complex-single-float object-not-complex-single-float-error
- complex-single-float-type)
+ complex-single-float-widetag)
(def-type-vops complex-double-float-p check-complex-double-float
complex-double-float object-not-complex-double-float-error
- complex-double-float-type)
+ complex-double-float-widetag)
#!+long-float
(def-type-vops complex-long-float-p check-complex-long-float
complex-long-float object-not-complex-long-float-error
- complex-long-float-type)
+ complex-long-float-widetag)
(def-type-vops single-float-p check-single-float single-float
- object-not-single-float-error single-float-type)
+ object-not-single-float-error single-float-widetag)
(def-type-vops double-float-p check-double-float double-float
- object-not-double-float-error double-float-type)
+ object-not-double-float-error double-float-widetag)
#!+long-float
(def-type-vops long-float-p check-long-float long-float
- object-not-long-float-error long-float-type)
+ object-not-long-float-error long-float-widetag)
(def-type-vops simple-string-p check-simple-string simple-string
- object-not-simple-string-error simple-string-type)
+ object-not-simple-string-error simple-string-widetag)
(def-type-vops simple-bit-vector-p check-simple-bit-vector simple-bit-vector
- object-not-simple-bit-vector-error simple-bit-vector-type)
+ object-not-simple-bit-vector-error simple-bit-vector-widetag)
(def-type-vops simple-vector-p check-simple-vector simple-vector
- object-not-simple-vector-error simple-vector-type)
+ object-not-simple-vector-error simple-vector-widetag)
(def-type-vops simple-array-unsigned-byte-2-p
check-simple-array-unsigned-byte-2
simple-array-unsigned-byte-2
object-not-simple-array-unsigned-byte-2-error
- simple-array-unsigned-byte-2-type)
+ simple-array-unsigned-byte-2-widetag)
(def-type-vops simple-array-unsigned-byte-4-p
check-simple-array-unsigned-byte-4
simple-array-unsigned-byte-4
object-not-simple-array-unsigned-byte-4-error
- simple-array-unsigned-byte-4-type)
+ simple-array-unsigned-byte-4-widetag)
(def-type-vops simple-array-unsigned-byte-8-p
check-simple-array-unsigned-byte-8
simple-array-unsigned-byte-8
object-not-simple-array-unsigned-byte-8-error
- simple-array-unsigned-byte-8-type)
+ simple-array-unsigned-byte-8-widetag)
(def-type-vops simple-array-unsigned-byte-16-p
check-simple-array-unsigned-byte-16
simple-array-unsigned-byte-16
object-not-simple-array-unsigned-byte-16-error
- simple-array-unsigned-byte-16-type)
+ simple-array-unsigned-byte-16-widetag)
(def-type-vops simple-array-unsigned-byte-32-p
check-simple-array-unsigned-byte-32
simple-array-unsigned-byte-32
object-not-simple-array-unsigned-byte-32-error
- simple-array-unsigned-byte-32-type)
+ simple-array-unsigned-byte-32-widetag)
(def-type-vops simple-array-signed-byte-8-p
check-simple-array-signed-byte-8
simple-array-signed-byte-8
object-not-simple-array-signed-byte-8-error
- simple-array-signed-byte-8-type)
+ simple-array-signed-byte-8-widetag)
(def-type-vops simple-array-signed-byte-16-p
check-simple-array-signed-byte-16
simple-array-signed-byte-16
object-not-simple-array-signed-byte-16-error
- simple-array-signed-byte-16-type)
+ simple-array-signed-byte-16-widetag)
(def-type-vops simple-array-signed-byte-30-p
check-simple-array-signed-byte-30
simple-array-signed-byte-30
object-not-simple-array-signed-byte-30-error
- simple-array-signed-byte-30-type)
+ simple-array-signed-byte-30-widetag)
(def-type-vops simple-array-signed-byte-32-p
check-simple-array-signed-byte-32
simple-array-signed-byte-32
object-not-simple-array-signed-byte-32-error
- simple-array-signed-byte-32-type)
+ simple-array-signed-byte-32-widetag)
(def-type-vops simple-array-single-float-p check-simple-array-single-float
simple-array-single-float object-not-simple-array-single-float-error
- simple-array-single-float-type)
+ simple-array-single-float-widetag)
(def-type-vops simple-array-double-float-p check-simple-array-double-float
simple-array-double-float object-not-simple-array-double-float-error
- simple-array-double-float-type)
+ simple-array-double-float-widetag)
#!+long-float
(def-type-vops simple-array-long-float-p check-simple-array-long-float
simple-array-long-float object-not-simple-array-long-float-error
- simple-array-long-float-type)
+ simple-array-long-float-widetag)
(def-type-vops simple-array-complex-single-float-p
check-simple-array-complex-single-float
simple-array-complex-single-float
object-not-simple-array-complex-single-float-error
- simple-array-complex-single-float-type)
+ simple-array-complex-single-float-widetag)
(def-type-vops simple-array-complex-double-float-p
check-simple-array-complex-double-float
simple-array-complex-double-float
object-not-simple-array-complex-double-float-error
- simple-array-complex-double-float-type)
+ simple-array-complex-double-float-widetag)
#!+long-float
(def-type-vops simple-array-complex-long-float-p
check-simple-array-complex-long-float
simple-array-complex-long-float
object-not-simple-array-complex-long-float-error
- simple-array-complex-long-float-type)
+ simple-array-complex-long-float-widetag)
(def-type-vops base-char-p check-base-char base-char
- object-not-base-char-error base-char-type)
+ object-not-base-char-error base-char-widetag)
(def-type-vops system-area-pointer-p check-system-area-pointer
- system-area-pointer object-not-sap-error sap-type)
+ system-area-pointer object-not-sap-error sap-widetag)
(def-type-vops weak-pointer-p check-weak-pointer weak-pointer
- object-not-weak-pointer-error weak-pointer-type)
+ object-not-weak-pointer-error weak-pointer-widetag)
(def-type-vops code-component-p nil nil nil
- code-header-type)
+ code-header-widetag)
(def-type-vops lra-p nil nil nil
- return-pc-header-type)
+ return-pc-header-widetag)
(def-type-vops fdefn-p nil nil nil
- fdefn-type)
+ fdefn-widetag)
(def-type-vops funcallable-instance-p nil nil nil
- funcallable-instance-header-type)
+ funcallable-instance-header-widetag)
(def-type-vops array-header-p nil nil nil
- simple-array-type complex-string-type complex-bit-vector-type
- complex-vector-type complex-array-type)
+ simple-array-widetag complex-string-widetag complex-bit-vector-widetag
+ complex-vector-widetag complex-array-widetag)
(def-type-vops stringp check-string nil object-not-string-error
- simple-string-type complex-string-type)
+ simple-string-widetag complex-string-widetag)
(def-type-vops bit-vector-p check-bit-vector nil object-not-bit-vector-error
- simple-bit-vector-type complex-bit-vector-type)
+ simple-bit-vector-widetag complex-bit-vector-widetag)
(def-type-vops vectorp check-vector nil object-not-vector-error
- simple-string-type simple-bit-vector-type simple-vector-type
- simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type
- simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type
- simple-array-unsigned-byte-32-type
- simple-array-signed-byte-8-type simple-array-signed-byte-16-type
- simple-array-signed-byte-30-type simple-array-signed-byte-32-type
- simple-array-single-float-type simple-array-double-float-type
- #!+long-float simple-array-long-float-type
- simple-array-complex-single-float-type
- simple-array-complex-double-float-type
- #!+long-float simple-array-complex-long-float-type
- complex-string-type complex-bit-vector-type complex-vector-type)
+ simple-string-widetag simple-bit-vector-widetag simple-vector-widetag
+ simple-array-unsigned-byte-2-widetag simple-array-unsigned-byte-4-widetag
+ simple-array-unsigned-byte-8-widetag simple-array-unsigned-byte-16-widetag
+ simple-array-unsigned-byte-32-widetag
+ simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
+ simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
+ simple-array-single-float-widetag simple-array-double-float-widetag
+ #!+long-float simple-array-long-float-widetag
+ simple-array-complex-single-float-widetag
+ simple-array-complex-double-float-widetag
+ #!+long-float simple-array-complex-long-float-widetag
+ complex-string-widetag complex-bit-vector-widetag complex-vector-widetag)
;;; Note that this "type VOP" is sort of an oddball; it doesn't so
;;; much test for a Lisp-level type as just expose a low-level type
;;; associated backend type predicates and so forth as we do for
;;; ordinary type VOPs.
(def-type-vops complex-vector-p check-complex-vector nil object-not-complex-vector-error
- complex-vector-type)
+ complex-vector-widetag)
(def-type-vops simple-array-p check-simple-array nil object-not-simple-array-error
- simple-array-type simple-string-type simple-bit-vector-type
- simple-vector-type simple-array-unsigned-byte-2-type
- simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
- simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
- simple-array-signed-byte-8-type simple-array-signed-byte-16-type
- simple-array-signed-byte-30-type simple-array-signed-byte-32-type
- simple-array-single-float-type simple-array-double-float-type
- #!+long-float simple-array-long-float-type
- simple-array-complex-single-float-type
- simple-array-complex-double-float-type
- #!+long-float simple-array-complex-long-float-type)
+ simple-array-widetag simple-string-widetag simple-bit-vector-widetag
+ simple-vector-widetag simple-array-unsigned-byte-2-widetag
+ simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
+ simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
+ simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
+ simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
+ simple-array-single-float-widetag simple-array-double-float-widetag
+ #!+long-float simple-array-long-float-widetag
+ simple-array-complex-single-float-widetag
+ simple-array-complex-double-float-widetag
+ #!+long-float simple-array-complex-long-float-widetag)
(def-type-vops arrayp check-array nil object-not-array-error
- simple-array-type simple-string-type simple-bit-vector-type
- simple-vector-type simple-array-unsigned-byte-2-type
- simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
- simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
- simple-array-signed-byte-8-type simple-array-signed-byte-16-type
- simple-array-signed-byte-30-type simple-array-signed-byte-32-type
- simple-array-single-float-type simple-array-double-float-type
- #!+long-float simple-array-long-float-type
- simple-array-complex-single-float-type
- simple-array-complex-double-float-type
- #!+long-float simple-array-complex-long-float-type
- complex-string-type complex-bit-vector-type complex-vector-type
- complex-array-type)
+ simple-array-widetag simple-string-widetag simple-bit-vector-widetag
+ simple-vector-widetag simple-array-unsigned-byte-2-widetag
+ simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
+ simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
+ simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
+ simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
+ simple-array-single-float-widetag simple-array-double-float-widetag
+ #!+long-float simple-array-long-float-widetag
+ simple-array-complex-single-float-widetag
+ simple-array-complex-double-float-widetag
+ #!+long-float simple-array-complex-long-float-widetag
+ complex-string-widetag complex-bit-vector-widetag complex-vector-widetag
+ complex-array-widetag)
(def-type-vops numberp check-number nil object-not-number-error
- 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)
+ even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag ratio-widetag
+ single-float-widetag double-float-widetag
+ #!+long-float long-float-widetag
+ complex-widetag complex-single-float-widetag complex-double-float-widetag
+ #!+long-float complex-long-float-widetag)
(def-type-vops rationalp check-rational nil object-not-rational-error
- even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type)
+ even-fixnum-lowtag odd-fixnum-lowtag ratio-widetag bignum-widetag)
(def-type-vops integerp check-integer nil object-not-integer-error
- even-fixnum-lowtag odd-fixnum-lowtag bignum-type)
+ even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag)
(def-type-vops floatp check-float nil object-not-float-error
- single-float-type double-float-type #!+long-float long-float-type)
+ single-float-widetag double-float-widetag #!+long-float long-float-widetag)
(def-type-vops realp check-real nil object-not-real-error
- even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type
- single-float-type double-float-type #!+long-float long-float-type)
+ even-fixnum-lowtag odd-fixnum-lowtag ratio-widetag bignum-widetag
+ single-float-widetag double-float-widetag #!+long-float long-float-widetag)
\f
;;;; other integer ranges
(inst cmp al-tn other-pointer-lowtag)
(inst jmp :ne nope)
(loadw eax-tn value 0 other-pointer-lowtag)
- (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
+ (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
(inst jmp (if not-p :ne :e) target))
NOT-TARGET))
(inst cmp al-tn other-pointer-lowtag)
(inst jmp :ne nope)
(loadw eax-tn value 0 other-pointer-lowtag)
- (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
+ (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
(inst jmp :ne nope))
YEP
(move result value)))
;; Get the header.
(loadw eax-tn value 0 other-pointer-lowtag)
;; Is it one?
- (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
+ (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
(inst jmp :e single-word)
;; If it's other than two, we can't be an (unsigned-byte 32)
- (inst cmp eax-tn (+ (ash 2 type-bits) bignum-type))
+ (inst cmp eax-tn (+ (ash 2 n-widetag-bits) bignum-widetag))
(inst jmp :ne nope)
;; Get the second digit.
(loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
;; Get the header.
(loadw eax-tn value 0 other-pointer-lowtag)
;; Is it one?
- (inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
+ (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
(inst jmp :e single-word)
;; If it's other than two, we can't be an (unsigned-byte 32)
- (inst cmp eax-tn (+ (ash 2 type-bits) bignum-type))
+ (inst cmp eax-tn (+ (ash 2 n-widetag-bits) bignum-widetag))
(inst jmp :ne nope)
;; Get the second digit.
(loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
(let ((is-symbol-label (if not-p drop-thru target)))
(inst cmp value nil-value)
(inst jmp :e is-symbol-label)
- (test-type value target not-p symbol-header-type))
+ (test-type value target not-p symbol-header-widetag))
DROP-THRU))
(define-vop (check-symbol check-type)
(let ((error (generate-error-code vop object-not-symbol-error value)))
(inst cmp value nil-value)
(inst jmp :e drop-thru)
- (test-type value error t symbol-header-type))
+ (test-type value error t symbol-header-widetag))
DROP-THRU
(move result value)))
lispobj *result;
result = alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj)));
- *result = (lispobj) (words << N_TYPE_BITS) | type;
+ *result = (lispobj) (words << N_WIDETAG_BITS) | type;
return result;
}
if (-0x20000000 < n && n < 0x20000000)
return make_fixnum(n);
else {
- ptr = (struct bignum *)alloc_unboxed(type_Bignum, 1);
+ ptr = (struct bignum *)alloc_unboxed(BIGNUM_WIDETAG, 1);
ptr->digits[0] = n;
alloc_string(char *str)
{
int len = strlen(str);
- lispobj result = alloc_vector(type_SimpleString, len+1, 8);
+ lispobj result = alloc_vector(SIMPLE_STRING_WIDETAG, len+1, 8);
struct vector *vec = (struct vector *)native_pointer(result);
vec->length = make_fixnum(len);
int n_words_to_alloc =
(sizeof(struct sap) - sizeof(lispobj)) / sizeof(u32);
struct sap *sap =
- (struct sap *)alloc_unboxed((int)type_Sap, n_words_to_alloc);
+ (struct sap *)alloc_unboxed((int)SAP_WIDETAG, n_words_to_alloc);
sap->pointer = ptr;
return (lispobj) sap | OTHER_POINTER_LOWTAG;
}
.globl call_into_lisp_LRA
call_into_lisp_LRA:
- .long type_ReturnPcHeader
+ .long RETURN_PC_HEADER_WIDETAG
/* execution resumes here*/
mov reg_OCFP,reg_CSP
.set noreorder
.globl fun_end_breakpoint_guts
fun_end_breakpoint_guts:
- .long type_ReturnPcHeader
+ .long RETURN_PC_HEADER_WIDETAG
br zero, fun_end_breakpoint_trap
nop
mov reg_CSP, reg_OCFP
headerp = (lispobj *) native_pointer(object);
header = *headerp;
- type = TypeOf(header);
+ type = widetag_of(header);
switch (type) {
- case type_CodeHeader:
+ case CODE_HEADER_WIDETAG:
break;
- case type_ReturnPcHeader:
- case type_SimpleFunHeader:
- case type_ClosureFunHeader:
+ case RETURN_PC_HEADER_WIDETAG:
+ case SIMPLE_FUN_HEADER_WIDETAG:
+ case CLOSURE_FUN_HEADER_WIDETAG:
len = HEADER_LENGTH(header);
if (len == 0)
headerp = NULL;
unsigned long pc;
info->interrupted = 1;
- if (lowtagof(*os_context_register_addr(context, reg_CODE))
+ if (lowtag_of(*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. */
header = (struct simple_fun *) native_pointer(function);
name = header->name;
- if (lowtagof(name) == OTHER_POINTER_LOWTAG) {
+ if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
lispobj *object;
object = (lispobj *) native_pointer(name);
- if (TypeOf(*object) == type_SymbolHeader) {
+ if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) {
struct symbol *symbol;
symbol = (struct symbol *) object;
object = (lispobj *) native_pointer(symbol->name);
}
- if (TypeOf(*object) == type_SimpleString) {
+ if (widetag_of(*object) == SIMPLE_STRING_WIDETAG) {
struct vector *string;
string = (struct vector *) object;
lispobj code = *os_context_register_addr(context, reg_CODE);
lispobj header;
- if (lowtagof(code) != OTHER_POINTER_LOWTAG)
+ if (lowtag_of(code) != OTHER_POINTER_LOWTAG)
return NIL;
header = *(lispobj *)(code-OTHER_POINTER_LOWTAG);
- if (TypeOf(header) == type_CodeHeader)
+ if (widetag_of(header) == CODE_HEADER_WIDETAG)
return code;
else
return code - HeaderValue(header)*sizeof(lispobj);
gc_assert((nwords & 0x01) == 0);
/* get tag of object */
- tag = lowtagof(object);
+ tag = lowtag_of(object);
/* allocate space */
new = new_space_free_pointer;
int type, words_scavenged;
object = *start;
- type = TypeOf(object);
+ type = widetag_of(object);
#if defined(DEBUG_SCAVENGE_VERBOSE)
fprintf(stderr,"Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
int tag;
lispobj *pointer;
- tag = lowtagof(object);
+ tag = lowtag_of(object);
switch (tag) {
case LIST_POINTER_LOWTAG:
case OTHER_POINTER_LOWTAG:
pointer = (lispobj *) native_pointer(object);
header = *pointer;
- type = TypeOf(header);
+ type = widetag_of(header);
nwords = (sizetab[type])(pointer);
}
} else {
- type = TypeOf(object);
+ type = widetag_of(object);
nwords = (sizetab[type])(start);
total_words_not_copied += nwords;
printf("%4d words not copied at 0x%16lx; ",
/* to either a function header, a closure */
/* function header, or to a closure header. */
- type = TypeOf(first);
+ type = widetag_of(first);
switch (type) {
- case type_SimpleFunHeader:
- case type_ClosureFunHeader:
+ case SIMPLE_FUN_HEADER_WIDETAG:
+ case CLOSURE_FUN_HEADER_WIDETAG:
copy = trans_fun_header(object);
break;
default:
return (struct code *) native_pointer(first);
}
- gc_assert(TypeOf(first) == type_CodeHeader);
+ gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
/* prepare to transport the code vector */
l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
lispobj nfheaderl;
fheaderp = (struct simple_fun *) native_pointer(fheaderl);
- gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader);
+ gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
/* calcuate the new function pointer and the new */
/* function header */
fheaderl = code->entry_points;
while (fheaderl != NIL) {
fheaderp = (struct simple_fun *) native_pointer(fheaderl);
- gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader);
+ gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
#if defined(DEBUG_CODE_GC)
printf("Scavenging boxed section of entry point located at 0x%08x.\n",
cdr = cons->cdr;
- if (lowtagof(cdr) != LIST_POINTER_LOWTAG ||
+ if (lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
!from_space_p(cdr) ||
(is_lisp_pointer(first = *(lispobj *)native_pointer(cdr))
&& new_space_p(first)))
/* Object is a pointer into from space - not a FP */
first_pointer = (lispobj *) native_pointer(object);
- first = *first_pointer = (transother[TypeOf(*first_pointer)])(object);
+ first = *first_pointer = (transother[widetag_of(*first_pointer)])(object);
gc_assert(is_lisp_pointer(first));
gc_assert(!from_space_p(first));
static int
scav_vector(lispobj *where, lispobj object)
{
- if (HeaderValue(object) == subtype_VectorValidHashing)
- *where = (subtype_VectorMustRehash<<N_TYPE_BITS) | type_SimpleVector;
+ if (HeaderValue(object) == subtype_VectorValidHashing) {
+ *where =
+ (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
+ }
return 1;
}
}
-#ifdef type_SimpleArrayLongFloat
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
static int
scav_vector_long_float(lispobj *where, lispobj object)
{
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
static int
scav_vector_complex_single_float(lispobj *where, lispobj object)
{
}
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
static int
scav_vector_complex_double_float(lispobj *where, lispobj object)
{
}
#endif
-#ifdef type_SimpleArrayComplexLongFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
static int
scav_vector_complex_long_float(lispobj *where, lispobj object)
{
scavtab[OTHER_POINTER_LOWTAG|(i<<3)] = scav_other_pointer;
}
- scavtab[type_Bignum] = scav_unboxed;
- scavtab[type_Ratio] = scav_boxed;
- scavtab[type_SingleFloat] = scav_unboxed;
- scavtab[type_DoubleFloat] = scav_unboxed;
-#ifdef type_LongFloat
- scavtab[type_LongFloat] = scav_unboxed;
-#endif
- scavtab[type_Complex] = scav_boxed;
-#ifdef type_ComplexSingleFloat
- scavtab[type_ComplexSingleFloat] = scav_unboxed;
-#endif
-#ifdef type_ComplexDoubleFloat
- scavtab[type_ComplexDoubleFloat] = scav_unboxed;
-#endif
-#ifdef type_ComplexLongFloat
- scavtab[type_ComplexLongFloat] = scav_unboxed;
-#endif
- scavtab[type_SimpleArray] = scav_boxed;
- scavtab[type_SimpleString] = scav_string;
- scavtab[type_SimpleBitVector] = scav_vector_bit;
- scavtab[type_SimpleVector] = scav_vector;
- scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
- scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
- scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
- scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
- scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
-#ifdef type_SimpleArraySignedByte8
- scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
-#endif
-#ifdef type_SimpleArraySignedByte16
- scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
-#endif
-#ifdef type_SimpleArraySignedByte30
- scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
-#endif
-#ifdef type_SimpleArraySignedByte32
- scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
-#endif
- scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
- scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
-#ifdef type_SimpleArrayLongFloat
- scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
-#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float;
-#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float;
-#endif
-#ifdef type_SimpleArrayComplexLongFloat
- scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
-#endif
- scavtab[type_ComplexString] = scav_boxed;
- scavtab[type_ComplexBitVector] = scav_boxed;
- scavtab[type_ComplexVector] = scav_boxed;
- scavtab[type_ComplexArray] = scav_boxed;
- scavtab[type_CodeHeader] = scav_code_header;
- scavtab[type_SimpleFunHeader] = scav_fun_header;
- scavtab[type_ClosureFunHeader] = scav_fun_header;
- scavtab[type_ReturnPcHeader] = scav_return_pc_header;
+ scavtab[BIGNUM_WIDETAG] = scav_unboxed;
+ scavtab[RATIO_WIDETAG] = scav_boxed;
+ scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
+ scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
+#ifdef LONG_FLOAT_WIDETAG
+ scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
+#endif
+ scavtab[COMPLEX_WIDETAG] = scav_boxed;
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
+#endif
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
+#endif
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
+#endif
+ scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
+ scavtab[SIMPLE_STRING_WIDETAG] = scav_string;
+ scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
+ scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
+ scav_vector_unsigned_byte_2;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
+ scav_vector_unsigned_byte_4;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
+ scav_vector_unsigned_byte_8;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
+ scav_vector_unsigned_byte_16;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
+ scav_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
+ scav_vector_unsigned_byte_8;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
+ scav_vector_unsigned_byte_16;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
+ scav_vector_unsigned_byte_32;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
+ scav_vector_unsigned_byte_32;
+#endif
+ scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
+ scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
+ scav_vector_complex_single_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
+ scav_vector_complex_double_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
+ scav_vector_complex_long_float;
+#endif
+ scavtab[COMPLEX_STRING_WIDETAG] = scav_boxed;
+ scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
+ scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
+ scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
+ scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
+ scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
+ scavtab[CLOSURE_FUN_HEADER_WIDETAG] = scav_fun_header;
+ scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
#ifdef __i386__
- scavtab[type_ClosureHeader] = scav_closure_header;
- scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
+ scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
+ scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
#else
- scavtab[type_ClosureHeader] = scav_boxed;
- scavtab[type_FuncallableInstanceHeader] = scav_boxed;
-#endif
- scavtab[type_ValueCellHeader] = scav_boxed;
- scavtab[type_SymbolHeader] = scav_boxed;
- scavtab[type_BaseChar] = scav_immediate;
- scavtab[type_Sap] = scav_unboxed;
- scavtab[type_UnboundMarker] = scav_immediate;
- scavtab[type_WeakPointer] = scav_weak_pointer;
- scavtab[type_InstanceHeader] = scav_boxed;
+ scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
+ scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
+#endif
+ scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
+ scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
+ scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
+ scavtab[SAP_WIDETAG] = scav_unboxed;
+ scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
+ scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer;
+ scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
#ifndef sparc
- scavtab[type_Fdefn] = scav_fdefn;
+ scavtab[FDEFN_WIDETAG] = scav_fdefn;
#else
- scavtab[type_Fdefn] = scav_boxed;
+ scavtab[FDEFN_WIDETAG] = scav_boxed;
#endif
/* Transport Other Table */
for (i = 0; i < 256; i++)
transother[i] = trans_lose;
- transother[type_Bignum] = trans_unboxed;
- transother[type_Ratio] = trans_boxed;
- transother[type_SingleFloat] = trans_unboxed;
- transother[type_DoubleFloat] = trans_unboxed;
-#ifdef type_LongFloat
- transother[type_LongFloat] = trans_unboxed;
-#endif
- transother[type_Complex] = trans_boxed;
-#ifdef type_ComplexSingleFloat
- transother[type_ComplexSingleFloat] = trans_unboxed;
-#endif
-#ifdef type_ComplexDoubleFloat
- transother[type_ComplexDoubleFloat] = trans_unboxed;
-#endif
-#ifdef type_ComplexLongFloat
- transother[type_ComplexLongFloat] = trans_unboxed;
-#endif
- transother[type_SimpleArray] = trans_boxed;
- transother[type_SimpleString] = trans_string;
- transother[type_SimpleBitVector] = trans_vector_bit;
- transother[type_SimpleVector] = trans_vector;
- transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
- transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
- transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
- transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
- transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
-#ifdef type_SimpleArraySignedByte8
- transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
-#endif
-#ifdef type_SimpleArraySignedByte16
- transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
-#endif
-#ifdef type_SimpleArraySignedByte30
- transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
-#endif
-#ifdef type_SimpleArraySignedByte32
- transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
-#endif
- transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
- transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
-#ifdef type_SimpleArrayLongFloat
- transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
-#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float;
-#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float;
-#endif
-#ifdef type_SimpleArrayComplexLongFloat
- transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float;
-#endif
- transother[type_ComplexString] = trans_boxed;
- transother[type_ComplexBitVector] = trans_boxed;
- transother[type_ComplexVector] = trans_boxed;
- transother[type_ComplexArray] = trans_boxed;
- transother[type_CodeHeader] = trans_code_header;
- transother[type_SimpleFunHeader] = trans_fun_header;
- transother[type_ClosureFunHeader] = trans_fun_header;
- transother[type_ReturnPcHeader] = trans_return_pc_header;
- transother[type_ClosureHeader] = trans_boxed;
- transother[type_FuncallableInstanceHeader] = trans_boxed;
- transother[type_ValueCellHeader] = trans_boxed;
- transother[type_SymbolHeader] = trans_boxed;
- transother[type_BaseChar] = trans_immediate;
- transother[type_Sap] = trans_unboxed;
- transother[type_UnboundMarker] = trans_immediate;
- transother[type_WeakPointer] = trans_weak_pointer;
- transother[type_InstanceHeader] = trans_boxed;
- transother[type_Fdefn] = trans_boxed;
+ transother[BIGNUM_WIDETAG] = trans_unboxed;
+ transother[RATIO_WIDETAG] = trans_boxed;
+ transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
+ transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
+#ifdef LONG_FLOAT_WIDETAG
+ transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
+#endif
+ transother[COMPLEX_WIDETAG] = trans_boxed;
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
+#endif
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
+#endif
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
+#endif
+ transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed;
+ transother[SIMPLE_STRING_WIDETAG] = trans_string;
+ transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
+ transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
+ trans_vector_unsigned_byte_2;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
+ trans_vector_unsigned_byte_4;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
+ trans_vector_unsigned_byte_8;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
+ trans_vector_unsigned_byte_16;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
+ trans_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
+ trans_vector_unsigned_byte_8;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
+ trans_vector_unsigned_byte_16;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
+ trans_vector_unsigned_byte_32;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
+ trans_vector_unsigned_byte_32;
+#endif
+ transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
+ trans_vector_single_float;
+ transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
+ trans_vector_double_float;
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
+ trans_vector_long_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
+ trans_vector_complex_single_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
+ trans_vector_complex_double_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
+ trans_vector_complex_long_float;
+#endif
+ transother[COMPLEX_STRING_WIDETAG] = trans_boxed;
+ transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
+ transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
+ transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
+ transother[CODE_HEADER_WIDETAG] = trans_code_header;
+ transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
+ transother[CLOSURE_FUN_HEADER_WIDETAG] = trans_fun_header;
+ transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
+ transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
+ transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
+ transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
+ transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
+ transother[BASE_CHAR_WIDETAG] = trans_immediate;
+ transother[SAP_WIDETAG] = trans_unboxed;
+ transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
+ transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
+ transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
+ transother[FDEFN_WIDETAG] = trans_boxed;
/* Size table */
sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer;
}
- sizetab[type_Bignum] = size_unboxed;
- sizetab[type_Ratio] = size_boxed;
- sizetab[type_SingleFloat] = size_unboxed;
- sizetab[type_DoubleFloat] = size_unboxed;
-#ifdef type_LongFloat
- sizetab[type_LongFloat] = size_unboxed;
-#endif
- sizetab[type_Complex] = size_boxed;
-#ifdef type_ComplexSingleFloat
- sizetab[type_ComplexSingleFloat] = size_unboxed;
-#endif
-#ifdef type_ComplexDoubleFloat
- sizetab[type_ComplexDoubleFloat] = size_unboxed;
-#endif
-#ifdef type_ComplexLongFloat
- sizetab[type_ComplexLongFloat] = size_unboxed;
-#endif
- sizetab[type_SimpleArray] = size_boxed;
- sizetab[type_SimpleString] = size_string;
- sizetab[type_SimpleBitVector] = size_vector_bit;
- sizetab[type_SimpleVector] = size_vector;
- sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
- sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
- sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
- sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
- sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
-#ifdef type_SimpleArraySignedByte8
- sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
-#endif
-#ifdef type_SimpleArraySignedByte16
- sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
-#endif
-#ifdef type_SimpleArraySignedByte30
- sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
-#endif
-#ifdef type_SimpleArraySignedByte32
- sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
-#endif
- sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
- sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
-#ifdef type_SimpleArrayLongFloat
- sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
-#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float;
-#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float;
-#endif
-#ifdef type_SimpleArrayComplexLongFloat
- sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
-#endif
- sizetab[type_ComplexString] = size_boxed;
- sizetab[type_ComplexBitVector] = size_boxed;
- sizetab[type_ComplexVector] = size_boxed;
- sizetab[type_ComplexArray] = size_boxed;
- sizetab[type_CodeHeader] = size_code_header;
+ sizetab[BIGNUM_WIDETAG] = size_unboxed;
+ sizetab[RATIO_WIDETAG] = size_boxed;
+ sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
+ sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
+#ifdef LONG_FLOAT_WIDETAG
+ sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
+#endif
+ sizetab[COMPLEX_WIDETAG] = size_boxed;
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
+#endif
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
+#endif
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
+#endif
+ sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
+ sizetab[SIMPLE_STRING_WIDETAG] = size_string;
+ sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
+ sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
+ size_vector_unsigned_byte_2;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
+ size_vector_unsigned_byte_4;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
+ size_vector_unsigned_byte_8;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
+ size_vector_unsigned_byte_16;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
+ size_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
+ size_vector_unsigned_byte_8;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
+ size_vector_unsigned_byte_16;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
+ size_vector_unsigned_byte_32;
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
+ size_vector_unsigned_byte_32;
+#endif
+ sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
+ sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
+ size_vector_complex_single_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
+ size_vector_complex_double_float;
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
+ size_vector_complex_long_float;
+#endif
+ sizetab[COMPLEX_STRING_WIDETAG] = size_boxed;
+ sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
+ sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
+ sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
+ sizetab[CODE_HEADER_WIDETAG] = size_code_header;
#if 0
/* Shouldn't see these so just lose if it happens */
- sizetab[type_SimpleFunHeader] = size_function_header;
- sizetab[type_ClosureFunHeader] = size_function_header;
- sizetab[type_ReturnPcHeader] = size_return_pc_header;
-#endif
- sizetab[type_ClosureHeader] = size_boxed;
- sizetab[type_FuncallableInstanceHeader] = size_boxed;
- sizetab[type_ValueCellHeader] = size_boxed;
- sizetab[type_SymbolHeader] = size_boxed;
- sizetab[type_BaseChar] = size_immediate;
- sizetab[type_Sap] = size_unboxed;
- sizetab[type_UnboundMarker] = size_immediate;
- sizetab[type_WeakPointer] = size_weak_pointer;
- sizetab[type_InstanceHeader] = size_boxed;
- sizetab[type_Fdefn] = size_boxed;
+ sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
+ sizetab[CLOSURE_FUN_HEADER_WIDETAG] = size_function_header;
+ sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
+#endif
+ sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
+ sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
+ sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
+ sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
+ sizetab[BASE_CHAR_WIDETAG] = size_immediate;
+ sizetab[SAP_WIDETAG] = size_unboxed;
+ sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
+ sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
+ sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
+ sizetab[FDEFN_WIDETAG] = size_boxed;
}
\f
/* noise to manipulate the gc trigger stuff */
gc_assert((nwords & 0x01) == 0);
/* Get tag of object. */
- tag = lowtagof(object);
+ tag = lowtag_of(object);
/* Allocate space. */
new = gc_quick_alloc(nwords*4);
return(object);
} else {
/* Get tag of object. */
- tag = lowtagof(object);
+ tag = lowtag_of(object);
/* Allocate space. */
new = gc_quick_alloc_large(nwords*4);
gc_assert((nwords & 0x01) == 0);
/* Get tag of object. */
- tag = lowtagof(object);
+ tag = lowtag_of(object);
/* Allocate space. */
new = gc_quick_alloc_unboxed(nwords*4);
}
else {
/* Get tag of object. */
- tag = lowtagof(object);
+ tag = lowtag_of(object);
/* Allocate space. */
new = gc_quick_alloc_large_unboxed(nwords*4);
} else {
/* Scavenge that pointer. */
n_words_scavenged =
- (scavtab[TypeOf(object)])(object_ptr, object);
+ (scavtab[widetag_of(object)])(object_ptr, object);
}
} else {
/* It points somewhere other than oldspace. Leave it
} else {
/* It's some sort of header object or another. */
n_words_scavenged =
- (scavtab[TypeOf(object)])(object_ptr, object);
+ (scavtab[widetag_of(object)])(object_ptr, object);
}
}
gc_assert(object_ptr == end);
/* must transport object -- object may point to either a function
* header, a closure function header, or to a closure header. */
- switch (TypeOf(*first_pointer)) {
- case type_SimpleFunHeader:
- case type_ClosureFunHeader:
+ switch (widetag_of(*first_pointer)) {
+ case SIMPLE_FUN_HEADER_WIDETAG:
+ case CLOSURE_FUN_HEADER_WIDETAG:
copy = trans_fun_header(object);
break;
default:
/* It will be 0 or the unbound-marker if there are no fixups, and
* will be an other pointer if it is valid. */
- if ((fixups == 0) || (fixups == type_UnboundMarker) ||
+ if ((fixups == 0) || (fixups == UNBOUND_MARKER_WIDETAG) ||
!is_lisp_pointer(fixups)) {
/* Check for possible errors. */
if (check_code_fixups)
/*SHOW("got fixups");*/
- if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) {
+ if (widetag_of(fixups_vector->header) ==
+ SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) {
/* Got the fixups for the code block. Now work through the vector,
and apply a fixup at each address. */
int length = fixnum_value(fixups_vector->length);
if (*((lispobj *)code) == 0x01)
return (struct code*)(((lispobj *)code)[1]);
- gc_assert(TypeOf(code->header) == type_CodeHeader);
+ gc_assert(widetag_of(code->header) == CODE_HEADER_WIDETAG);
/* Prepare to transport the code vector. */
l_code = (lispobj) code | OTHER_POINTER_LOWTAG;
lispobj nfheaderl;
fheaderp = (struct simple_fun *) native_pointer(fheaderl);
- gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader);
+ gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
/* Calculate the new function pointer and the new */
/* function header. */
gc_assert(is_lisp_pointer(entry_point));
function_ptr = (struct simple_fun *) native_pointer(entry_point);
- gc_assert(TypeOf(function_ptr->header) == type_SimpleFunHeader);
+ gc_assert(widetag_of(function_ptr->header) == SIMPLE_FUN_HEADER_WIDETAG);
scavenge(&function_ptr->name, 1);
scavenge(&function_ptr->arglist, 1);
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 | lowtag_of(object);
/* Grab the cdr before it is clobbered. */
cdr = cons->cdr;
lispobj new_cdr;
struct cons *cdr_cons, *new_cdr_cons;
- if (lowtagof(cdr) != LIST_POINTER_LOWTAG || !from_space_p(cdr)
+ if (lowtag_of(cdr) != LIST_POINTER_LOWTAG || !from_space_p(cdr)
|| (*((lispobj *)native_pointer(cdr)) == 0x01))
break;
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 | lowtag_of(cdr);
/* Grab the cdr before it is clobbered. */
cdr = cdr_cons->cdr;
/* Object is a pointer into from space - not FP. */
first_pointer = (lispobj *) native_pointer(object);
- first = (transother[TypeOf(*first_pointer)])(object);
+ first = (transother[widetag_of(*first_pointer)])(object);
if (first != object) {
/* Set forwarding pointer. */
if (!gencgc_hash) {
/* This is set for backward compatibility. FIXME: Do we need
* this any more? */
- *where = (subtype_VectorMustRehash << N_TYPE_BITS) | type_SimpleVector;
+ *where =
+ (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
return 1;
}
}
hash_table = (lispobj *)native_pointer(where[2]);
/*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
- if (TypeOf(hash_table[0]) != type_InstanceHeader) {
+ if (widetag_of(hash_table[0]) != INSTANCE_HEADER_WIDETAG) {
lose("hash table not instance (%x at %x)", hash_table[0], hash_table);
}
}
empty_symbol = where[3];
/* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
- if (TypeOf(*(lispobj *)native_pointer(empty_symbol)) != type_SymbolHeader) {
+ if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
+ SYMBOL_HEADER_WIDETAG) {
lose("not a symbol where empty-hash-table-slot symbol expected: %x",
*(lispobj *)native_pointer(empty_symbol));
}
lispobj index_vector_obj = hash_table[13];
if (is_lisp_pointer(index_vector_obj) &&
- (TypeOf(*(lispobj *)native_pointer(index_vector_obj)) == type_SimpleArrayUnsignedByte32)) {
+ (widetag_of(*(lispobj *)native_pointer(index_vector_obj)) ==
+ SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG)) {
index_vector = ((unsigned int *)native_pointer(index_vector_obj)) + 2;
/*FSHOW((stderr, "/index_vector = %x\n",index_vector));*/
length = fixnum_value(((unsigned int *)native_pointer(index_vector_obj))[1]);
lispobj next_vector_obj = hash_table[14];
if (is_lisp_pointer(next_vector_obj) &&
- (TypeOf(*(lispobj *)native_pointer(next_vector_obj)) == type_SimpleArrayUnsignedByte32)) {
+ (widetag_of(*(lispobj *)native_pointer(next_vector_obj)) ==
+ SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG)) {
next_vector = ((unsigned int *)native_pointer(next_vector_obj)) + 2;
/*FSHOW((stderr, "/next_vector = %x\n", next_vector));*/
next_vector_length = fixnum_value(((unsigned int *)native_pointer(next_vector_obj))[1]);
lispobj hash_vector_obj = hash_table[15];
if (is_lisp_pointer(hash_vector_obj) &&
- (TypeOf(*(lispobj *)native_pointer(hash_vector_obj))
- == type_SimpleArrayUnsignedByte32)) {
+ (widetag_of(*(lispobj *)native_pointer(hash_vector_obj))
+ == SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG)) {
hash_vector = ((unsigned int *)native_pointer(hash_vector_obj)) + 2;
/*FSHOW((stderr, "/hash_vector = %x\n", hash_vector));*/
gc_assert(fixnum_value(((unsigned int *)native_pointer(hash_vector_obj))[1])
return nwords;
}
-#ifdef type_SimpleArrayLongFloat
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
static int
scav_vector_long_float(lispobj *where, lispobj object)
{
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
static int
scav_vector_complex_single_float(lispobj *where, lispobj object)
{
}
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
static int
scav_vector_complex_double_float(lispobj *where, lispobj object)
{
#endif
-#ifdef type_SimpleArrayComplexLongFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
static int
scav_vector_complex_long_float(lispobj *where, lispobj object)
{
first_pointer = (lispobj *)native_pointer(value);
- /*
- FSHOW((stderr, "/weak pointer at 0x%08x\n", (unsigned long) wp));
- FSHOW((stderr, "/value: 0x%08x\n", (unsigned long) value));
- */
-
if (is_lisp_pointer(value) && from_space_p(value)) {
/* Now, we need to check whether the object has been forwarded. If
* it has been, the weak pointer is still good and needs to be
wp->value = first_pointer[1];
} else {
/* Break it. */
- SHOW("broken");
wp->value = NIL;
wp->broken = T;
}
static int
scav_lose(lispobj *where, lispobj object)
{
- lose("no scavenge function for object 0x%08x", (unsigned long) object);
+ lose("no scavenge function for object 0x%08x (widetag 0x%x)",
+ (unsigned long)object,
+ widetag_of(*(lispobj*)native_pointer(object)));
return 0; /* bogus return value to satisfy static type checking */
}
static lispobj
trans_lose(lispobj object)
{
- lose("no transport function for object 0x%08x", (unsigned long) object);
+ lose("no transport function for object 0x%08x (widetag 0x%x)",
+ (unsigned long)object,
+ widetag_of(*(lispobj*)native_pointer(object)));
return NIL; /* bogus return value to satisfy static type checking */
}
static int
size_lose(lispobj *where)
{
- lose("no size function for object at 0x%08x", (unsigned long) where);
+ lose("no size function for object at 0x%08x (widetag 0x%x)",
+ (unsigned long)where,
+ widetag_of(where));
return 1; /* bogus return value to satisfy static type checking */
}
scavtab[i] = scav_lose;
}
- /* For each type which can be selected by the low 3 bits of the tag
- * 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! */
+ /* For each type which can be selected by the lowtag alone, set
+ * multiple entries in our widetag scavenge table (one for each
+ * possible value of the high bits).
+ *
+ * FIXME: bare constant 32 and 3 here, ick! */
+ for (i = 0; i < 32; i++) {
scavtab[EVEN_FIXNUM_LOWTAG|(i<<3)] = scav_immediate;
scavtab[FUN_POINTER_LOWTAG|(i<<3)] = scav_fun_pointer;
/* skipping OTHER_IMMEDIATE_0_LOWTAG */
scavtab[OTHER_POINTER_LOWTAG|(i<<3)] = scav_other_pointer;
}
- /* Other-pointer types (those selected by all eight bits of the tag) get
- * one entry each in the scavenge table. */
- scavtab[type_Bignum] = scav_unboxed;
- scavtab[type_Ratio] = scav_boxed;
- scavtab[type_SingleFloat] = scav_unboxed;
- scavtab[type_DoubleFloat] = scav_unboxed;
-#ifdef type_LongFloat
- scavtab[type_LongFloat] = scav_unboxed;
+ /* Other-pointer types (those selected by all eight bits of the
+ * tag) get one entry each in the scavenge table. */
+ scavtab[BIGNUM_WIDETAG] = scav_unboxed;
+ scavtab[RATIO_WIDETAG] = scav_boxed;
+ scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
+ scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
+#ifdef LONG_FLOAT_WIDETAG
+ scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
#endif
- scavtab[type_Complex] = scav_boxed;
-#ifdef type_ComplexSingleFloat
- scavtab[type_ComplexSingleFloat] = scav_unboxed;
+ scavtab[COMPLEX_WIDETAG] = scav_boxed;
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
#endif
-#ifdef type_ComplexDoubleFloat
- scavtab[type_ComplexDoubleFloat] = scav_unboxed;
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
#endif
-#ifdef type_ComplexLongFloat
- scavtab[type_ComplexLongFloat] = scav_unboxed;
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
#endif
- scavtab[type_SimpleArray] = scav_boxed;
- scavtab[type_SimpleString] = scav_string;
- scavtab[type_SimpleBitVector] = scav_vector_bit;
- scavtab[type_SimpleVector] = scav_vector;
- scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
- scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
- scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
- scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
- scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
-#ifdef type_SimpleArraySignedByte8
- scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
+ scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
+ scavtab[SIMPLE_STRING_WIDETAG] = scav_string;
+ scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
+ scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
+ scav_vector_unsigned_byte_2;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
+ scav_vector_unsigned_byte_4;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
+ scav_vector_unsigned_byte_8;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
+ scav_vector_unsigned_byte_16;
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
+ scav_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
#endif
-#ifdef type_SimpleArraySignedByte16
- scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
+ scav_vector_unsigned_byte_16;
#endif
-#ifdef type_SimpleArraySignedByte30
- scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
+ scav_vector_unsigned_byte_32;
#endif
-#ifdef type_SimpleArraySignedByte32
- scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
+ scav_vector_unsigned_byte_32;
#endif
- scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
- scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
-#ifdef type_SimpleArrayLongFloat
- scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
+ scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
+ scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
+ scav_vector_complex_single_float;
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
+ scav_vector_complex_double_float;
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
+ scav_vector_complex_long_float;
#endif
- scavtab[type_ComplexString] = scav_boxed;
- scavtab[type_ComplexBitVector] = scav_boxed;
- scavtab[type_ComplexVector] = scav_boxed;
- scavtab[type_ComplexArray] = scav_boxed;
- scavtab[type_CodeHeader] = scav_code_header;
- /*scavtab[type_SimpleFunHeader] = scav_fun_header;*/
- /*scavtab[type_ClosureFunHeader] = scav_fun_header;*/
- /*scavtab[type_ReturnPcHeader] = scav_return_pc_header;*/
+ scavtab[COMPLEX_STRING_WIDETAG] = scav_boxed;
+ scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
+ scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
+ scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
+ scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
+ /*scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;*/
+ /*scavtab[CLOSURE_FUN_HEADER_WIDETAG] = scav_fun_header;*/
+ /*scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;*/
#ifdef __i386__
- scavtab[type_ClosureHeader] = scav_closure_header;
- scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
+ scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
+ scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
#else
- scavtab[type_ClosureHeader] = scav_boxed;
- scavtab[type_FuncallableInstanceHeader] = scav_boxed;
+ scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
+ scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
#endif
- scavtab[type_ValueCellHeader] = scav_boxed;
- scavtab[type_SymbolHeader] = scav_boxed;
- scavtab[type_BaseChar] = scav_immediate;
- scavtab[type_Sap] = scav_unboxed;
- scavtab[type_UnboundMarker] = scav_immediate;
- scavtab[type_WeakPointer] = scav_weak_pointer;
- scavtab[type_InstanceHeader] = scav_boxed;
- scavtab[type_Fdefn] = scav_fdefn;
+ scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
+ scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
+ scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
+ scavtab[SAP_WIDETAG] = scav_unboxed;
+ scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
+ scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer;
+ scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
+ scavtab[FDEFN_WIDETAG] = scav_fdefn;
/* transport other table, initialized same way as scavtab */
for (i = 0; i < 256; i++)
transother[i] = trans_lose;
- transother[type_Bignum] = trans_unboxed;
- transother[type_Ratio] = trans_boxed;
- transother[type_SingleFloat] = trans_unboxed;
- transother[type_DoubleFloat] = trans_unboxed;
-#ifdef type_LongFloat
- transother[type_LongFloat] = trans_unboxed;
+ transother[BIGNUM_WIDETAG] = trans_unboxed;
+ transother[RATIO_WIDETAG] = trans_boxed;
+ transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
+ transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
+#ifdef LONG_FLOAT_WIDETAG
+ transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
#endif
- transother[type_Complex] = trans_boxed;
-#ifdef type_ComplexSingleFloat
- transother[type_ComplexSingleFloat] = trans_unboxed;
+ transother[COMPLEX_WIDETAG] = trans_boxed;
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
#endif
-#ifdef type_ComplexDoubleFloat
- transother[type_ComplexDoubleFloat] = trans_unboxed;
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
#endif
-#ifdef type_ComplexLongFloat
- transother[type_ComplexLongFloat] = trans_unboxed;
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
#endif
- transother[type_SimpleArray] = trans_boxed_large;
- transother[type_SimpleString] = trans_string;
- transother[type_SimpleBitVector] = trans_vector_bit;
- transother[type_SimpleVector] = trans_vector;
- transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
- transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
- transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
- transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
- transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
-#ifdef type_SimpleArraySignedByte8
- transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
+ transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large;
+ transother[SIMPLE_STRING_WIDETAG] = trans_string;
+ transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
+ transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
+ trans_vector_unsigned_byte_2;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
+ trans_vector_unsigned_byte_4;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
+ trans_vector_unsigned_byte_8;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
+ trans_vector_unsigned_byte_16;
+ transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
+ trans_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
+ trans_vector_unsigned_byte_8;
#endif
-#ifdef type_SimpleArraySignedByte16
- transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
+ trans_vector_unsigned_byte_16;
#endif
-#ifdef type_SimpleArraySignedByte30
- transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
+ trans_vector_unsigned_byte_32;
#endif
-#ifdef type_SimpleArraySignedByte32
- transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
+ trans_vector_unsigned_byte_32;
#endif
- transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
- transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
-#ifdef type_SimpleArrayLongFloat
- transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
+ transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
+ trans_vector_single_float;
+ transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
+ trans_vector_double_float;
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
+ trans_vector_long_float;
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
+ trans_vector_complex_single_float;
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
+ trans_vector_complex_double_float;
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
+ trans_vector_complex_long_float;
#endif
- transother[type_ComplexString] = trans_boxed;
- transother[type_ComplexBitVector] = trans_boxed;
- transother[type_ComplexVector] = trans_boxed;
- transother[type_ComplexArray] = trans_boxed;
- transother[type_CodeHeader] = trans_code_header;
- transother[type_SimpleFunHeader] = trans_fun_header;
- transother[type_ClosureFunHeader] = trans_fun_header;
- transother[type_ReturnPcHeader] = trans_return_pc_header;
- transother[type_ClosureHeader] = trans_boxed;
- transother[type_FuncallableInstanceHeader] = trans_boxed;
- transother[type_ValueCellHeader] = trans_boxed;
- transother[type_SymbolHeader] = trans_boxed;
- transother[type_BaseChar] = trans_immediate;
- transother[type_Sap] = trans_unboxed;
- transother[type_UnboundMarker] = trans_immediate;
- transother[type_WeakPointer] = trans_weak_pointer;
- transother[type_InstanceHeader] = trans_boxed;
- transother[type_Fdefn] = trans_boxed;
+ transother[COMPLEX_STRING_WIDETAG] = trans_boxed;
+ transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
+ transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
+ transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
+ transother[CODE_HEADER_WIDETAG] = trans_code_header;
+ transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
+ transother[CLOSURE_FUN_HEADER_WIDETAG] = trans_fun_header;
+ transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
+ transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
+ transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
+ transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
+ transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
+ transother[BASE_CHAR_WIDETAG] = trans_immediate;
+ transother[SAP_WIDETAG] = trans_unboxed;
+ transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
+ transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
+ transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
+ transother[FDEFN_WIDETAG] = trans_boxed;
/* size table, initialized the same way as scavtab */
for (i = 0; i < 256; i++)
/* skipping OTHER_IMMEDIATE_1_LOWTAG */
sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer;
}
- sizetab[type_Bignum] = size_unboxed;
- sizetab[type_Ratio] = size_boxed;
- sizetab[type_SingleFloat] = size_unboxed;
- sizetab[type_DoubleFloat] = size_unboxed;
-#ifdef type_LongFloat
- sizetab[type_LongFloat] = size_unboxed;
+ sizetab[BIGNUM_WIDETAG] = size_unboxed;
+ sizetab[RATIO_WIDETAG] = size_boxed;
+ sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
+ sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
+#ifdef LONG_FLOAT_WIDETAG
+ sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
#endif
- sizetab[type_Complex] = size_boxed;
-#ifdef type_ComplexSingleFloat
- sizetab[type_ComplexSingleFloat] = size_unboxed;
+ sizetab[COMPLEX_WIDETAG] = size_boxed;
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
#endif
-#ifdef type_ComplexDoubleFloat
- sizetab[type_ComplexDoubleFloat] = size_unboxed;
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
#endif
-#ifdef type_ComplexLongFloat
- sizetab[type_ComplexLongFloat] = size_unboxed;
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
#endif
- sizetab[type_SimpleArray] = size_boxed;
- sizetab[type_SimpleString] = size_string;
- sizetab[type_SimpleBitVector] = size_vector_bit;
- sizetab[type_SimpleVector] = size_vector;
- sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
- sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
- sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
- sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
- sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
-#ifdef type_SimpleArraySignedByte8
- sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
+ sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
+ sizetab[SIMPLE_STRING_WIDETAG] = size_string;
+ sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
+ sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
+ size_vector_unsigned_byte_2;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
+ size_vector_unsigned_byte_4;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
+ size_vector_unsigned_byte_8;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
+ size_vector_unsigned_byte_16;
+ sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
+ size_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
#endif
-#ifdef type_SimpleArraySignedByte16
- sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
+ size_vector_unsigned_byte_16;
#endif
-#ifdef type_SimpleArraySignedByte30
- sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
+ size_vector_unsigned_byte_32;
#endif
-#ifdef type_SimpleArraySignedByte32
- sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
+ size_vector_unsigned_byte_32;
#endif
- sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
- sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
-#ifdef type_SimpleArrayLongFloat
- sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
+ sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
+ sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
+ size_vector_complex_single_float;
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
+ size_vector_complex_double_float;
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
+ size_vector_complex_long_float;
#endif
- sizetab[type_ComplexString] = size_boxed;
- sizetab[type_ComplexBitVector] = size_boxed;
- sizetab[type_ComplexVector] = size_boxed;
- sizetab[type_ComplexArray] = size_boxed;
- sizetab[type_CodeHeader] = size_code_header;
+ sizetab[COMPLEX_STRING_WIDETAG] = size_boxed;
+ sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
+ sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
+ sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
+ sizetab[CODE_HEADER_WIDETAG] = size_code_header;
#if 0
/* We shouldn't see these, so just lose if it happens. */
- sizetab[type_SimpleFunHeader] = size_function_header;
- sizetab[type_ClosureFunHeader] = size_function_header;
- sizetab[type_ReturnPcHeader] = size_return_pc_header;
+ sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
+ sizetab[CLOSURE_FUN_HEADER_WIDETAG] = size_function_header;
+ sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
#endif
- sizetab[type_ClosureHeader] = size_boxed;
- sizetab[type_FuncallableInstanceHeader] = size_boxed;
- sizetab[type_ValueCellHeader] = size_boxed;
- sizetab[type_SymbolHeader] = size_boxed;
- sizetab[type_BaseChar] = size_immediate;
- sizetab[type_Sap] = size_unboxed;
- sizetab[type_UnboundMarker] = size_immediate;
- sizetab[type_WeakPointer] = size_weak_pointer;
- sizetab[type_InstanceHeader] = size_boxed;
- sizetab[type_Fdefn] = size_boxed;
+ sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
+ sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
+ sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
+ sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
+ sizetab[BASE_CHAR_WIDETAG] = size_immediate;
+ sizetab[SAP_WIDETAG] = size_unboxed;
+ sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
+ sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
+ sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
+ sizetab[FDEFN_WIDETAG] = size_boxed;
}
\f
/* Scan an area looking for an object which encloses the given pointer.
/* If thing is an immediate then this is a cons. */
if (is_lisp_pointer(thing)
|| ((thing & 3) == 0) /* fixnum */
- || (TypeOf(thing) == type_BaseChar)
- || (TypeOf(thing) == type_UnboundMarker))
+ || (widetag_of(thing) == BASE_CHAR_WIDETAG)
+ || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
count = 2;
else
- count = (sizetab[TypeOf(thing)])(start);
+ count = (sizetab[widetag_of(thing)])(start);
/* Check whether the pointer is within this object. */
if ((pointer >= start) && (pointer < (start+count))) {
/* We need to allow raw pointers into Code objects for return
* addresses. This will also pick up pointers to functions in code
* objects. */
- if (TypeOf(*start_addr) == type_CodeHeader) {
+ if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) {
/* XXX could do some further checks here */
return 1;
}
* 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)) {
+ switch (lowtag_of((lispobj)pointer)) {
case FUN_POINTER_LOWTAG:
/* Start_addr should be the enclosing code object, or a closure
* header. */
- switch (TypeOf(*start_addr)) {
- case type_CodeHeader:
+ switch (widetag_of(*start_addr)) {
+ case CODE_HEADER_WIDETAG:
/* This case is probably caught above. */
break;
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
if ((unsigned)pointer !=
((unsigned)start_addr+FUN_POINTER_LOWTAG)) {
if (gencgc_verbose)
/* Is it plausible cons? */
if ((is_lisp_pointer(start_addr[0])
|| ((start_addr[0] & 3) == 0) /* fixnum */
- || (TypeOf(start_addr[0]) == type_BaseChar)
- || (TypeOf(start_addr[0]) == type_UnboundMarker))
+ || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
&& (is_lisp_pointer(start_addr[1])
|| ((start_addr[1] & 3) == 0) /* fixnum */
- || (TypeOf(start_addr[1]) == type_BaseChar)
- || (TypeOf(start_addr[1]) == type_UnboundMarker)))
+ || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG)))
break;
else {
if (gencgc_verbose)
pointer, start_addr, *start_addr));
return 0;
}
- if (TypeOf(start_addr[0]) != type_InstanceHeader) {
+ if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
if (gencgc_verbose)
FSHOW((stderr,
"/Wi2: %x %x %x\n",
pointer, start_addr, *start_addr));
return 0;
}
- switch (TypeOf(start_addr[0])) {
- case type_UnboundMarker:
- case type_BaseChar:
+ switch (widetag_of(start_addr[0])) {
+ case UNBOUND_MARKER_WIDETAG:
+ case BASE_CHAR_WIDETAG:
if (gencgc_verbose)
FSHOW((stderr,
"*Wo3: %x %x %x\n",
return 0;
/* only pointed to by function pointers? */
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
if (gencgc_verbose)
FSHOW((stderr,
"*Wo4: %x %x %x\n",
pointer, start_addr, *start_addr));
return 0;
- case type_InstanceHeader:
+ case INSTANCE_HEADER_WIDETAG:
if (gencgc_verbose)
FSHOW((stderr,
"*Wo5: %x %x %x\n",
return 0;
/* the valid other immediate pointer objects */
- case type_SimpleVector:
- case type_Ratio:
- case type_Complex:
-#ifdef type_ComplexSingleFloat
- case type_ComplexSingleFloat:
+ case SIMPLE_VECTOR_WIDETAG:
+ case RATIO_WIDETAG:
+ case COMPLEX_WIDETAG:
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ case COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexDoubleFloat
- case type_ComplexDoubleFloat:
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case COMPLEX_DOUBLE_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexLongFloat
- case type_ComplexLongFloat:
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ case COMPLEX_LONG_FLOAT_WIDETAG:
#endif
- case type_SimpleArray:
- case type_ComplexString:
- case type_ComplexBitVector:
- case type_ComplexVector:
- case type_ComplexArray:
- case type_ValueCellHeader:
- case type_SymbolHeader:
- case type_Fdefn:
- case type_CodeHeader:
- case type_Bignum:
- case type_SingleFloat:
- case type_DoubleFloat:
-#ifdef type_LongFloat
- case type_LongFloat:
+ case SIMPLE_ARRAY_WIDETAG:
+ case COMPLEX_STRING_WIDETAG:
+ case COMPLEX_BIT_VECTOR_WIDETAG:
+ case COMPLEX_VECTOR_WIDETAG:
+ case COMPLEX_ARRAY_WIDETAG:
+ case VALUE_CELL_HEADER_WIDETAG:
+ case SYMBOL_HEADER_WIDETAG:
+ case FDEFN_WIDETAG:
+ case CODE_HEADER_WIDETAG:
+ case BIGNUM_WIDETAG:
+ case SINGLE_FLOAT_WIDETAG:
+ case DOUBLE_FLOAT_WIDETAG:
+#ifdef LONG_FLOAT_WIDETAG
+ case LONG_FLOAT_WIDETAG:
#endif
- case type_SimpleString:
- case type_SimpleBitVector:
- case type_SimpleArrayUnsignedByte2:
- case type_SimpleArrayUnsignedByte4:
- case type_SimpleArrayUnsignedByte8:
- case type_SimpleArrayUnsignedByte16:
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
+ case SIMPLE_STRING_WIDETAG:
+ case SIMPLE_BIT_VECTOR_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
#endif
- case type_SimpleArraySingleFloat:
- case type_SimpleArrayDoubleFloat:
-#ifdef type_SimpleArrayLongFloat
- case type_SimpleArrayLongFloat:
+ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
+ case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
#endif
- case type_Sap:
- case type_WeakPointer:
+ case SAP_WIDETAG:
+ case WEAK_POINTER_WIDETAG:
break;
default:
int boxed;
/* Check whether it's a vector or bignum object. */
- switch (TypeOf(where[0])) {
- case type_SimpleVector:
+ switch (widetag_of(where[0])) {
+ case SIMPLE_VECTOR_WIDETAG:
boxed = BOXED_PAGE;
break;
- case type_Bignum:
- case type_SimpleString:
- case type_SimpleBitVector:
- case type_SimpleArrayUnsignedByte2:
- case type_SimpleArrayUnsignedByte4:
- case type_SimpleArrayUnsignedByte8:
- case type_SimpleArrayUnsignedByte16:
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
+ case BIGNUM_WIDETAG:
+ case SIMPLE_STRING_WIDETAG:
+ case SIMPLE_BIT_VECTOR_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
#endif
- case type_SimpleArraySingleFloat:
- case type_SimpleArrayDoubleFloat:
-#ifdef type_SimpleArrayLongFloat
- case type_SimpleArrayLongFloat:
+ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
+ case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
#endif
boxed = UNBOXED_PAGE;
break;
}
/* Find its current size. */
- nwords = (sizetab[TypeOf(where[0])])(where);
+ nwords = (sizetab[widetag_of(where[0])])(where);
first_page = find_page_index((void *)where);
gc_assert(first_page >= 0);
if (thing & 0x3) { /* Skip fixnums. FIXME: There should be an
* is_fixnum for this. */
- switch(TypeOf(*start)) {
+ switch(widetag_of(*start)) {
/* boxed objects */
- case type_SimpleVector:
- case type_Ratio:
- case type_Complex:
- case type_SimpleArray:
- case type_ComplexString:
- case type_ComplexBitVector:
- case type_ComplexVector:
- case type_ComplexArray:
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
- case type_ValueCellHeader:
- case type_SymbolHeader:
- case type_BaseChar:
- case type_UnboundMarker:
- case type_InstanceHeader:
- case type_Fdefn:
+ case SIMPLE_VECTOR_WIDETAG:
+ case RATIO_WIDETAG:
+ case COMPLEX_WIDETAG:
+ case SIMPLE_ARRAY_WIDETAG:
+ case COMPLEX_STRING_WIDETAG:
+ case COMPLEX_BIT_VECTOR_WIDETAG:
+ case COMPLEX_VECTOR_WIDETAG:
+ case COMPLEX_ARRAY_WIDETAG:
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
+ case VALUE_CELL_HEADER_WIDETAG:
+ case SYMBOL_HEADER_WIDETAG:
+ case BASE_CHAR_WIDETAG:
+ case UNBOUND_MARKER_WIDETAG:
+ case INSTANCE_HEADER_WIDETAG:
+ case FDEFN_WIDETAG:
count = 1;
break;
- case type_CodeHeader:
+ case CODE_HEADER_WIDETAG:
{
lispobj object = *start;
struct code *code;
while (fheaderl != NIL) {
fheaderp =
(struct simple_fun *) native_pointer(fheaderl);
- gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader);
+ gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
verify_space(&fheaderp->name, 1);
verify_space(&fheaderp->arglist, 1);
verify_space(&fheaderp->type, 1);
}
/* unboxed objects */
- case type_Bignum:
- case type_SingleFloat:
- case type_DoubleFloat:
-#ifdef type_ComplexLongFloat
- case type_LongFloat:
+ case BIGNUM_WIDETAG:
+ case SINGLE_FLOAT_WIDETAG:
+ case DOUBLE_FLOAT_WIDETAG:
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ case LONG_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexSingleFloat
- case type_ComplexSingleFloat:
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ case COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexDoubleFloat
- case type_ComplexDoubleFloat:
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case COMPLEX_DOUBLE_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexLongFloat
- case type_ComplexLongFloat:
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ case COMPLEX_LONG_FLOAT_WIDETAG:
#endif
- case type_SimpleString:
- case type_SimpleBitVector:
- case type_SimpleArrayUnsignedByte2:
- case type_SimpleArrayUnsignedByte4:
- case type_SimpleArrayUnsignedByte8:
- case type_SimpleArrayUnsignedByte16:
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
+ case SIMPLE_STRING_WIDETAG:
+ case SIMPLE_BIT_VECTOR_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
#endif
- case type_SimpleArraySingleFloat:
- case type_SimpleArrayDoubleFloat:
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayLongFloat:
+ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
+ case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
#endif
- case type_Sap:
- case type_WeakPointer:
- count = (sizetab[TypeOf(*start)])(start);
+ case SAP_WIDETAG:
+ case WEAK_POINTER_WIDETAG:
+ count = (sizetab[widetag_of(*start)])(start);
break;
default:
object = search_dynamic_space(pc);
if (object) /* if we found something */
- if (TypeOf(*object) == type_CodeHeader) /* if it's a code object */
+ if (widetag_of(*object) == CODE_HEADER_WIDETAG) /* if it's a code object */
return(object);
return (NULL);
== 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))
+ if (lowtag_of(*os_context_register_addr(context, reg_CODE))
== FUN_POINTER_LOWTAG) {
/* We have called, but not built the new frame, so
* build it for them. */
* support decides to pass on it. */
lose("no handler for signal %d in interrupt_handle_now(..)", signal);
- } else if (lowtagof(handler.lisp) == FUN_POINTER_LOWTAG) {
+ } else if (lowtag_of(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
obj = *end;
addr = end;
end += 2;
- if (TypeOf(obj) == type_SimpleFunHeader) {
+ if (widetag_of(obj) == SIMPLE_FUN_HEADER_WIDETAG) {
print((long)addr | FUN_POINTER_LOWTAG);
- } else if (lowtagof(obj) == OTHER_IMMEDIATE_0_LOWTAG ||
- lowtagof(obj) == OTHER_IMMEDIATE_1_LOWTAG) {
+ } else if (lowtag_of(obj) == OTHER_IMMEDIATE_0_LOWTAG ||
+ lowtag_of(obj) == OTHER_IMMEDIATE_1_LOWTAG) {
print((lispobj)addr | OTHER_POINTER_LOWTAG);
} else {
print((lispobj)addr);
lispobj thing = parse_lispobj(ptr), function, result = 0, cons, args[3];
int numargs;
- if (lowtagof(thing) == OTHER_POINTER_LOWTAG) {
- switch (TypeOf(*(lispobj *)(thing-OTHER_POINTER_LOWTAG))) {
- case type_SymbolHeader:
+ if (lowtag_of(thing) == OTHER_POINTER_LOWTAG) {
+ switch (widetag_of(*(lispobj *)(thing-OTHER_POINTER_LOWTAG))) {
+ case SYMBOL_HEADER_WIDETAG:
for (cons = SymbolValue(INITIAL_FDEFN_OBJECTS);
cons != NIL;
cons = CONS(cons)->cdr) {
printf("Symbol 0x%08lx is undefined.\n", (long unsigned)thing);
return;
- case type_Fdefn:
+ case FDEFN_WIDETAG:
fdefn:
function = FDEFN(thing)->fun;
if (function == NIL) {
return;
}
}
- else if (lowtagof(thing) != FUN_POINTER_LOWTAG) {
+ else if (lowtag_of(thing) != FUN_POINTER_LOWTAG) {
printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n",
(long unsigned)thing);
return;
/*
* FIXME:
- * Some of the code in here (subtype_Names[] and the various
- * foo_slots[], at least) is deeply broken, depending on fixed
- * (and already out-of-date) values in sbcl.h.
+ * Some of the code in here (the various
+ * foo_slots[], at least) is deeply broken, depending on guessing
+ * already out-of-date values instead of getting them from sbcl.h.
*/
#include <stdio.h>
"ratio",
"single float",
"double float",
-#ifdef type_LongFloat
+#ifdef LONG_FLOAT_WIDETAG
"long float",
#endif
"complex",
-#ifdef type_ComplexSingleFloat
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
"complex single float",
#endif
-#ifdef type_ComplexDoubleFloat
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
"complex double float",
#endif
-#ifdef type_ComplexLongFloat
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
"complex long float",
#endif
"simple-array",
"(simple-array (unsigned-byte 8) (*))",
"(simple-array (unsigned-byte 16) (*))",
"(simple-array (unsigned-byte 32) (*))",
-#ifdef type_SimpleArraySignedByte8
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
"(simple-array (signed-byte 8) (*))",
#endif
-#ifdef type_SimpleArraySignedByte16
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
"(simple-array (signed-byte 16) (*))",
#endif
-#ifdef type_SimpleArraySignedByte30
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
"(simple-array fixnum (*))",
#endif
-#ifdef type_SimpleArraySignedByte32
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
"(simple-array (signed-byte 32) (*))",
#endif
"(simple-array single-float (*))",
"(simple-array double-float (*))",
-#ifdef type_SimpleArrayLongFloat
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
"(simple-array long-float (*))",
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
"(simple-array (complex single-float) (*))",
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
"(simple-array (complex double-float) (*))",
#endif
-#ifdef type_SimpleArrayComplexLongFloat
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
"(simple-array (complex long-float) (*))",
#endif
"complex-string",
int type, c, idx;
char buffer[10];
- type = TypeOf(obj);
+ type = widetag_of(obj);
switch (type) {
- case type_BaseChar:
+ case BASE_CHAR_WIDETAG:
c = (obj>>8)&0xff;
switch (c) {
case '\0':
}
break;
- case type_UnboundMarker:
+ case UNBOUND_MARKER_WIDETAG:
printf("<unbound marker>");
break;
default:
idx = type >> 2;
- if (idx < (sizeof(subtype_Names) / sizeof(char *)))
- printf("%s", subtype_Names[idx]);
+ if (idx < (sizeof(SUBNAMES_WIDETAG) / sizeof(char *)))
+ printf("%s", SUBNAMES_WIDETAG[idx]);
else
printf("unknown type (0x%0x)", type);
break;
{
int type, idx;
- type = TypeOf(obj);
+ type = widetag_of(obj);
idx = type >> 2;
- if (idx < (sizeof(subtype_Names) / sizeof(char *)))
- printf(", %s", subtype_Names[idx]);
+ if (idx < (sizeof(SUBNAMES_WIDETAG) / sizeof(char *)))
+ printf(", %s", SUBNAMES_WIDETAG[idx]);
else
printf(", unknown type (0x%0x)", type);
- switch (TypeOf(obj)) {
- case type_BaseChar:
+ switch (widetag_of(obj)) {
+ case BASE_CHAR_WIDETAG:
printf(": ");
brief_otherimm(obj);
break;
- case type_Sap:
- case type_UnboundMarker:
+ case SAP_WIDETAG:
+ case UNBOUND_MARKER_WIDETAG:
break;
default:
printf("NIL");
else {
putchar('(');
- while (lowtagof(obj) == LIST_POINTER_LOWTAG) {
+ while (lowtag_of(obj) == LIST_POINTER_LOWTAG) {
struct cons *cons = (struct cons *)native_pointer(obj);
if (space)
}
header = *ptr;
- type = TypeOf(header);
+ type = widetag_of(header);
switch (type) {
- case type_SymbolHeader:
+ case SYMBOL_HEADER_WIDETAG:
symbol = (struct symbol *)ptr;
vector = (struct vector *)native_pointer(symbol->name);
for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
}
break;
- case type_SimpleString:
+ case SIMPLE_STRING_WIDETAG:
vector = (struct vector *)ptr;
putchar('"');
for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
}
}
-/* FIXME: Yikes again! This, like subtype_Names[], needs to depend
+/* FIXME: Yikes again! This, like SUBNAMES_WIDETAG[], needs to depend
* on the values in sbcl.h. */
static char *symbol_slots[] = {"value: ", "unused: ",
"plist: ", "name: ", "package: ", NULL};
header = *ptr++;
length = (*ptr) >> 2;
count = header>>8;
- type = TypeOf(header);
+ type = widetag_of(header);
print_obj("header: ", header);
- if (lowtagof(header) != OTHER_IMMEDIATE_0_LOWTAG &&
- lowtagof(header) != OTHER_IMMEDIATE_1_LOWTAG) {
+ if (lowtag_of(header) != OTHER_IMMEDIATE_0_LOWTAG &&
+ lowtag_of(header) != OTHER_IMMEDIATE_1_LOWTAG) {
NEWLINE_OR_RETURN;
printf("(invalid header object)");
return;
}
switch (type) {
- case type_Bignum:
+ case BIGNUM_WIDETAG:
ptr += count;
NEWLINE_OR_RETURN;
printf("0x");
printf("%08lx", (unsigned long) *--ptr);
break;
- case type_Ratio:
+ case RATIO_WIDETAG:
print_slots(ratio_slots, count, ptr);
break;
- case type_Complex:
+ case COMPLEX_WIDETAG:
print_slots(complex_slots, count, ptr);
break;
- case type_SymbolHeader:
+ case SYMBOL_HEADER_WIDETAG:
print_slots(symbol_slots, count, ptr);
break;
- case type_SingleFloat:
+ case SINGLE_FLOAT_WIDETAG:
NEWLINE_OR_RETURN;
printf("%g", ((struct single_float *)native_pointer(obj))->value);
break;
- case type_DoubleFloat:
+ case DOUBLE_FLOAT_WIDETAG:
NEWLINE_OR_RETURN;
printf("%g", ((struct double_float *)native_pointer(obj))->value);
break;
-#ifdef type_LongFloat
- case type_LongFloat:
+#ifdef LONG_FLOAT_WIDETAG
+ case LONG_FLOAT_WIDETAG:
NEWLINE_OR_RETURN;
printf("%Lg", ((struct long_float *)native_pointer(obj))->value);
break;
#endif
-#ifdef type_ComplexSingleFloat
- case type_ComplexSingleFloat:
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ case COMPLEX_SINGLE_FLOAT_WIDETAG:
NEWLINE_OR_RETURN;
printf("%g", ((struct complex_single_float *)native_pointer(obj))->real);
NEWLINE_OR_RETURN;
break;
#endif
-#ifdef type_ComplexDoubleFloat
- case type_ComplexDoubleFloat:
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case COMPLEX_DOUBLE_FLOAT_WIDETAG:
NEWLINE_OR_RETURN;
printf("%g", ((struct complex_double_float *)native_pointer(obj))->real);
NEWLINE_OR_RETURN;
break;
#endif
-#ifdef type_ComplexLongFloat
- case type_ComplexLongFloat:
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ case COMPLEX_LONG_FLOAT_WIDETAG:
NEWLINE_OR_RETURN;
printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->real);
NEWLINE_OR_RETURN;
break;
#endif
- case type_SimpleString:
+ case SIMPLE_STRING_WIDETAG:
NEWLINE_OR_RETURN;
cptr = (char *)(ptr+1);
putchar('"');
putchar('"');
break;
- case type_SimpleVector:
+ case SIMPLE_VECTOR_WIDETAG:
NEWLINE_OR_RETURN;
printf("length = %ld", length);
ptr++;
}
break;
- case type_InstanceHeader:
+ case INSTANCE_HEADER_WIDETAG:
NEWLINE_OR_RETURN;
printf("length = %ld", (long) count);
index = 0;
}
break;
- case type_SimpleArray:
- case type_SimpleBitVector:
- case type_SimpleArrayUnsignedByte2:
- case type_SimpleArrayUnsignedByte4:
- case type_SimpleArrayUnsignedByte8:
- case type_SimpleArrayUnsignedByte16:
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
+ case SIMPLE_ARRAY_WIDETAG:
+ case SIMPLE_BIT_VECTOR_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
#endif
- case type_SimpleArraySingleFloat:
- case type_SimpleArrayDoubleFloat:
-#ifdef type_SimpleArrayLongFloat
- case type_SimpleArrayLongFloat:
+ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
+ case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
#endif
- case type_ComplexString:
- case type_ComplexBitVector:
- case type_ComplexVector:
- case type_ComplexArray:
+ case COMPLEX_STRING_WIDETAG:
+ case COMPLEX_BIT_VECTOR_WIDETAG:
+ case COMPLEX_VECTOR_WIDETAG:
+ case COMPLEX_ARRAY_WIDETAG:
break;
- case type_CodeHeader:
+ case CODE_HEADER_WIDETAG:
print_slots(code_slots, count-1, ptr);
break;
- case type_SimpleFunHeader:
- case type_ClosureFunHeader:
+ case SIMPLE_FUN_HEADER_WIDETAG:
+ case CLOSURE_FUN_HEADER_WIDETAG:
print_slots(fn_slots, 5, ptr);
break;
- case type_ReturnPcHeader:
+ case RETURN_PC_HEADER_WIDETAG:
print_obj("code: ", obj - (count * 4));
break;
- case type_ClosureHeader:
+ case CLOSURE_HEADER_WIDETAG:
print_slots(closure_slots, count, ptr);
break;
- case type_FuncallableInstanceHeader:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
print_slots(funcallable_instance_slots, count, ptr);
break;
- case type_ValueCellHeader:
+ case VALUE_CELL_HEADER_WIDETAG:
print_slots(value_cell_slots, 1, ptr);
break;
- case type_Sap:
+ case SAP_WIDETAG:
NEWLINE_OR_RETURN;
#ifndef alpha
printf("0x%08lx", (unsigned long) *ptr);
#endif
break;
- case type_WeakPointer:
+ case WEAK_POINTER_WIDETAG:
print_slots(weak_pointer_slots, 1, ptr);
break;
- case type_BaseChar:
- case type_UnboundMarker:
+ case BASE_CHAR_WIDETAG:
+ case UNBOUND_MARKER_WIDETAG:
NEWLINE_OR_RETURN;
printf("pointer to an immediate?");
break;
- case type_Fdefn:
+ case FDEFN_WIDETAG:
print_slots(fdefn_slots, count, ptr);
break;
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 = lowtag_of(obj);
struct var *var = lookup_by_obj(obj);
char buffer[256];
boolean verbose = cur_depth < brief_depth;
/* Check that the object pointed to is consistent with the pointer
* low tag. */
- switch (lowtagof((lispobj)pointer)) {
+ switch (lowtag_of((lispobj)pointer)) {
case FUN_POINTER_LOWTAG:
/* Start_addr should be the enclosing code object, or a closure
* header. */
- switch (TypeOf(*start_addr)) {
- case type_CodeHeader:
+ switch (widetag_of(*start_addr)) {
+ case CODE_HEADER_WIDETAG:
/* This case is probably caught above. */
break;
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
if ((int)pointer != ((int)start_addr+FUN_POINTER_LOWTAG)) {
if (pointer_filter_verbose) {
fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer,
/* Is it plausible cons? */
if((is_lisp_pointer(start_addr[0])
|| ((start_addr[0] & 3) == 0) /* fixnum */
- || (TypeOf(start_addr[0]) == type_BaseChar)
- || (TypeOf(start_addr[0]) == type_UnboundMarker))
+ || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
&& (is_lisp_pointer(start_addr[1])
|| ((start_addr[1] & 3) == 0) /* fixnum */
- || (TypeOf(start_addr[1]) == type_BaseChar)
- || (TypeOf(start_addr[1]) == type_UnboundMarker))) {
+ || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) {
break;
} else {
if (pointer_filter_verbose) {
}
return 0;
}
- if (TypeOf(start_addr[0]) != type_InstanceHeader) {
+ if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
if (pointer_filter_verbose) {
fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned int) pointer,
(unsigned int) start_addr, *start_addr);
}
return 0;
}
- switch (TypeOf(start_addr[0])) {
- case type_UnboundMarker:
- case type_BaseChar:
+ switch (widetag_of(start_addr[0])) {
+ case UNBOUND_MARKER_WIDETAG:
+ case BASE_CHAR_WIDETAG:
if (pointer_filter_verbose) {
fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer,
(unsigned int) start_addr, *start_addr);
return 0;
/* only pointed to by function pointers? */
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
if (pointer_filter_verbose) {
fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer,
(unsigned int) start_addr, *start_addr);
}
return 0;
- case type_InstanceHeader:
+ case INSTANCE_HEADER_WIDETAG:
if (pointer_filter_verbose) {
fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned int) pointer,
(unsigned int) start_addr, *start_addr);
return 0;
/* the valid other immediate pointer objects */
- case type_SimpleVector:
- case type_Ratio:
- case type_Complex:
-#ifdef type_ComplexSingleFloat
- case type_ComplexSingleFloat:
-#endif
-#ifdef type_ComplexDoubleFloat
- case type_ComplexDoubleFloat:
-#endif
-#ifdef type_ComplexLongFloat
- case type_ComplexLongFloat:
-#endif
- case type_SimpleArray:
- case type_ComplexString:
- case type_ComplexBitVector:
- case type_ComplexVector:
- case type_ComplexArray:
- case type_ValueCellHeader:
- case type_SymbolHeader:
- case type_Fdefn:
- case type_CodeHeader:
- case type_Bignum:
- case type_SingleFloat:
- case type_DoubleFloat:
-#ifdef type_LongFloat
- case type_LongFloat:
-#endif
- case type_SimpleString:
- case type_SimpleBitVector:
- case type_SimpleArrayUnsignedByte2:
- case type_SimpleArrayUnsignedByte4:
- case type_SimpleArrayUnsignedByte8:
- case type_SimpleArrayUnsignedByte16:
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
-#endif
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
-#endif
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
-#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
-#endif
- case type_SimpleArraySingleFloat:
- case type_SimpleArrayDoubleFloat:
-#ifdef type_SimpleArrayLongFloat
- case type_SimpleArrayLongFloat:
-#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
-#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
-#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
-#endif
- case type_Sap:
- case type_WeakPointer:
+ case SIMPLE_VECTOR_WIDETAG:
+ case RATIO_WIDETAG:
+ case COMPLEX_WIDETAG:
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ case COMPLEX_SINGLE_FLOAT_WIDETAG:
+#endif
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case COMPLEX_DOUBLE_FLOAT_WIDETAG:
+#endif
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ case COMPLEX_LONG_FLOAT_WIDETAG:
+#endif
+ case SIMPLE_ARRAY_WIDETAG:
+ case COMPLEX_STRING_WIDETAG:
+ case COMPLEX_BIT_VECTOR_WIDETAG:
+ case COMPLEX_VECTOR_WIDETAG:
+ case COMPLEX_ARRAY_WIDETAG:
+ case VALUE_CELL_HEADER_WIDETAG:
+ case SYMBOL_HEADER_WIDETAG:
+ case FDEFN_WIDETAG:
+ case CODE_HEADER_WIDETAG:
+ case BIGNUM_WIDETAG:
+ case SINGLE_FLOAT_WIDETAG:
+ case DOUBLE_FLOAT_WIDETAG:
+#ifdef LONG_FLOAT_WIDETAG
+ case LONG_FLOAT_WIDETAG:
+#endif
+ case SIMPLE_STRING_WIDETAG:
+ case SIMPLE_BIT_VECTOR_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
+#endif
+ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
+ case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
+#endif
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
+#endif
+ case SAP_WIDETAG:
+ case WEAK_POINTER_WIDETAG:
break;
default:
/* We need to allow raw pointers into Code objects for
* return addresses. This will also pick up pointers to
* functions in code objects. */
- if (TypeOf(*start_addr) == type_CodeHeader) {
+ if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) {
gc_assert(num_valid_stack_ra_locations <
MAX_STACK_RETURN_ADDRESSES);
valid_stack_ra_locations[num_valid_stack_ra_locations] = sp;
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtagof(thing);
+ result = (lispobj)new | lowtag_of(thing);
*old = result;
/* Scavenge it. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtagof(thing);
+ result = (lispobj)new | lowtag_of(thing);
*old = result;
/* Scavenge it. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtagof(thing);
+ result = (lispobj)new | lowtag_of(thing);
*old = result;
/* Scavenge the function. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtagof(thing);
+ result = (lispobj)new | lowtag_of(thing);
*old = result;
return result;
bcopy(vector, new, nwords * sizeof(lispobj));
- result = (lispobj)new | lowtagof(thing);
+ result = (lispobj)new | lowtag_of(thing);
vector->header = result;
if (boxed)
/* It will be 0 or the unbound-marker if there are no fixups, and
* will be an other-pointer to a vector if it is valid. */
if ((fixups==0) ||
- (fixups==type_UnboundMarker) ||
+ (fixups==UNBOUND_MARKER_WIDETAG) ||
!is_lisp_pointer(fixups)) {
#ifdef GENCGC
/* Check for a possible errors. */
fixups_vector = (struct vector *)native_pointer(*(lispobj *)fixups_vector);
}
- if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) {
+ if (widetag_of(fixups_vector->header) ==
+ SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) {
/* We got the fixups for the code block. Now work through the vector,
* and apply a fixup at each address. */
int length = fixnum_value(fixups_vector->length);
func != NIL;
func = ((struct simple_fun *)native_pointer(func))->next) {
- gc_assert(lowtagof(func) == FUN_POINTER_LOWTAG);
+ gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
*(lispobj *)native_pointer(func) = result + (func - thing);
}
for (func = new->entry_points;
func != NIL;
func = ((struct simple_fun *)native_pointer(func))->next) {
- gc_assert(lowtagof(func) == FUN_POINTER_LOWTAG);
+ gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
gc_assert(!dynamic_pointer_p(func));
#ifdef __i386__
* Otherwise we have to do something strange, 'cause it is buried
* inside a code object. */
- if (TypeOf(header) == type_SimpleFunHeader ||
- TypeOf(header) == type_ClosureFunHeader) {
+ if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG ||
+ widetag_of(header) == CLOSURE_FUN_HEADER_WIDETAG) {
/* We can only end up here if the code object has not been
* scavenged, because if it had been scavenged, forwarding pointers
old = (lispobj *)native_pointer(thing);
/* Allocate the new one. */
- if (TypeOf(header) == type_FuncallableInstanceHeader) {
+ if (widetag_of(header) == FUNCALLABLE_INSTANCE_HEADER_WIDETAG) {
/* FINs *must* not go in read_only space. */
new = static_free;
static_free += CEILING(nwords, 2);
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtagof(thing);
+ result = (lispobj)new | lowtag_of(thing);
*old = result;
/* Scavenge it. */
/* And count this cell. */
length++;
- } while (lowtagof(thing) == LIST_POINTER_LOWTAG &&
+ } while (lowtag_of(thing) == LIST_POINTER_LOWTAG &&
dynamic_pointer_p(thing) &&
!(forwarding_pointer_p(*(lispobj *)native_pointer(thing))));
static lispobj
ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
{
- switch (TypeOf(header)) {
- case type_Bignum:
- case type_SingleFloat:
- case type_DoubleFloat:
-#ifdef type_LongFloat
- case type_LongFloat:
+ switch (widetag_of(header)) {
+ case BIGNUM_WIDETAG:
+ case SINGLE_FLOAT_WIDETAG:
+ case DOUBLE_FLOAT_WIDETAG:
+#ifdef LONG_FLOAT_WIDETAG
+ case LONG_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexSingleFloat
- case type_ComplexSingleFloat:
+#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
+ case COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexDoubleFloat
- case type_ComplexDoubleFloat:
+#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case COMPLEX_DOUBLE_FLOAT_WIDETAG:
#endif
-#ifdef type_ComplexLongFloat
- case type_ComplexLongFloat:
+#ifdef COMPLEX_LONG_FLOAT_WIDETAG
+ case COMPLEX_LONG_FLOAT_WIDETAG:
#endif
- case type_Sap:
+ case SAP_WIDETAG:
return ptrans_unboxed(thing, header);
- case type_Ratio:
- case type_Complex:
- case type_SimpleArray:
- case type_ComplexString:
- case type_ComplexVector:
- case type_ComplexArray:
+ case RATIO_WIDETAG:
+ case COMPLEX_WIDETAG:
+ case SIMPLE_ARRAY_WIDETAG:
+ case COMPLEX_STRING_WIDETAG:
+ case COMPLEX_VECTOR_WIDETAG:
+ case COMPLEX_ARRAY_WIDETAG:
return ptrans_boxed(thing, header, constant);
- case type_ValueCellHeader:
- case type_WeakPointer:
+ case VALUE_CELL_HEADER_WIDETAG:
+ case WEAK_POINTER_WIDETAG:
return ptrans_boxed(thing, header, 0);
- case type_SymbolHeader:
+ case SYMBOL_HEADER_WIDETAG:
return ptrans_boxed(thing, header, 0);
- case type_SimpleString:
+ case SIMPLE_STRING_WIDETAG:
return ptrans_vector(thing, 8, 1, 0, constant);
- case type_SimpleBitVector:
+ case SIMPLE_BIT_VECTOR_WIDETAG:
return ptrans_vector(thing, 1, 0, 0, constant);
- case type_SimpleVector:
+ case SIMPLE_VECTOR_WIDETAG:
return ptrans_vector(thing, 32, 0, 1, constant);
- case type_SimpleArrayUnsignedByte2:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
return ptrans_vector(thing, 2, 0, 0, constant);
- case type_SimpleArrayUnsignedByte4:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
return ptrans_vector(thing, 4, 0, 0, constant);
- case type_SimpleArrayUnsignedByte8:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
#endif
return ptrans_vector(thing, 8, 0, 0, constant);
- case type_SimpleArrayUnsignedByte16:
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
#endif
return ptrans_vector(thing, 16, 0, 0, constant);
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
#endif
return ptrans_vector(thing, 32, 0, 0, constant);
- case type_SimpleArraySingleFloat:
+ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
return ptrans_vector(thing, 32, 0, 0, constant);
- case type_SimpleArrayDoubleFloat:
+ case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
return ptrans_vector(thing, 64, 0, 0, constant);
-#ifdef type_SimpleArrayLongFloat
- case type_SimpleArrayLongFloat:
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
#ifdef __i386__
return ptrans_vector(thing, 96, 0, 0, constant);
#endif
#endif
#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
return ptrans_vector(thing, 64, 0, 0, constant);
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
return ptrans_vector(thing, 128, 0, 0, constant);
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
#ifdef __i386__
return ptrans_vector(thing, 192, 0, 0, constant);
#endif
#endif
#endif
- case type_CodeHeader:
+ case CODE_HEADER_WIDETAG:
return ptrans_code(thing);
- case type_ReturnPcHeader:
+ case RETURN_PC_HEADER_WIDETAG:
return ptrans_returnpc(thing, header);
- case type_Fdefn:
+ case FDEFN_WIDETAG:
return ptrans_fdefn(thing, header);
default:
for (func = code->entry_points;
func != NIL;
func = ((struct simple_fun *)native_pointer(func))->next) {
- gc_assert(lowtagof(func) == FUN_POINTER_LOWTAG);
+ gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
gc_assert(!dynamic_pointer_p(func));
#ifdef __i386__
thing = header;
else {
/* Nope, copy the object. */
- switch (lowtagof(thing)) {
+ switch (lowtag_of(thing)) {
case FUN_POINTER_LOWTAG:
thing = ptrans_func(thing, header);
break;
else if (thing & 3) {
/* It's an other immediate. Maybe the header for an unboxed */
/* object. */
- switch (TypeOf(thing)) {
- case type_Bignum:
- case type_SingleFloat:
- case type_DoubleFloat:
-#ifdef type_LongFloat
- case type_LongFloat:
-#endif
- case type_Sap:
+ switch (widetag_of(thing)) {
+ case BIGNUM_WIDETAG:
+ case SINGLE_FLOAT_WIDETAG:
+ case DOUBLE_FLOAT_WIDETAG:
+#ifdef LONG_FLOAT_WIDETAG
+ case LONG_FLOAT_WIDETAG:
+#endif
+ case SAP_WIDETAG:
/* It's an unboxed simple object. */
count = HeaderValue(thing)+1;
break;
- case type_SimpleVector:
- if (HeaderValue(thing) == subtype_VectorValidHashing)
- *addr = (subtype_VectorMustRehash<<N_TYPE_BITS) |
- type_SimpleVector;
+ case SIMPLE_VECTOR_WIDETAG:
+ if (HeaderValue(thing) == subtype_VectorValidHashing) {
+ *addr = (subtype_VectorMustRehash << N_WIDETAG_BITS) |
+ SIMPLE_VECTOR_WIDETAG;
+ }
count = 1;
break;
- case type_SimpleString:
+ case SIMPLE_STRING_WIDETAG:
vector = (struct vector *)addr;
count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2);
break;
- case type_SimpleBitVector:
+ case SIMPLE_BIT_VECTOR_WIDETAG:
vector = (struct vector *)addr;
count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2);
break;
- case type_SimpleArrayUnsignedByte2:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
vector = (struct vector *)addr;
count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2);
break;
- case type_SimpleArrayUnsignedByte4:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
vector = (struct vector *)addr;
count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2);
break;
- case type_SimpleArrayUnsignedByte8:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
#endif
vector = (struct vector *)addr;
count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
break;
- case type_SimpleArrayUnsignedByte16:
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
#endif
vector = (struct vector *)addr;
count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
break;
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
#endif
vector = (struct vector *)addr;
count = CEILING(fixnum_value(vector->length)+2,2);
break;
- case type_SimpleArraySingleFloat:
+ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
vector = (struct vector *)addr;
count = CEILING(fixnum_value(vector->length)+2,2);
break;
- case type_SimpleArrayDoubleFloat:
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
+ case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
+#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
vector = (struct vector *)addr;
count = fixnum_value(vector->length)*2+2;
break;
-#ifdef type_SimpleArrayLongFloat
- case type_SimpleArrayLongFloat:
+#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
vector = (struct vector *)addr;
#ifdef __i386__
count = fixnum_value(vector->length)*3+2;
break;
#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
vector = (struct vector *)addr;
count = fixnum_value(vector->length)*4+2;
break;
#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
+#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
+ case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
vector = (struct vector *)addr;
#ifdef __i386__
count = fixnum_value(vector->length)*6+2;
break;
#endif
- case type_CodeHeader:
+ case CODE_HEADER_WIDETAG:
#ifndef __i386__
gc_abort(); /* no code headers in static space */
#else
#endif
break;
- case type_SimpleFunHeader:
- case type_ClosureFunHeader:
- case type_ReturnPcHeader:
+ case SIMPLE_FUN_HEADER_WIDETAG:
+ case CLOSURE_FUN_HEADER_WIDETAG:
+ case RETURN_PC_HEADER_WIDETAG:
/* We should never hit any of these, 'cause they occur
* buried in the middle of code objects. */
gc_abort();
break;
#ifdef __i386__
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
/* The function self pointer needs special care on the
* x86 because it is the real entry point. */
{
break;
#endif
- case type_WeakPointer:
+ case WEAK_POINTER_WIDETAG:
/* Weak pointers get preserved during purify, 'cause I
* don't feel like figuring out how to break them. */
pscav(addr+1, 2, constant);
count = 4;
break;
- case type_Fdefn:
+ case FDEFN_WIDETAG:
/* We have to handle fdefn objects specially, so we
* can fix up the raw function address. */
count = pscav_fdefn((struct fdefn *)addr);
* want/need this functionality, and can test and document it,
* please submit a patch. */
#if 0
- if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != type_UnboundMarker
+ if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != UNBOUND_MARKER_WIDETAG
&& SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {
unsigned read_only_space_size =
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) -
#define N_LOWTAG_BITS 3
#define LOWTAG_MASK ((1<<N_LOWTAG_BITS)-1)
-#define N_TYPE_BITS 8
-#define TYPE_MASK ((1<<N_TYPE_BITS)-1)
+#define N_WIDETAG_BITS 8
+#define WIDETAG_MASK ((1<<N_WIDETAG_BITS)-1)
-/* FIXME: There seems to be no reason that TypeOf, HeaderValue, CONS,
- * SYMBOL, and FDEFN can't be defined as (possibly inline) functions
- * instead of macros. */
+/* FIXME: Make HeaderValue, CONS, SYMBOL, and FDEFN into inline
+ * functions instead of macros. */
-#define TypeOf(obj) ((obj)&TYPE_MASK)
-#define HeaderValue(obj) ((unsigned long) ((obj)>>N_TYPE_BITS))
+#define HeaderValue(obj) ((unsigned long) ((obj) >> N_WIDETAG_BITS))
#define CONS(obj) ((struct cons *)((obj)-LIST_POINTER_LOWTAG))
#define SYMBOL(obj) ((struct symbol *)((obj)-OTHER_POINTER_LOWTAG))
typedef u32 lispobj;
static inline int
-lowtagof(lispobj obj) {
+lowtag_of(lispobj obj) {
return obj & LOWTAG_MASK;
}
+static inline int
+widetag_of(lispobj obj) {
+ return obj & WIDETAG_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
if (*count != -1)
*count -= 2;
- if (TypeOf(obj) == type)
+ if (widetag_of(obj) == type)
return 1;
(*start) += 2;
struct symbol *symbol;
struct vector *symbol_name;
- while (search_for_type(type_SymbolHeader, start, count)) {
+ while (search_for_type(SYMBOL_HEADER_WIDETAG, start, count)) {
symbol = (struct symbol *)native_pointer((lispobj)*start);
- if (lowtagof(symbol->name) == OTHER_POINTER_LOWTAG) {
+ if (lowtag_of(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 &&
+ widetag_of(symbol_name->header) == SIMPLE_STRING_WIDETAG &&
strcmp((char *)symbol_name->data, name) == 0)
return 1;
}
int3
.byte trap_Error
.byte 2
-#ifdef type_LongFloat
+#ifdef LONG_FLOAT_WIDETAG
.byte 24
#else
.byte 23
("src/code/primordial-extensions")
;; for various constants e.g. SB!VM:*TARGET-MOST-POSITIVE-FIXNUM* and
- ;; SB!VM:LOWTAG-BITS, needed by "early-objdef" and others
+ ;; SB!VM:N-LOWTAG-BITS, needed by "early-objdef" and others
("src/compiler/generic/early-vm")
("src/compiler/generic/early-objdef")
("src/compiler/target/parms")
(declare (type function fun))
;; The Lisp-level type FUNCTION can conceal a multitude of sins..
(case (sb-kernel:get-type fun)
- ((#.sb-vm:simple-fun-header-type #.sb-vm:closure-fun-header-type)
+ ((#.sb-vm:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag)
(sb-kernel:%simple-fun-arglist fun))
- (#.sb-vm:closure-header-type (has-arglist-info-p
- (sb-kernel:%closure-fun fun)))
+ (#.sb-vm:closure-header-widetag (has-arglist-info-p
+ (sb-kernel:%closure-fun fun)))
;; In code/describe.lisp, ll. 227 (%describe-function), we use a scheme
;; like above, and it seems to work. -- MNA 2001-06-12
;;
;; (There might be other cases with arglist info also.
- ;; SIMPLE-FUN-HEADER-TYPE and CLOSURE-HEADER-TYPE just
+ ;; SIMPLE-FUN-HEADER-WIDETAG and CLOSURE-HEADER-WIDETAG just
;; happen to be the two case that I had my nose rubbed in when
;; debugging a GC problem caused by applying %SIMPLE-FUN-ARGLIST to
;; a closure. -- WHN 2001-06-05)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.57"
+"0.pre7.58"
projects / sbcl.git / commitdiff