X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=781a270d1bcf1acff64802186813a6ad21810350;hb=b83353d9f998e5c0e34604b5593df70c66d2c510;hp=b7b0aa92b44c8ecce8774b179407b9ecdf245b24;hpb=48fb9976298ca77d4a7e4ec4d8427f041d2bf327;p=sbcl.git diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index b7b0aa9..781a270 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -1,4 +1,4 @@ -;;;; a bunch of handy macros for the x86 +;;;; a bunch of handy macros for x86-64 ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -13,21 +13,31 @@ ;;;; instruction-like macros -(defmacro move (dst src) +;;; This used to be a macro (and still is on the other platforms) but +;;; the support for SC-dependent move instructions needed here makes +;;; that expand into so large an expression that the resulting code +;;; bloat is not justifiable. +(defun move (dst src) #!+sb-doc "Move SRC into DST unless they are location=." - (once-only ((n-dst dst) - (n-src src)) - `(unless (location= ,n-dst ,n-src) - (sc-case ,n-dst - ((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)))))) + (unless (location= dst src) + (sc-case dst + ((single-reg complex-single-reg) + (aver (xmm-register-p src)) + (inst movaps dst src)) + ((double-reg complex-double-reg) + (aver (xmm-register-p src)) + (inst movapd dst src)) + #!+sb-simd-pack + ((int-sse-reg sse-reg) + (aver (xmm-register-p src)) + (inst movdqa dst src)) + #!+sb-simd-pack + ((single-sse-reg double-sse-reg) + (aver (xmm-register-p src)) + (inst movaps dst src)) + (t + (inst mov dst src))))) (defmacro make-ea-for-object-slot (ptr slot lowtag) `(make-ea :qword :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag))) @@ -51,6 +61,14 @@ (defmacro popw (ptr &optional (slot 0) (lowtag 0)) `(inst pop (make-ea-for-object-slot ,ptr ,slot ,lowtag))) + +(defun call-indirect (offset) + (typecase offset + ((signed-byte 32) + (inst call (make-ea :qword :disp offset))) + (t + (inst mov temp-reg-tn offset) + (inst call (make-ea :qword :base temp-reg-tn))))) ;;;; macros to generate useful values @@ -99,14 +117,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*)) @@ -120,10 +138,10 @@ (n-offset offset)) (ecase *backend-byte-order* (:little-endian - `(inst mov ,n-target + `(inst movzx ,n-target (make-ea :byte :base ,n-source :disp ,n-offset))) (:big-endian - `(inst mov ,n-target + `(inst movzx ,n-target (make-ea :byte :base ,n-source :disp (+ ,n-offset (1- n-word-bytes)))))))) @@ -150,9 +168,8 @@ ;;; object. (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 mov alloc-tn (make-fixup "alloc_tramp" :foreign)) + (inst call alloc-tn) (inst pop alloc-tn) (when lowtag (inst lea alloc-tn (make-ea :byte :base alloc-tn :disp lowtag))) @@ -294,27 +311,40 @@ #!+sb-thread (defmacro %clear-pseudo-atomic () '(inst mov (make-ea :qword :base thread-base-tn - :disp (* 8 thread-pseudo-atomic-bits-slot)) + :disp (* n-word-bytes thread-pseudo-atomic-bits-slot)) 0)) +#!+sb-safepoint +(defun emit-safepoint () + (inst test al-tn (make-ea :byte :disp sb!vm::gc-safepoint-page-addr))) + #!+sb-thread (defmacro pseudo-atomic (&rest forms) + #!+sb-safepoint-strictly + `(progn ,@forms (emit-safepoint)) + #!-sb-safepoint-strictly (with-unique-names (label) `(let ((,label (gen-label))) (inst mov (make-ea :qword :base thread-base-tn - :disp (* 8 thread-pseudo-atomic-bits-slot)) + :disp (* n-word-bytes thread-pseudo-atomic-bits-slot)) rbp-tn) ,@forms (inst xor (make-ea :qword :base thread-base-tn - :disp (* 8 thread-pseudo-atomic-bits-slot)) + :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)))) + (emit-label ,label) + #!+sb-safepoint + ;; In this case, when allocation thinks a GC should be done, it + ;; does not mark PA as interrupted, but schedules a safepoint + ;; trap instead. Let's take the opportunity to trigger that + ;; safepoint right now. + (emit-safepoint)))) #!-sb-thread @@ -362,6 +392,7 @@ (:generator 5 (move rax old-value) (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 :lock) (move value rax))))) @@ -379,6 +410,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")) @@ -413,6 +445,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")) @@ -447,6 +480,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))) @@ -489,6 +523,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))) @@ -524,7 +559,7 @@ 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 (sb!xc:gensym "WITH-PINNED-OBJECTS-THUNK"))) ;; BODY is stuffed in a function to preserve the lexical ;; environment. `(flet ((,wpo () (progn ,@body)))