src/pcl/dlisp.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3
   4 ;;;; This software is derived from software originally released by Xerox
   5 ;;;; Corporation. Copyright and release statements follow. Later modifications
   6 ;;;; to the software are in the public domain and are provided with
   7 ;;;; absolutely no warranty. See the COPYING and CREDITS files for more
   8 ;;;; information.
   9
  10 ;;;; copyright information from original PCL sources:
  11 ;;;;
  12 ;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  13 ;;;; All rights reserved.
  14 ;;;;
  15 ;;;; Use and copying of this software and preparation of derivative works based
  16 ;;;; upon this software are permitted. Any distribution of this software or
  17 ;;;; derivative works must comply with all applicable United States export
  18 ;;;; control laws.
  19 ;;;;
  20 ;;;; This software is made available AS IS, and Xerox Corporation makes no
  21 ;;;; warranty about the software, its performance or its conformity to any
  22 ;;;; specification.
  23
  24 (in-package "SB-PCL")
  25
  26 ;;;; some support stuff for getting a hold of symbols that we need when
  27 ;;;; building the discriminator codes. It's OK for these to be interned
  28 ;;;; symbols because we don't capture any user code in the scope in which
  29 ;;;; these symbols are bound.
  30
  31 (declaim (list *dfun-arg-symbols*))
  32 (defvar *dfun-arg-symbols* '(.ARG0. .ARG1. .ARG2. .ARG3.))
  33
  34 (defun dfun-arg-symbol (arg-number)
  35   (or (nth arg-number *dfun-arg-symbols*)
  36       (format-symbol *pcl-package* ".ARG~A." arg-number)))
  37
  38 (declaim (list *slot-vector-symbols*))
  39 (defvar *slot-vector-symbols* '(.SLOTS0. .SLOTS1. .SLOTS2. .SLOTS3.))
  40
  41 (defun slot-vector-symbol (arg-number)
  42   (or (nth arg-number *slot-vector-symbols*)
  43       (format-symbol *pcl-package* ".SLOTS~A." arg-number)))
  44
  45 (declaim (inline make-dfun-required-args))
  46 (defun make-dfun-required-args (metatypes)
  47   ;; Micro-optimizations 'R Us
  48   (labels ((rec (types i)
  49              (declare (fixnum i))
  50              (when types
  51                (cons (dfun-arg-symbol i)
  52                      (rec (cdr types) (1+ i))))))
  53     (rec metatypes 0)))
  54
  55 (defun make-dfun-lambda-list (metatypes applyp)
  56   (let ((required (make-dfun-required-args metatypes)))
  57     (if applyp
  58         (nconc required
  59                ;; Use &MORE arguments to avoid consing up an &REST list
  60                ;; that we might not need at all. See MAKE-EMF-CALL and
  61                ;; INVOKE-EFFECTIVE-METHOD-FUNCTION for the other
  62                ;; pieces.
  63                '(&more .dfun-more-context. .dfun-more-count.))
  64       required)))
  65
  66 (defun make-dlap-lambda-list (metatypes applyp)
  67   (let* ((required (make-dfun-required-args metatypes))
  68          (lambda-list (if applyp
  69                           (append required '(&more .more-context. .more-count.))
  70                           required)))
  71     ;; Return the full lambda list, the required arguments, a form
  72     ;; that will generate a rest-list, and a list of the &MORE
  73     ;; parameters used.
  74     (values lambda-list
  75             required
  76             (when applyp
  77               '((sb-c::%listify-rest-args
  78                  .more-context.
  79                  (the (and unsigned-byte fixnum)
  80                    .more-count.))))
  81             (when applyp
  82               '(.more-context. .more-count.)))))
  83
  84 (defun make-emf-call (metatypes applyp fn-variable &optional emf-type)
  85   (let ((required (make-dfun-required-args metatypes)))
  86     `(,(if (eq emf-type 'fast-method-call)
  87            'invoke-effective-method-function-fast
  88            'invoke-effective-method-function)
  89        ,fn-variable
  90        ,applyp
  91        :required-args ,required
  92        ;; INVOKE-EFFECTIVE-METHOD-FUNCTION will decide whether to use
  93        ;; the :REST-ARG version or the :MORE-ARG version depending on
  94        ;; the type of the EMF.
  95        :rest-arg ,(if applyp
  96                       ;; Creates a list from the &MORE arguments.
  97                       '((sb-c::%listify-rest-args
  98                          .dfun-more-context.
  99                          (the (and unsigned-byte fixnum)
 100                            .dfun-more-count.)))
 101                       nil)
 102        :more-arg ,(when applyp
 103                     '(.dfun-more-context. .dfun-more-count.)))))
 104
 105 (defun make-fast-method-call-lambda-list (metatypes applyp)
 106   (list* '.pv-cell. '.next-method-call.
 107          (make-dfun-lambda-list metatypes applyp)))
 108 \f
 109 ;;; Emitting various accessors.
 110
 111 (defun emit-one-class-reader (class-slot-p)
 112   (emit-reader/writer :reader 1 class-slot-p))
 113
 114 (defun emit-one-class-boundp (class-slot-p)
 115   (emit-reader/writer :boundp 1 class-slot-p))
 116
 117 (defun emit-one-class-writer (class-slot-p)
 118   (emit-reader/writer :writer 1 class-slot-p))
 119
 120 (defun emit-two-class-reader (class-slot-p)
 121   (emit-reader/writer :reader 2 class-slot-p))
 122
 123 (defun emit-two-class-boundp (class-slot-p)
 124   (emit-reader/writer :boundp 2 class-slot-p))
 125
 126 (defun emit-two-class-writer (class-slot-p)
 127   (emit-reader/writer :writer 2 class-slot-p))
 128
 129 ;;; --------------------------------
 130
 131 (defun emit-one-index-readers (class-slot-p)
 132   (emit-one-or-n-index-reader/writer :reader nil class-slot-p))
 133
 134 (defun emit-one-index-boundps (class-slot-p)
 135   (emit-one-or-n-index-reader/writer :boundp nil class-slot-p))
 136
 137 (defun emit-one-index-writers (class-slot-p)
 138   (emit-one-or-n-index-reader/writer :writer nil class-slot-p))
 139
 140 (defun emit-n-n-readers ()
 141   (emit-one-or-n-index-reader/writer :reader t nil))
 142
 143 (defun emit-n-n-boundps ()
 144   (emit-one-or-n-index-reader/writer :boundp t nil))
 145
 146 (defun emit-n-n-writers ()
 147   (emit-one-or-n-index-reader/writer :writer t nil))
 148
 149 ;;; --------------------------------
 150
 151 (defun emit-checking (metatypes applyp)
 152   (emit-checking-or-caching nil nil metatypes applyp))
 153
 154 (defun emit-caching (metatypes applyp)
 155   (emit-checking-or-caching t nil metatypes applyp))
 156
 157 (defun emit-in-checking-cache-p (metatypes)
 158   (emit-checking-or-caching nil t metatypes nil))
 159
 160 (defun emit-constant-value (metatypes)
 161   (emit-checking-or-caching t t metatypes nil))
 162
 163 ;;; --------------------------------
 164
 165 ;;; FIXME: What do these variables mean?
 166 (defvar *precompiling-lap* nil)
 167 (defvar *emit-function-p* t)
 168
 169 ;;; FIXME: This variable is motivated by Gerd Moellman's observation,
 170 ;;; in <867kga1wra.fsf@gerd.free-bsd.org> on cmucl-imp 2002-10-22,
 171 ;;; that the functions returned from EMIT-xxx-FUNCTION can cause an
 172 ;;; order-of-magnitude slowdown.  We include this variable for now,
 173 ;;; but maybe its effect should rather be controlled by compilation
 174 ;;; policy if there is a noticeable space difference between the
 175 ;;; branches, or else maybe the EMIT-xxx-FUNCTION branches should be
 176 ;;; deleted.  It's not clear to me how all of this works, though, so
 177 ;;; until proper benchmarks are done it's probably safest simply to
 178 ;;; have this pseudo-constant to hide code.  -- CSR, 2003-02-14
 179 (defvar *optimize-cache-functions-p* t)
 180
 181 (defun emit-default-only (metatypes applyp)
 182   (unless *optimize-cache-functions-p*
 183     (when (and (null *precompiling-lap*) *emit-function-p*)
 184       (return-from emit-default-only
 185         (emit-default-only-function metatypes applyp))))
 186   (multiple-value-bind (lambda-list args rest-arg more-arg)
 187       (make-dlap-lambda-list metatypes applyp)
 188     (generating-lisp '(emf)
 189                      lambda-list
 190                      `(invoke-effective-method-function emf
 191                                                         ,applyp
 192                                                         :required-args ,args
 193                                                         :more-arg ,more-arg
 194                                                         :rest-arg ,rest-arg))))
 195
 196 ;;; --------------------------------
 197
 198 (defun generating-lisp (closure-variables args form)
 199   (let ((lambda `(lambda ,closure-variables
 200                    ,@(when (member 'miss-fn closure-variables)
 201                            `((declare (type function miss-fn))))
 202                    #'(lambda ,args
 203                        (let ()
 204                          (declare #.*optimize-speed*)
 205                          ,form)))))
 206     (values (if *precompiling-lap*
 207                 `#',lambda
 208                 (compile nil lambda))
 209             nil)))
 210
 211 ;;; note on implementation for CMU 17 and later (including SBCL):
 212 ;;; Since STD-INSTANCE-P is weakened, that branch may run on non-PCL
 213 ;;; instances (structures). The result will be the non-wrapper layout
 214 ;;; for the structure, which will cause a miss. The "slots" will be
 215 ;;; whatever the first slot is, but will be ignored. Similarly,
 216 ;;; FSC-INSTANCE-P returns true on funcallable structures as well as
 217 ;;; PCL fins.
 218 (defun emit-reader/writer (reader/writer 1-or-2-class class-slot-p)
 219   (unless *optimize-cache-functions-p*
 220     (when (and (null *precompiling-lap*) *emit-function-p*)
 221       (return-from emit-reader/writer
 222         (emit-reader/writer-function
 223          reader/writer 1-or-2-class class-slot-p))))
 224   (let ((instance nil)
 225         (arglist  ())
 226         (closure-variables ())
 227         (field +first-wrapper-cache-number-index+)
 228         (read-form (emit-slot-read-form class-slot-p 'index 'slots)))
 229     ;;we need some field to do the fast obsolete check
 230     (ecase reader/writer
 231       ((:reader :boundp)
 232        (setq instance (dfun-arg-symbol 0)
 233              arglist  (list instance)))
 234       (:writer (setq instance (dfun-arg-symbol 1)
 235                      arglist  (list (dfun-arg-symbol 0) instance))))
 236     (ecase 1-or-2-class
 237       (1 (setq closure-variables '(wrapper-0 index miss-fn)))
 238       (2 (setq closure-variables '(wrapper-0 wrapper-1 index miss-fn))))
 239     (generating-lisp
 240      closure-variables
 241      arglist
 242      `(let* (,@(unless class-slot-p `((slots nil)))
 243                (wrapper (cond ((std-instance-p ,instance)
 244                                ,@(unless class-slot-p
 245                                    `((setq slots
 246                                            (std-instance-slots ,instance))))
 247                                (std-instance-wrapper ,instance))
 248                               ((fsc-instance-p ,instance)
 249                                ,@(unless class-slot-p
 250                                    `((setq slots
 251                                            (fsc-instance-slots ,instance))))
 252                                (fsc-instance-wrapper ,instance)))))
 253         (block access
 254           (when (and wrapper
 255                      (/= (layout-clos-hash wrapper ,field) 0)
 256                      ,@(if (eql 1 1-or-2-class)
 257                            `((eq wrapper wrapper-0))
 258                            `((or (eq wrapper wrapper-0)
 259                                  (eq wrapper wrapper-1)))))
 260             ,@(ecase reader/writer
 261                 (:reader
 262                  `((let ((value ,read-form))
 263                      (unless (eq value +slot-unbound+)
 264                        (return-from access value)))))
 265                 (:boundp
 266                  `((let ((value ,read-form))
 267                       (return-from access (not (eq value +slot-unbound+))))))
 268                 (:writer
 269                  `((return-from access (setf ,read-form ,(car arglist)))))))
 270           (funcall miss-fn ,@arglist))))))
 271
 272 (defun emit-slot-read-form (class-slot-p index slots)
 273   (if class-slot-p
 274       `(cdr ,index)
 275       `(clos-slots-ref ,slots ,index)))
 276
 277 (defun emit-boundp-check (value-form miss-fn arglist)
 278   `(let ((value ,value-form))
 279      (if (eq value +slot-unbound+)
 280          (funcall ,miss-fn ,@arglist)
 281          value)))
 282
 283 (defun emit-slot-access (reader/writer class-slot-p slots
 284                          index miss-fn arglist)
 285   (let ((read-form (emit-slot-read-form class-slot-p index slots)))
 286     (ecase reader/writer
 287       (:reader (emit-boundp-check read-form miss-fn arglist))
 288       (:boundp `(not (eq ,read-form +slot-unbound+)))
 289       (:writer `(setf ,read-form ,(car arglist))))))
 290
 291 (defmacro emit-reader/writer-macro (reader/writer 1-or-2-class class-slot-p)
 292   (let ((*emit-function-p* nil)
 293         (*precompiling-lap* t))
 294     (values
 295      (emit-reader/writer reader/writer 1-or-2-class class-slot-p))))
 296
 297 (defun emit-one-or-n-index-reader/writer (reader/writer
 298                                           cached-index-p
 299                                           class-slot-p)
 300   (unless *optimize-cache-functions-p*
 301     (when (and (null *precompiling-lap*) *emit-function-p*)
 302       (return-from emit-one-or-n-index-reader/writer
 303         (emit-one-or-n-index-reader/writer-function
 304          reader/writer cached-index-p class-slot-p))))
 305   (multiple-value-bind (arglist metatypes)
 306       (ecase reader/writer
 307         ((:reader :boundp)
 308          (values (list (dfun-arg-symbol 0))
 309                  '(standard-instance)))
 310         (:writer (values (list (dfun-arg-symbol 0) (dfun-arg-symbol 1))
 311                          '(t standard-instance))))
 312     (generating-lisp
 313      `(cache ,@(unless cached-index-p '(index)) miss-fn)
 314      arglist
 315      `(let (,@(unless class-slot-p '(slots))
 316             ,@(when cached-index-p '(index)))
 317         ,(emit-dlap 'cache arglist metatypes
 318                     (emit-slot-access reader/writer class-slot-p
 319                                       'slots 'index 'miss-fn arglist)
 320                     `(funcall miss-fn ,@arglist)
 321                     (when cached-index-p 'index)
 322                     (unless class-slot-p '(slots)))))))
 323
 324 (defmacro emit-one-or-n-index-reader/writer-macro
 325     (reader/writer cached-index-p class-slot-p)
 326   (let ((*emit-function-p* nil)
 327         (*precompiling-lap* t))
 328     (values
 329      (emit-one-or-n-index-reader/writer reader/writer
 330                                         cached-index-p
 331                                         class-slot-p))))
 332
 333 (defun emit-miss (miss-fn args applyp)
 334   (if applyp
 335       `(multiple-value-call ,miss-fn ,@args
 336                             (sb-c::%more-arg-values .more-context.
 337                                                     0
 338                                                     .more-count.))
 339       `(funcall ,miss-fn ,@args)))
 340
 341 (defun emit-checking-or-caching (cached-emf-p return-value-p metatypes applyp)
 342   (unless *optimize-cache-functions-p*
 343     (when (and (null *precompiling-lap*) *emit-function-p*)
 344       (return-from emit-checking-or-caching
 345         (emit-checking-or-caching-function
 346          cached-emf-p return-value-p metatypes applyp))))
 347   (multiple-value-bind (lambda-list args rest-arg more-arg)
 348       (make-dlap-lambda-list metatypes applyp)
 349     (generating-lisp
 350      `(cache ,@(unless cached-emf-p '(emf)) miss-fn)
 351      lambda-list
 352      `(let (,@(when cached-emf-p '(emf)))
 353         ,(emit-dlap 'cache args metatypes
 354                     (if return-value-p
 355                         (if cached-emf-p 'emf t)
 356                         `(invoke-effective-method-function
 357                           emf ,applyp
 358                           :required-args ,args
 359                           :more-arg ,more-arg
 360                           :rest-arg ,rest-arg))
 361                     (emit-miss 'miss-fn args applyp)
 362                     (when cached-emf-p 'emf))))))
 363
 364 (defmacro emit-checking-or-caching-macro (cached-emf-p
 365                                           return-value-p
 366                                           metatypes
 367                                           applyp)
 368   (let ((*emit-function-p* nil)
 369         (*precompiling-lap* t))
 370     (values
 371      (emit-checking-or-caching cached-emf-p return-value-p metatypes applyp))))
 372
 373 (defun emit-dlap (cache-var args metatypes hit-form miss-form value-var
 374                   &optional slot-vars)
 375   (let* ((index -1)
 376          (miss-tag (gensym "MISSED"))
 377          (wrapper-bindings (mapcan (lambda (arg mt)
 378                                      (unless (eq mt t)
 379                                        (incf index)
 380                                        `((,(format-symbol *pcl-package*
 381                                                           "WRAPPER-~D"
 382                                                           index)
 383                                           ,(emit-fetch-wrapper
 384                                             mt arg miss-tag (pop slot-vars))))))
 385                                    args metatypes))
 386          (wrapper-vars (mapcar #'car wrapper-bindings)))
 387     (declare (fixnum index))
 388     (unless wrapper-vars
 389       (error "Every metatype is T."))
 390     `(prog ()
 391         (return
 392           (let ((field (cache-field ,cache-var))
 393                 (cache-vector (cache-vector ,cache-var))
 394                 (mask (cache-mask ,cache-var))
 395                 (size (cache-size ,cache-var))
 396                 (overflow (cache-overflow ,cache-var))
 397                 ,@wrapper-bindings)
 398             (declare (fixnum size field mask))
 399             ,(emit-cache-lookup wrapper-vars miss-tag value-var)
 400             ,hit-form))
 401       ,miss-tag
 402         (return ,miss-form))))
 403
 404 (defun emit-cache-lookup (wrapper-vars miss-tag value-reg)
 405   (cond ((cdr wrapper-vars)
 406          (emit-greater-than-1-dlap wrapper-vars miss-tag value-reg))
 407         (value-reg
 408          (emit-1-t-dlap (car wrapper-vars) miss-tag value-reg))
 409         (t
 410          (emit-1-nil-dlap (car wrapper-vars) miss-tag))))
 411
 412 (defun emit-1-nil-dlap (wrapper miss-label)
 413   `(let* ((primary ,(emit-1-wrapper-compute-primary-cache-location wrapper
 414                                                                    miss-label))
 415           (location primary))
 416      (declare (fixnum primary location))
 417      (block search
 418        (loop (when (eq ,wrapper (cache-vector-ref cache-vector location))
 419                (return-from search nil))
 420              (setq location (the fixnum (+ location 1)))
 421              (when (= location size)
 422                (setq location 0))
 423              (when (= location primary)
 424                (dolist (entry overflow)
 425                  (when (eq (car entry) ,wrapper)
 426                    (return-from search nil)))
 427                (go ,miss-label))))))
 428
 429 (defmacro get-cache-vector-lock-count (cache-vector)
 430   `(let ((lock-count (cache-vector-lock-count ,cache-vector)))
 431      (unless (typep lock-count 'fixnum)
 432        (error "My cache got freed somehow."))
 433      (the fixnum lock-count)))
 434
 435 (defun emit-1-t-dlap (wrapper miss-label value)
 436   `(let ((primary ,(emit-1-wrapper-compute-primary-cache-location wrapper
 437                                                                   miss-label))
 438          (initial-lock-count (get-cache-vector-lock-count cache-vector)))
 439      (declare (fixnum primary initial-lock-count))
 440      (let ((location primary))
 441        (declare (fixnum location))
 442        (block search
 443          (loop (when (eq ,wrapper (cache-vector-ref cache-vector location))
 444                  (setq ,value (cache-vector-ref cache-vector (1+ location)))
 445                  (return-from search nil))
 446                (setq location (the fixnum (+ location 2)))
 447                (when (= location size)
 448                  (setq location 0))
 449                (when (= location primary)
 450                  (dolist (entry overflow)
 451                    (when (eq (car entry) ,wrapper)
 452                      (setq ,value (cdr entry))
 453                      (return-from search nil)))
 454                  (go ,miss-label))))
 455        (unless (= initial-lock-count
 456                   (get-cache-vector-lock-count cache-vector))
 457          (go ,miss-label)))))
 458
 459 (defun emit-greater-than-1-dlap (wrappers miss-label value)
 460   (declare (type list wrappers))
 461   (let ((cache-line-size (compute-line-size (+ (length wrappers)
 462                                                (if value 1 0)))))
 463     `(let ((primary 0)
 464            (size-1 (the fixnum (- size 1))))
 465        (declare (fixnum primary size-1))
 466        ,(emit-n-wrapper-compute-primary-cache-location wrappers miss-label)
 467        (let ((initial-lock-count (get-cache-vector-lock-count cache-vector)))
 468          (declare (fixnum initial-lock-count))
 469          (let ((location primary)
 470                (next-location 0))
 471            (declare (fixnum location next-location))
 472            (block search
 473              (loop (setq next-location
 474                          (the fixnum (+ location ,cache-line-size)))
 475                    (when (and ,@(mapcar
 476                                  (lambda (wrapper)
 477                                    `(eq ,wrapper
 478                                         (cache-vector-ref
 479                                          cache-vector
 480                                          (setq location
 481                                                (the fixnum (+ location 1))))))
 482                                  wrappers))
 483                      ,@(when value
 484                          `((setq location (the fixnum (+ location 1)))
 485                            (setq ,value (cache-vector-ref cache-vector
 486                                                           location))))
 487                      (return-from search nil))
 488                    (setq location next-location)
 489                    (when (= location size-1)
 490                      (setq location 0))
 491                    (when (= location primary)
 492                      (dolist (entry overflow)
 493                        (let ((entry-wrappers (car entry)))
 494                          (when (and ,@(mapcar (lambda (wrapper)
 495                                                 `(eq ,wrapper
 496                                                      (pop entry-wrappers)))
 497                                               wrappers))
 498                            ,@(when value
 499                                `((setq ,value (cdr entry))))
 500                            (return-from search nil))))
 501                      (go ,miss-label))))
 502            (unless (= initial-lock-count
 503                       (get-cache-vector-lock-count cache-vector))
 504              (go ,miss-label)))))))
 505
 506 (defun emit-1-wrapper-compute-primary-cache-location (wrapper miss-label)
 507   `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field)))
 508      (declare (fixnum wrapper-cache-no))
 509      (when (zerop wrapper-cache-no) (go ,miss-label))
 510      ,(let ((form `(logand mask wrapper-cache-no)))
 511         `(the fixnum ,form))))
 512
 513 (defun emit-n-wrapper-compute-primary-cache-location (wrappers miss-label)
 514   (declare (type list wrappers))
 515   ;; This returns 1 less that the actual location.
 516   `(progn
 517      ,@(let ((adds 0) (len (length wrappers)))
 518          (declare (fixnum adds len))
 519          (mapcar (lambda (wrapper)
 520                    `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field)))
 521                       (declare (fixnum wrapper-cache-no))
 522                       (when (zerop wrapper-cache-no) (go ,miss-label))
 523                       (setq primary (the fixnum (+ primary wrapper-cache-no)))
 524                       ,@(progn
 525                           (incf adds)
 526                           (when (or (zerop (mod adds
 527                                                 wrapper-cache-number-adds-ok))
 528                                     (eql adds len))
 529                             `((setq primary
 530                                     ,(let ((form `(logand primary mask)))
 531                                        `(the fixnum ,form))))))))
 532                  wrappers))))
 533
 534 ;;; CMU17 (and SBCL) note: Since STD-INSTANCE-P is weakened in the
 535 ;;; CMU/SBCL approach of using funcallable instances, that branch may
 536 ;;; run on non-pcl instances (structures). The result will be the
 537 ;;; non-wrapper layout for the structure, which will cause a miss. The
 538 ;;; "slots" will be whatever the first slot is, but will be ignored.
 539 ;;; Similarly, FSC-INSTANCE-P returns true on funcallable structures
 540 ;;; as well as PCL fins.
 541 (defun emit-fetch-wrapper (metatype argument miss-label &optional slot)
 542   (ecase metatype
 543     ((standard-instance)
 544      `(cond ((std-instance-p ,argument)
 545              ,@(when slot `((setq ,slot (std-instance-slots ,argument))))
 546              (std-instance-wrapper ,argument))
 547             ((fsc-instance-p ,argument)
 548              ,@(when slot `((setq ,slot (fsc-instance-slots ,argument))))
 549              (fsc-instance-wrapper ,argument))
 550             (t
 551              (go ,miss-label))))
 552     (class
 553      (when slot (error "can't do a slot reg for this metatype"))
 554      `(wrapper-of ,argument))
 555     ((built-in-instance structure-instance)
 556      (when slot (error "can't do a slot reg for this metatype"))
 557      `(built-in-or-structure-wrapper
 558        ,argument))))