Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs1:/tmp/cvs-serv31970/src/compiler/x86
Modified Files:
Tag: dan_native_threads_branch
cell.lisp macros.lisp
Log Message:
0.7.9.54.thread.14
Some more allocator cleanup -
... it's now officially a requirement that allocations are done
inside pseudo-atomic, so replace half of alloc() with an assertion
... the interrupt_handle_pending mechanism already copes quite nicely
with scheduling a GC for nearest convenient safe time, so we may
as well use it instead of trying to stand on our hands in the middle
of allocating. replace half of the remaining alloc() with two
lines to set maybe_gc_pending and *p-a-i*
Rewrite allocate macro to use thread-local defns of *p-a-a* and
*p-a-i* (note that this is done in bletcherous fashion and needs
sorting out again later)
Some locking functions for mutex and rwlocks, and cmpxchg VOP
borrowed from CMUCL. These all untested yet due to wish to get
gc changes committed
Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/cell.lisp,v
retrieving revision 1.10.4.4
retrieving revision 1.10.4.5
diff -u -d -r1.10.4.4 -r1.10.4.5
--- cell.lisp 3 Dec 2002 22:55:22 -0000 1.10.4.4
+++ cell.lisp 21 Dec 2002 00:11:09 -0000 1.10.4.5
@@ -374,6 +374,32 @@
(define-full-setter instance-index-set * instance-slots-offset
instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set)
+
+
+(defknown %instance-set-conditional (instance index t t) t
+ (unsafe))
+
+(define-vop (instance-set-conditional)
+ (:translate %instance-set-conditional)
+ (:args (object :scs (descriptor-reg) :to :eval)
+ (slot :scs (any-reg) :to :result)
+ (old-value :scs (descriptor-reg any-reg) :target eax)
+ (new-value :scs (descriptor-reg any-reg)))
+ (:arg-types instance positive-fixnum * *)
+ (:temporary (:sc descriptor-reg :offset eax-offset
+ :from (:argument 2) :to :result :target result) eax)
+ (:results (result :scs (descriptor-reg any-reg)))
+ ;(:guard (backend-featurep :i486))
+ (:policy :fast-safe)
+ (:generator 5
+ (move eax old-value)
+ (inst cmpxchg (make-ea :dword :base object :index slot :scale 1
+ :disp (- (* instance-slots-offset n-word-bytes)
+ instance-pointer-lowtag))
+ new-value)
+ (move result eax)))
+
+
;;;; code object frobbing
Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v
retrieving revision 1.10.2.3
retrieving revision 1.10.2.4
diff -u -d -r1.10.2.3 -r1.10.2.4
--- macros.lisp 5 Dec 2002 01:38:54 -0000 1.10.2.3
+++ macros.lisp 21 Dec 2002 00:11:09 -0000 1.10.2.4
@@ -320,13 +320,6 @@
;;;; PSEUDO-ATOMIC
-;;; FIXME: This should be a compile-time option, not a runtime option. Doing it
-;;; at runtime is bizarre. As I understand it, the default should definitely be
-;;; to have pseudo-atomic behavior, but for a performance-critical program
-;;; which is guaranteed not to have asynchronous exceptions, it could be worth
-;;; something to compile with :SB-NO-PSEUDO-ATOMIC.
-(defvar *enable-pseudo-atomic* t)
-
;;; 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
@@ -337,47 +330,22 @@
(defmacro pseudo-atomic (&rest forms)
(let ((label (gensym "LABEL-")))
`(let ((,label (gen-label)))
- (when *enable-pseudo-atomic*
- ;; 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
- (when *enable-pseudo-atomic*
- (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)
- (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 gs-segment-prefix)
+ (inst mov (make-ea :byte :disp (* 4 23)) 1) ;FIXME EVIL HARDCODED NUMBER
+ (inst gs-segment-prefix)
+ (inst mov (make-ea :byte :disp (* 4 24)) 0) ;(23 and 24 are the slot offsets
+ ,@forms ;for *p-a-a* and *p-a-i* in struct thread)
+ (inst gs-segment-prefix)
+ (inst mov (make-ea :byte :disp (* 4 23)) 0)
+ (inst gs-segment-prefix)
+ (inst cmp (make-ea :byte :disp (* 4 24)) 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
|