X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=af0366328fe3c3beac5298295951b8cab135e723;hb=e049902f5e7c30501d2dbb7a41d058a0c717fc1f;hp=b82ca88006f525d3a05de4f6c33e67ec04030aaa;hpb=aa2dc9529460ea0d9c99998dc87283fc1a43e808;p=sbcl.git

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index b82ca88..af03663 100644
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -11,12 +11,12 @@
 
 (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))
@@ -47,7 +47,7 @@
        (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)))
@@ -73,7 +73,7 @@
 		  :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
@@ -81,7 +81,7 @@
 		  :disp (+ nil-value
 			   (static-symbol-offset ',symbol)
 			   (ash symbol-value-slot word-shift)
-			   (- other-pointer-type)))
+			   (- other-pointer-lowtag)))
 	 ,reg))
 
 
@@ -257,35 +257,20 @@
 				       :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)
-  #!+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)
-    (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
-     (make-ea :byte :base ,result-tn :disp other-pointer-type))
+     (make-ea :byte :base ,result-tn :disp other-pointer-lowtag))
     ,@forms))
 
 ;;;; error code
-
-(defvar *adjustable-vectors* nil)
-
-(defmacro with-adjustable-vector ((var) &rest body)
-  `(let ((,var (or (pop *adjustable-vectors*)
-		   (make-array 16
-			       :element-type '(unsigned-byte 8)
-			       :fill-pointer 0
-			       :adjustable t))))
-     (setf (fill-pointer ,var) 0)
-     (unwind-protect
-	 (progn
-	   ,@body)
-       (push ,var *adjustable-vectors*))))
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun emit-error-break (vop kind code values)
     (let ((vector (gensym)))
@@ -386,13 +371,13 @@
 					   (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)
-					   (- other-pointer-type)))
+					   (- other-pointer-lowtag)))
 	       (fixnumize 1)))
        ,@forms
        (when *enable-pseudo-atomic*
@@ -400,7 +385,7 @@
 					   (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
@@ -413,7 +398,7 @@
 				     (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)
@@ -434,7 +419,8 @@
        (: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)))
@@ -446,7 +432,7 @@
        (: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)
@@ -463,7 +449,7 @@
        (: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"))
@@ -478,7 +464,8 @@
        (: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)))))