(defun my-make-wired-tn (prim-type-name sc-name offset)
(make-wired-tn (primitive-type-or-lose prim-type-name)
- (sc-number-or-lose sc-name)
- offset))
+ (sc-number-or-lose sc-name)
+ offset))
(defstruct arg-state
(args 0))
(defstruct (arg-info
- (:constructor make-arg-info (offset prim-type reg-sc stack-sc)))
+ (:constructor make-arg-info (offset prim-type reg-sc stack-sc)))
offset
prim-type
reg-sc
(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))))
(define-alien-type-method (system-area-pointer :arg-tn) (type state)
(declare (ignore type))
(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))
(defun make-arg-tns (type)
(let* ((state (make-arg-state))
- (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)))
(values
(mapcar #'(lambda (arg)
- (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)
(* frame-size n-word-bytes))))
(!def-vm-support-routine make-call-out-tns (type)
(arg-tns stack-size)
(make-arg-tns type)
(values (make-normal-tn *fixnum-primitive-type*)
- stack-size
- arg-tns
- (invoke-alien-type-method
- :result-tn
- (alien-fun-type-result-type type)))))
+ 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)
(define-vop (call-out)
(:args (function :scs (sap-reg) :target cfunc)
- (args :more t))
+ (args :more t))
(:results (results :more t))
(:ignore args results)
(:save-p t)
(:temporary (:sc any-reg :offset cfunc-offset
- :from (:argument 0) :to (:result 0)) cfunc)
+ :from (:argument 0) :to (:result 0)) cfunc)
(: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
- (store-stack-tn nfp-save cur-nfp))
+ (store-stack-tn nfp-save cur-nfp))
(move function cfunc)
(let ((fixup (make-fixup "call_into_c" :foreign)))
- (inst ldil fixup temp)
- (inst ble fixup c-text-space temp :nullify t))
+ (inst ldil fixup temp)
+ (inst ble fixup c-text-space temp :nullify t))
(inst nop)
(when cur-nfp
- (load-stack-tn cur-nfp nfp-save)))))
+ (load-stack-tn cur-nfp nfp-save)))))
(define-vop (alloc-number-stack-space)
(:info amount)
(move nsp-tn result)
(unless (zerop amount)
(let ((delta (logandc2 (+ amount 63) 63)))
- (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)))))))
(define-vop (dealloc-number-stack-space)
(:info amount)
(:generator 0
(unless (zerop amount)
(let ((delta (- (logandc2 (+ amount 63) 63))))
- (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)))))))