X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fmacros.lisp;h=958e05a11a179c66596b74dce3567207e813ece5;hb=90ca09b75fbc3b63b2f7d09c67b04b866dd783f6;hp=d89804534c2c12d0ce15be5dc58a2b5bdb106837;hpb=f143939b1dbaf38ebd4f92c851fbc4ecddf37af1;p=sbcl.git diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index d898045..958e05a 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -;;; a handy macro for defining top-level forms that depend on the +;;; a handy macro for defining top level forms that depend on the ;;; compile environment (defmacro expand (expr) (let ((gensym (gensym))) @@ -61,14 +61,14 @@ `(inst ldl ,reg (+ (static-symbol-offset ',symbol) (ash symbol-value-slot word-shift) - (- other-pointer-type)) + (- other-pointer-lowtag)) null-tn)) (defmacro store-symbol-value (reg symbol) `(inst stl ,reg (+ (static-symbol-offset ',symbol) (ash symbol-value-slot word-shift) - (- other-pointer-type)) + (- other-pointer-lowtag)) null-tn)) (defmacro load-type (target source &optional (offset 0)) @@ -88,7 +88,7 @@ "Jump to the lisp function FUNCTION. LIP is an interior-reg temporary." `(progn (inst lda ,lip (- (ash sb!vm:simple-fun-code-offset sb!vm:word-shift) - sb!vm:fun-pointer-type) + sb!vm:fun-pointer-lowtag) ,function) (move ,function code-tn) (inst jsr zero-tn ,lip 1))) @@ -97,7 +97,7 @@ "Return to RETURN-PC. LIP is an interior-reg temporary." `(progn (inst lda ,lip - (- (* (1+ ,offset) word-bytes) other-pointer-type) + (- (* (1+ ,offset) n-word-bytes) other-pointer-lowtag) ,return-pc) ,@(when frob-code `((move ,return-pc code-tn))) @@ -108,7 +108,7 @@ "Emit a return-pc header word. LABEL is the label to use for this return-pc." `(progn - (align lowtag-bits) + (align n-lowtag-bits) (emit-label ,label) (inst lra-header-word))) @@ -161,24 +161,21 @@ ;;;; storage allocation -;;; Do stuff to allocate an other-pointer object of fixed Size with a -;;; single word header having the specified Type-Code. The result is -;;; placed in Result-TN, Flag-Tn must be wired to NL3-OFFSET, and +;;; Do stuff to allocate an other-pointer object of fixed SIZE with a +;;; single word header having the specified WIDETAG value. The result is +;;; placed in RESULT-TN, Flag-Tn must be wired to NL3-OFFSET, and ;;; Temp-TN is a non- descriptor temp (which may be randomly used by ;;; the body.) The body is placed inside the PSEUDO-ATOMIC, and ;;; presumably initializes the object. -(defmacro with-fixed-allocation ((result-tn temp-tn type-code size) +(defmacro with-fixed-allocation ((result-tn temp-tn widetag size) &body body) `(pseudo-atomic (:extra (pad-data-block ,size)) - (inst bis alloc-tn other-pointer-type ,result-tn) - (inst li (logior (ash (1- ,size) type-bits) ,type-code) ,temp-tn) - (storew ,temp-tn ,result-tn 0 other-pointer-type) + (inst bis alloc-tn other-pointer-lowtag ,result-tn) + (inst li (logior (ash (1- ,size) n-widetag-bits) ,widetag) ,temp-tn) + (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) ,@body)) - - -;;;; Error Code - +;;;; error code (defvar *adjustable-vectors* nil) @@ -269,11 +266,11 @@ (deftype load/store-index (scale lowtag min-offset &optional (max-offset min-offset)) `(integer ,(- (truncate (+ (ash 1 16) - (* min-offset word-bytes) + (* min-offset n-word-bytes) (- lowtag)) scale)) ,(truncate (- (+ (1- (ash 1 16)) lowtag) - (* max-offset word-bytes)) + (* max-offset n-word-bytes)) scale))) (defmacro define-full-reffer (name type offset lowtag scs el-type @@ -291,7 +288,7 @@ (:result-types ,el-type) (:generator 5 (inst addq object index lip) - (inst ldl value (- (* ,offset word-bytes) ,lowtag) lip) + (inst ldl value (- (* ,offset n-word-bytes) ,lowtag) lip) ,@(when (equal scs '(unsigned-reg)) '((inst mskll value 4 value))))) (define-vop (,(symbolicate name "-C")) @@ -301,12 +298,12 @@ (:args (object :scs (descriptor-reg))) (:info index) (:arg-types ,type - (:constant (load/store-index ,word-bytes ,(eval lowtag) + (:constant (load/store-index ,n-word-bytes ,(eval lowtag) ,(eval offset)))) (:results (value :scs ,scs)) (:result-types ,el-type) (:generator 4 - (inst ldl value (- (* (+ ,offset index) word-bytes) ,lowtag) + (inst ldl value (- (* (+ ,offset index) n-word-bytes) ,lowtag) object) ,@(when (equal scs '(unsigned-reg)) '((inst mskll value 4 value))))))) @@ -327,7 +324,7 @@ (:result-types ,el-type) (:generator 2 (inst addq index object lip) - (inst stl value (- (* ,offset word-bytes) ,lowtag) lip) + (inst stl value (- (* ,offset n-word-bytes) ,lowtag) lip) (move value result))) (define-vop (,(symbolicate name "-C")) ,@(when translate @@ -337,13 +334,13 @@ (value :scs ,scs)) (:info index) (:arg-types ,type - (:constant (load/store-index ,word-bytes ,(eval lowtag) + (:constant (load/store-index ,n-word-bytes ,(eval lowtag) ,(eval offset))) ,el-type) (:results (result :scs ,scs)) (:result-types ,el-type) (:generator 1 - (inst stl value (- (* (+ ,offset index) word-bytes) ,lowtag) + (inst stl value (- (* (+ ,offset index) n-word-bytes) ,lowtag) object) (move value result))))) @@ -371,28 +368,31 @@ ,@(ecase size (:byte (if signed - `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag) + `((inst ldq_u temp (- (* ,offset n-word-bytes) ,lowtag) lip) - (inst lda temp1 (1+ (- (* ,offset word-bytes) ,lowtag)) + (inst lda temp1 (1+ (- (* ,offset n-word-bytes) ,lowtag)) lip) (inst extqh temp temp1 temp) (inst sra temp 56 value)) - `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag) lip) - (inst lda temp1 (- (* ,offset word-bytes) ,lowtag) + `((inst ldq_u + temp + (- (* ,offset n-word-bytes) ,lowtag) + lip) + (inst lda temp1 (- (* ,offset n-word-bytes) ,lowtag) lip) (inst extbl temp temp1 value)))) (:short (if signed - `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag) + `((inst ldq_u temp (- (* ,offset n-word-bytes) ,lowtag) lip) - (inst lda temp1 (- (* ,offset word-bytes) ,lowtag) + (inst lda temp1 (- (* ,offset n-word-bytes) ,lowtag) lip) (inst extwl temp temp1 temp) (inst sll temp 48 temp) (inst sra temp 48 value)) - `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag) + `((inst ldq_u temp (- (* ,offset n-word-bytes) ,lowtag) lip) - (inst lda temp1 (- (* ,offset word-bytes) ,lowtag) lip) + (inst lda temp1 (- (* ,offset n-word-bytes) ,lowtag) lip) (inst extwl temp temp1 value))))))) (define-vop (,(symbolicate name "-C")) ,@(when translate @@ -412,36 +412,36 @@ ,@(ecase size (:byte (if signed - `((inst ldq_u temp (- (+ (* ,offset word-bytes) + `((inst ldq_u temp (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag) object) - (inst lda temp1 (1+ (- (+ (* ,offset word-bytes) + (inst lda temp1 (1+ (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag)) object) (inst extqh temp temp1 temp) (inst sra temp 56 value)) - `((inst ldq_u temp (- (+ (* ,offset word-bytes) + `((inst ldq_u temp (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag) object) - (inst lda temp1 (- (+ (* ,offset word-bytes) + (inst lda temp1 (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag) object) (inst extbl temp temp1 value)))) (:short (if signed - `((inst ldq_u temp (- (+ (* ,offset word-bytes) + `((inst ldq_u temp (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag) object) - (inst lda temp1 (- (+ (* ,offset word-bytes) + (inst lda temp1 (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag) object) (inst extwl temp temp1 temp) (inst sll temp 48 temp) (inst sra temp 48 value)) - `((inst ldq_u temp (- (+ (* ,offset word-bytes) + `((inst ldq_u temp (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag) object) - (inst lda temp1 (- (+ (* ,offset word-bytes) + (inst lda temp1 (- (+ (* ,offset n-word-bytes) (* index ,scale)) ,lowtag) object) (inst extwl temp temp1 value)))))))))) @@ -470,19 +470,19 @@ '((inst addq lip index lip))) ,@(ecase size (:byte - `((inst lda temp (- (* ,offset word-bytes) ,lowtag) lip) - (inst ldq_u temp1 (- (* ,offset word-bytes) ,lowtag) lip) + `((inst lda temp (- (* ,offset n-word-bytes) ,lowtag) lip) + (inst ldq_u temp1 (- (* ,offset n-word-bytes) ,lowtag) lip) (inst insbl value temp temp2) (inst mskbl temp1 temp temp1) (inst bis temp1 temp2 temp1) - (inst stq_u temp1 (- (* ,offset word-bytes) ,lowtag) lip))) + (inst stq_u temp1 (- (* ,offset n-word-bytes) ,lowtag) lip))) (:short - `((inst lda temp (- (* ,offset word-bytes) ,lowtag) lip) - (inst ldq_u temp1 (- (* ,offset word-bytes) ,lowtag) lip) + `((inst lda temp (- (* ,offset n-word-bytes) ,lowtag) lip) + (inst ldq_u temp1 (- (* ,offset n-word-bytes) ,lowtag) lip) (inst mskwl temp1 temp temp1) (inst inswl value temp temp2) (inst bis temp1 temp2 temp) - (inst stq_u temp (- (* ,offset word-bytes) ,lowtag) lip)))) + (inst stq_u temp (- (* ,offset n-word-bytes) ,lowtag) lip)))) (move value result))) (define-vop (,(symbolicate name "-C")) ,@(when translate @@ -504,27 +504,27 @@ (:generator 5 ,@(ecase size (:byte - `((inst lda temp (- (* ,offset word-bytes) + `((inst lda temp (- (* ,offset n-word-bytes) (* index ,scale) ,lowtag) object) - (inst ldq_u temp1 (- (* ,offset word-bytes) + (inst ldq_u temp1 (- (* ,offset n-word-bytes) (* index ,scale) ,lowtag) object) (inst insbl value temp temp2) (inst mskbl temp1 temp temp1) (inst bis temp1 temp2 temp1) - (inst stq_u temp1 (- (* ,offset word-bytes) + (inst stq_u temp1 (- (* ,offset n-word-bytes) (* index ,scale) ,lowtag) object))) (:short - `((inst lda temp (- (* ,offset word-bytes) + `((inst lda temp (- (* ,offset n-word-bytes) (* index ,scale) ,lowtag) object) - (inst ldq_u temp1 (- (* ,offset word-bytes) + (inst ldq_u temp1 (- (* ,offset n-word-bytes) (* index ,scale) ,lowtag) object) (inst mskwl temp1 temp temp1) (inst inswl value temp temp2) (inst bis temp1 temp2 temp) - (inst stq_u temp (- (* ,offset word-bytes) + (inst stq_u temp (- (* ,offset n-word-bytes) (* index ,scale) ,lowtag) object)))) (move value result))))))