X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Fsap.lisp;h=0b1675c6533f58efe4c246be828c4b95e22b4165;hb=b6e9c116826f9461e2660d87c031fd1c4488e776;hp=8255ed6a6763255e39ba087aa7e52b5da3d4f4a5;hpb=9e3a856afd1c42055b3a9d323179afbd78884186;p=sbcl.git diff --git a/src/compiler/sparc/sap.lisp b/src/compiler/sparc/sap.lisp index 8255ed6..0b1675c 100644 --- a/src/compiler/sparc/sap.lisp +++ b/src/compiler/sparc/sap.lisp @@ -30,7 +30,7 @@ (:args (sap :scs (sap-reg) :to :save)) (:temporary (:scs (non-descriptor-reg)) ndescr) (:results (res :scs (descriptor-reg))) - (:note "SAP to pointer coercion") + (:note "SAP to pointer coercion") (:generator 20 (with-fixed-allocation (res ndescr sap-widetag sap-size) (storew sap res sap-pointer-slot other-pointer-lowtag)))) @@ -42,10 +42,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)))) (:note "SAP move") (:effects) (:affected) @@ -59,9 +59,9 @@ ;;; 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 @@ -107,7 +107,7 @@ (define-vop (pointer+) (:translate sap+) (:args (ptr :scs (sap-reg)) - (offset :scs (signed-reg))) + (offset :scs (signed-reg))) (:arg-types system-area-pointer signed-num) (:results (res :scs (sap-reg))) (:result-types system-area-pointer) @@ -129,7 +129,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))) @@ -140,103 +140,103 @@ ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET (macrolet ((def-system-ref-and-set (ref-name set-name sc type size &optional signed) - (let ((ref-name-c (symbolicate ref-name "-C")) - (set-name-c (symbolicate set-name "-C"))) - `(progn - (define-vop (,ref-name) - (:translate ,ref-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg))) - (:arg-types system-area-pointer signed-num) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 5 - ,@(if (eql size :long-float) - '((load-long-reg result sap offset t)) - `((inst ,(ecase size - (:byte (if signed 'ldsb 'ldub)) - (:short (if signed 'ldsh 'lduh)) - (:long 'ld) - (:single 'ldf) - (:double 'lddf)) - result sap offset))))) - (define-vop (,ref-name-c) - (:translate ,ref-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg))) - (:arg-types system-area-pointer (:constant (signed-byte 13))) - (:info offset) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 4 - ,@(if (eql size :long-float) - '((load-long-reg result sap offset t)) - `((inst ,(ecase size - (:byte (if signed 'ldsb 'ldub)) - (:short (if signed 'ldsh 'lduh)) - (:long 'ld) - (:single 'ldf) - (:double 'lddf)) - result sap offset))))) - (define-vop (,set-name) - (:translate ,set-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg)) - (offset :scs (signed-reg)) - (value :scs (,sc) :target result)) - (:arg-types system-area-pointer signed-num ,type) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 5 - ,@(if (eql size :long-float) - '((store-long-reg value sap offset t)) - `((inst ,(ecase size - (:byte 'stb) - (:short 'sth) - (:long 'st) - (:single 'stf) - (:double 'stdf)) - value sap offset))) - (unless (location= result value) - ,@(case size - (:single - '((inst fmovs result value))) - (:double - '((move-double-reg result value))) - (:long-float - '((move-long-reg result value))) - (t - '((inst move result value))))))) - (define-vop (,set-name-c) - (:translate ,set-name) - (:policy :fast-safe) - (:args (sap :scs (sap-reg)) - (value :scs (,sc) :target result)) - (:arg-types system-area-pointer (:constant (signed-byte 13)) ,type) - (:info offset) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 4 - ,@(if (eql size :long-float) - '((store-long-reg value sap offset t)) - `((inst ,(ecase size - (:byte 'stb) - (:short 'sth) - (:long 'st) - (:single 'stf) - (:double 'stdf)) - value sap offset))) - (unless (location= result value) - ,@(case size - (:single - '((inst fmovs result value))) - (:double - '((move-double-reg result value))) - (:long-float - '((move-long-reg result value))) - (t - '((inst move result value))))))))))) + (let ((ref-name-c (symbolicate ref-name "-C")) + (set-name-c (symbolicate set-name "-C"))) + `(progn + (define-vop (,ref-name) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg)) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 5 + ,@(if (eql size :long-float) + '((load-long-reg result sap offset t)) + `((inst ,(ecase size + (:byte (if signed 'ldsb 'ldub)) + (:short (if signed 'ldsh 'lduh)) + (:long 'ld) + (:single 'ldf) + (:double 'lddf)) + result sap offset))))) + (define-vop (,ref-name-c) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg))) + (:arg-types system-area-pointer (:constant (signed-byte 13))) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 4 + ,@(if (eql size :long-float) + '((load-long-reg result sap offset t)) + `((inst ,(ecase size + (:byte (if signed 'ldsb 'ldub)) + (:short (if signed 'ldsh 'lduh)) + (:long 'ld) + (:single 'ldf) + (:double 'lddf)) + result sap offset))))) + (define-vop (,set-name) + (:translate ,set-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg)) + (offset :scs (signed-reg)) + (value :scs (,sc) :target result)) + (:arg-types system-area-pointer signed-num ,type) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 5 + ,@(if (eql size :long-float) + '((store-long-reg value sap offset t)) + `((inst ,(ecase size + (:byte 'stb) + (:short 'sth) + (:long 'st) + (:single 'stf) + (:double 'stdf)) + value sap offset))) + (unless (location= result value) + ,@(case size + (:single + '((inst fmovs result value))) + (:double + '((move-double-reg result value))) + (:long-float + '((move-long-reg result value))) + (t + '((inst move result value))))))) + (define-vop (,set-name-c) + (:translate ,set-name) + (:policy :fast-safe) + (:args (sap :scs (sap-reg)) + (value :scs (,sc) :target result)) + (:arg-types system-area-pointer (:constant (signed-byte 13)) ,type) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 4 + ,@(if (eql size :long-float) + '((store-long-reg value sap offset t)) + `((inst ,(ecase size + (:byte 'stb) + (:short 'sth) + (:long 'st) + (:single 'stf) + (:double 'stdf)) + value sap offset))) + (unless (location= result value) + ,@(case size + (:single + '((inst fmovs result value))) + (:double + '((move-double-reg result value))) + (:long-float + '((move-long-reg result value))) + (t + '((inst move result value))))))))))) (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 unsigned-reg positive-fixnum :byte nil) @@ -271,16 +271,16 @@ (:result-types system-area-pointer) (:generator 2 (inst add sap vector - (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))) ;;; Transforms for 64-bit SAP accessors. (deftransform sap-ref-64 ((sap offset) (* *)) '(logior (ash (sap-ref-32 sap offset) 32) - (sap-ref-32 sap (+ offset 4)))) + (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)))) + (sap-ref-32 sap (+ 4 offset)))) (deftransform %set-sap-ref-64 ((sap offset value) (* * *)) '(progn