src/compiler/ppc/type-vops.lisp

   1 ;;;; type testing and checking VOPs for the PPC VM
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13 \f
  14 (defun %test-fixnum (value target not-p &key temp)
  15   (assemble ()
  16     ;; FIXME: again, this 3 should be FIXNUM-MASK
  17     (inst andi. temp value 3)
  18     (inst b? (if not-p :ne :eq) target)))
  19
  20 (defun %test-fixnum-and-headers (value target not-p headers &key temp)
  21   (let ((drop-through (gen-label)))
  22     (assemble ()
  23       (inst andi. temp value 3)
  24       (inst beq (if not-p drop-through target)))
  25     (%test-headers value target not-p nil headers
  26                    :drop-through drop-through :temp temp)))
  27
  28 (defun %test-immediate (value target not-p immediate &key temp)
  29   (assemble ()
  30     (inst andi. temp value widetag-mask)
  31     (inst cmpwi temp immediate)
  32     (inst b? (if not-p :ne :eq) target)))
  33
  34 (defun %test-lowtag (value target not-p lowtag &key temp)
  35   (assemble ()
  36     (inst andi. temp value lowtag-mask)
  37     (inst cmpwi temp lowtag)
  38     (inst b? (if not-p :ne :eq) target)))
  39
  40 (defun %test-lowtag-and-headers (value target not-p lowtag function-p headers
  41                                  &key temp)
  42   (let ((drop-through (gen-label)))
  43     (%test-lowtag value (if not-p drop-through target) not-p lowtag
  44                   :temp temp)
  45     (%test-headers value target not-p function-p headers
  46                    :temp temp :drop-through drop-through)))
  47
  48 (defun %test-headers (value target not-p function-p headers
  49                       &key temp (drop-through (gen-label)))
  50     (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag)))
  51     (multiple-value-bind (when-true when-false)
  52         (if not-p
  53             (values drop-through target)
  54             (values target drop-through))
  55       (assemble ()
  56         (%test-lowtag value when-false t lowtag :temp temp)
  57         (load-type temp value (- lowtag))
  58         (do ((remaining headers (cdr remaining)))
  59             ((null remaining))
  60           (let ((header (car remaining))
  61                 (last (null (cdr remaining))))
  62             (cond
  63               ((atom header)
  64                (inst cmpwi temp header)
  65                (if last
  66                    (inst b? (if not-p :ne :eq) target)
  67                    (inst beq when-true)))
  68               (t
  69                (let ((start (car header))
  70                      (end (cdr header)))
  71                  (unless (= start bignum-widetag)
  72                    (inst cmpwi temp start)
  73                    (inst blt when-false))
  74                  (inst cmpwi temp end)
  75                  (if last
  76                      (inst b? (if not-p :gt :le) target)
  77                      (inst ble when-true)))))))
  78         (emit-label drop-through)))))
  79
  80 ;;; Simple type checking and testing:
  81 (define-vop (check-type)
  82   (:args (value :target result :scs (any-reg descriptor-reg)))
  83   (:results (result :scs (any-reg descriptor-reg)))
  84   (:temporary (:scs (non-descriptor-reg)) temp)
  85   (:vop-var vop)
  86   (:save-p :compute-only))
  87
  88 (define-vop (type-predicate)
  89   (:args (value :scs (any-reg descriptor-reg)))
  90   (:conditional)
  91   (:info target not-p)
  92   (:policy :fast-safe)
  93   (:temporary (:scs (non-descriptor-reg)) temp))
  94
  95 (defun cost-to-test-types (type-codes)
  96   (+ (* 2 (length type-codes))
  97      (if (> (apply #'max type-codes) lowtag-limit) 7 2)))
  98
  99 (defmacro !define-type-vops (pred-name check-name ptype error-code
 100                              (&rest type-codes)
 101                              ;; KLUDGE: ideally, the compiler could
 102                              ;; derive that it can use the sneaky trap
 103                              ;; twice mechanism itself.  However, one
 104                              ;; thing at a time...
 105                              &key mask &allow-other-keys)
 106   (let ((cost (cost-to-test-types (mapcar #'eval type-codes))))
 107     `(progn
 108        ,@(when pred-name
 109            `((define-vop (,pred-name type-predicate)
 110                (:translate ,pred-name)
 111                (:generator ,cost
 112                  (test-type value target not-p (,@type-codes) :temp temp)))))
 113        ,@(when check-name
 114            `((define-vop (,check-name check-type)
 115                (:generator ,cost
 116                  ,@(if mask
 117                        `((inst andi. temp value ,mask)
 118                          (inst twi 0 value (error-number-or-lose ',error-code))
 119                          (inst twi :ne temp ,@(if ;; KLUDGE: At
 120                                                   ;; present, MASK is
 121                                                   ;; 3 or LOWTAG-MASK
 122                                                   (eql mask 3)
 123                                                   ;; KLUDGE
 124                                                   `(0)
 125                                                   type-codes))
 126                          (move result value))
 127                        `((let ((err-lab
 128                                 (generate-error-code vop ,error-code value)))
 129                            (test-type value err-lab t (,@type-codes) :temp temp)
 130                            (move result value))))))))
 131        ,@(when ptype
 132            `((primitive-type-vop ,check-name (:check) ,ptype))))))
 133
 134 #|
 135   (def-type-vops fixnump nil nil object-not-fixnum-error
 136                  sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag)
 137   (define-vop (check-fixnum check-type)
 138       (:generator 3
 139                   (inst andi. temp value 3)
 140                   (inst twi 0 value (error-number-or-lose 'object-not-fixnum-error))
 141                   (inst twi :ne temp 0)
 142                   (move result value)))
 143   (primitive-type-vop check-fixnum (:check) fixnum)
 144   (def-type-vops functionp nil nil
 145                  object-not-fun-error sb!vm:fun-pointer-lowtag)
 146
 147   (define-vop (check-fun check-type)
 148       (:generator 3
 149                   (inst andi. temp value 7)
 150                   (inst twi 0 value (error-number-or-lose 'object-not-fun-error))
 151                   (inst twi :ne temp sb!vm:fun-pointer-lowtag)
 152                   (move result value)))
 153   (primitive-type-vop check-fun (:check) function)
 154
 155   (def-type-vops listp nil nil
 156                  object-not-list-error sb!vm:list-pointer-lowtag)
 157   (define-vop (check-list check-type)
 158       (:generator 3
 159                   (inst andi. temp value 7)
 160                   (inst twi 0 value (error-number-or-lose 'object-not-list-error))
 161                   (inst twi :ne temp sb!vm:list-pointer-lowtag)
 162                   (move result value)))
 163   (primitive-type-vop check-list (:check) list)
 164
 165   (def-type-vops %instancep nil nil
 166                  object-not-instance-error sb!vm:instance-pointer-lowtag)
 167   (define-vop (check-instance check-type)
 168       (:generator 3
 169                   (inst andi. temp value 7)
 170                   (inst twi 0 value (error-number-or-lose 'object-not-instance-error))
 171                   (inst twi :ne temp sb!vm:instance-pointer-lowtag)
 172                   (move result value)))
 173   (primitive-type-vop check-instance (:check) instance)
 174
 175
 176   (def-type-vops bignump check-bignum bignum
 177                  object-not-bignum-error sb!vm:bignum-widetag)
 178
 179   (def-type-vops ratiop check-ratio ratio
 180                  object-not-ratio-error sb!vm:ratio-widetag)
 181
 182   (def-type-vops complexp check-complex complex
 183                  object-not-complex-error sb!vm:complex-widetag
 184                  complex-single-float-widetag complex-double-float-widetag)
 185
 186   (def-type-vops complex-rational-p check-complex-rational nil
 187                  object-not-complex-rational-error complex-widetag)
 188
 189   (def-type-vops complex-float-p check-complex-float nil
 190                  object-not-complex-float-error
 191                  complex-single-float-widetag complex-double-float-widetag)
 192
 193   (def-type-vops complex-single-float-p check-complex-single-float
 194     complex-single-float object-not-complex-single-float-error
 195     complex-single-float-widetag)
 196
 197   (def-type-vops complex-double-float-p check-complex-double-float
 198     complex-double-float object-not-complex-double-float-error
 199     complex-double-float-widetag)
 200
 201 (def-type-vops single-float-p check-single-float single-float
 202   object-not-single-float-error sb!vm:single-float-widetag)
 203
 204 (def-type-vops double-float-p check-double-float double-float
 205   object-not-double-float-error sb!vm:double-float-widetag)
 206
 207 (def-type-vops simple-string-p check-simple-string simple-string
 208   object-not-simple-string-error sb!vm:simple-string-widetag)
 209
 210 (def-type-vops simple-bit-vector-p check-simple-bit-vector simple-bit-vector
 211   object-not-simple-bit-vector-error simple-bit-vector-widetag)
 212
 213 (def-type-vops simple-vector-p check-simple-vector simple-vector
 214   object-not-simple-vector-error sb!vm:simple-vector-widetag)
 215
 216 (def-type-vops simple-array-unsigned-byte-2-p
 217   check-simple-array-unsigned-byte-2
 218   simple-array-unsigned-byte-2
 219   object-not-simple-array-unsigned-byte-2-error
 220   sb!vm:simple-array-unsigned-byte-2-widetag)
 221
 222 (def-type-vops simple-array-unsigned-byte-4-p
 223   check-simple-array-unsigned-byte-4
 224   simple-array-unsigned-byte-4
 225   object-not-simple-array-unsigned-byte-4-error
 226   sb!vm:simple-array-unsigned-byte-4-widetag)
 227
 228 (def-type-vops simple-array-unsigned-byte-8-p
 229   check-simple-array-unsigned-byte-8
 230   simple-array-unsigned-byte-8
 231   object-not-simple-array-unsigned-byte-8-error
 232   sb!vm:simple-array-unsigned-byte-8-widetag)
 233
 234 (def-type-vops simple-array-unsigned-byte-16-p
 235   check-simple-array-unsigned-byte-16
 236   simple-array-unsigned-byte-16
 237   object-not-simple-array-unsigned-byte-16-error
 238   sb!vm:simple-array-unsigned-byte-16-widetag)
 239
 240 (def-type-vops simple-array-unsigned-byte-32-p
 241   check-simple-array-unsigned-byte-32
 242   simple-array-unsigned-byte-32
 243   object-not-simple-array-unsigned-byte-32-error
 244   sb!vm:simple-array-unsigned-byte-32-widetag)
 245
 246 (def-type-vops simple-array-signed-byte-8-p
 247   check-simple-array-signed-byte-8
 248   simple-array-signed-byte-8
 249   object-not-simple-array-signed-byte-8-error
 250   simple-array-signed-byte-8-widetag)
 251
 252 (def-type-vops simple-array-signed-byte-16-p
 253   check-simple-array-signed-byte-16
 254   simple-array-signed-byte-16
 255   object-not-simple-array-signed-byte-16-error
 256   simple-array-signed-byte-16-widetag)
 257
 258 (def-type-vops simple-array-signed-byte-30-p
 259   check-simple-array-signed-byte-30
 260   simple-array-signed-byte-30
 261   object-not-simple-array-signed-byte-30-error
 262   simple-array-signed-byte-30-widetag)
 263
 264 (def-type-vops simple-array-signed-byte-32-p
 265   check-simple-array-signed-byte-32
 266   simple-array-signed-byte-32
 267   object-not-simple-array-signed-byte-32-error
 268   simple-array-signed-byte-32-widetag)
 269
 270 (def-type-vops simple-array-single-float-p check-simple-array-single-float
 271   simple-array-single-float object-not-simple-array-single-float-error
 272   sb!vm:simple-array-single-float-widetag)
 273
 274 (def-type-vops simple-array-double-float-p check-simple-array-double-float
 275   simple-array-double-float object-not-simple-array-double-float-error
 276   sb!vm:simple-array-double-float-widetag)
 277
 278 (def-type-vops simple-array-complex-single-float-p
 279   check-simple-array-complex-single-float
 280   simple-array-complex-single-float
 281   object-not-simple-array-complex-single-float-error
 282   simple-array-complex-single-float-widetag)
 283
 284 (def-type-vops simple-array-complex-double-float-p
 285   check-simple-array-complex-double-float
 286   simple-array-complex-double-float
 287   object-not-simple-array-complex-double-float-error
 288   simple-array-complex-double-float-widetag)
 289
 290 (def-type-vops base-char-p check-base-char base-char
 291   object-not-base-char-error sb!vm:base-char-widetag)
 292
 293 (def-type-vops system-area-pointer-p check-system-area-pointer
 294   system-area-pointer object-not-sap-error sb!vm:sap-widetag)
 295
 296 (def-type-vops weak-pointer-p check-weak-pointer weak-pointer
 297   object-not-weak-pointer-error sb!vm:weak-pointer-widetag)
 298
 299 (def-type-vops code-component-p nil nil nil
 300   sb!vm:code-header-widetag)
 301
 302 (def-type-vops lra-p nil nil nil
 303   sb!vm:return-pc-header-widetag)
 304
 305 (def-type-vops fdefn-p nil nil nil
 306   sb!vm:fdefn-widetag)
 307
 308 (def-type-vops funcallable-instance-p nil nil nil
 309   sb!vm:funcallable-instance-header-widetag)
 310
 311 (def-type-vops array-header-p nil nil nil
 312   sb!vm:simple-array-widetag sb!vm:complex-string-widetag sb!vm:complex-bit-vector-widetag
 313   sb!vm:complex-vector-widetag sb!vm:complex-array-widetag)
 314
 315 (def-type-vops nil check-function-or-symbol nil object-not-function-or-symbol-error
 316   sb!vm:fun-pointer-lowtag sb!vm:symbol-header-widetag)
 317
 318 (def-type-vops stringp check-string nil object-not-string-error
 319   sb!vm:simple-string-widetag sb!vm:complex-string-widetag)
 320
 321 (def-type-vops complex-vector-p check-complex-vector nil
 322  object-not-complex-vector-error complex-vector-widetag)
 323
 324 (def-type-vops bit-vector-p check-bit-vector nil object-not-bit-vector-error
 325   sb!vm:simple-bit-vector-widetag sb!vm:complex-bit-vector-widetag)
 326
 327 (def-type-vops vectorp check-vector nil object-not-vector-error
 328   simple-string-widetag simple-bit-vector-widetag simple-vector-widetag
 329   simple-array-unsigned-byte-2-widetag simple-array-unsigned-byte-4-widetag
 330   simple-array-unsigned-byte-8-widetag simple-array-unsigned-byte-16-widetag
 331   simple-array-unsigned-byte-32-widetag
 332   simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
 333   simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
 334   simple-array-single-float-widetag simple-array-double-float-widetag
 335   simple-array-complex-single-float-widetag
 336   simple-array-complex-double-float-widetag
 337   complex-string-widetag complex-bit-vector-widetag complex-vector-widetag)
 338
 339 (def-type-vops simple-array-p check-simple-array nil object-not-simple-array-error
 340   simple-array-widetag simple-string-widetag simple-bit-vector-widetag
 341   simple-vector-widetag simple-array-unsigned-byte-2-widetag
 342   simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
 343   simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
 344   simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
 345   simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
 346   simple-array-single-float-widetag simple-array-double-float-widetag
 347   simple-array-complex-single-float-widetag
 348   simple-array-complex-double-float-widetag)
 349
 350 (def-type-vops arrayp check-array nil object-not-array-error
 351   simple-array-widetag simple-string-widetag simple-bit-vector-widetag
 352   simple-vector-widetag simple-array-unsigned-byte-2-widetag
 353   simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
 354   simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
 355   simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
 356   simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
 357   simple-array-single-float-widetag simple-array-double-float-widetag
 358   simple-array-complex-single-float-widetag
 359   simple-array-complex-double-float-widetag
 360   complex-string-widetag complex-bit-vector-widetag complex-vector-widetag
 361   complex-array-widetag)
 362
 363 (def-type-vops numberp check-number nil object-not-number-error
 364   even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag ratio-widetag
 365   single-float-widetag double-float-widetag complex-widetag
 366   complex-single-float-widetag complex-double-float-widetag)
 367
 368 (def-type-vops rationalp check-rational nil object-not-rational-error
 369   sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:ratio-widetag sb!vm:bignum-widetag)
 370
 371 (def-type-vops integerp check-integer nil object-not-integer-error
 372   sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:bignum-widetag)
 373
 374 (def-type-vops floatp check-float nil object-not-float-error
 375   sb!vm:single-float-widetag sb!vm:double-float-widetag)
 376
 377 (def-type-vops realp check-real nil object-not-real-error
 378   sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:ratio-widetag sb!vm:bignum-widetag
 379   sb!vm:single-float-widetag sb!vm:double-float-widetag))
 380 |#
 381 \f
 382 ;;;; Other integer ranges.
 383
 384 ;;; A (signed-byte 32) can be represented with either fixnum or a bignum with
 385 ;;; exactly one digit.
 386
 387 (define-vop (signed-byte-32-p type-predicate)
 388   (:translate signed-byte-32-p)
 389   (:generator 45
 390     (let ((not-target (gen-label)))
 391       (multiple-value-bind
 392           (yep nope)
 393           (if not-p
 394               (values not-target target)
 395               (values target not-target))
 396         (inst andi. temp value #x3)
 397         (inst beq yep)
 398         (test-type value nope t (other-pointer-lowtag) :temp temp)
 399         (loadw temp value 0 other-pointer-lowtag)
 400         (inst cmpwi temp (+ (ash 1 n-widetag-bits)
 401                           bignum-widetag))
 402         (inst b? (if not-p :ne :eq) target)
 403         (emit-label not-target)))))
 404
 405 (define-vop (check-signed-byte-32 check-type)
 406   (:generator 45
 407     (let ((nope (generate-error-code vop object-not-signed-byte-32-error value))
 408           (yep (gen-label)))
 409       (inst andi. temp value #x3)
 410       (inst beq yep)
 411       (test-type value nope t (other-pointer-lowtag) :temp temp)
 412       (loadw temp value 0 other-pointer-lowtag)
 413       (inst cmpwi temp (+ (ash 1 n-widetag-bits) bignum-widetag))
 414       (inst bne nope)
 415       (emit-label yep)
 416       (move result value))))
 417
 418
 419 ;;; An (unsigned-byte 32) can be represented with either a positive fixnum, a
 420 ;;; bignum with exactly one positive digit, or a bignum with exactly two digits
 421 ;;; and the second digit all zeros.
 422
 423 (define-vop (unsigned-byte-32-p type-predicate)
 424   (:translate unsigned-byte-32-p)
 425   (:generator 45
 426     (let ((not-target (gen-label))
 427           (single-word (gen-label))
 428           (fixnum (gen-label)))
 429       (multiple-value-bind
 430           (yep nope)
 431           (if not-p
 432               (values not-target target)
 433               (values target not-target))
 434         ;; Is it a fixnum?
 435         (inst andi. temp value #x3)
 436         (inst cmpwi :cr1 value 0)
 437         (inst beq fixnum)
 438
 439         ;; If not, is it an other pointer?
 440         (test-type value nope t (other-pointer-lowtag) :temp temp)
 441         ;; Get the header.
 442         (loadw temp value 0 other-pointer-lowtag)
 443         ;; Is it one?
 444         (inst cmpwi temp (+ (ash 1 n-widetag-bits) bignum-widetag))
 445         (inst beq single-word)
 446         ;; If it's other than two, we can't be an (unsigned-byte 32)
 447         (inst cmpwi temp (+ (ash 2 n-widetag-bits) bignum-widetag))
 448         (inst bne nope)
 449         ;; Get the second digit.
 450         (loadw temp value (1+ bignum-digits-offset) other-pointer-lowtag)
 451         ;; All zeros, its an (unsigned-byte 32).
 452         (inst cmpwi temp 0)
 453         (inst beq yep)
 454         ;; Otherwise, it isn't.
 455         (inst b nope)
 456
 457         (emit-label single-word)
 458         ;; Get the single digit.
 459         (loadw temp value bignum-digits-offset other-pointer-lowtag)
 460         (inst cmpwi :cr1 temp 0)
 461
 462         ;; positive implies (unsigned-byte 32).
 463         (emit-label fixnum)
 464         (inst b?  :cr1 (if not-p :lt :ge) target)
 465
 466         (emit-label not-target)))))
 467
 468 (define-vop (check-unsigned-byte-32 check-type)
 469   (:generator 45
 470     (let ((nope
 471            (generate-error-code vop object-not-unsigned-byte-32-error value))
 472           (yep (gen-label))
 473           (fixnum (gen-label))
 474           (single-word (gen-label)))
 475       ;; Is it a fixnum?
 476       (inst andi. temp value #x3)
 477       (inst cmpwi :cr1 value 0)
 478       (inst beq fixnum)
 479
 480       ;; If not, is it an other pointer?
 481       (test-type value nope t (other-pointer-lowtag) :temp temp)
 482       ;; Get the number of digits.
 483       (loadw temp value 0 other-pointer-lowtag)
 484       ;; Is it one?
 485       (inst cmpwi temp (+ (ash 1 n-widetag-bits) bignum-widetag))
 486       (inst beq single-word)
 487       ;; If it's other than two, we can't be an (unsigned-byte 32)
 488       (inst cmpwi temp (+ (ash 2 n-widetag-bits) bignum-widetag))
 489       (inst bne nope)
 490       ;; Get the second digit.
 491       (loadw temp value (1+ bignum-digits-offset) other-pointer-lowtag)
 492       ;; All zeros, its an (unsigned-byte 32).
 493       (inst cmpwi temp 0)
 494       (inst beq yep)
 495       ;; Otherwise, it isn't.
 496       (inst b nope)
 497
 498       (emit-label single-word)
 499       ;; Get the single digit.
 500       (loadw temp value bignum-digits-offset other-pointer-lowtag)
 501       ;; positive implies (unsigned-byte 32).
 502       (inst cmpwi :cr1 temp 0)
 503
 504       (emit-label fixnum)
 505       (inst blt :cr1 nope)
 506
 507       (emit-label yep)
 508       (move result value))))
 509
 510
 511
 512 \f
 513 ;;;; List/symbol types:
 514 ;;;
 515 ;;; symbolp (or symbol (eq nil))
 516 ;;; consp (and list (not (eq nil)))
 517
 518 (define-vop (symbolp type-predicate)
 519   (:translate symbolp)
 520   (:generator 12
 521     (let* ((drop-thru (gen-label))
 522            (is-symbol-label (if not-p drop-thru target)))
 523       (inst cmpw value null-tn)
 524       (inst beq is-symbol-label)
 525       (test-type value target not-p (symbol-header-widetag) :temp temp)
 526       (emit-label drop-thru))))
 527
 528 (define-vop (check-symbol check-type)
 529   (:generator 12
 530     (let ((drop-thru (gen-label))
 531           (error (generate-error-code vop object-not-symbol-error value)))
 532       (inst cmpw value null-tn)
 533       (inst beq drop-thru)
 534       (test-type value error t (symbol-header-widetag) :temp temp)
 535       (emit-label drop-thru)
 536       (move result value))))
 537
 538 (define-vop (consp type-predicate)
 539   (:translate consp)
 540   (:generator 8
 541     (let* ((drop-thru (gen-label))
 542            (is-not-cons-label (if not-p target drop-thru)))
 543       (inst cmpw value null-tn)
 544       (inst beq is-not-cons-label)
 545       (test-type value target not-p (list-pointer-lowtag) :temp temp)
 546       (emit-label drop-thru))))
 547
 548 (define-vop (check-cons check-type)
 549   (:generator 8
 550     (let ((error (generate-error-code vop object-not-cons-error value)))
 551       (inst cmpw value null-tn)
 552       (inst beq error)
 553       (test-type value error t (list-pointer-lowtag) :temp temp)
 554       (move result value))))
 555