X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fsap.lisp;h=a46db40e790c33a575739736f63cea9202e2403d;hb=69e6aef5e6fb3bd682c7a2cbf774034d2ea58ee8;hp=e0cd61481ee4d11bebfcee6b4a507ccdcb6aa0e4;hpb=6fb6e66f531dfb6140ec3e0cc8f84f6ecd1927ca;p=sbcl.git diff --git a/src/compiler/alpha/sap.lisp b/src/compiler/alpha/sap.lisp index e0cd614..a46db40 100644 --- a/src/compiler/alpha/sap.lisp +++ b/src/compiler/alpha/sap.lisp @@ -32,7 +32,7 @@ (:note "system area pointer allocation") (:generator 20 (move x sap) - (with-fixed-allocation (y ndescr sap-type sap-size) + (with-fixed-allocation (y ndescr sap-widetag sap-size) (storeq sap y sap-pointer-slot other-pointer-lowtag)))) (define-move-vop move-from-sap :move (sap-reg) (descriptor-reg)) @@ -40,10 +40,10 @@ ;;; Move untagged SAP values. (define-vop (sap-move) (:args (x :target y - :scs (sap-reg) - :load-if (not (location= x y)))) + :scs (sap-reg) + :load-if (not (location= x y)))) (:results (y :scs (sap-reg) - :load-if (not (location= x y)))) + :load-if (not (location= x y)))) (:effects) (:affected) (:generator 0 @@ -52,11 +52,11 @@ (sap-reg) (sap-reg)) ;;; Move untagged SAP arguments/return-values. -(define-vop (move-sap-argument) +(define-vop (move-sap-arg) (:args (x :target y - :scs (sap-reg)) - (fp :scs (any-reg) - :load-if (not (sc-is y sap-reg)))) + :scs (sap-reg)) + (fp :scs (any-reg) + :load-if (not (sc-is y sap-reg)))) (:results (y)) (:generator 0 (sc-case y @@ -64,12 +64,12 @@ (move x y)) (sap-stack (storeq x fp (tn-offset y)))))) -(define-move-vop move-sap-argument :move-argument +(define-move-vop move-sap-arg :move-arg (descriptor-reg sap-reg) (sap-reg)) -;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a +;;; Use standard MOVE-ARG + coercion to move an untagged sap to a ;;; descriptor passing location. -(define-move-vop move-argument :move-argument +(define-move-vop move-arg :move-arg (sap-reg) (descriptor-reg)) ;;;; SAP-INT and INT-SAP @@ -99,7 +99,7 @@ (define-vop (pointer+) (:translate sap+) (:args (ptr :scs (sap-reg)) - (offset :scs (signed-reg immediate))) + (offset :scs (signed-reg immediate))) (:arg-types system-area-pointer signed-num) (:results (res :scs (sap-reg))) (:result-types system-area-pointer) @@ -114,7 +114,7 @@ (define-vop (pointer-) (:translate sap-) (:args (ptr1 :scs (sap-reg)) - (ptr2 :scs (sap-reg))) + (ptr2 :scs (sap-reg))) (:arg-types system-area-pointer system-area-pointer) (:policy :fast-safe) (:results (res :scs (signed-reg))) @@ -219,7 +219,10 @@ (:single '((inst lds result offset object))) (:double - '((inst ldt result (+ offset word-bytes) object)))))) + '((inst ldt + result + (+ offset n-word-bytes) + object)))))) (define-vop (,set-name) (:translate ,set-name) (:policy :fast-safe) @@ -336,6 +339,8 @@ signed-reg signed-num :quad t) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap sap-reg system-area-pointer :quad) + (def-system-ref-and-set sap-ref-lispobj %set-sap-ref-lispobj + descriptor-reg * :long) (def-system-ref-and-set sap-ref-single %set-sap-ref-single single-reg single-float :single) (def-system-ref-and-set sap-ref-double %set-sap-ref-double @@ -351,5 +356,5 @@ (:result-types system-area-pointer) (:generator 2 (inst lda sap - (- (* vector-data-offset word-bytes) other-pointer-lowtag) - vector))) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) + vector)))