From: William Harold Newman Date: Fri, 11 Mar 2005 17:09:49 +0000 (+0000) Subject: 0.8.20.17: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f78c1fecf191e147ca081026cc11f2683ee80905;p=sbcl.git 0.8.20.17: suppressed a VERIFY-BACKTRACE test, because it seems to be broken independent of the haiblefixes I'm merging merged various fixes from Bruno Haible sbcl-devel 2005-03-10. (Note that some can't be properly exercised w/out a Mac or CLISP, but since they were self-evidently broken before (e.g., #+DARWIN or SUBTYPEP where only #!+DARWIN or SB!XC:SUBTYPEP makes sense), I merged them on the theory that it can't be making things fundamentally worse.:-) (+ unrelated .cvsignore tweaks to reduce general CVS nagging) --- diff --git a/doc/manual/.cvsignore b/doc/manual/.cvsignore index 373f939..3e98371 100644 --- a/doc/manual/.cvsignore +++ b/doc/manual/.cvsignore @@ -1,5 +1,6 @@ contrib-doc-list.texi-temp docstrings +variables.texinfo *-stamp sbcl sbcl.cp @@ -7,3 +8,4 @@ sbcl.cp sbcl.fn sbcl.tp sbcl.vr +*.texi-temp diff --git a/src/code/defbangstruct.lisp b/src/code/defbangstruct.lisp index c16b0fc..3e5c3a6 100644 --- a/src/code/defbangstruct.lisp +++ b/src/code/defbangstruct.lisp @@ -219,12 +219,18 @@ (multiple-value-bind (name defstruct-args mlff def!struct-supertype) (apply #'parse-def!struct-args args) `(progn - ;; Make sure that we really do include STRUCTURE!OBJECT. (If an - ;; :INCLUDE clause was used, and the included class didn't - ;; itself include STRUCTURE!OBJECT, then we wouldn't; and it's - ;; better to find out ASAP then to let the bug lurk until - ;; someone tries to do MAKE-LOAD-FORM on the object.) - (aver (subtypep ',def!struct-supertype 'structure!object)) + ;; There are two valid cases here: creating the + ;; STRUCTURE!OBJECT root of the inheritance hierarchy, or + ;; inheriting from STRUCTURE!OBJECT somehow. + ;; + ;; The invalid case that we want to exclude is when an :INCLUDE + ;; clause was used, and the included class didn't inherit frmo + ;; STRUCTURE!OBJECT. We want to catch that error ASAP because + ;; otherwise the bug might lurk until someone tried to do + ;; MAKE-LOAD-FORM on an instance of the class. + ,@(if (eq name 'structure!object) + (aver (null def!struct-supertype)) + `((aver (subtypep ',def!struct-supertype 'structure!object)))) (defstruct ,@defstruct-args) (setf (def!struct-type-make-load-form-fun ',name) ,(if (symbolp mlff) @@ -232,20 +238,6 @@ mlff) (def!struct-supertype ',name) ',def!struct-supertype) - ;; This bit of commented-out code hasn't been needed for quite - ;; some time, but the comments here about why not might still - ;; be useful to me until I finally get the system to work. When - ;; I do remove all this, I should be sure also to remove the - ;; "outside the EVAL-WHEN" comments above, since they will no - ;; longer make sense. -- WHN 19990803 - ;;(eval-when (:compile-toplevel :load-toplevel :execute) - ;; ;; (The DEFSTRUCT used to be in here, but that failed when trying - ;; ;; to cross-compile the hash table implementation.) - ;; ;;(defstruct ,@defstruct-args) - ;; ;; The (SETF (DEF!STRUCT-TYPE-MAKE-LOAD-FORM-FUN ..) ..) used to - ;; ;; be in here too, but that failed an assertion in the SETF - ;; ;; definition once we moved the DEFSTRUCT outside.) - ;; ) #+sb-xc-host ,(let ((u (uncross-defstruct-args defstruct-args))) (if (boundp '*delayed-def!structs*) `(push (make-delayed-def!struct :args ',u) diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index ef5559c..6508d2c 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -822,8 +822,8 @@ modified (copy-structure included-slot)))) (when (and (neq (dsd-type new-slot) (dsd-type included-slot)) - (not (subtypep (dsd-type included-slot) - (dsd-type new-slot))) + (not (sb!xc:subtypep (dsd-type included-slot) + (dsd-type new-slot))) (dsd-safe-p included-slot)) (setf (dsd-safe-p new-slot) nil) ;; XXX: notify? diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index fd0664f..0ccbe21 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -107,9 +107,8 @@ (def!constant linkage-table-space-start #x50000000) (def!constant linkage-table-space-end #x51000000) (def!constant linkage-table-entry-size 16)) - -;;;; Other random constants. +;;;; Other miscellaneous constants. (defenum (:suffix -trap :start 8) halt diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index d21e488..429807f 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -156,7 +156,7 @@ previous_info(struct call_info *info) int free; if (!cs_valid_pointer_p(info->frame)) { - printf("Bogus callee value (0x%08x).\n", (unsigned long)info->frame); + printf("Bogus callee value (0x%08lx).\n", (unsigned long)info->frame); return 0; } @@ -207,13 +207,13 @@ backtrace(int nframes) call_info_from_lisp_state(&info); do { - printf("entry_points; @@ -257,7 +257,7 @@ backtrace(int nframes) printf("CODE: ???, "); if (info.lra != NIL) - printf("LRA: 0x%08x, ", (unsigned long)info.lra); + printf("LRA: 0x%08lx, ", (unsigned long)info.lra); else printf(", "); diff --git a/src/runtime/cheneygc.c b/src/runtime/cheneygc.c index 1227d43..fc003f5 100644 --- a/src/runtime/cheneygc.c +++ b/src/runtime/cheneygc.c @@ -599,16 +599,16 @@ void set_auto_gc_trigger(os_vm_size_t dynamic_usage) if (addr < (os_vm_address_t)dynamic_space_free_pointer) { fprintf(stderr, - "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n", - (unsigned int)dynamic_usage, - (os_vm_address_t)dynamic_space_free_pointer - - (os_vm_address_t)current_dynamic_space); + "set_auto_gc_trigger: tried to set gc trigger too low! (%ld < 0x%08lx)\n", + (unsigned long)dynamic_usage, + (unsigned long)((os_vm_address_t)dynamic_space_free_pointer + - (os_vm_address_t)current_dynamic_space)); lose("lost"); } else if (length < 0) { fprintf(stderr, - "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n", - dynamic_usage); + "set_auto_gc_trigger: tried to set gc trigger too high! (0x%08lx)\n", + (unsigned long)dynamic_usage); lose("lost"); } diff --git a/src/runtime/interr.c b/src/runtime/interr.c index 60e9d11..fc66ac9 100644 --- a/src/runtime/interr.c +++ b/src/runtime/interr.c @@ -136,13 +136,13 @@ describe_internal_error(os_context_t *context) #ifdef sc_WordPointerReg case sc_WordPointerReg: #endif - printf("\t0x%08lx\n", *os_context_register_addr(context, offset)); + printf("\t0x%08lx\n", (unsigned long) *os_context_register_addr(context, offset)); break; case sc_SignedReg: - printf("\t%ld\n", *os_context_register_addr(context, offset)); + printf("\t%ld\n", (long) *os_context_register_addr(context, offset)); break; case sc_UnsignedReg: - printf("\t%lu\n", *os_context_register_addr(context, offset)); + printf("\t%lu\n", (unsigned long) *os_context_register_addr(context, offset)); break; #ifdef sc_SingleFloatReg case sc_SingleFloatReg: diff --git a/src/runtime/thread.c b/src/runtime/thread.c index 2a174d6..43d551a 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -179,7 +179,8 @@ struct thread * create_thread_struct(lispobj initial_function) { bind_variable(INTERRUPT_PENDING, NIL,th); bind_variable(INTERRUPTS_ENABLED,T,th); - th->interrupt_data=os_validate(0,(sizeof (struct interrupt_data))); + th->interrupt_data = + os_validate(0,(sizeof (struct interrupt_data))); if(all_threads) memcpy(th->interrupt_data, arch_os_get_current_thread()->interrupt_data, diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index 1c4225d..2dbf94e 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -145,6 +145,7 @@ (list *undefined-function-frame* (list '(flet test) #'optimized)))) + #-x86 ; bug 353: This test fails at least most of the time for x86/linux ca. 0.8.20.16. -- WHN (assert (verify-backtrace (lambda () (test #'not-optimized)) (list *undefined-function-frame* diff --git a/version.lisp-expr b/version.lisp-expr index e30f44a..07e9f88 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.20.16" +"0.8.20.17"