X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=28a35ea9a605b91d69352c5e3f5a7299d906c7b7;hb=7646aefa188758e2892fea2ad02be4f29b3938f2;hp=1af259d902d763d8e06fa6bed0c4cd7ea2b1c8b9;hpb=670010e3f3dcd62efaf23f61abdc73950edb88c6;p=sbcl.git diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 1af259d..28a35ea 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -111,6 +111,7 @@ (inst mov (make-ea :dword :scale 1 :index ,temp) ,reg))) #!-sb-thread (defmacro store-tl-symbol-value (reg symbol temp) + (declare (ignore temp)) `(store-symbol-value ,reg ,symbol)) (defmacro load-type (target source &optional (offset 0)) @@ -130,45 +131,41 @@ ;;;; allocation helpers -;;; Two allocation approaches are implemented. A call into C can be -;;; used, and in that case special care can be taken to disable -;;; interrupts. Alternatively with gencgc inline allocation is possible -;;; although it isn't interrupt safe. +;;; All allocation is done by calls to assembler routines that +;;; eventually invoke the C alloc() function. Once upon a time +;;; (before threads) allocation within an alloc_region could also be +;;; done inline, with the aid of two C symbols storing the current +;;; allocation region boundaries; however, C cymbols are global. -;;; For GENCGC it is possible to inline object allocation, to permit -;;; this set the following variable to True. -;;; -;;; FIXME: The comment above says that this isn't interrupt safe. Is that -;;; right? If so, do we want to do this? And surely we don't want to do this by -;;; default? How much time does it save to do this? Is it any different in the -;;; current CMU CL version instead of the one that I grabbed in 1998? -;;; (Later observation: In order to be interrupt safe, it'd probably -;;; have to use PSEUDO-ATOMIC, so it's probably not -- yuck. Try benchmarks -;;; with and without inline allocation, and unless the inline allocation -;;; wins by a whole lot, it's not likely to be worth messing with. If -;;; we want to hack up memory allocation for performance, effort spent -;;; on DYNAMIC-EXTENT would probably give a better payoff.) -(defvar *maybe-use-inline-allocation* t) +;;; C calls for allocation don't /seem/ to make an awful lot of +;;; difference to speed. Guessing from historical context, it looks +;;; like inline allocation was introduced before pseudo-atomic, at +;;; which time all calls to alloc() would have needed a syscall to +;;; mask signals for the duration. Now we have pseudoatomic there's +;;; no need for that overhead. Still, inline alloc would be a neat +;;; addition someday + +(defvar *maybe-use-inline-allocation* t) ; FIXME unused ;;; Emit code to allocate an object with a size in bytes given by -;;; Size. The size may be an integer of a TN. If Inline is a VOP +;;; SIZE. The size may be an integer of a TN. If Inline is a VOP ;;; node-var then it is used to make an appropriate speed vs size ;;; decision. -;;; -;;; FIXME: We call into C.. except when inline allocation is enabled..? -;;; -;;; FIXME: Also, calls to -;;; ALLOCATION are always wrapped with PSEUDO-ATOMIC -- why? Is it to -;;; make sure that no GC happens between the time of allocation and the -;;; time that the allocated memory has its tag bits set correctly? -;;; If so, then ALLOCATION itself might as well set the PSEUDO-ATOMIC -;;; bits, so that the caller need only clear them. Check whether it's -;;; true that every ALLOCATION is surrounded by PSEUDO-ATOMIC, and -;;; that every PSEUDO-ATOMIC contains a single ALLOCATION, which is -;;; its first instruction. If so, the connection should probably be -;;; formalized, in documentation and in macro definition, -;;; with the macro becoming e.g. PSEUDO-ATOMIC-ALLOCATION. -(defun allocation (alloc-tn size &optional inline) + +(defun allocation-dynamic-extent (alloc-tn size) + (inst sub esp-tn size) + ;; FIXME: SIZE _should_ be double-word aligned (suggested but + ;; unfortunately not enforced by PAD-DATA-BLOCK and + ;; WITH-FIXED-ALLOCATION), so that ESP is always divisible by 8 (for + ;; 32-bit lispobjs). In that case, this AND instruction is + ;; unneccessary and could be removed. If not, explain why. -- CSR, + ;; 2004-03-30 + (inst and esp-tn #.(ldb (byte 32 0) (lognot lowtag-mask))) + (aver (not (location= alloc-tn esp-tn))) + (inst mov alloc-tn esp-tn) + (values)) + +(defun allocation-notinline (alloc-tn size) (flet ((load-size (dst-tn size) (unless (and (tn-p size) (location= alloc-tn size)) (inst mov dst-tn size)))) @@ -236,7 +233,18 @@ (t (load-size edi-tn size) (inst call (make-fixup (extern-alien-name "alloc_to_edi") - :foreign)))))))) + :foreign))))))))) + +;;; This macro should only be used inside a pseudo-atomic section, +;;; which should also cover subsequent initialization of the object. +;;; (FIXME: so why aren't we asserting this?) +(defun allocation (alloc-tn size &optional inline dynamic-extent) + ;; FIXME: since it appears that inline allocation is gone, we should + ;; remove the INLINE parameter and *MAYBE-USE-INLINE-ALLOCATION* + (declare (ignore inline)) + (cond + (dynamic-extent (allocation-dynamic-extent alloc-tn size)) + (t (allocation-notinline alloc-tn size))) (values)) ;;; Allocate an other-pointer object of fixed SIZE with a single word @@ -253,7 +261,7 @@ ,@forms)) ;;;; error code -(eval-when (:compile-toplevel :load-toplevel :execute) +(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 @@ -298,81 +306,94 @@ ;;;; PSEUDO-ATOMIC +;;; This is used to wrap operations which leave untagged memory lying +;;; around. It's an operation which the AOP weenies would describe as +;;; having "cross-cutting concerns", meaning it appears all over the +;;; place and there's no logical single place to attach documentation. +;;; grep (mostly in src/runtime) is your friend + ;;; FIXME: *PSEUDO-ATOMIC-FOO* could be made into *PSEUDO-ATOMIC-BITS*, ;;; set with a single operation and cleared with SHR *PSEUDO-ATOMIC-BITS*,-2; ;;; the ATOMIC bit is bit 0, the INTERRUPTED bit is bit 1, and you check ;;; the C flag after the shift to see whether you were interrupted. +;;; +;;; KLUDGE: since the stack on the x86 is treated conservatively, it +;;; 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) -;;; FIXME: It appears that PSEUDO-ATOMIC is used to wrap operations which leave -;;; untagged memory lying around, but some documentation would be nice. #!+sb-thread (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) - `(let ((,label (gen-label))) - (inst fs-segment-prefix) - (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1) - (inst fs-segment-prefix) - (inst mov (make-ea :byte - :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) - ,@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)))) + `(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))))) #!-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 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)))) - - + `(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))))) ;;;; indexed references @@ -439,3 +460,21 @@ value) (move result value))))) +;;; helper for alien stuff. +(defmacro with-pinned-objects ((&rest objects) &body body) + "Arrange with the garbage collector that the pages occupied by +OBJECTS will not be moved in memory for the duration of BODY. +Useful for e.g. foreign calls where another thread may trigger +garbage collection" + `(multiple-value-prog1 + (progn + ,@(loop for p in objects + collect `(push-word-on-c-stack + (int-sap (sb!kernel:get-lisp-obj-address ,p)))) + ,@body) + ;; If the body returned normally, we should restore the stack pointer + ;; for the benefit of any following code in the same function. If + ;; there's a non-local exit in the body, sp is garbage anyway and + ;; will get set appropriately from {a, the} frame pointer before it's + ;; next needed + (pop-words-from-c-stack ,(length objects))))