0.9.6.42:

  * clear the interrupted flag in interrupt_handle_pending (one less
    MOV in PSEUDO-ATOMIC) on x86/x86-64
  * fixed compilation error with QSHOW in gencgc.c

diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index 002f7de..ef889ec 100644 (file)
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -286,9 +286,6 @@
     `(let ((,label (gen-label)))
       (inst mov (make-ea :byte
                  :base thread-base-tn
-                 :disp (* 8 thread-pseudo-atomic-interrupted-slot)) 0)
-      (inst mov (make-ea :byte
-                 :base thread-base-tn
                  :disp (* 8 thread-pseudo-atomic-atomic-slot))
             (fixnumize 1))
       ,@forms
@@ -313,14 +310,6 @@
       ;; 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)))
@@ -332,12 +321,6 @@
                                         (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

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index 0b8f234..6acfca8 100644 (file)
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -324,9 +324,6 @@
   (with-unique-names (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))
             (fixnumize 1))
        ,@forms
@@ -350,14 +347,6 @@
        ;; 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)))
@@ -369,12 +358,6 @@
                                          (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

diff --git a/src/runtime/arch.h b/src/runtime/arch.h
index b529137..147bd0f 100644 (file)
--- a/src/runtime/arch.h
+++ b/src/runtime/arch.h
@@ -24,6 +24,7 @@ extern void arch_init(void);
 extern void arch_skip_instruction(os_context_t*);
 extern boolean arch_pseudo_atomic_atomic(os_context_t*);
 extern void arch_set_pseudo_atomic_interrupted(os_context_t*);
+extern void arch_clear_pseudo_atomic_interrupted(os_context_t*);
 extern os_vm_address_t arch_get_bad_addr(int, siginfo_t*, os_context_t*);
 extern unsigned char *arch_internal_error_arguments(os_context_t*);
 extern unsigned int arch_install_breakpoint(void *pc);

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index d39bf9b..b84987b 100644 (file)
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -2754,15 +2754,15 @@ scavenge_generations(generation_index_t from, generation_index_t to)
                         num_wp += update_page_write_prot(j);
                     }
                 }
+                if ((gencgc_verbose > 1) && (num_wp != 0)) {
+                    FSHOW((stderr,
+                           "/write protected %d pages within generation %d\n",
+                           num_wp, generation));
+                }
             }
             i = last_page;
         }
     }
-    if ((gencgc_verbose > 1) && (num_wp != 0)) {
-        FSHOW((stderr,
-               "/write protected %d pages within generation %d\n",
-               num_wp, generation));
-    }
 
 #if SC_GEN_CK
     /* Check that none of the write_protected pages in this generation

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 8a93526..f24c454 100644 (file)
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -346,6 +346,12 @@ interrupt_handle_pending(os_context_t *context)
     thread=arch_os_get_current_thread();
     data=thread->interrupt_data;
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+    /* If pseudo_atomic_interrupted is set then the interrupt is going
+     * to be handled now, ergo it's safe to clear it. */
+    arch_clear_pseudo_atomic_interrupted(context);
+#endif
+
     if (SymbolValue(GC_INHIBIT,thread)==NIL) {
 #ifdef LISP_FEATURE_SB_THREAD
         if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) {

diff --git a/src/runtime/x86-64-arch.c b/src/runtime/x86-64-arch.c
index 40b0683..09a874d 100644 (file)
--- a/src/runtime/x86-64-arch.c
+++ b/src/runtime/x86-64-arch.c
@@ -132,6 +132,13 @@ arch_set_pseudo_atomic_interrupted(os_context_t *context)
     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1),
                    arch_os_get_current_thread());
 }
+
+void
+arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),
+                   arch_os_get_current_thread());
+}
 \f
 /*
  * This stuff seems to get called for TRACE and debug activity.

diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c
index 8b6783b..7f136f7 100644 (file)
--- a/src/runtime/x86-arch.c
+++ b/src/runtime/x86-arch.c
@@ -133,6 +133,13 @@ arch_set_pseudo_atomic_interrupted(os_context_t *context)
     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1),
                    arch_os_get_current_thread());
 }
+
+void
+arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),
+                   arch_os_get_current_thread());
+}
 \f
 /*
  * This stuff seems to get called for TRACE and debug activity.

diff --git a/version.lisp-expr b/version.lisp-expr
index 381f362..0840280 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.6.41"
+"0.9.6.42"