X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fsap.lisp;h=c6f37a25dbac2aabb684f298774768029ad89e3e;hb=e86533e804513080f610795b9d43ca36ad842467;hp=98efa7a6968c1b76c911e8e2c4dd9a968abed624;hpb=52cfe54802db8736f1f4e2b67764c43bba9b78b3;p=sbcl.git diff --git a/src/compiler/mips/sap.lisp b/src/compiler/mips/sap.lisp index 98efa7a..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)))) (:results (y :scs (sap-reg) :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)))) (: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)) @@ -260,7 +260,7 @@ (:info offset) (:results (result :scs (,sc))) (:result-types ,type) - (:generator 5 + (:generator 4 ,@(ecase size (:byte '((inst sb value object offset) @@ -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 @@ -316,38 +318,3 @@ (: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))))) -