1.0.0.11:
authorChristophe Rhodes <csr21@cam.ac.uk>
Fri, 1 Dec 2006 20:47:04 +0000 (20:47 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Fri, 1 Dec 2006 20:47:04 +0000 (20:47 +0000)
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)

NEWS
src/pcl/dfun.lisp
src/runtime/breakpoint.h
src/runtime/win32-os.c
src/runtime/x86-arch.c
src/runtime/x86-win32-os.c
tools-for-build/wxs.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 0b77999..107b7f4 100644 (file)
--- 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,
index e9cd883..c75394c 100644 (file)
@@ -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 "~@<Vicious metacircle:  The computation of a ~
-              dfun of ~s for argument ~s uses the dfun being ~
-              computed.~@:>"
-             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))
index 5564474..b0c59c8 100644 (file)
@@ -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
index 02c6704..9161889 100644 (file)
@@ -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. */
index 521369c..6cdaf75 100644 (file)
@@ -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
 
index 13f3233..fc076de 100644 (file)
 #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
index 705e12e..a6f1678 100644 (file)
@@ -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*))))
 
index 9fd3c95..37ddb33 100644 (file)
@@ -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"