X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Fsap.lisp;h=6aa3972f1c36678319c756bbe669fde4b0a945be;hb=6d3b9d5de8a28cd92e280f3451b60ce412260c19;hp=ed13310d9ae47f7a14ce19ce977f2c222de31c56;hpb=63817d29028c8551cda23f432a3328acd7fdd62f;p=sbcl.git diff --git a/src/compiler/hppa/sap.lisp b/src/compiler/hppa/sap.lisp index ed13310..6aa3972 100644 --- a/src/compiler/hppa/sap.lisp +++ b/src/compiler/hppa/sap.lisp @@ -38,10 +38,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,9 +52,9 @@ ;;; Move untagged sap args/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)) (:generator 0 (sc-case y @@ -95,7 +95,7 @@ (define-vop (pointer+) (:translate sap+) (:args (ptr :scs (sap-reg) :target res) - (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) @@ -117,7 +117,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))) @@ -127,95 +127,95 @@ ;;;; 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)) - (offset :scs (signed-reg))) - (:arg-types system-area-pointer signed-num) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 5 - (inst ,(ecase size - (:byte 'ldbx) - (:short 'ldhx) - (:long 'ldwx) - (:float 'fldx)) - offset object result) - ,@(when (and signed (not (eq size :long))) - `((inst extrs result 31 ,(ecase size - (:byte 8) - (:short 16)) - result))))) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (object :scs (sap-reg)) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 5 + (inst ,(ecase size + (:byte 'ldbx) + (:short 'ldhx) + (:long 'ldwx) + (:float 'fldx)) + offset object result) + ,@(when (and signed (not (eq size :long))) + `((inst extrs result 31 ,(ecase size + (:byte 8) + (:short 16)) + result))))) (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 :float) - '(signed-byte 5) - '(signed-byte 14)))) - (:info offset) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 4 - (inst ,(ecase size - (:byte 'ldb) - (:short 'ldh) - (:long 'ldw) - (:float 'flds)) - offset object result) - ,@(when (and signed (not (eq size :long))) - `((inst extrs result 31 ,(ecase size - (:byte 8) - (:short 16)) - result))))) + (:translate ,ref-name) + (:policy :fast-safe) + (:args (object :scs (sap-reg))) + (:arg-types system-area-pointer + (:constant ,(if (eq size :float) + '(signed-byte 5) + '(signed-byte 14)))) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 4 + (inst ,(ecase size + (:byte 'ldb) + (:short 'ldh) + (:long 'ldw) + (:float 'flds)) + offset object result) + ,@(when (and signed (not (eq size :long))) + `((inst extrs result 31 ,(ecase size + (:byte 8) + (:short 16)) + result))))) (define-vop (,set-name) - (:translate ,set-name) - (:policy :fast-safe) - (:args (object :scs (sap-reg) - ,@(unless (eq size :float) '(: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) - ,@(unless (eq size :float) - '((:temporary (:scs (sap-reg) :from (:argument 0)) sap))) - (:generator 5 - ,@(if (eq size :float) - `((inst fstx value offset object) - (unless (location= value result) - (inst funop :copy value result))) - `((inst add object offset sap) - (inst ,(ecase size (:byte 'stb) (:short 'sth) (:long 'stw)) - value 0 sap) - (move value result))))) + (:translate ,set-name) + (:policy :fast-safe) + (:args (object :scs (sap-reg) + ,@(unless (eq size :float) '(: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) + ,@(unless (eq size :float) + '((:temporary (:scs (sap-reg) :from (:argument 0)) sap))) + (:generator 5 + ,@(if (eq size :float) + `((inst fstx value offset object) + (unless (location= value result) + (inst funop :copy value result))) + `((inst add object offset sap) + (inst ,(ecase size (:byte 'stb) (:short 'sth) (:long 'stw)) + value 0 sap) + (move value result))))) (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 :float) - '(signed-byte 5) - '(signed-byte 14))) - ,type) - (:info offset) - (:results (result :scs (,sc))) - (:result-types ,type) - (:generator 5 - ,@(if (eq size :float) - `((inst fsts value offset object) - (unless (location= value result) - (inst funop :copy value result))) - `((inst ,(ecase size (:byte 'stb) (:short 'sth) (:long 'stw)) - value offset object) - (move value result))))))))) + (: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 :float) + '(signed-byte 5) + '(signed-byte 14))) + ,type) + (:info offset) + (:results (result :scs (,sc))) + (:result-types ,type) + (:generator 5 + ,@(if (eq size :float) + `((inst fsts value offset object) + (unless (location= value result) + (inst funop :copy value result))) + `((inst ,(ecase size (:byte 'stb) (:short 'sth) (:long 'stw)) + value offset object) + (move value result))))))))) (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 @@ -244,19 +244,19 @@ (:result-types system-area-pointer) (:generator 2 (inst addi - (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) - vector - sap))) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) + vector + sap))) ;;; 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