projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.pre7.124:
[sbcl.git]
/
src
/
compiler
/
alpha
/
macros.lisp
diff --git
a/src/compiler/alpha/macros.lisp
b/src/compiler/alpha/macros.lisp
index
84179d9
..
96eb188
100644
(file)
--- a/
src/compiler/alpha/macros.lisp
+++ b/
src/compiler/alpha/macros.lisp
@@
-11,7
+11,7
@@
(in-package "SB!VM")
(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)))
;;; compile environment
(defmacro expand (expr)
(let ((gensym (gensym)))
@@
-97,7
+97,7
@@
"Return to RETURN-PC. LIP is an interior-reg temporary."
`(progn
(inst lda ,lip
"Return to RETURN-PC. LIP is an interior-reg temporary."
`(progn
(inst lda ,lip
- (- (* (1+ ,offset) word-bytes) other-pointer-lowtag)
+ (- (* (1+ ,offset) n-word-bytes) other-pointer-lowtag)
,return-pc)
,@(when frob-code
`((move ,return-pc code-tn)))
,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
"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)))
(emit-label ,label)
(inst lra-header-word)))
@@
-161,24
+161,21
@@
\f
;;;; storage allocation
\f
;;;; 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.
;;; 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-lowtag ,result-tn)
&body body)
`(pseudo-atomic (:extra (pad-data-block ,size))
(inst bis alloc-tn other-pointer-lowtag ,result-tn)
- (inst li (logior (ash (1- ,size) type-bits) ,type-code) ,temp-tn)
+ (inst li (logior (ash (1- ,size) n-widetag-bits) ,widetag) ,temp-tn)
(storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
,@body))
(storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
,@body))
-
-
\f
\f
-;;;; Error Code
-
+;;;; error code
(defvar *adjustable-vectors* nil)
(defvar *adjustable-vectors* nil)
@@
-203,12
+200,12
@@
(inst gentrap ,kind)
(with-adjustable-vector (,vector)
(write-var-integer (error-number-or-lose ',code) ,vector)
(inst gentrap ,kind)
(with-adjustable-vector (,vector)
(write-var-integer (error-number-or-lose ',code) ,vector)
- ,@(mapcar #'(lambda (tn)
- `(let ((tn ,tn))
- (write-var-integer (make-sc-offset (sc-number
- (tn-sc tn))
- (tn-offset tn))
- ,vector)))
+ ,@(mapcar (lambda (tn)
+ `(let ((tn ,tn))
+ (write-var-integer (make-sc-offset (sc-number
+ (tn-sc tn))
+ (tn-offset tn))
+ ,vector)))
values)
(inst byte (length ,vector))
(dotimes (i (length ,vector))
values)
(inst byte (length ,vector))
(dotimes (i (length ,vector))
@@
-269,11
+266,11
@@
(deftype load/store-index (scale lowtag min-offset
&optional (max-offset min-offset))
`(integer ,(- (truncate (+ (ash 1 16)
(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)
(- 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
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)
(: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"))
,@(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
(: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
,(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)))))))
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)
(: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
(move value result)))
(define-vop (,(symbolicate name "-C"))
,@(when translate
@@
-337,13
+334,13
@@
(value :scs ,scs))
(:info index)
(:arg-types ,type
(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
,(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)))))
object)
(move value result)))))
@@
-371,28
+368,31
@@
,@(ecase size
(:byte
(if signed
,@(ecase size
(:byte
(if signed
- `((inst ldq_u temp (- (* ,offset word-bytes) ,lowtag)
+ `((inst ldq_u temp (- (* ,offset n-word-bytes) ,lowtag)
lip)
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))
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
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)
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))
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)
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
(inst extwl temp temp1 value)))))))
(define-vop (,(symbolicate name "-C"))
,@(when translate
@@
-412,36
+412,36
@@
,@(ecase size
(:byte
(if signed
,@(ecase size
(:byte
(if signed
- `((inst ldq_u temp (- (+ (* ,offset word-bytes)
+ `((inst ldq_u temp (- (+ (* ,offset n-word-bytes)
(* index ,scale)) ,lowtag)
object)
(* 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))
(* 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)
(* 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
(* 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)
(* 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))
(* 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)
(* 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))))))))))
(* index ,scale)) ,lowtag)
object)
(inst extwl temp temp1 value))))))))))
@@
-470,19
+470,19
@@
'((inst addq lip index lip)))
,@(ecase size
(:byte
'((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 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
(: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 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
(move value result)))
(define-vop (,(symbolicate name "-C"))
,@(when translate
@@
-504,27
+504,27
@@
(:generator 5
,@(ecase size
(:byte
(:generator 5
,@(ecase size
(:byte
- `((inst lda temp (- (* ,offset word-bytes)
+ `((inst lda temp (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag)
object)
(* 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)
(* 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
(* index ,scale) ,lowtag) object)))
(:short
- `((inst lda temp (- (* ,offset word-bytes)
+ `((inst lda temp (- (* ,offset n-word-bytes)
(* index ,scale) ,lowtag)
object)
(* 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)
(* 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))))))
(* index ,scale) ,lowtag) object))))
(move value result))))))
projects / sbcl.git / blobdiff