0.8.7.10:

	Various things that are definitely fixes for something
	... s/DO-PENDING-INTERRUPT/RECEIVE-PENDING-INTERRUPT/
		in ppc/system.lisp (as suggested by Lennart Staflin
		sbcl-help 2004-01-01).  This may not fix everything,
		but it's clearly part of *a* problem if not *the*
		problem.
	... define and use a fixnump() static inline function in
		gencgc.c and purify.c, correcting along the way the
		problem in ptrans_code (CSR sbcl-devel 2004-01-08)
	Let's see what difference that makes, shall we?

diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp
index 8d74e7c..15c686b 100644 (file)
--- a/src/compiler/ppc/system.lisp
+++ b/src/compiler/ppc/system.lisp
@@ -210,18 +210,16 @@
 ;;;; Other random VOPs.
 
 
-(defknown sb!unix::do-pending-interrupt () (values))
-(define-vop (sb!unix::do-pending-interrupt)
+(defknown sb!unix::receive-pending-interrupt () (values))
+(define-vop (sb!unix::receive-pending-interrupt)
   (:policy :fast-safe)
-  (:translate sb!unix::do-pending-interrupt)
+  (:translate sb!unix::receive-pending-interrupt)
   (:generator 1
     (inst unimp pending-interrupt-trap)))
 
 (define-vop (halt)
   (:generator 1
     (inst unimp halt-trap)))
-
-
 \f
 ;;;; Dynamic vop count collection support
 

diff --git a/src/runtime/gc.h b/src/runtime/gc.h
index c27ab79..8b0f62e 100644 (file)
--- a/src/runtime/gc.h
+++ b/src/runtime/gc.h
@@ -28,4 +28,12 @@ extern void set_auto_gc_trigger(os_vm_size_t usage);
 extern void clear_auto_gc_trigger(void);
 
 extern int maybe_gc_pending;
+
+static inline int fixnump(lispobj obj) {
+    return((obj & 
+           (LOWTAG_MASK & 
+            (~(EVEN_FIXNUM_LOWTAG|ODD_FIXNUM_LOWTAG)))) 
+          == 0);
+}
+
 #endif /* _GC_H_ */

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 73c3e3b..c018418 100644 (file)
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -3146,9 +3146,8 @@ verify_space(lispobj *start, size_t words)
                }
            }
        } else {
-           if (thing & 0x3) { /* Skip fixnums. FIXME: There should be an
-                               * is_fixnum for this. */
-
+           if (!(fixnump(thing))) { 
+               /* skip fixnums */
                switch(widetag_of(*start)) {
 
                    /* boxed objects */
@@ -3195,7 +3194,7 @@ verify_space(lispobj *start, size_t words)
                             * there's no byte compiler, but I've got
                             * too much to worry about right now to try
                             * to make sure. -- WHN 2001-10-06 */
-                           && !(code->trace_table_offset & 0x3)
+                           && fixnump(code->trace_table_offset)
                            /* Only when enabled */
                            && verify_dynamic_code_check) {
                            FSHOW((stderr,

diff --git a/src/runtime/purify.c b/src/runtime/purify.c
index db80505..9e8159a 100644 (file)
--- a/src/runtime/purify.c
+++ b/src/runtime/purify.c
@@ -735,7 +735,11 @@ ptrans_code(lispobj thing)
     pscav_later(&new->debug_info, 1);
 
     /* FIXME: why would this be a fixnum? */
-    if (!(new->trace_table_offset & (EVEN_FIXNUM_LOWTAG|ODD_FIXNUM_LOWTAG)))
+    /* "why" is a hard word, but apparently for compiled functions the
+       trace_table_offset contains the length of the instructions, as
+       a fixnum.  See CODE-INST-AREA-LENGTH in
+       src/compiler/target-disassem.lisp.  -- CSR, 2004-01-08 */
+    if (!(fixnump(new->trace_table_offset)))
 #if 0
        pscav(&new->trace_table_offset, 1, 0);
 #else

diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp
index ab31744..c8c3d0f 100644 (file)
--- a/tests/interface.impure.lisp
+++ b/tests/interface.impure.lisp
@@ -35,7 +35,13 @@
                 "(class-predicate foo) documentation"))
 (assert (string= (documentation #'(sb-pcl::class-predicate foo) 'function)
                 "(class-predicate foo) documentation"))
+\f
+;;; DISASSEMBLE shouldn't fail on closures or unpurified functions
+(defun disassemble-fun (x) x)
+(disassemble 'disassemble-fun)
 
+(let ((x 1)) (defun disassemble-closure (y) (if y (setq x y) x)))
+(disassemble 'disassemble-closure)
 \f
 ;;;; success
 (sb-ext:quit :unix-status 104)

diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp
index 227ab07..5ac83e0 100644 (file)
--- a/tests/interface.pure.lisp
+++ b/tests/interface.pure.lisp
@@ -128,3 +128,7 @@
   (test (* 86400 365) -1/3600 (1 0 0 1 1 1901 1 -1/3600))
   (test (* 86400 365) 0 (0 0 0 1 1 1901 1 0))
   (test (* 86400 365) 1/3600 (59 59 23 31 12 1900 0 1/3600)))
+
+;;; DISASSEMBLE shouldn't fail on purified functions
+(disassemble 'cl:+)
+(disassemble 'sb-ext:run-program)

diff --git a/version.lisp-expr b/version.lisp-expr
index a15c236..3e837e8 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.8.7.9"
+"0.8.7.10"