From: Nikodemus Siivola Date: Thu, 30 Nov 2006 16:20:41 +0000 (+0000) Subject: 1.0.0.2: TRACE :ENCAPSULATE NIL, plus other minor Windows improvements X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1fca8fbb946ba06cedf777c3a6927f14d24cfae5;p=sbcl.git 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 --- 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 --- 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))) -|# +||# -;;; 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 --- 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 --- 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 --- 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 --- 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) } 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 --- 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 --- 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 --- 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 --- 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"