X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=018b43cb435a03502feee73ec0437be034c224cc;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=9857d1543137040a6464468cf7b24fe0cbe1346f;hpb=c6538bf61955a67d0145aa3e6c937f6dd03f9e51;p=sbcl.git diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 9857d15..018b43c 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -20,10 +20,12 @@ (n-src src)) `(unless (location= ,n-dst ,n-src) (sc-case ,n-dst - (single-reg - (inst movss ,n-dst ,n-src)) - (double-reg - (inst movsd ,n-dst ,n-src)) + ((single-reg complex-single-reg) + (aver (xmm-register-p ,n-src)) + (inst movaps ,n-dst ,n-src)) + ((double-reg complex-double-reg) + (aver (xmm-register-p ,n-src)) + (inst movapd ,n-dst ,n-src)) (t (inst mov ,n-dst ,n-src)))))) @@ -138,30 +140,31 @@ ;;; node-var then it is used to make an appropriate speed vs size ;;; decision. -(defun allocation-dynamic-extent (alloc-tn size) +(defun allocation-dynamic-extent (alloc-tn size lowtag) (inst sub rsp-tn size) ;; see comment in x86/macros.lisp implementation of this (inst and rsp-tn #.(lognot lowtag-mask)) (aver (not (location= alloc-tn rsp-tn))) - (inst mov alloc-tn rsp-tn) + (inst lea alloc-tn (make-ea :byte :base rsp-tn :disp lowtag)) (values)) ;;; This macro should only be used inside a pseudo-atomic section, ;;; which should also cover subsequent initialization of the ;;; object. -(defun allocation-tramp (alloc-tn size &optional ignored) - (declare (ignore ignored)) +(defun allocation-tramp (alloc-tn size lowtag) (inst push size) (inst lea temp-reg-tn (make-ea :qword :disp (make-fixup "alloc_tramp" :foreign))) (inst call temp-reg-tn) (inst pop alloc-tn) + (when lowtag + (inst lea alloc-tn (make-ea :byte :base alloc-tn :disp lowtag))) (values)) -(defun allocation (alloc-tn size &optional ignored dynamic-extent) +(defun allocation (alloc-tn size &optional ignored dynamic-extent lowtag) (declare (ignore ignored)) (when dynamic-extent - (allocation-dynamic-extent alloc-tn size) + (allocation-dynamic-extent alloc-tn size lowtag) (return-from allocation (values))) (let ((NOT-INLINE (gen-label)) (DONE (gen-label)) @@ -188,7 +191,7 @@ :scale 1 :disp (make-fixup "boxed_region" :foreign 8)))) (cond (in-elsewhere - (allocation-tramp alloc-tn size)) + (allocation-tramp alloc-tn size lowtag)) (t (inst mov temp-reg-tn free-pointer) (if (tn-p size) @@ -201,17 +204,19 @@ (inst cmp end-addr alloc-tn) (inst jmp :be NOT-INLINE) (inst mov free-pointer alloc-tn) - (inst mov alloc-tn temp-reg-tn) + (if lowtag + (inst lea alloc-tn (make-ea :byte :base temp-reg-tn :disp lowtag)) + (inst mov alloc-tn temp-reg-tn)) (emit-label DONE) (assemble (*elsewhere*) (emit-label NOT-INLINE) (cond ((numberp size) - (allocation-tramp alloc-tn size)) + (allocation-tramp alloc-tn size lowtag)) (t (inst sub alloc-tn free-pointer) - (allocation-tramp alloc-tn alloc-tn))) - (inst jmp DONE)) - (values))))) + (allocation-tramp alloc-tn alloc-tn lowtag))) + (inst jmp DONE)))) + (values))) ;;; Allocate an other-pointer object of fixed SIZE with a single word ;;; header having the specified WIDETAG value. The result is placed in @@ -222,11 +227,10 @@ (bug "empty &body in WITH-FIXED-ALLOCATION")) (once-only ((result-tn result-tn) (size size) (stack-allocate-p stack-allocate-p)) `(maybe-pseudo-atomic ,stack-allocate-p - (allocation ,result-tn (pad-data-block ,size) ,inline ,stack-allocate-p) + (allocation ,result-tn (pad-data-block ,size) ,inline ,stack-allocate-p + other-pointer-lowtag) (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag) - ,result-tn) - (inst lea ,result-tn - (make-ea :qword :base ,result-tn :disp other-pointer-lowtag)) + ,result-tn 0 other-pointer-lowtag) ,@forms))) ;;;; error code @@ -292,48 +296,46 @@ (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) `(let ((,label (gen-label))) - (inst or (make-ea :byte - :base thread-base-tn - :disp (* 8 thread-pseudo-atomic-bits-slot)) - (fixnumize 1)) - ,@forms - (inst xor (make-ea :byte - :base thread-base-tn - :disp (* 8 thread-pseudo-atomic-bits-slot)) - (fixnumize 1)) - (inst jmp :z ,label) - ;; if PAI was set, interrupts were disabled at the same - ;; time using the process signal mask. - (inst break pending-interrupt-trap) - (emit-label ,label)))) + (inst mov (make-ea :qword + :base thread-base-tn + :disp (* 8 thread-pseudo-atomic-bits-slot)) + rbp-tn) + ,@forms + (inst xor (make-ea :qword + :base thread-base-tn + :disp (* 8 thread-pseudo-atomic-bits-slot)) + rbp-tn) + (inst jmp :z ,label) + ;; if PAI was set, interrupts were disabled at the same time + ;; using the process signal mask. + (inst break pending-interrupt-trap) + (emit-label ,label)))) #!-sb-thread (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) `(let ((,label (gen-label))) - ;; FIXME: The MAKE-EA noise should become a MACROLET macro or - ;; something. (perhaps SVLB, for static variable low byte) - (inst or (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-bits*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - (fixnumize 1)) - ,@forms - (inst xor (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-bits*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - (fixnumize 1)) - (inst jmp :z ,label) - ;; if PAI was set, interrupts were disabled at the same time - ;; using the process signal mask. - (inst break pending-interrupt-trap) - (emit-label ,label)))) - - + ;; FIXME: The MAKE-EA noise should become a MACROLET macro or + ;; something. (perhaps SVLB, for static variable low byte) + (inst mov (make-ea :qword :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-bits*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + rbp-tn) + ,@forms + (inst xor (make-ea :qword :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-bits*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + rbp-tn) + (inst jmp :z ,label) + ;; if PAI was set, interrupts were disabled at the same time + ;; using the process signal mask. + (inst break pending-interrupt-trap) + (emit-label ,label)))) ;;;; indexed references @@ -354,11 +356,9 @@ (:result-types ,el-type) (:generator 5 (move rax old-value) - #!+sb-thread - (inst lock) (inst cmpxchg (make-ea :qword :base object :index index :disp (- (* ,offset n-word-bytes) ,lowtag)) - new-value) + new-value :lock) (move value rax))))) (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate) @@ -523,6 +523,7 @@ collection." ;; BODY is stuffed in a function to preserve the lexical ;; environment. `(flet ((,wpo () (progn ,@body))) + (declare (muffle-conditions compiler-note)) ;; PINS are dx-allocated in case the compiler for some ;; unfathomable reason decides to allocate value-cells ;; for them -- since we have DX value-cells on x86oid