projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.7.7.22:
[sbcl.git]
/
src
/
compiler
/
x86
/
macros.lisp
diff --git
a/src/compiler/x86/macros.lisp
b/src/compiler/x86/macros.lisp
index
b82ca88
..
ca4519c
100644
(file)
--- a/
src/compiler/x86/macros.lisp
+++ b/
src/compiler/x86/macros.lisp
@@
-11,12
+11,12
@@
(in-package "SB!VM")
(in-package "SB!VM")
-;;; We can load/store into fp registers through the top of
-;;; stack %st(0) (fr0 here). Loads imply a push to an empty register
-;;; which then changes all the reg numbers. These macros help manage that.
+;;; We can load/store into fp registers through the top of stack
+;;; %st(0) (fr0 here). Loads imply a push to an empty register which
+;;; then changes all the reg numbers. These macros help manage that.
-;;; Use this when we don't have to load anything. It preserves old tos value,
-;;; but probably destroys tn with operation.
+;;; Use this when we don't have to load anything. It preserves old tos
+;;; value, but probably destroys tn with operation.
(defmacro with-tn@fp-top((tn) &body body)
`(progn
(unless (zerop (tn-offset ,tn))
(defmacro with-tn@fp-top((tn) &body body)
`(progn
(unless (zerop (tn-offset ,tn))
@@
-47,7
+47,7
@@
(inst mov ,n-dst ,n-src))))
(defmacro make-ea-for-object-slot (ptr slot lowtag)
(inst mov ,n-dst ,n-src))))
(defmacro make-ea-for-object-slot (ptr slot lowtag)
- `(make-ea :dword :base ,ptr :disp (- (* ,slot word-bytes) ,lowtag)))
+ `(make-ea :dword :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag)))
(defmacro loadw (value ptr &optional (slot 0) (lowtag 0))
`(inst mov ,value (make-ea-for-object-slot ,ptr ,slot ,lowtag)))
(defmacro loadw (value ptr &optional (slot 0) (lowtag 0))
`(inst mov ,value (make-ea-for-object-slot ,ptr ,slot ,lowtag)))
@@
-73,7
+73,7
@@
:disp (+ nil-value
(static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
:disp (+ nil-value
(static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
- (- other-pointer-type)))))
+ (- other-pointer-lowtag)))))
(defmacro store-symbol-value (reg symbol)
`(inst mov
(defmacro store-symbol-value (reg symbol)
`(inst mov
@@
-81,7
+81,7
@@
:disp (+ nil-value
(static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
:disp (+ nil-value
(static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
- (- other-pointer-type)))
+ (- other-pointer-lowtag)))
,reg))
,reg))
@@
-257,17
+257,17
@@
:foreign)))))))))
(values))
:foreign)))))))))
(values))
-(defmacro with-fixed-allocation ((result-tn type-code size &optional inline)
+;;; 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.
+(defmacro with-fixed-allocation ((result-tn widetag size &optional inline)
&rest forms)
&rest forms)
- #!+sb-doc
- "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."
`(pseudo-atomic
(allocation ,result-tn (pad-data-block ,size) ,inline)
`(pseudo-atomic
(allocation ,result-tn (pad-data-block ,size) ,inline)
- (storew (logior (ash (1- ,size) sb!vm:type-bits) ,type-code) ,result-tn)
+ (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag)
+ ,result-tn)
(inst lea ,result-tn
(inst lea ,result-tn
- (make-ea :byte :base ,result-tn :disp other-pointer-type))
+ (make-ea :byte :base ,result-tn :disp other-pointer-lowtag))
,@forms))
\f
;;;; error code
,@forms))
\f
;;;; error code
@@
-280,6
+280,7
@@
:element-type '(unsigned-byte 8)
:fill-pointer 0
:adjustable t))))
:element-type '(unsigned-byte 8)
:fill-pointer 0
:adjustable t))))
+ (declare (type (vector (unsigned-byte 8) 16) ,var))
(setf (fill-pointer ,var) 0)
(unwind-protect
(progn
(setf (fill-pointer ,var) 0)
(unwind-protect
(progn
@@
-386,13
+387,13
@@
(ash symbol-value-slot word-shift)
;; FIXME: Use mask, not minus, to
;; take out type bits.
(ash symbol-value-slot word-shift)
;; FIXME: Use mask, not minus, to
;; take out type bits.
- (- other-pointer-type)))
+ (- other-pointer-lowtag)))
0)
(inst mov (make-ea :byte :disp (+ nil-value
(static-symbol-offset
'*pseudo-atomic-atomic*)
(ash symbol-value-slot word-shift)
0)
(inst mov (make-ea :byte :disp (+ nil-value
(static-symbol-offset
'*pseudo-atomic-atomic*)
(ash symbol-value-slot word-shift)
- (- other-pointer-type)))
+ (- other-pointer-lowtag)))
(fixnumize 1)))
,@forms
(when *enable-pseudo-atomic*
(fixnumize 1)))
,@forms
(when *enable-pseudo-atomic*
@@
-400,7
+401,7
@@
(static-symbol-offset
'*pseudo-atomic-atomic*)
(ash symbol-value-slot word-shift)
(static-symbol-offset
'*pseudo-atomic-atomic*)
(ash symbol-value-slot word-shift)
- (- other-pointer-type)))
+ (- other-pointer-lowtag)))
0)
;; KLUDGE: Is there any requirement for interrupts to be
;; handled in order? It seems as though an interrupt coming
0)
;; KLUDGE: Is there any requirement for interrupts to be
;; handled in order? It seems as though an interrupt coming
@@
-413,7
+414,7
@@
(static-symbol-offset
'*pseudo-atomic-interrupted*)
(ash symbol-value-slot word-shift)
(static-symbol-offset
'*pseudo-atomic-interrupted*)
(ash symbol-value-slot word-shift)
- (- other-pointer-type)))
+ (- other-pointer-lowtag)))
0)
(inst jmp :eq ,label)
(inst break pending-interrupt-trap)
0)
(inst jmp :eq ,label)
(inst break pending-interrupt-trap)
@@
-434,7
+435,8
@@
(:result-types ,el-type)
(:generator 3 ; pw was 5
(inst mov value (make-ea :dword :base object :index index
(:result-types ,el-type)
(:generator 3 ; pw was 5
(inst mov value (make-ea :dword :base object :index index
- :disp (- (* ,offset word-bytes) ,lowtag)))))
+ :disp (- (* ,offset n-word-bytes)
+ ,lowtag)))))
(define-vop (,(symbolicate name "-C"))
,@(when translate
`((:translate ,translate)))
(define-vop (,(symbolicate name "-C"))
,@(when translate
`((:translate ,translate)))
@@
-446,7
+448,7
@@
(:result-types ,el-type)
(:generator 2 ; pw was 5
(inst mov value (make-ea :dword :base object
(:result-types ,el-type)
(:generator 2 ; pw was 5
(inst mov value (make-ea :dword :base object
- :disp (- (* (+ ,offset index) word-bytes)
+ :disp (- (* (+ ,offset index) n-word-bytes)
,lowtag)))))))
(defmacro define-full-setter (name type offset lowtag scs el-type &optional translate)
,lowtag)))))))
(defmacro define-full-setter (name type offset lowtag scs el-type &optional translate)
@@
-463,7
+465,7
@@
(:result-types ,el-type)
(:generator 4 ; was 5
(inst mov (make-ea :dword :base object :index index
(:result-types ,el-type)
(:generator 4 ; was 5
(inst mov (make-ea :dword :base object :index index
- :disp (- (* ,offset word-bytes) ,lowtag))
+ :disp (- (* ,offset n-word-bytes) ,lowtag))
value)
(move result value)))
(define-vop (,(symbolicate name "-C"))
value)
(move result value)))
(define-vop (,(symbolicate name "-C"))
@@
-478,7
+480,8
@@
(:result-types ,el-type)
(:generator 3 ; was 5
(inst mov (make-ea :dword :base object
(:result-types ,el-type)
(:generator 3 ; was 5
(inst mov (make-ea :dword :base object
- :disp (- (* (+ ,offset index) word-bytes) ,lowtag))
+ :disp (- (* (+ ,offset index) n-word-bytes)
+ ,lowtag))
value)
(move result value)))))
value)
(move result value)))))