X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fsap.lisp;h=c6f37a25dbac2aabb684f298774768029ad89e3e;hb=aa7b669779e8e88349938ca962229f31ead08af2;hp=91ea9d114578721ea798c6c94f0cdca475558ba9;hpb=bc9235363fc93155dbdbba04755b4fa89fc00ea8;p=sbcl.git diff --git a/src/compiler/mips/sap.lisp b/src/compiler/mips/sap.lisp index 91ea9d1..c6f37a2 100644 --- a/src/compiler/mips/sap.lisp +++ b/src/compiler/mips/sap.lisp @@ -15,9 +15,9 @@ ;;; Move a tagged SAP to an untagged representation. (define-vop (move-to-sap) - (:args (x :scs (descriptor-reg))) + (:args (x :scs (any-reg descriptor-reg))) (:results (y :scs (sap-reg))) - (:note "system area pointer indirection") + (:note "pointer to SAP coercion") (:generator 1 (loadw y x sap-pointer-slot other-pointer-lowtag))) @@ -26,27 +26,26 @@ ;;; Move an untagged SAP to a tagged representation. (define-vop (move-from-sap) - (:args (x :scs (sap-reg) :target sap)) - (:temporary (:scs (sap-reg) :from (:argument 0)) sap) + (:args (sap :scs (sap-reg) :to :save)) (:temporary (:scs (non-descriptor-reg)) ndescr) (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) - (:results (y :scs (descriptor-reg))) - (:note "system area pointer allocation") + (:results (res :scs (descriptor-reg))) + (:note "SAP to pointer coercion") (:generator 20 - (move sap x) - (with-fixed-allocation (y pa-flag ndescr sap-widetag sap-size) - (storew sap y sap-pointer-slot other-pointer-lowtag)))) + (with-fixed-allocation (res pa-flag ndescr sap-widetag sap-size nil) + (storew sap res sap-pointer-slot other-pointer-lowtag)))) (define-move-vop move-from-sap :move (sap-reg) (descriptor-reg)) -;;; Move untagged sap values. +;;; 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)))) + (:note "SAP move") (:effects) (:affected) (:generator 0 @@ -55,13 +54,14 @@ (define-move-vop sap-move :move (sap-reg) (sap-reg)) -;;; Move untagged sap arguments/return-values. +;;; Move untagged SAP arguments/return-values. (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)) + (:note "SAP argument move") (:generator 0 (sc-case y (sap-reg @@ -72,7 +72,7 @@ (define-move-vop move-sap-arg :move-arg (descriptor-reg sap-reg) (sap-reg)) -;;; Use standard MOVE-ARG + 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-arg :move-arg (sap-reg) (descriptor-reg)) @@ -109,7 +109,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) @@ -124,7 +124,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))) @@ -134,159 +134,159 @@ ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET (macrolet ((def-system-ref-and-set - (ref-name set-name sc type size &optional signed) + (ref-name set-name sc type size &optional signed) (let ((ref-name-c (symbolicate ref-name "-C")) - (set-name-c (symbolicate set-name "-C"))) + (set-name-c (symbolicate set-name "-C"))) `(progn (define-vop (,ref-name) - (:translate ,ref-name) - (:policy :fast-safe) - (:args (object :scs (sap-reg) :target sap) - (offset :scs (signed-reg))) - (:arg-types system-area-pointer signed-num) - (:results (result :scs (,sc))) - (:result-types ,type) - (:temporary (:scs (sap-reg) :from (:argument 0)) sap) - (:generator 5 - (inst addu sap object offset) - ,@(ecase size - (:byte - (if signed - '((inst lb result sap 0)) - '((inst lbu result sap 0)))) - (:short - (if signed - '((inst lh result sap 0)) - '((inst lhu result sap 0)))) - (:long - '((inst lw result sap 0))) - (:single - '((inst lwc1 result sap 0))) - (:double - (ecase *backend-byte-order* - (:big-endian - '((inst lwc1 result sap n-word-bytes) - (inst lwc1-odd result sap 0))) - (:little-endian - '((inst lwc1 result sap 0) - (inst lwc1-odd result sap n-word-bytes)))))) - (inst nop))) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (object :scs (sap-reg) :target sap) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) + (:results (result :scs (,sc))) + (:result-types ,type) + (:temporary (:scs (sap-reg) :from (:argument 0)) sap) + (:generator 5 + (inst addu sap object offset) + ,@(ecase size + (:byte + (if signed + '((inst lb result sap 0)) + '((inst lbu result sap 0)))) + (:short + (if signed + '((inst lh result sap 0)) + '((inst lhu result sap 0)))) + (:long + '((inst lw result sap 0))) + (:single + '((inst lwc1 result sap 0))) + (:double + (ecase *backend-byte-order* + (:big-endian + '((inst lwc1 result sap n-word-bytes) + (inst lwc1-odd result sap 0))) + (:little-endian + '((inst lwc1 result sap 0) + (inst lwc1-odd result sap n-word-bytes)))))) + (inst nop))) (define-vop (,ref-name-c) - (:translate ,ref-name) - (:policy :fast-safe) - (:args (object :scs (sap-reg))) - (:arg-types system-area-pointer - (:constant ,(if (eq size :double) - ;; We need to be able to add 4. - `(integer ,(- (ash 1 16)) - ,(- (ash 1 16) 5)) - '(signed-byte 16)))) - (:info offset) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 4 - ,@(ecase size - (:byte - (if signed - '((inst lb result object offset)) - '((inst lbu result object offset)))) - (:short - (if signed - '((inst lh result object offset)) - '((inst lhu result object offset)))) - (:long - '((inst lw result object offset))) - (:single - '((inst lwc1 result object offset))) - (:double - (ecase *backend-byte-order* - (:big-endian - '((inst lwc1 result object (+ offset n-word-bytes)) - (inst lwc1-odd result object offset))) - (:little-endian - '((inst lwc1 result object offset) - (inst lwc1-odd result object (+ offset n-word-bytes))))))) - (inst nop))) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (object :scs (sap-reg))) + (:arg-types system-area-pointer + (:constant ,(if (eq size :double) + ;; We need to be able to add 4. + `(integer ,(- (ash 1 16)) + ,(- (ash 1 16) 5)) + '(signed-byte 16)))) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 4 + ,@(ecase size + (:byte + (if signed + '((inst lb result object offset)) + '((inst lbu result object offset)))) + (:short + (if signed + '((inst lh result object offset)) + '((inst lhu result object offset)))) + (:long + '((inst lw result object offset))) + (:single + '((inst lwc1 result object offset))) + (:double + (ecase *backend-byte-order* + (:big-endian + '((inst lwc1 result object (+ offset n-word-bytes)) + (inst lwc1-odd result object offset))) + (:little-endian + '((inst lwc1 result object offset) + (inst lwc1-odd result object (+ offset n-word-bytes))))))) + (inst nop))) (define-vop (,set-name) - (:translate ,set-name) - (:policy :fast-safe) - (:args (object :scs (sap-reg) :target sap) - (offset :scs (signed-reg)) - (value :scs (,sc) :target result)) - (:arg-types system-area-pointer signed-num ,type) - (:results (result :scs (,sc))) - (:result-types ,type) - (:temporary (:scs (sap-reg) :from (:argument 0)) sap) - (:generator 5 - (inst addu sap object offset) - ,@(ecase size - (:byte - '((inst sb value sap 0) - (move result value))) - (:short - '((inst sh value sap 0) - (move result value))) - (:long - '((inst sw value sap 0) - (move result value))) - (:single - '((inst swc1 value sap 0) - (unless (location= result value) - (inst fmove :single result value)))) - (:double - (ecase *backend-byte-order* - (:big-endian - '((inst swc1 value sap n-word-bytes) - (inst swc1-odd value sap 0) - (unless (location= result value) - (inst fmove :double result value)))) - (:little-endian - '((inst swc1 value sap 0) - (inst swc1-odd value sap n-word-bytes) - (unless (location= result value) - (inst fmove :double result value))))))))) + (:translate ,set-name) + (:policy :fast-safe) + (:args (object :scs (sap-reg) :target sap) + (offset :scs (signed-reg)) + (value :scs (,sc) :target result)) + (:arg-types system-area-pointer signed-num ,type) + (:results (result :scs (,sc))) + (:result-types ,type) + (:temporary (:scs (sap-reg) :from (:argument 0)) sap) + (:generator 5 + (inst addu sap object offset) + ,@(ecase size + (:byte + '((inst sb value sap 0) + (move result value))) + (:short + '((inst sh value sap 0) + (move result value))) + (:long + '((inst sw value sap 0) + (move result value))) + (:single + '((inst swc1 value sap 0) + (unless (location= result value) + (inst fmove :single result value)))) + (:double + (ecase *backend-byte-order* + (:big-endian + '((inst swc1 value sap n-word-bytes) + (inst swc1-odd value sap 0) + (unless (location= result value) + (inst fmove :double result value)))) + (:little-endian + '((inst swc1 value sap 0) + (inst swc1-odd value sap n-word-bytes) + (unless (location= result value) + (inst fmove :double result value))))))))) (define-vop (,set-name-c) - (:translate ,set-name) - (:policy :fast-safe) - (:args (object :scs (sap-reg)) - (value :scs (,sc) :target result)) - (:arg-types system-area-pointer - (:constant ,(if (eq size :double) - ;; We need to be able to add 4. - `(integer ,(- (ash 1 16)) - ,(- (ash 1 16) 5)) - '(signed-byte 16))) - ,type) - (:info offset) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 5 - ,@(ecase size - (:byte - '((inst sb value object offset) - (move result value))) - (:short - '((inst sh value object offset) - (move result value))) - (:long - '((inst sw value object offset) - (move result value))) - (:single - '((inst swc1 value object offset) - (unless (location= result value) - (inst fmove :single result value)))) - (:double - (ecase *backend-byte-order* - (:big-endian - '((inst swc1 value object (+ offset n-word-bytes)) - (inst swc1-odd value object (+ offset n-word-bytes)) - (unless (location= result value) - (inst fmove :double result value)))) - (:little-endian - '((inst swc1 value object offset) - (inst swc1-odd value object (+ offset n-word-bytes)) - (unless (location= result value) - (inst fmove :double result value))))))))))))) + (:translate ,set-name) + (:policy :fast-safe) + (:args (object :scs (sap-reg)) + (value :scs (,sc) :target result)) + (:arg-types system-area-pointer + (:constant ,(if (eq size :double) + ;; We need to be able to add 4. + `(integer ,(- (ash 1 16)) + ,(- (ash 1 16) 5)) + '(signed-byte 16))) + ,type) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 4 + ,@(ecase size + (:byte + '((inst sb value object offset) + (move result value))) + (:short + '((inst sh value object offset) + (move result value))) + (:long + '((inst sw value object offset) + (move result value))) + (:single + '((inst swc1 value object offset) + (unless (location= result value) + (inst fmove :single result value)))) + (:double + (ecase *backend-byte-order* + (:big-endian + '((inst swc1 value object (+ offset n-word-bytes)) + (inst swc1-odd value object (+ offset n-word-bytes)) + (unless (location= result value) + (inst fmove :double result value)))) + (:little-endian + '((inst swc1 value object offset) + (inst swc1-odd value object (+ offset n-word-bytes)) + (unless (location= result value) + (inst fmove :double result value))))))))))))) (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 unsigned-reg positive-fixnum :byte nil) (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8 @@ -301,6 +301,8 @@ signed-reg signed-num :long t) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap sap-reg system-area-pointer :long) + (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 @@ -315,39 +317,4 @@ (:result-types system-area-pointer) (:generator 2 (inst addu sap vector - (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))) - -;;; Transforms for 64-bit SAP accessors. -#!+little-endian -(progn - (deftransform sap-ref-64 ((sap offset) (* *)) - '(logior (sap-ref-32 sap offset) - (ash (sap-ref-32 sap (+ offset 4)) 32))) - (deftransform signed-sap-ref-64 ((sap offset) (* *)) - '(logior (sap-ref-32 sap offset) - (ash (signed-sap-ref-32 sap (+ offset 4)) 32))) - (deftransform %set-sap-ref-64 ((sap offset value) (* * *)) - '(progn - (%set-sap-ref-32 sap offset (logand value #xffffffff)) - (%set-sap-ref-32 sap (+ offset 4) (ash value -32)))) - (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *)) - '(progn - (%set-sap-ref-32 sap offset (logand value #xffffffff)) - (%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32))))) -#!-little-endian -(progn - (deftransform sap-ref-64 ((sap offset) (* *)) - '(logior (ash (sap-ref-32 sap offset) 32) - (sap-ref-32 sap (+ offset 4)))) - (deftransform signed-sap-ref-64 ((sap offset) (* *)) - '(logior (ash (signed-sap-ref-32 sap offset) 32) - (sap-ref-32 sap (+ 4 offset)))) - (deftransform %set-sap-ref-64 ((sap offset value) (* * *)) - '(progn - (%set-sap-ref-32 sap offset (ash value -32)) - (%set-sap-ref-32 sap (+ offset 4) (logand value #xffffffff)))) - (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *)) - '(progn - (%set-signed-sap-ref-32 sap offset (ash value -32)) - (%set-sap-ref-32 sap (+ 4 offset) (logand value #xffffffff))))) - + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))