X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Ftype-vops.lisp;h=712d4de591f16ee3ab9ff7429750dc3acc0aa58c;hb=7deecae2d959173eda6a153d490c752c32050a9e;hp=0260508c3b2fb3703e7f7bfbf17e00f9e2d36130;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git diff --git a/src/compiler/ppc/type-vops.lisp b/src/compiler/ppc/type-vops.lisp index 0260508..712d4de 100644 --- a/src/compiler/ppc/type-vops.lisp +++ b/src/compiler/ppc/type-vops.lisp @@ -1,11 +1,106 @@ -(in-package "SB!VM") +;;;; type testing and checking VOPs for the PPC VM - -;;;; Simple type checking and testing: -;;; -;;; These types are represented by a single type code, so are easily -;;; open-coded as a mask and compare. +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") + +(defun %test-fixnum (value target not-p &key temp) + (assemble () + (inst andi. temp value fixnum-tag-mask) + (inst b? (if not-p :ne :eq) target))) + +(defun %test-fixnum-and-headers (value target not-p headers &key temp) + (let ((drop-through (gen-label))) + (assemble () + (inst andi. temp value fixnum-tag-mask) + (inst beq (if not-p drop-through target))) + (%test-headers value target not-p nil headers + :drop-through drop-through :temp temp))) + +(defun %test-immediate (value target not-p immediate &key temp) + (assemble () + (inst andi. temp value widetag-mask) + (inst cmpwi temp immediate) + (inst b? (if not-p :ne :eq) target))) + +(defun %test-lowtag (value target not-p lowtag &key temp) + (assemble () + (inst andi. temp value lowtag-mask) + (inst cmpwi temp lowtag) + (inst b? (if not-p :ne :eq) target))) + +(defun %test-headers (value target not-p function-p headers + &key temp (drop-through (gen-label))) + (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag))) + (multiple-value-bind (when-true when-false) + (if not-p + (values drop-through target) + (values target drop-through)) + (assemble () + (%test-lowtag value when-false t lowtag :temp temp) + (load-type temp value (- lowtag)) + (do ((remaining headers (cdr remaining))) + ((null remaining)) + (let ((header (car remaining)) + (last (null (cdr remaining)))) + (cond + ((atom header) + (cond + ((and (not last) (null (cddr remaining)) + (atom (cadr remaining)) + (= (logcount (logxor header (cadr remaining))) 1)) + (inst andi. temp temp (ldb (byte 8 0) (logeqv header (cadr remaining)))) + (inst cmpwi temp (ldb (byte 8 0) (logand header (cadr remaining)))) + (inst b? (if not-p :ne :eq) target) + (return)) + (t + (inst cmpwi temp header) + (if last + (inst b? (if not-p :ne :eq) target) + (inst beq when-true))))) + (t + (let ((start (car header)) + (end (cdr header))) + (cond + ((and last (not (= start bignum-widetag)) + (= (+ start 4) end) + (= (logcount (logxor start end)) 1)) + (inst andi. temp temp (ldb (byte 8 0) (logeqv start end))) + (inst cmpwi temp (ldb (byte 8 0) (logand start end))) + (inst b? (if not-p :ne :eq) target)) + ((and (not last) (null (cddr remaining)) + (= (+ start 4) end) (= (logcount (logxor start end)) 1) + (listp (cadr remaining)) + (= (+ (caadr remaining) 4) (cdadr remaining)) + (= (logcount (logxor (caadr remaining) (cdadr remaining))) 1) + (= (logcount (logxor (caadr remaining) start)) 1)) + (inst andi. temp temp (ldb (byte 8 0) (logeqv start (cdadr remaining)))) + (inst cmpwi temp (ldb (byte 8 0) (logand start (cdadr remaining)))) + (inst b? (if not-p :ne :eq) target) + (return)) + (t + (unless (= start bignum-widetag) + (inst cmpwi temp start) + (if (= end complex-array-widetag) + (progn + (aver last) + (inst b? (if not-p :lt :ge) target)) + (inst blt when-false))) + (unless (= end complex-array-widetag) + (inst cmpwi temp end) + (if last + (inst b? (if not-p :gt :le) target) + (inst ble when-true)))))))))) + (emit-label drop-through))))) + +;;; Simple type checking and testing: (define-vop (check-type) (:args (value :target result :scs (any-reg descriptor-reg))) (:results (result :scs (any-reg descriptor-reg))) @@ -20,276 +115,40 @@ (:policy :fast-safe) (:temporary (:scs (non-descriptor-reg)) temp)) -(eval-when (:compile-toplevel :load-toplevel) - (defun cost-to-test-types (type-codes) - (+ (* 2 (length type-codes)) - (if (> (apply #'max type-codes) lowtag-limit) 7 2)))) - -(macrolet ((def-type-vops (pred-name check-name ptype error-code - &rest type-codes) - (let ((cost (cost-to-test-types (mapcar #'eval type-codes)))) +(defun cost-to-test-types (type-codes) + (+ (* 2 (length type-codes)) + (if (> (apply #'max type-codes) lowtag-limit) 7 2))) + +(defmacro !define-type-vops (pred-name check-name ptype error-code + (&rest type-codes) + ;; KLUDGE: ideally, the compiler could + ;; derive that it can use the sneaky trap + ;; twice mechanism itself. However, one + ;; thing at a time... + &key mask &allow-other-keys) + (let ((cost (cost-to-test-types (mapcar #'eval type-codes)))) `(progn ,@(when pred-name - `((define-vop (,pred-name type-predicate) - (:translate ,pred-name) - (:generator ,cost - (test-type value temp target not-p ,@type-codes))))) + `((define-vop (,pred-name type-predicate) + (:translate ,pred-name) + (:generator ,cost + (test-type value target not-p (,@type-codes) :temp temp))))) ,@(when check-name - `((define-vop (,check-name check-type) - (:generator ,cost - (let ((err-lab - (generate-error-code vop ,error-code value))) - (test-type value temp err-lab t ,@type-codes) - (move result value)))))) + `((define-vop (,check-name check-type) + (:generator ,cost + ,@(if mask + `((inst andi. temp value ,mask) + (inst twi 0 value (error-number-or-lose ',error-code)) + (inst twi :ne temp ,@(ecase mask + ((fixnum-tag-mask) `(0)) + ((lowtag-mask) type-codes))) + (move result value)) + `((let ((err-lab + (generate-error-code vop ',error-code value))) + (test-type value err-lab t (,@type-codes) :temp temp) + (move result value)))))))) ,@(when ptype - `((primitive-type-vop ,check-name (:check) ,ptype))))))) - - (def-type-vops fixnump nil nil object-not-fixnum-error - sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag) - (define-vop (check-fixnum check-type) - (:generator 3 - (inst andi. temp value 3) - (inst twi 0 value (error-number-or-lose 'object-not-fixnum-error)) - (inst twi :ne temp 0) - (move result value))) - (primitive-type-vop check-fixnum (:check) fixnum) - (def-type-vops functionp nil nil - object-not-fun-error sb!vm:fun-pointer-lowtag) - - (define-vop (check-fun check-type) - (:generator 3 - (inst andi. temp value 7) - (inst twi 0 value (error-number-or-lose 'object-not-fun-error)) - (inst twi :ne temp sb!vm:fun-pointer-lowtag) - (move result value))) - (primitive-type-vop check-fun (:check) function) - - (def-type-vops listp nil nil - object-not-list-error sb!vm:list-pointer-lowtag) - (define-vop (check-list check-type) - (:generator 3 - (inst andi. temp value 7) - (inst twi 0 value (error-number-or-lose 'object-not-list-error)) - (inst twi :ne temp sb!vm:list-pointer-lowtag) - (move result value))) - (primitive-type-vop check-list (:check) list) - - (def-type-vops %instancep nil nil - object-not-instance-error sb!vm:instance-pointer-lowtag) - (define-vop (check-instance check-type) - (:generator 3 - (inst andi. temp value 7) - (inst twi 0 value (error-number-or-lose 'object-not-instance-error)) - (inst twi :ne temp sb!vm:instance-pointer-lowtag) - (move result value))) - (primitive-type-vop check-instance (:check) instance) - - - (def-type-vops bignump check-bignum bignum - object-not-bignum-error sb!vm:bignum-widetag) - - (def-type-vops ratiop check-ratio ratio - object-not-ratio-error sb!vm:ratio-widetag) - - (def-type-vops complexp check-complex complex - object-not-complex-error sb!vm: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-widetag) - - (def-type-vops complex-float-p check-complex-float nil - object-not-complex-float-error - 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-widetag) - - (def-type-vops complex-double-float-p check-complex-double-float - complex-double-float object-not-complex-double-float-error - complex-double-float-widetag) - -(def-type-vops single-float-p check-single-float single-float - object-not-single-float-error sb!vm:single-float-widetag) - -(def-type-vops double-float-p check-double-float double-float - object-not-double-float-error sb!vm:double-float-widetag) - -(def-type-vops simple-string-p check-simple-string simple-string - object-not-simple-string-error sb!vm: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-widetag) - -(def-type-vops simple-vector-p check-simple-vector simple-vector - object-not-simple-vector-error sb!vm: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 - sb!vm: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 - sb!vm: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 - sb!vm: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 - sb!vm: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 - sb!vm: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-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-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-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-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 - sb!vm: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 - sb!vm: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-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-widetag) - -(def-type-vops base-char-p check-base-char base-char - object-not-base-char-error sb!vm:base-char-widetag) - -(def-type-vops system-area-pointer-p check-system-area-pointer - system-area-pointer object-not-sap-error sb!vm:sap-widetag) - -(def-type-vops weak-pointer-p check-weak-pointer weak-pointer - object-not-weak-pointer-error sb!vm:weak-pointer-widetag) - -(def-type-vops code-component-p nil nil nil - sb!vm:code-header-widetag) - -(def-type-vops lra-p nil nil nil - sb!vm:return-pc-header-widetag) - -(def-type-vops fdefn-p nil nil nil - sb!vm:fdefn-widetag) - -(def-type-vops funcallable-instance-p nil nil nil - sb!vm:funcallable-instance-header-widetag) - -(def-type-vops array-header-p nil nil nil - sb!vm:simple-array-widetag sb!vm:complex-string-widetag sb!vm:complex-bit-vector-widetag - sb!vm:complex-vector-widetag sb!vm:complex-array-widetag) - -(def-type-vops nil check-function-or-symbol nil object-not-function-or-symbol-error - sb!vm:fun-pointer-lowtag sb!vm:symbol-header-widetag) - -(def-type-vops stringp check-string nil object-not-string-error - sb!vm:simple-string-widetag sb!vm:complex-string-widetag) - -(def-type-vops complex-vector-p check-complex-vector nil - object-not-complex-vector-error complex-vector-widetag) - -(def-type-vops bit-vector-p check-bit-vector nil object-not-bit-vector-error - sb!vm:simple-bit-vector-widetag sb!vm:complex-bit-vector-widetag) - -(def-type-vops vectorp check-vector nil object-not-vector-error - 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-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-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-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 - sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:ratio-widetag sb!vm:bignum-widetag) - -(def-type-vops integerp check-integer nil object-not-integer-error - sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:bignum-widetag) - -(def-type-vops floatp check-float nil object-not-float-error - sb!vm:single-float-widetag sb!vm:double-float-widetag) - -(def-type-vops realp check-real nil object-not-real-error - sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:ratio-widetag sb!vm:bignum-widetag - sb!vm:single-float-widetag sb!vm:double-float-widetag)) - + `((primitive-type-vop ,check-name (:check) ,ptype)))))) ;;;; Other integer ranges. @@ -301,28 +160,28 @@ (:generator 45 (let ((not-target (gen-label))) (multiple-value-bind - (yep nope) - (if not-p - (values not-target target) - (values target not-target)) - (inst andi. temp value #x3) - (inst beq yep) - (test-type value temp nope t sb!vm:other-pointer-lowtag) - (loadw temp value 0 sb!vm:other-pointer-lowtag) - (inst cmpwi temp (+ (ash 1 sb!vm:n-widetag-bits) - sb!vm:bignum-widetag)) - (inst b? (if not-p :ne :eq) target) - (emit-label not-target))))) + (yep nope) + (if not-p + (values not-target target) + (values target not-target)) + (inst andi. temp value fixnum-tag-mask) + (inst beq yep) + (test-type value nope t (other-pointer-lowtag) :temp temp) + (loadw temp value 0 other-pointer-lowtag) + (inst cmpwi temp (+ (ash 1 n-widetag-bits) + bignum-widetag)) + (inst b? (if not-p :ne :eq) target) + (emit-label not-target))))) (define-vop (check-signed-byte-32 check-type) (:generator 45 - (let ((nope (generate-error-code vop object-not-signed-byte-32-error value)) - (yep (gen-label))) - (inst andi. temp value #x3) + (let ((nope (generate-error-code vop 'object-not-signed-byte-32-error value)) + (yep (gen-label))) + (inst andi. temp value fixnum-tag-mask) (inst beq yep) - (test-type value temp nope t sb!vm:other-pointer-lowtag) - (loadw temp value 0 sb!vm:other-pointer-lowtag) - (inst cmpwi temp (+ (ash 1 sb!vm:n-widetag-bits) sb!vm:bignum-widetag)) + (test-type value nope t (other-pointer-lowtag) :temp temp) + (loadw temp value 0 other-pointer-lowtag) + (inst cmpwi temp (+ (ash 1 n-widetag-bits) bignum-widetag)) (inst bne nope) (emit-label yep) (move result value)))) @@ -336,86 +195,86 @@ (:translate unsigned-byte-32-p) (:generator 45 (let ((not-target (gen-label)) - (single-word (gen-label)) - (fixnum (gen-label))) + (single-word (gen-label)) + (fixnum (gen-label))) (multiple-value-bind - (yep nope) - (if not-p - (values not-target target) - (values target not-target)) - ;; Is it a fixnum? - (inst andi. temp value #x3) + (yep nope) + (if not-p + (values not-target target) + (values target not-target)) + ;; Is it a fixnum? + (inst andi. temp value fixnum-tag-mask) (inst cmpwi :cr1 value 0) (inst beq fixnum) - ;; If not, is it an other pointer? - (test-type value temp nope t sb!vm:other-pointer-lowtag) - ;; Get the header. - (loadw temp value 0 sb!vm:other-pointer-lowtag) - ;; Is it one? - (inst cmpwi temp (+ (ash 1 sb!vm:n-widetag-bits) sb!vm:bignum-widetag)) - (inst beq single-word) - ;; If it's other than two, we can't be an (unsigned-byte 32) - (inst cmpwi temp (+ (ash 2 sb!vm:n-widetag-bits) sb!vm:bignum-widetag)) - (inst bne nope) - ;; Get the second digit. - (loadw temp value (1+ sb!vm:bignum-digits-offset) sb!vm:other-pointer-lowtag) - ;; All zeros, its an (unsigned-byte 32). - (inst cmpwi temp 0) - (inst beq yep) - ;; Otherwise, it isn't. - (inst b nope) - - (emit-label single-word) - ;; Get the single digit. - (loadw temp value sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag) - (inst cmpwi :cr1 temp 0) - - ;; positive implies (unsigned-byte 32). - (emit-label fixnum) - (inst b? :cr1 (if not-p :lt :ge) target) - - (emit-label not-target))))) + ;; If not, is it an other pointer? + (test-type value nope t (other-pointer-lowtag) :temp temp) + ;; Get the header. + (loadw temp value 0 other-pointer-lowtag) + ;; Is it one? + (inst cmpwi temp (+ (ash 1 n-widetag-bits) bignum-widetag)) + (inst beq single-word) + ;; If it's other than two, we can't be an (unsigned-byte 32) + (inst cmpwi temp (+ (ash 2 n-widetag-bits) bignum-widetag)) + (inst bne nope) + ;; Get the second digit. + (loadw temp value (1+ bignum-digits-offset) other-pointer-lowtag) + ;; All zeros, its an (unsigned-byte 32). + (inst cmpwi temp 0) + (inst beq yep) + ;; Otherwise, it isn't. + (inst b nope) + + (emit-label single-word) + ;; Get the single digit. + (loadw temp value bignum-digits-offset other-pointer-lowtag) + (inst cmpwi :cr1 temp 0) + + ;; positive implies (unsigned-byte 32). + (emit-label fixnum) + (inst b? :cr1 (if not-p :lt :ge) target) + + (emit-label not-target))))) (define-vop (check-unsigned-byte-32 check-type) (:generator 45 (let ((nope - (generate-error-code vop object-not-unsigned-byte-32-error value)) - (yep (gen-label)) - (fixnum (gen-label)) - (single-word (gen-label))) + (generate-error-code vop 'object-not-unsigned-byte-32-error value)) + (yep (gen-label)) + (fixnum (gen-label)) + (single-word (gen-label))) ;; Is it a fixnum? - (inst andi. temp value #x3) + (inst andi. temp value fixnum-tag-mask) (inst cmpwi :cr1 value 0) (inst beq fixnum) ;; If not, is it an other pointer? - (test-type value temp nope t sb!vm:other-pointer-lowtag) + (test-type value nope t (other-pointer-lowtag) :temp temp) ;; Get the number of digits. - (loadw temp value 0 sb!vm:other-pointer-lowtag) + (loadw temp value 0 other-pointer-lowtag) ;; Is it one? - (inst cmpwi temp (+ (ash 1 sb!vm:n-widetag-bits) sb!vm:bignum-widetag)) + (inst cmpwi temp (+ (ash 1 n-widetag-bits) bignum-widetag)) (inst beq single-word) ;; If it's other than two, we can't be an (unsigned-byte 32) - (inst cmpwi temp (+ (ash 2 sb!vm:n-widetag-bits) sb!vm:bignum-widetag)) + (inst cmpwi temp (+ (ash 2 n-widetag-bits) bignum-widetag)) (inst bne nope) ;; Get the second digit. - (loadw temp value (1+ sb!vm:bignum-digits-offset) sb!vm:other-pointer-lowtag) + (loadw temp value (1+ bignum-digits-offset) other-pointer-lowtag) ;; All zeros, its an (unsigned-byte 32). (inst cmpwi temp 0) (inst beq yep) ;; Otherwise, it isn't. (inst b nope) - + (emit-label single-word) ;; Get the single digit. - (loadw temp value sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag) + (loadw temp value bignum-digits-offset other-pointer-lowtag) ;; positive implies (unsigned-byte 32). (inst cmpwi :cr1 temp 0) - + (emit-label fixnum) (inst blt :cr1 nope) - + (emit-label yep) (move result value)))) @@ -423,7 +282,7 @@ ;;;; List/symbol types: -;;; +;;; ;;; symbolp (or symbol (eq nil)) ;;; consp (and list (not (eq nil))) @@ -431,37 +290,37 @@ (:translate symbolp) (:generator 12 (let* ((drop-thru (gen-label)) - (is-symbol-label (if not-p drop-thru target))) + (is-symbol-label (if not-p drop-thru target))) (inst cmpw value null-tn) (inst beq is-symbol-label) - (test-type value temp target not-p sb!vm:symbol-header-widetag) + (test-type value target not-p (symbol-header-widetag) :temp temp) (emit-label drop-thru)))) (define-vop (check-symbol check-type) (:generator 12 (let ((drop-thru (gen-label)) - (error (generate-error-code vop object-not-symbol-error value))) + (error (generate-error-code vop 'object-not-symbol-error value))) (inst cmpw value null-tn) (inst beq drop-thru) - (test-type value temp error t sb!vm:symbol-header-widetag) + (test-type value error t (symbol-header-widetag) :temp temp) (emit-label drop-thru) (move result value)))) - + (define-vop (consp type-predicate) (:translate consp) (:generator 8 (let* ((drop-thru (gen-label)) - (is-not-cons-label (if not-p target drop-thru))) + (is-not-cons-label (if not-p target drop-thru))) (inst cmpw value null-tn) (inst beq is-not-cons-label) - (test-type value temp target not-p sb!vm:list-pointer-lowtag) + (test-type value target not-p (list-pointer-lowtag) :temp temp) (emit-label drop-thru)))) (define-vop (check-cons check-type) (:generator 8 - (let ((error (generate-error-code vop object-not-cons-error value))) + (let ((error (generate-error-code vop 'object-not-cons-error value))) (inst cmpw value null-tn) (inst beq error) - (test-type value temp error t sb!vm:list-pointer-lowtag) + (test-type value error t (list-pointer-lowtag) :temp temp) (move result value))))