From: Christophe Rhodes Date: Fri, 1 Dec 2006 20:47:04 +0000 (+0000) Subject: 1.0.0.11: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=14ee896f8d31180cee945d11a8ee677558b944aa;p=sbcl.git 1.0.0.11: Fix for Pascal Costanza's issue over delay/force using a method on SLOT-UNBOUND and recursion in accessors. ... safety nets? We don't need no safety nets! (also whitespace damage) --- diff --git a/NEWS b/NEWS index 0b77999..107b7f4 100644 --- a/NEWS +++ b/NEWS @@ -9,6 +9,8 @@ changes in sbcl-1.0.1 relative to sbcl-1.0: * bug fix: non-required arguments were not passed correctly when a method defined using DEFMETHOD was called from a mop-generated method using CALL-NEXT-METHOD (reported by Pascal Costanza) + * bug fix: recursion is now permitted in accessors through + SLOT-UNBOUND. (reported by Pascal Costanza) * bug fix: an error was signaled at startup if the HOME environment variable was defined, but had an empty value (reported by Peter Van Eynde) * optimization: loading generic functions no longer takes O(n^2) time, diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index e9cd883..c75394c 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -966,29 +966,20 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (t (make-final-caching-dfun gf classes-list new-class))))) -(defvar *accessor-miss-history* nil) (defun accessor-miss (gf new object dfun-info) - (let ((wrapper (wrapper-of object)) - (previous-miss (assq gf *accessor-miss-history*))) - (when (eq wrapper (cdr previous-miss)) - (error "~@" - gf object)) - (let* ((*accessor-miss-history* (acons gf wrapper *accessor-miss-history*)) - (ostate (type-of dfun-info)) - (otype (dfun-info-accessor-type dfun-info)) - oindex ow0 ow1 cache - (args (ecase otype - ((reader boundp) (list object)) - (writer (list new object))))) - (dfun-miss (gf args wrappers invalidp nemf ntype nindex) - ;; The following lexical functions change the state of the - ;; dfun to that which is their name. They accept arguments - ;; which are the parameters of the new state, and get other - ;; information from the lexical variables bound above. - (flet ((two-class (index w0 w1) + (let* ((ostate (type-of dfun-info)) + (otype (dfun-info-accessor-type dfun-info)) + oindex ow0 ow1 cache + (args (ecase otype + ((reader boundp) (list object)) + (writer (list new object))))) + (dfun-miss (gf args wrappers invalidp nemf ntype nindex) + ;; The following lexical functions change the state of the + ;; dfun to that which is their name. They accept arguments + ;; which are the parameters of the new state, and get other + ;; information from the lexical variables bound above. + (flet ((two-class (index w0 w1) (when (zerop (random 2 *pcl-misc-random-state*)) (psetf w0 w1 w1 w0)) (dfun-update gf @@ -1051,7 +1042,7 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (setq cache (dfun-info-cache dfun-info)) (if (consp nindex) (caching) - (do-fill #'n-n))))))))))) + (do-fill #'n-n)))))))))) (defun checking-miss (generic-function args dfun-info) (let ((oemf (dfun-info-function dfun-info)) diff --git a/src/runtime/breakpoint.h b/src/runtime/breakpoint.h index 5564474..b0c59c8 100644 --- a/src/runtime/breakpoint.h +++ b/src/runtime/breakpoint.h @@ -23,7 +23,7 @@ extern void handle_breakpoint(int signal, siginfo_t *info, extern void *handle_fun_end_breakpoint(int signal, siginfo_t *info, os_context_t *context); -extern void handle_single_step_trap(os_context_t *context, int kind, - int register_offset); +extern void handle_single_step_trap(os_context_t *context, int kind, + int register_offset); #endif diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c index 02c6704..9161889 100644 --- a/src/runtime/win32-os.c +++ b/src/runtime/win32-os.c @@ -334,9 +334,9 @@ extern boolean internal_errors_enabled; * unwinding in Lisp. */ -EXCEPTION_DISPOSITION +EXCEPTION_DISPOSITION sigtrap_emulator(CONTEXT *context, - struct lisp_exception_frame *exception_frame) + struct lisp_exception_frame *exception_frame) { if (*((char *)context->Eip + 1) == trap_ContextRestore) { /* This is the cleanup for what is immediately below, and @@ -425,22 +425,22 @@ void sigtrap_wrapper(void) /* set_seh_frame(handler.handler[0]); */ } -EXCEPTION_DISPOSITION +EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *exception_record, - struct lisp_exception_frame *exception_frame, - CONTEXT *context, - void *dc) /* FIXME: What's dc again? */ + struct lisp_exception_frame *exception_frame, + CONTEXT *context, + void *dc) /* FIXME: What's dc again? */ { /* For EXCEPTION_ACCESS_VIOLATION only. */ void *fault_address = (void *)exception_record->ExceptionInformation[1]; - if (single_stepping && - exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) { - /* We are doing a displaced instruction. At least function - * end breakpoints uses this. */ - restore_breakpoint_from_single_step(context); - return ExceptionContinueExecution; - } + if (single_stepping && + exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) { + /* We are doing a displaced instruction. At least function + * end breakpoints uses this. */ + restore_breakpoint_from_single_step(context); + return ExceptionContinueExecution; + } if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) { /* Pick off sigtrap case first. */ diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c index 521369c..6cdaf75 100644 --- a/src/runtime/x86-arch.c +++ b/src/runtime/x86-arch.c @@ -222,12 +222,12 @@ restore_breakpoint_from_single_step(os_context_t * context) #endif /* Re-install the breakpoint if possible. */ if (*os_context_pc_addr(context) == (int)single_stepping + 1) { - fprintf(stderr, "warning: couldn't reinstall breakpoint\n"); + fprintf(stderr, "warning: couldn't reinstall breakpoint\n"); } else { - *((char *)single_stepping) = BREAKPOINT_INST; /* x86 INT3 */ - *((char *)single_stepping+1) = trap_Breakpoint; + *((char *)single_stepping) = BREAKPOINT_INST; /* x86 INT3 */ + *((char *)single_stepping+1) = trap_Breakpoint; } - + single_stepping = NULL; return; } @@ -241,8 +241,8 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) #ifndef LISP_FEATURE_WIN32 /* On Windows this is done in the SE handler. */ if (single_stepping && (signal==SIGTRAP)) { - restore_breakpoint_from_single_step(context); - return; + restore_breakpoint_from_single_step(context); + return; } #endif diff --git a/src/runtime/x86-win32-os.c b/src/runtime/x86-win32-os.c index 13f3233..fc076de 100644 --- a/src/runtime/x86-win32-os.c +++ b/src/runtime/x86-win32-os.c @@ -42,14 +42,14 @@ #include "validate.h" size_t os_vm_page_size; -int arch_os_thread_init(struct thread *thread) +int arch_os_thread_init(struct thread *thread) { { void *top_exception_frame; void *cur_stack_end; void *cur_stack_start; - MEMORY_BASIC_INFORMATION stack_memory; - + MEMORY_BASIC_INFORMATION stack_memory; + asm volatile ("movl %%fs:0,%0": "=r" (top_exception_frame)); asm volatile ("movl %%fs:4,%0": "=r" (cur_stack_end)); @@ -57,13 +57,13 @@ int arch_os_thread_init(struct thread *thread) * because that's only what currently has memory behind * it from being used, so do a quick VirtualQuery() and * grab the AllocationBase. -AB 2006/11/25 - */ + */ - if (!VirtualQuery(&stack_memory, &stack_memory, sizeof(stack_memory))) { - fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError()); - lose("Could not query stack memory information."); - } - cur_stack_start = stack_memory.AllocationBase; + if (!VirtualQuery(&stack_memory, &stack_memory, sizeof(stack_memory))) { + fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError()); + lose("Could not query stack memory information."); + } + cur_stack_start = stack_memory.AllocationBase; /* We use top_exception_frame rather than cur_stack_end to * elide the last few (boring) stack entries at the bottom of diff --git a/tools-for-build/wxs.lisp b/tools-for-build/wxs.lisp index 705e12e..a6f1678 100644 --- a/tools-for-build/wxs.lisp +++ b/tools-for-build/wxs.lisp @@ -14,7 +14,7 @@ (defvar *indent-level* 0) (defvar *sbcl-source-root* - (truename + (truename (merge-pathnames (make-pathname :directory (list :relative :up)) (make-pathname :name nil :type nil :defaults *load-truename*)))) diff --git a/version.lisp-expr b/version.lisp-expr index 9fd3c95..37ddb33 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".) -"1.0.0.10" +"1.0.0.11"