- (vop set-slot node block result
- (ecase kind
- (:arg
- (aver args)
- (lvar-tn node block (pop args)))
- (:unbound
- (or unbound-marker-tn
- (setf unbound-marker-tn
- (let ((tn (make-restricted-tn
- nil
- (sc-number-or-lose 'sb!vm::any-reg))))
- (vop make-unbound-marker node block tn)
- tn))))
- (:null
- (emit-constant nil))
- (:funcallable-instance-tramp
- (or funcallable-instance-tramp-tn
- (setf funcallable-instance-tramp-tn
- (let ((tn (make-restricted-tn
- nil
- (sc-number-or-lose 'sb!vm::any-reg))))
- (vop make-funcallable-instance-tramp node block tn)
- tn)))))
- name slot lowtag))))
- (aver (null args)))
+ (case kind
+ (:slot
+ (let ((raw-type (pop slot))
+ (arg-tn (lvar-tn node block (pop args))))
+ (macrolet ((make-case ()
+ `(ecase raw-type
+ ((t)
+ (vop set-slot node block object arg-tn
+ name (+ sb!vm:instance-slots-offset slot) lowtag))
+ ,@(mapcar (lambda (rsd)
+ `(,(sb!kernel::raw-slot-data-raw-type rsd)
+ (vop ,(sb!kernel::raw-slot-data-init-vop rsd)
+ node block
+ object arg-tn instance-length slot)))
+ #!+raw-instance-init-vops
+ sb!kernel::*raw-slot-data-list*
+ #!-raw-instance-init-vops
+ nil))))
+ (make-case))))
+ (:dd
+ (vop set-slot node block object
+ (emit-constant (sb!kernel::dd-layout-or-lose slot))
+ name sb!vm:instance-slots-offset lowtag))
+ (otherwise
+ (vop set-slot node block object
+ (ecase kind
+ (:arg
+ (aver args)
+ (lvar-tn node block (pop args)))
+ (:unbound
+ (or unbound-marker-tn
+ (setf unbound-marker-tn
+ (let ((tn (make-restricted-tn
+ nil
+ (sc-number-or-lose 'sb!vm::any-reg))))
+ (vop make-unbound-marker node block tn)
+ tn))))
+ (:null
+ (emit-constant nil))
+ (:funcallable-instance-tramp
+ (or funcallable-instance-tramp-tn
+ (setf funcallable-instance-tramp-tn
+ (let ((tn (make-restricted-tn
+ nil
+ (sc-number-or-lose 'sb!vm::any-reg))))
+ (vop make-funcallable-instance-tramp node block tn)
+ tn)))))
+ name slot lowtag))))))
+ (unless (null args)
+ (bug "Leftover args: ~S" args)))