From f706a441d7c09cba32701289b63946527fef3c78 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 8 Jan 2004 16:26:33 +0000 Subject: [PATCH] 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? --- src/compiler/ppc/system.lisp | 8 +++----- src/runtime/gc.h | 8 ++++++++ src/runtime/gencgc.c | 7 +++---- src/runtime/purify.c | 6 +++++- tests/interface.impure.lisp | 6 ++++++ tests/interface.pure.lisp | 4 ++++ version.lisp-expr | 2 +- 7 files changed, 30 insertions(+), 11 deletions(-) diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp index 8d74e7c..15c686b 100644 --- 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))) - - ;;;; Dynamic vop count collection support diff --git a/src/runtime/gc.h b/src/runtime/gc.h index c27ab79..8b0f62e 100644 --- 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 --- 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 --- 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 --- 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")) + +;;; 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) ;;;; success (sb-ext:quit :unix-status 104) diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index 227ab07..5ac83e0 100644 --- 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 --- 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" -- 1.7.10.4