X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=d252203ec732bb23c118eb9025767b45dd2b4bb6;hb=3b3086ad5ad36a66302e1e6c5b7c8246c7963462;hp=028d6b71f7c4d0271c2a11d23721526e5c17e233;hpb=0f534f7e3e8298e8acdd2abb8316e50bcfbc1603;p=sbcl.git diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 028d6b7..d252203 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -174,10 +174,9 @@ (unless (or (eql size 8) (eql size 16)) (unless (and (tn-p size) (location= alloc-tn size)) (inst mov alloc-tn size))) - (inst call (make-fixup (extern-alien-name - (concatenate 'string + (inst call (make-fixup (concatenate 'string "alloc_" size-text - "to_" tn-text)) + "to_" tn-text) :foreign)))) (defun allocation-inline (alloc-tn size) @@ -185,14 +184,12 @@ (free-pointer (make-ea :dword :disp #!+sb-thread (* n-word-bytes thread-alloc-region-slot) - #!-sb-thread (make-fixup (extern-alien-name "boxed_region") - :foreign) + #!-sb-thread (make-fixup "boxed_region" :foreign) :scale 1)) ; thread->alloc_region.free_pointer (end-addr (make-ea :dword :disp #!+sb-thread (* n-word-bytes (1+ thread-alloc-region-slot)) - #!-sb-thread (make-fixup (extern-alien-name "boxed_region") - :foreign 4) + #!-sb-thread (make-fixup "boxed_region" :foreign 4) :scale 1))) ; thread->alloc_region.end_addr (unless (and (tn-p size) (location= alloc-tn size)) (inst mov alloc-tn size)) @@ -208,7 +205,7 @@ (#.ebx-offset "alloc_overflow_ebx") (#.esi-offset "alloc_overflow_esi") (#.edi-offset "alloc_overflow_edi")))) - (inst call (make-fixup (extern-alien-name dst) :foreign))) + (inst call (make-fixup dst :foreign))) (emit-label ok) #!+sb-thread (inst fs-segment-prefix) (inst xchg free-pointer alloc-tn)) @@ -313,79 +310,78 @@ ;;; does not matter whether a signal occurs during construction of a ;;; dynamic-extent object, as the half-finished construction of the ;;; object will not cause any difficulty. We can therefore elide -(defvar *dynamic-extent* nil) +(defmacro maybe-pseudo-atomic (really-p &body forms) + `(if ,really-p + (progn ,@forms) + (pseudo-atomic ,@forms))) #!+sb-thread (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) - `(if *dynamic-extent* ; I will burn in hell - (progn ,@forms) - (let ((,label (gen-label))) - (inst fs-segment-prefix) - (inst mov (make-ea :byte - :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) - (inst fs-segment-prefix) - (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1) - ,@forms - (inst fs-segment-prefix) - (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0) - (inst fs-segment-prefix) - (inst cmp (make-ea :byte - :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) - (inst jmp :eq ,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))))) + `(let ((,label (gen-label))) + (inst fs-segment-prefix) + (inst mov (make-ea :byte + :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) + (inst fs-segment-prefix) + (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1) + ,@forms + (inst fs-segment-prefix) + (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0) + (inst fs-segment-prefix) + (inst cmp (make-ea :byte + :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) + (inst jmp :eq ,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) - `(if *dynamic-extent* - (progn ,@forms) - (let ((,label (gen-label))) - ;; 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 - (static-symbol-offset - '*pseudo-atomic-interrupted*) - (ash symbol-value-slot word-shift) - ;; FIXME: Use mask, not minus, to - ;; take out type bits. - (- other-pointer-lowtag))) - 0) - (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-atomic*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - (fixnumize 1)) - ,@forms - (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-atomic*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - 0) - ;; KLUDGE: Is there any requirement for interrupts to be - ;; handled in order? It seems as though an interrupt coming - ;; in at this point will be executed before any pending - ;; interrupts. Or do incoming interrupts check to see - ;; whether any interrupts are pending? I wish I could find - ;; the documentation for pseudo-atomics.. -- WHN 19991130 - (inst cmp (make-ea :byte - :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-interrupted*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - 0) - (inst jmp :eq ,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))))) + `(let ((,label (gen-label))) + ;; 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 + (static-symbol-offset + '*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + ;; FIXME: Use mask, not minus, to + ;; take out type bits. + (- other-pointer-lowtag))) + 0) + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + (fixnumize 1)) + ,@forms + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + 0) + ;; KLUDGE: Is there any requirement for interrupts to be + ;; handled in order? It seems as though an interrupt coming + ;; in at this point will be executed before any pending + ;; interrupts. Or do incoming interrupts check to see + ;; whether any interrupts are pending? I wish I could find + ;; the documentation for pseudo-atomics.. -- WHN 19991130 + (inst cmp (make-ea :byte + :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + 0) + (inst jmp :eq ,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