X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=32b3923b908cc517547b26fe7242ff129f6ff6e9;hb=0e7a9105ae992fc4befa37846c42f298e12918c0;hp=d8026c5ff8a1baf9acccbced7ef6305258d0e97a;hpb=6fa968aaa8051da23cc3153a1c0e67addbea85f6;p=sbcl.git diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index d8026c5..32b3923 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -125,7 +125,8 @@ (make-ea :byte :base ,n-source :disp ,n-offset))) (:big-endian `(inst mov ,n-target - (make-ea :byte :base ,n-source :disp (+ ,n-offset 4))))))) + (make-ea :byte :base ,n-source + :disp (+ ,n-offset (1- n-word-bytes)))))))) ;;;; allocation helpers @@ -175,7 +176,7 @@ #!-sb-thread (make-ea :qword :scale 1 :disp - (make-fixup (extern-alien-name "boxed_region") :foreign))) + (make-fixup "boxed_region" :foreign))) ;; thread->alloc_region.end_addr (end-addr #!+sb-thread @@ -185,7 +186,7 @@ #!-sb-thread (make-ea :qword :scale 1 :disp - (make-fixup (extern-alien-name "boxed_region") :foreign 8)))) + (make-fixup "boxed_region" :foreign 8)))) (cond (in-elsewhere (allocation-tramp alloc-tn size)) (t @@ -225,13 +226,13 @@ ;;; 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) +(defmacro with-fixed-allocation ((result-tn widetag size &optional inline stack-allocate-p) &body forms) (unless forms (bug "empty &body in WITH-FIXED-ALLOCATION")) - (once-only ((result-tn result-tn) (size size)) - `(pseudo-atomic - (allocation ,result-tn (pad-data-block ,size) ,inline) + (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) (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag) ,result-tn) (inst lea ,result-tn @@ -242,7 +243,16 @@ (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) - `((inst int 3) ; i386 breakpoint instruction + `((progn + #!-darwin (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 + ;; doesn't seem to be reliably firing SIGTRAP + ;; 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 (inst word #x0b0f)) + ;; The return PC points here; note the location for the debugger. (let ((vop ,vop)) (when vop @@ -345,6 +355,30 @@ ;;;; indexed references +(defmacro define-full-compare-and-swap + (name type offset lowtag scs el-type &optional translate) + `(progn + (define-vop (,name) + ,@(when translate `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg) :to :eval) + (index :scs (any-reg) :to :result) + (old-value :scs ,scs :target rax) + (new-value :scs ,scs)) + (:arg-types ,type tagged-num ,el-type ,el-type) + (:temporary (:sc descriptor-reg :offset rax-offset + :from (:argument 2) :to :result :target value) rax) + (:results (value :scs ,scs)) + (: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) + (move value rax))))) + (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate) `(progn (define-vop (,name) @@ -376,6 +410,42 @@ :disp (- (* (+ ,offset index) n-word-bytes) ,lowtag))))))) +(defmacro define-full-reffer+offset (name type offset lowtag scs el-type &optional translate) + `(progn + (define-vop (,name) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:info offset) + (:arg-types ,type tagged-num + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,el-type) + (:generator 3 ; pw was 5 + (inst mov value (make-ea :qword :base object :index index + :disp (- (* (+ ,offset offset) n-word-bytes) + ,lowtag))))) + (define-vop (,(symbolicate name "-C")) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:info index offset) + (:arg-types ,type + (:constant (load/store-index ,n-word-bytes ,(eval lowtag) + ,(eval offset))) + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,el-type) + (:generator 2 ; pw was 5 + (inst mov value (make-ea :qword :base object + :disp (- (* (+ ,offset index offset) n-word-bytes) + ,lowtag))))))) + (defmacro define-full-setter (name type offset lowtag scs el-type &optional translate) `(progn (define-vop (,name) @@ -413,6 +483,51 @@ value) (move result value))))) +(defmacro define-full-setter+offset (name type offset lowtag scs el-type &optional translate) + `(progn + (define-vop (,name) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs ,scs :target result)) + (:info offset) + (:arg-types ,type tagged-num + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes + vector-data-offset)) + ,el-type) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 4 ; was 5 + (inst mov (make-ea :qword :base object :index index + :disp (- (* (+ ,offset offset) n-word-bytes) ,lowtag)) + value) + (move result value))) + (define-vop (,(symbolicate name "-C")) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs ,scs :target result)) + (:info index offset) + (:arg-types ,type + (:constant (load/store-index ,n-word-bytes ,(eval lowtag) + ,(eval offset))) + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes + vector-data-offset)) + ,el-type) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 3 ; was 5 + (inst mov (make-ea :qword :base object + :disp (- (* (+ ,offset index offset) n-word-bytes) + ,lowtag)) + value) + (move result value))))) + ;;; helper for alien stuff. (def!macro with-pinned-objects ((&rest objects) &body body) "Arrange with the garbage collector that the pages occupied by