/[cmucl]/src/pcl/dlisp.lisp
ViewVC logotype

Diff of /src/pcl/dlisp.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by dtc, Sun Dec 20 04:30:19 1998 UTC revision 1.6 by pw, Thu Mar 11 16:51:05 1999 UTC
# Line 376  Line 376 
376    `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref ,wrapper field)))    `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref ,wrapper field)))
377       (declare (fixnum wrapper-cache-no))       (declare (fixnum wrapper-cache-no))
378       (when (zerop wrapper-cache-no) (go ,miss-label))       (when (zerop wrapper-cache-no) (go ,miss-label))
379       ,(let ((form `(#+lucid %logand #-lucid logand       ,(let ((form `(logand
380                      mask wrapper-cache-no)))                      mask wrapper-cache-no)))
381          #+lucid form          `(the fixnum ,form))))
         #-lucid `(the fixnum ,form))))  
382    
383  (defun emit-n-wrapper-compute-primary-cache-location (wrappers miss-label)  (defun emit-n-wrapper-compute-primary-cache-location (wrappers miss-label)
384    (declare (type list wrappers))    (declare (type list wrappers))
# Line 398  Line 397 
397                              (when (or (zerop (mod adds wrapper-cache-number-adds-ok))                              (when (or (zerop (mod adds wrapper-cache-number-adds-ok))
398                                        (eql adds len))                                        (eql adds len))
399                                `((setq primary                                `((setq primary
400                                        ,(let ((form `(#+lucid %logand #-lucid logand                                        ,(let ((form `(logand primary mask)))
401                                                       primary mask)))                                           `(the fixnum ,form))))))))
                                          #+lucid form  
                                          #-lucid `(the fixnum ,form))))))))  
402                   wrappers))))                   wrappers))))
403    
404  ;;; cmu17 note: since std-instance-p is weakened, that branch may run  ;;; cmu17 note: since std-instance-p is weakened, that branch may run
# Line 412  Line 409 
409  ;;;  ;;;
410  (defun emit-fetch-wrapper (metatype argument miss-label &optional slot)  (defun emit-fetch-wrapper (metatype argument miss-label &optional slot)
411    (ecase metatype    (ecase metatype
412      ((standard-instance #+new-kcl-wrapper structure-instance)      ((standard-instance)
413       `(cond ((std-instance-p ,argument)       `(cond ((std-instance-p ,argument)
414               ,@(when slot `((setq ,slot (std-instance-slots ,argument))))               ,@(when slot `((setq ,slot (std-instance-slots ,argument))))
415               (std-instance-wrapper ,argument))               (std-instance-wrapper ,argument))
# Line 424  Line 421 
421      (class      (class
422       (when slot (error "Can't do a slot reg for this metatype."))       (when slot (error "Can't do a slot reg for this metatype."))
423       `(wrapper-of-macro ,argument))       `(wrapper-of-macro ,argument))
424      ((built-in-instance #-new-kcl-wrapper structure-instance)      ((built-in-instance structure-instance)
425       (when slot (error "Can't do a slot reg for this metatype."))       (when slot (error "Can't do a slot reg for this metatype."))
426       `(#+new-kcl-wrapper built-in-wrapper-of       `(built-in-or-structure-wrapper
        #-new-kcl-wrapper built-in-or-structure-wrapper  
427         ,argument))))         ,argument))))
428    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.5