1.0.0.2: TRACE :ENCAPSULATE NIL, plus other minor Windows improvements

 * Function end breakpoints need single-stepping awareness in
   order to work -- fixes TRACE :ENCAPSULATE NIL on Windows.
 * Add more exception codes to grovel-headers.c, and recognize
   them in HANDLE-WIN32-EXCEPTION -- for now just signal a simple
   error with the exception name as the message,
 * Tweak test-suite to recognize backtrace idiosyncracies on Windows,
   and skip a test that would hang due to non-working timouts.

diff --git a/NEWS b/NEWS
index 0990d5b..b4334a0 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@
 changes in sbcl-1.0.1 relative to sbcl-1.0:
   * bug fix: fix handling of non-ascii command-line arguments (thanks to
     Yaroslav Kavenchuk)
+  * bug fix: TRACE :ENCAPSULATE NIL (and function end breakpoints)
+    work on Windows.
 
 changes in sbcl-1.0 relative to sbcl-0.9.18:
   * improvement: experimental support for threading on FreeBSD/x86.

diff --git a/src/code/target-exception.lisp b/src/code/target-exception.lisp
index 397bf53..4a04e4b 100644 (file)
--- a/src/code/target-exception.lisp
+++ b/src/code/target-exception.lisp
@@ -34,25 +34,41 @@
 ;;;
 ;;; This specific bit of functionality may well be implemented entirely
 ;;; in the runtime.
-#|
+#||
 (defun sigint-%break (format-string &rest format-arguments)
   (flet ((break-it ()
            (apply #'%break 'sigint format-string format-arguments)))
     (sb!thread:interrupt-thread (sb!thread::foreground-thread) #'break-it)))
-|#
+||#
 \f
-;;; Map Windows Exception code to condition names
+;;; Map Windows Exception code to condition names: symbols or strings
 (defvar *exception-code-map*
-  (list
-   ;; Floating point exceptions
-   (cons +exception-flt-divide-by-zero+    'division-by-zero)
-   (cons +exception-flt-invalid-operation+ 'floating-point-invalid-operation)
-   (cons +exception-flt-underflow+         'floating-point-underflow)
-   (cons +exception-flt-overflow+          'floating-point-overflow)
-   (cons +exception-flt-inexact-result+    'floating-point-inexact)
-   (cons +exception-flt-denormal-operand+  'floating-point-exception)
-   (cons +exception-flt-stack-check+       'floating-point-exception)
-   (cons +exception-stack-overflow+        'sb!kernel::control-stack-exhausted)))
+  (macrolet ((cons-name (symbol)
+               `(cons ,symbol ,(remove #\+ (substitute #\_ #\- (string symbol))))))
+    (list
+     ;; Floating point exceptions
+     (cons +exception-flt-divide-by-zero+    'division-by-zero)
+     (cons +exception-flt-invalid-operation+ 'floating-point-invalid-operation)
+     (cons +exception-flt-underflow+         'floating-point-underflow)
+     (cons +exception-flt-overflow+          'floating-point-overflow)
+     (cons +exception-flt-inexact-result+    'floating-point-inexact)
+     (cons +exception-flt-denormal-operand+  'floating-point-exception)
+     (cons +exception-flt-stack-check+       'floating-point-exception)
+     ;; Stack overflow
+     (cons +exception-stack-overflow+        'sb!kernel::control-stack-exhausted)
+     ;; Various
+     (cons-name +exception-single-step+)
+     (cons-name +exception-access-violation+)
+     (cons-name +exception-array-bounds-exceeded+)
+     (cons-name +exception-breakpoint+)
+     (cons-name +exception-datatype-misalignment+)
+     (cons-name +exception-illegal-instruction+)
+     (cons-name +exception-in-page-error+)
+     (cons-name +exception-int-divide-by-zero+)
+     (cons-name +exception-int-overflow+)
+     (cons-name +exception-invalid-disposition+)
+     (cons-name +exception-noncontinuable-exception+)
+     (cons-name +exception-priv-instruction+))))
 
 (define-alien-type ()
     (struct exception-record

diff --git a/src/runtime/arch.h b/src/runtime/arch.h
index d94656b..4a7bc1b 100644 (file)
--- a/src/runtime/arch.h
+++ b/src/runtime/arch.h
@@ -46,4 +46,9 @@ extern lispobj *component_ptr_from_pc(lispobj *pc);
 extern void fpu_save(void *);
 extern void fpu_restore(void *);
 
+#ifdef LISP_FEATURE_X86
+extern unsigned int * single_stepping;
+extern void restore_breakpoint_from_single_step(os_context_t * context);
+#endif
+
 #endif /* __ARCH_H__ */

diff --git a/src/runtime/breakpoint.h b/src/runtime/breakpoint.h
index 19e1ef1..5564474 100644 (file)
--- a/src/runtime/breakpoint.h
+++ b/src/runtime/breakpoint.h
@@ -23,4 +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);
+
 #endif

diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c
index c5292c2..02c6704 100644 (file)
--- a/src/runtime/win32-os.c
+++ b/src/runtime/win32-os.c
@@ -334,8 +334,9 @@ extern boolean internal_errors_enabled;
  * unwinding in Lisp.
  */
 
-EXCEPTION_DISPOSITION sigtrap_emulator(CONTEXT *context,
-                                       struct lisp_exception_frame *exception_frame)
+EXCEPTION_DISPOSITION 
+sigtrap_emulator(CONTEXT *context,
+                struct lisp_exception_frame *exception_frame)
 {
     if (*((char *)context->Eip + 1) == trap_ContextRestore) {
         /* This is the cleanup for what is immediately below, and
@@ -424,19 +425,26 @@ void sigtrap_wrapper(void)
 /*     set_seh_frame(handler.handler[0]); */
 }
 
-EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *exception_record,
-                                       struct lisp_exception_frame *exception_frame,
-                                       CONTEXT *context,
-                                       void *dc) /* FIXME: What's dc again? */
+EXCEPTION_DISPOSITION 
+handle_exception(EXCEPTION_RECORD *exception_record,
+                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 (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
         /* Pick off sigtrap case first. */
         return sigtrap_emulator(context, exception_frame);
-
     }
     else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
              (is_valid_lisp_addr(fault_address) ||

diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c
index 4540142..521369c 100644 (file)
--- a/src/runtime/x86-arch.c
+++ b/src/runtime/x86-arch.c
@@ -209,34 +209,40 @@ arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
 }
 \f
 void
+restore_breakpoint_from_single_step(os_context_t * context)
+{
+    /* fprintf(stderr,"* single step trap %x\n", single_stepping); */
+#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG
+    /* Un-install single step helper instructions. */
+    *(single_stepping-3) = single_step_save1;
+    *(single_stepping-2) = single_step_save2;
+    *(single_stepping-1) = single_step_save3;
+#else
+    *context_eflags_addr(context) &= ~0x100;
+#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");
+    } else {
+       *((char *)single_stepping) = BREAKPOINT_INST;       /* x86 INT3 */
+       *((char *)single_stepping+1) = trap_Breakpoint;
+    }
+    
+    single_stepping = NULL;
+    return;
+}
+
+void
 sigtrap_handler(int signal, siginfo_t *info, void *void_context)
 {
     os_context_t *context = (os_context_t*)void_context;
     unsigned int trap;
 
 #ifndef LISP_FEATURE_WIN32
-    if (single_stepping && (signal==SIGTRAP))
-    {
-        /* fprintf(stderr,"* single step trap %x\n", single_stepping); */
-
-#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG
-        /* Un-install single step helper instructions. */
-        *(single_stepping-3) = single_step_save1;
-        *(single_stepping-2) = single_step_save2;
-        *(single_stepping-1) = single_step_save3;
-#else
-        *context_eflags_addr(context) &= ~0x100;
-#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");
-        } else {
-            *((char *)single_stepping) = BREAKPOINT_INST;       /* x86 INT3 */
-            *((char *)single_stepping+1) = trap_Breakpoint;
-        }
-
-        single_stepping = NULL;
-        return;
+    /* On Windows this is done in the SE handler. */
+    if (single_stepping && (signal==SIGTRAP)) {
+       restore_breakpoint_from_single_step(context);
+       return;
     }
 #endif
 

diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index 9c6473d..25ad2a7 100644 (file)
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -119,8 +119,9 @@
 
                         ;; Make sure the backtrace isn't stunted in
                         ;; any way.  (Depends on running in the main
-                        ;; thread.)
-                        (let ((end (last backtrace 2)))
+                        ;; thread.) FIXME: On Windows we get two
+                        ;; extra foreign frames below regular frames.
+                        (let ((end (last backtrace #-win32 2 #+win32 4)))
                           (unless (equal (caar end)
                                          (if *show-entry-point-details*
                                              '(sb-c::tl-xep sb-impl::toplevel-init)
@@ -433,3 +434,5 @@
   (loop while (sb-thread:thread-alive-p thread)))
 
 (disable-debugger)
+
+(write-line "/debug.impure.lisp done")

diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp
index 8531430..a2028b8 100644 (file)
--- a/tests/timer.impure.lisp
+++ b/tests/timer.impure.lisp
@@ -145,6 +145,9 @@
 (defun random-type (n)
   `(integer ,(random n) ,(+ n (random n))))
 
+;;; FIXME: Since timeouts do not work on Windows this would loop
+;;; forever.
+#-win32
 (with-test (:name '(:hash-cache :interrupt))
   (let* ((type1 (random-type 500))
          (type2 (random-type 500))

diff --git a/tools-for-build/grovel-headers.c b/tools-for-build/grovel-headers.c
index 53412dd..628605e 100644 (file)
--- a/tools-for-build/grovel-headers.c
+++ b/tools-for-build/grovel-headers.c
@@ -150,13 +150,25 @@ main(int argc, char *argv[])
     defconstant ("CSIDL_FLAG_MASK", CSIDL_FLAG_MASK);
 
     printf(";;; Exception codes\n");
+    defconstant("+exception-access-violation+", EXCEPTION_ACCESS_VIOLATION);
+    defconstant("+exception-array-bounds-exceeded+", EXCEPTION_ARRAY_BOUNDS_EXCEEDED);
+    defconstant("+exception-breakpoint+", EXCEPTION_BREAKPOINT);
+    defconstant("+exception-datatype-misalignment+", EXCEPTION_DATATYPE_MISALIGNMENT);
+    defconstant("+exception-flt-denormal-operand+", EXCEPTION_FLT_DENORMAL_OPERAND);
     defconstant("+exception-flt-divide-by-zero+", EXCEPTION_FLT_DIVIDE_BY_ZERO);
+    defconstant("+exception-flt-inexact-result+", EXCEPTION_FLT_INEXACT_RESULT);
     defconstant("+exception-flt-invalid-operation+", EXCEPTION_FLT_INVALID_OPERATION);
-    defconstant("+exception-flt-underflow+", EXCEPTION_FLT_UNDERFLOW);
     defconstant("+exception-flt-overflow+", EXCEPTION_FLT_OVERFLOW);
-    defconstant("+exception-flt-inexact-result+", EXCEPTION_FLT_INEXACT_RESULT);
-    defconstant("+exception-flt-denormal-operand+", EXCEPTION_FLT_DENORMAL_OPERAND);
     defconstant("+exception-flt-stack-check+", EXCEPTION_FLT_STACK_CHECK);
+    defconstant("+exception-flt-underflow+", EXCEPTION_FLT_UNDERFLOW);
+    defconstant("+exception-illegal-instruction+", EXCEPTION_ILLEGAL_INSTRUCTION);
+    defconstant("+exception-in-page-error+", EXCEPTION_IN_PAGE_ERROR);
+    defconstant("+exception-int-divide-by-zero+", EXCEPTION_INT_DIVIDE_BY_ZERO);
+    defconstant("+exception-int-overflow+", EXCEPTION_INT_OVERFLOW);
+    defconstant("+exception-invalid-disposition+", EXCEPTION_INVALID_DISPOSITION);
+    defconstant("+exception-noncontinuable-exception+", EXCEPTION_NONCONTINUABLE_EXCEPTION);
+    defconstant("+exception-priv-instruction+", EXCEPTION_PRIV_INSTRUCTION);
+    defconstant("+exception-single-step+", EXCEPTION_SINGLE_STEP);
     defconstant("+exception-stack-overflow+", EXCEPTION_STACK_OVERFLOW);
 
     printf(";;; FormatMessage\n");

diff --git a/version.lisp-expr b/version.lisp-expr
index 310cea7..ace9742 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".)
-"1.0.0.1"
+"1.0.0.2"