(defun my-make-wired-tn (prim-type-name sc-name offset)
(make-wired-tn (primitive-type-or-lose prim-type-name)
(defun my-make-wired-tn (prim-type-name sc-name offset)
(make-wired-tn (primitive-type-or-lose prim-type-name)
(let ((args (arg-state-args state)))
(setf (arg-state-args state) (1+ args))
(if (alien-integer-type-signed type)
(let ((args (arg-state-args state)))
(setf (arg-state-args state) (1+ args))
(if (alien-integer-type-signed type)
- (make-arg-info args 'signed-byte-32 'signed-reg 'signed-stack)
- (make-arg-info args 'unsigned-byte-32 'unsigned-reg 'unsigned-stack))))
+ (make-arg-info args 'signed-byte-32 'signed-reg 'signed-stack)
+ (make-arg-info args 'unsigned-byte-32 'unsigned-reg 'unsigned-stack))))
(if (alien-integer-type-signed type)
(my-make-wired-tn 'signed-byte-32 'signed-reg nl4-offset)
(my-make-wired-tn 'unsigned-byte-32 'unsigned-reg nl4-offset)))
(if (alien-integer-type-signed type)
(my-make-wired-tn 'signed-byte-32 'signed-reg nl4-offset)
(my-make-wired-tn 'unsigned-byte-32 'unsigned-reg nl4-offset)))
(define-alien-type-method (system-area-pointer :result-tn) (type)
(declare (ignore type))
(my-make-wired-tn 'system-area-pointer 'sap-reg nl4-offset))
(define-alien-type-method (system-area-pointer :result-tn) (type)
(declare (ignore type))
(my-make-wired-tn 'system-area-pointer 'sap-reg nl4-offset))
- (args (mapcar #'(lambda (arg-type)
- (invoke-alien-type-method :arg-tn arg-type state))
- (alien-fun-type-arg-types type)))
- ;; We need 8 words of cruft, and we need to round up to a multiple
- ;; of 16 words.
- (frame-size (logandc2 (+ (arg-state-args state) 8 15) 15)))
+ (args (mapcar #'(lambda (arg-type)
+ (invoke-alien-type-method :arg-tn arg-type state))
+ (alien-fun-type-arg-types type)))
+ ;; We need 8 words of cruft, and we need to round up to a multiple
+ ;; of 16 words.
+ (frame-size (logandc2 (+ (arg-state-args state) 8 15) 15)))
- (declare (type arg-info arg))
- (let ((offset (arg-info-offset arg))
- (prim-type (arg-info-prim-type arg)))
- (cond ((>= offset 4)
- (my-make-wired-tn prim-type (arg-info-stack-sc arg)
- (- frame-size offset 8 1)))
- ((or (eq prim-type 'single-float)
- (eq prim-type 'double-float))
- (my-make-wired-tn prim-type (arg-info-reg-sc arg)
- (+ offset 4)))
- (t
- (my-make-wired-tn prim-type (arg-info-reg-sc arg)
- (- nl0-offset offset))))))
- args)
+ (declare (type arg-info arg))
+ (let ((offset (arg-info-offset arg))
+ (prim-type (arg-info-prim-type arg)))
+ (cond ((>= offset 4)
+ (my-make-wired-tn prim-type (arg-info-stack-sc arg)
+ (- frame-size offset 8 1)))
+ ((or (eq prim-type 'single-float)
+ (eq prim-type 'double-float))
+ (my-make-wired-tn prim-type (arg-info-reg-sc arg)
+ (+ offset 4)))
+ (t
+ (my-make-wired-tn prim-type (arg-info-reg-sc arg)
+ (- nl0-offset offset))))))
+ args)
- stack-size
- arg-tns
- (invoke-alien-type-method
- :result-tn
- (alien-fun-type-result-type type)))))
-
-(define-vop (foreign-symbol-address)
- (:translate foreign-symbol-address)
+ stack-size
+ arg-tns
+ (invoke-alien-type-method
+ :result-tn
+ (alien-fun-type-result-type type)))))
+
+(define-vop (foreign-symbol-sap)
+ (:translate foreign-symbol-sap)
(:temporary (:scs (any-reg) :to (:result 0)) temp)
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:vop-var vop)
(:generator 0
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(:temporary (:scs (any-reg) :to (:result 0)) temp)
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:vop-var vop)
(:generator 0
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
- (cond ((< delta (ash 1 10))
- (inst addi delta nsp-tn nsp-tn))
- (t
- (inst li delta temp)
- (inst add temp nsp-tn nsp-tn)))))))
+ (cond ((< delta (ash 1 10))
+ (inst addi delta nsp-tn nsp-tn))
+ (t
+ (inst li delta temp)
+ (inst add temp nsp-tn nsp-tn)))))))
- (cond ((<= (- (ash 1 10)) delta)
- (inst addi delta nsp-tn nsp-tn))
- (t
- (inst li delta temp)
- (inst add temp nsp-tn nsp-tn)))))))
+ (cond ((<= (- (ash 1 10)) delta)
+ (inst addi delta nsp-tn nsp-tn))
+ (t
+ (inst li delta temp)
+ (inst add temp nsp-tn nsp-tn)))))))