X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=801c905da76b1ec4ee29b82014f9c5dc01806e56;hb=a3caf3155958590af9614705770358c0c8bdd8a8;hp=33235125417615bd94a731cbadb1279a166541ce;hpb=1fc851cde8352f4f3c1062ee46593e66a6284c60;p=sbcl.git diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 3323512..801c905 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)))))) @@ -39,11 +41,8 @@ (once-only ((value value)) `(cond ((and (integerp ,value) (not (typep ,value '(signed-byte 32)))) - (multiple-value-bind (lo hi) (dwords-for-quad ,value) - (inst mov (make-ea-for-object-slot-half - ,ptr ,slot ,lowtag) lo) - (inst mov (make-ea-for-object-slot-half - ,ptr (+ ,slot 1/2) ,lowtag) hi))) + (inst mov temp-reg-tn ,value) + (inst mov (make-ea-for-object-slot ,ptr ,slot ,lowtag) temp-reg-tn)) (t (inst mov (make-ea-for-object-slot ,ptr ,slot ,lowtag) ,value))))) @@ -100,14 +99,14 @@ (defmacro load-binding-stack-pointer (reg) #!+sb-thread `(inst mov ,reg (make-ea :qword :base thread-base-tn - :disp (* 8 thread-binding-stack-pointer-slot))) + :disp (* n-word-bytes thread-binding-stack-pointer-slot))) #!-sb-thread `(load-symbol-value ,reg *binding-stack-pointer*)) (defmacro store-binding-stack-pointer (reg) #!+sb-thread `(inst mov (make-ea :qword :base thread-base-tn - :disp (* 8 thread-binding-stack-pointer-slot)) + :disp (* n-word-bytes thread-binding-stack-pointer-slot)) ,reg) #!-sb-thread `(store-symbol-value ,reg *binding-stack-pointer*)) @@ -234,7 +233,7 @@ ;;;; error code (defun emit-error-break (vop kind code values) (assemble () - #!-darwin + #!-ud2-breakpoints (inst int 3) ; i386 breakpoint instruction ;; On Darwin, we need to use #x0b0f instead of int3 in order ;; to generate a SIGILL instead of a SIGTRAP as darwin/x86 @@ -242,7 +241,7 @@ ;; handlers. Hopefully this will be fixed by Apple at a ;; later date. Do the same on x86-64 as we do on x86 until this gets ;; sorted out. - #!+darwin + #!+ud2-breakpoints (inst word #x0b0f) ;; The return PC points here; note the location for the debugger. (when vop @@ -290,52 +289,58 @@ (progn ,@body) (pseudo-atomic ,@body))) +;;; Unsafely clear pa flags so that the image can properly lose in a +;;; pa section. +#!+sb-thread +(defmacro %clear-pseudo-atomic () + '(inst mov (make-ea :qword :base thread-base-tn + :disp (* n-word-bytes thread-pseudo-atomic-bits-slot)) + 0)) + #!+sb-thread (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 (* n-word-bytes thread-pseudo-atomic-bits-slot)) + rbp-tn) + ,@forms + (inst xor (make-ea :qword + :base thread-base-tn + :disp (* n-word-bytes 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 @@ -356,11 +361,10 @@ (:result-types ,el-type) (:generator 5 (move rax old-value) - #!+sb-thread - (inst lock) (inst cmpxchg (make-ea :qword :base object :index index + :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :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) @@ -376,6 +380,7 @@ (:result-types ,el-type) (:generator 3 ; pw was 5 (inst mov value (make-ea :qword :base object :index index + :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :disp (- (* ,offset n-word-bytes) ,lowtag))))) (define-vop (,(symbolicate name "-C")) @@ -410,6 +415,7 @@ (:result-types ,el-type) (:generator 3 ; pw was 5 (inst mov value (make-ea :qword :base object :index index + :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :disp (- (* (+ ,offset offset) n-word-bytes) ,lowtag))))) (define-vop (,(symbolicate name "-C")) @@ -444,6 +450,7 @@ (:result-types ,el-type) (:generator 4 ; was 5 (inst mov (make-ea :qword :base object :index index + :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :disp (- (* ,offset n-word-bytes) ,lowtag)) value) (move result value))) @@ -486,6 +493,7 @@ (:result-types ,el-type) (:generator 4 ; was 5 (inst mov (make-ea :qword :base object :index index + :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :disp (- (* (+ ,offset offset) n-word-bytes) ,lowtag)) value) (move result value))) @@ -521,10 +529,11 @@ Useful for e.g. foreign calls where another thread may trigger collection." (if objects (let ((pins (make-gensym-list (length objects))) - (wpo (block-gensym "WPO"))) + (wpo (gensym "WITH-PINNED-OBJECTS-THUNK"))) ;; 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