X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=50c4322576ec430f67b2567bcb0e48e8b4a1959b;hb=bc46c8bcdd6ac8918df8ea9e9db49808e4924fcf;hp=39d1f1639142d1ebc823f8d0c699aa800eb308bd;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 39d1f16..50c4322 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -11,15 +11,12 @@ (in-package "SB!VM") -(file-comment - "$Header$") +;;; 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)) @@ -50,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))) @@ -68,23 +65,23 @@ ;;;; macros to generate useful values (defmacro load-symbol (reg symbol) - `(inst mov ,reg (+ *nil-value* (static-symbol-offset ,symbol)))) + `(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol)))) (defmacro load-symbol-value (reg symbol) `(inst mov ,reg (make-ea :dword - :disp (+ *nil-value* + :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 (make-ea :dword - :disp (+ *nil-value* + :disp (+ nil-value (static-symbol-offset ',symbol) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) ,reg)) @@ -125,9 +122,12 @@ ;;; on DYNAMIC-EXTENT would probably give a better payoff.) (defvar *maybe-use-inline-allocation* t) -;;; Call into C. +;;; Emit code to allocate an object with a size in bytes given by +;;; Size. The size may be an integer of a TN. If Inline is a VOP +;;; node-var then it is used to make an appropriate speed vs size +;;; decision. ;;; -;;; FIXME: Except when inline allocation is enabled..? +;;; FIXME: We call into C.. except when inline allocation is enabled..? ;;; ;;; FIXME: Also, calls to ;;; ALLOCATION are always wrapped with PSEUDO-ATOMIC -- why? Is it to @@ -141,11 +141,6 @@ ;;; formalized, in documentation and in macro definition, ;;; with the macro becoming e.g. PSEUDO-ATOMIC-ALLOCATION. (defun allocation (alloc-tn size &optional inline) - #!+sb-doc - "Emit code to allocate an object with a size in bytes given by Size. - The size may be an integer of a TN. - If Inline is a VOP node-var then it is used to make an appropriate - speed vs size decision." (flet ((load-size (dst-tn size) (unless (and (tn-p size) (location= alloc-tn size)) (inst mov dst-tn size)))) @@ -262,19 +257,18 @@ :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 @@ -373,9 +367,6 @@ ;;; something to compile with :SB-NO-PSEUDO-ATOMIC. (defvar *enable-pseudo-atomic* t) -;;; FIXME: *PSEUDO-ATOMIC-ATOMIC* and *PSEUDO-ATOMIC-INTERRUPTED* -;;; should be in package SB!VM or SB!KERNEL, not SB!IMPL. - ;;; FIXME: *PSEUDO-ATOMIC-FOO* could be made into *PSEUDO-ATOMIC-BITS*, ;;; set with a single operation and cleared with SHR *PSEUDO-ATOMIC-BITS*,-2; ;;; the ATOMIC bit is bit 0, the INTERRUPTED bit is bit 1, and you check @@ -389,27 +380,27 @@ (when *enable-pseudo-atomic* ;; FIXME: The MAKE-EA noise should become a MACROLET macro or ;; something. (perhaps SVLB, for static variable low byte) - (inst mov (make-ea :byte :disp (+ *nil-value* + (inst mov (make-ea :byte :disp (+ nil-value (static-symbol-offset - 'sb!impl::*pseudo-atomic-interrupted*) + '*pseudo-atomic-interrupted*) (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* + (inst mov (make-ea :byte :disp (+ nil-value (static-symbol-offset - 'sb!impl::*pseudo-atomic-atomic*) + '*pseudo-atomic-atomic*) (ash symbol-value-slot word-shift) - (- other-pointer-type))) + (- other-pointer-lowtag))) (fixnumize 1))) ,@forms (when *enable-pseudo-atomic* - (inst mov (make-ea :byte :disp (+ *nil-value* + (inst mov (make-ea :byte :disp (+ nil-value (static-symbol-offset - 'sb!impl::*pseudo-atomic-atomic*) + '*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 @@ -418,11 +409,11 @@ ;; are pending? I wish I could find the documentation for ;; pseudo-atomics.. -- WHN 19991130 (inst cmp (make-ea :byte - :disp (+ *nil-value* + :disp (+ nil-value (static-symbol-offset - 'sb!impl::*pseudo-atomic-interrupted*) + '*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) @@ -443,7 +434,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))) @@ -455,7 +447,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) @@ -472,7 +464,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")) @@ -487,7 +479,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)))))