(loadw value object symbol-value-slot other-pointer-lowtag)
(inst xor value unbound-marker-widetag temp)
(if not-p
(loadw value object symbol-value-slot other-pointer-lowtag)
(inst xor value unbound-marker-widetag temp)
(if not-p
(:temporary (:scs (interior-reg)) lip)
(:temporary (:scs (non-descriptor-reg)) type)
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (interior-reg)) lip)
(:temporary (:scs (non-descriptor-reg)) type)
(:results (result :scs (descriptor-reg)))
(inst beq type normal-fn)
(inst li (make-fixup "closure_tramp" :foreign) lip)
(emit-label normal-fn)
(storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
(storew function fdefn fdefn-fun-slot other-pointer-lowtag)
(move function result))))
(inst beq type normal-fn)
(inst li (make-fixup "closure_tramp" :foreign) lip)
(emit-label normal-fn)
(storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
(storew function fdefn fdefn-fun-slot other-pointer-lowtag)
(move function result))))
;;; symbol on the binding stack and stuff the new value into the symbol.
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
;;; symbol on the binding stack and stuff the new value into the symbol.
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
(storew temp bsp-tn (- binding-value-slot binding-size))
(storew symbol bsp-tn (- binding-symbol-slot binding-size))
(#!+gengc storew-and-remember-slot #!-gengc storew
(storew temp bsp-tn (- binding-value-slot binding-size))
(storew symbol bsp-tn (- binding-symbol-slot binding-size))
(#!+gengc storew-and-remember-slot #!-gengc storew
(loadw symbol bsp-tn (- binding-symbol-slot binding-size))
(loadw value bsp-tn (- binding-value-slot binding-size))
(#!+gengc storew-and-remember-slot #!-gengc storew
(loadw symbol bsp-tn (- binding-symbol-slot binding-size))
(loadw value bsp-tn (- binding-value-slot binding-size))
(#!+gengc storew-and-remember-slot #!-gengc storew
(storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
(inst subq bsp-tn (* 2 n-word-bytes) bsp-tn)))
(storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
(inst subq bsp-tn (* 2 n-word-bytes) bsp-tn)))
(loadw value bsp-tn (- binding-value-slot binding-size))
(inst beq symbol skip)
(#!+gengc storew-and-remember-slot #!-gengc storew
(loadw value bsp-tn (- binding-value-slot binding-size))
(inst beq symbol skip)
(#!+gengc storew-and-remember-slot #!-gengc storew
(:variant ,offset))
,@(when writable
`((defknown ((setf ,fn)) (,lisp-type) ,lisp-type
(:variant ,offset))
,@(when writable
`((defknown ((setf ,fn)) (,lisp-type) ,lisp-type
(define-vop (,set ,set-vop)
(:translate (setf ,fn))
(:variant ,offset)))))))))
(define-vop (,set ,set-vop)
(:translate (setf ,fn))
(:variant ,offset)))))))))
(:arg-types * positive-fixnum)
(:results (value :scs (unsigned-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(:arg-types * positive-fixnum)
(:results (value :scs (unsigned-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(inst mskll value 4 value)))
(define-vop (raw-instance-set/word)
(:translate %raw-instance-set/word)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(inst mskll value 4 value)))
(define-vop (raw-instance-set/word)
(:translate %raw-instance-set/word)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (unsigned-reg)))
(:arg-types * positive-fixnum unsigned-num)
(:results (result :scs (unsigned-reg)))
(value :scs (unsigned-reg)))
(:arg-types * positive-fixnum unsigned-num)
(:results (result :scs (unsigned-reg)))
(move value result)))
(define-vop (raw-instance-ref/single)
(:translate %raw-instance-ref/single)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(move value result)))
(define-vop (raw-instance-ref/single)
(:translate %raw-instance-ref/single)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(:arg-types * positive-fixnum)
(:results (value :scs (single-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(:arg-types * positive-fixnum)
(:results (value :scs (single-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(define-vop (raw-instance-set/single)
(:translate %raw-instance-set/single)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(define-vop (raw-instance-set/single)
(:translate %raw-instance-set/single)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (single-reg)))
(:arg-types * positive-fixnum single-float)
(:results (result :scs (single-reg)))
(value :scs (single-reg)))
(:arg-types * positive-fixnum single-float)
(:results (result :scs (single-reg)))
(:arg-types * positive-fixnum)
(:results (value :scs (double-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(:arg-types * positive-fixnum)
(:results (value :scs (double-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(define-vop (raw-instance-set/double)
(:translate %raw-instance-set/double)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(define-vop (raw-instance-set/double)
(:translate %raw-instance-set/double)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (double-reg)))
(:arg-types * positive-fixnum double-float)
(:results (result :scs (double-reg)))
(value :scs (double-reg)))
(:arg-types * positive-fixnum double-float)
(:results (result :scs (double-reg)))
(:arg-types * positive-fixnum)
(:results (value :scs (complex-single-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(:arg-types * positive-fixnum)
(:results (value :scs (complex-single-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(define-vop (raw-instance-set/complex-single)
(:translate %raw-instance-set/complex-single)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(define-vop (raw-instance-set/complex-single)
(:translate %raw-instance-set/complex-single)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (complex-single-reg)))
(:arg-types * positive-fixnum complex-single-float)
(:results (result :scs (complex-single-reg)))
(value :scs (complex-single-reg)))
(:arg-types * positive-fixnum complex-single-float)
(:results (result :scs (complex-single-reg)))
(let ((value-real (complex-single-reg-real-tn value))
(result-real (complex-single-reg-real-tn result)))
(inst sts
(let ((value-real (complex-single-reg-real-tn value))
(result-real (complex-single-reg-real-tn result)))
(inst sts
(let ((value-imag (complex-single-reg-imag-tn value))
(result-imag (complex-single-reg-imag-tn result)))
(inst sts
(let ((value-imag (complex-single-reg-imag-tn value))
(result-imag (complex-single-reg-imag-tn result)))
(inst sts
(define-vop (raw-instance-ref/complex-double)
(:translate %raw-instance-ref/complex-double)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(define-vop (raw-instance-ref/complex-double)
(:translate %raw-instance-ref/complex-double)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(:arg-types * positive-fixnum)
(:results (value :scs (complex-double-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(:arg-types * positive-fixnum)
(:results (value :scs (complex-double-reg)))
(:temporary (:scs (non-descriptor-reg)) offset)
(define-vop (raw-instance-set/complex-double)
(:translate %raw-instance-set/complex-double)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(define-vop (raw-instance-set/complex-double)
(:translate %raw-instance-set/complex-double)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (complex-double-reg)))
(:arg-types * positive-fixnum complex-double-float)
(:results (result :scs (complex-double-reg)))
(value :scs (complex-double-reg)))
(:arg-types * positive-fixnum complex-double-float)
(:results (result :scs (complex-double-reg)))
(let ((value-real (complex-double-reg-real-tn value))
(result-real (complex-double-reg-real-tn result)))
(inst stt
(let ((value-real (complex-double-reg-real-tn value))
(result-real (complex-double-reg-real-tn result)))
(inst stt
(let ((value-imag (complex-double-reg-imag-tn value))
(result-imag (complex-double-reg-imag-tn result)))
(inst stt
(let ((value-imag (complex-double-reg-imag-tn value))
(result-imag (complex-double-reg-imag-tn result)))
(inst stt