From: William Harold Newman Date: Wed, 25 Oct 2000 02:37:24 +0000 (+0000) Subject: 0.6.7.26: fixed breakpoints on OpenBSD X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7f76d571fe545578e3bd26e627d181a39a8f1eb7;p=sbcl.git 0.6.7.26: fixed breakpoints on OpenBSD --- diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 307ecd3..a4d95df 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -3510,6 +3510,7 @@ ;;; debugging-tool break instruction. This does NOT handle all breaks; ;;; for example, it does not handle breaks for internal errors. (defun handle-breakpoint (offset component signal-context) + (/show0 "entering HANDLE-BREAKPOINT") (let ((data (breakpoint-data component offset nil))) (unless data (error "unknown breakpoint in ~S at offset ~S" @@ -3533,6 +3534,7 @@ ;;; This handles code-location and debug-function :FUNCTION-START ;;; breakpoints. (defun handle-breakpoint-aux (breakpoints data offset component signal-context) + (/show0 "entering HANDLE-BREAKPOINT-AUX") (unless breakpoints (error "internal error: breakpoint that nobody wants")) (unless (member data *executing-breakpoint-hooks*) @@ -3575,6 +3577,7 @@ bpt))))) (defun handle-function-end-breakpoint (offset component context) + (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT") (let ((data (breakpoint-data component offset nil))) (unless data (error "unknown breakpoint in ~S at offset ~S" @@ -3589,6 +3592,7 @@ ;;; [old C code] or HANDLE-FUNCTION-END-BREAKPOINT calls this directly ;;; [new C code]. (defun handle-function-end-breakpoint-aux (breakpoints data signal-context) + (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT-AUX") (delete-breakpoint-data data) (let* ((scp (locally diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index c0f0511..5def05c 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -35,12 +35,12 @@ ;;;; internal state -;;; a hash table that maps each traced function to the TRACE-INFO. The entry -;;; for a closure is the shared function-entry object. +;;; a hash table that maps each traced function to the TRACE-INFO. The +;;; entry for a closure is the shared function-entry object. (defvar *traced-functions* (make-hash-table :test 'eq)) -;;; A TRACE-INFO object represents all the information we need to trace a -;;; given function. +;;; A TRACE-INFO object represents all the information we need to +;;; trace a given function. (def!struct (trace-info (:make-load-form-fun sb-kernel:just-dump-it-normally) (:print-object (lambda (x stream) @@ -61,13 +61,14 @@ ;; the list of function names for WHEREIN, or NIL if unspecified (wherein nil :type list) - ;; The following slots represent the forms that we are supposed to evaluate - ;; on each iteration. Each form is represented by a cons (Form . Function), - ;; where the Function is the cached result of coercing Form to a function. - ;; Forms which use the current environment are converted with - ;; PREPROCESS-FOR-EVAL, which gives us a one-arg function. - ;; Null environment forms also have one-arg functions, but the argument is - ;; ignored. NIL means unspecified (the default.) + ;; The following slots represent the forms that we are supposed to + ;; evaluate on each iteration. Each form is represented by a cons + ;; (Form . Function), where the Function is the cached result of + ;; coercing Form to a function. Forms which use the current + ;; environment are converted with PREPROCESS-FOR-EVAL, which gives + ;; us a one-arg function. Null environment forms also have one-arg + ;; functions, but the argument is ignored. NIL means unspecified + ;; (the default.) ;; current environment forms (condition nil) @@ -101,19 +102,19 @@ (defvar *traced-entries* ()) (declaim (list *traced-entries*)) -;;; This variable is used to discourage infinite recursions when some trace -;;; action invokes a function that is itself traced. In this case, we quietly -;;; ignore the inner tracing. +;;; This variable is used to discourage infinite recursions when some +;;; trace action invokes a function that is itself traced. In this +;;; case, we quietly ignore the inner tracing. (defvar *in-trace* nil) ;;;; utilities -;;; Given a function name, a function or a macro name, return the raw -;;; definition and some information. "Raw" means that if the result is a -;;; closure, we strip off the closure and return the bare code. The second -;;; value is T if the argument was a function name. The third value is one of -;;; :COMPILED, :COMPILED-CLOSURE, :INTERPRETED, :INTERPRETED-CLOSURE and -;;; :FUNCALLABLE-INSTANCE. +;;; Given a function name, a function or a macro name, return the raw +;;; definition and some information. "Raw" means that if the result is +;;; a closure, we strip off the closure and return the bare code. The +;;; second value is T if the argument was a function name. The third +;;; value is one of :COMPILED, :COMPILED-CLOSURE, :INTERPRETED, +;;; :INTERPRETED-CLOSURE and :FUNCALLABLE-INSTANCE. (defun trace-fdefinition (x) (multiple-value-bind (res named-p) (typecase x @@ -137,8 +138,8 @@ (values res named-p :funcallable-instance)) (t (values res named-p :compiled)))))) -;;; When a function name is redefined, and we were tracing that name, then -;;; untrace the old definition and trace the new one. +;;; When a function name is redefined, and we were tracing that name, +;;; then untrace the old definition and trace the new one. (defun trace-redefined-update (fname new-value) (when (fboundp fname) (let* ((fun (trace-fdefinition fname)) @@ -148,10 +149,10 @@ (trace-1 fname info new-value))))) (push #'trace-redefined-update sb-int:*setf-fdefinition-hook*) -;;; Annotate some forms to evaluate with pre-converted functions. Each form -;;; is really a cons (exp . function). Loc is the code location to use for -;;; the lexical environment. If Loc is NIL, evaluate in the null environment. -;;; If Form is NIL, just return NIL. +;;; Annotate some forms to evaluate with pre-converted functions. Each +;;; form is really a cons (exp . function). Loc is the code location +;;; to use for the lexical environment. If Loc is NIL, evaluate in the +;;; null environment. If Form is NIL, just return NIL. (defun coerce-form (form loc) (when form (let ((exp (car form))) @@ -218,8 +219,8 @@ (trace-info-what info))))) ;;; This function discards any invalid cookies on our simulated stack. -;;; Encapsulated entries are always valid, since we bind *traced-entries* in -;;; the encapsulation. +;;; Encapsulated entries are always valid, since we bind +;;; *TRACED-ENTRIES* in the encapsulation. (defun discard-invalid-entries (frame) (loop (when (or (null *traced-entries*) @@ -231,10 +232,10 @@ ;;;; hook functions -;;; Return a closure that can be used for a function start breakpoint hook -;;; function and a closure that can be used as the FUNCTION-END-COOKIE -;;; function. The first communicates the sense of the Condition to the second -;;; via a closure variable. +;;; Return a closure that can be used for a function start breakpoint +;;; hook function and a closure that can be used as the +;;; FUNCTION-END-COOKIE function. The first communicates the sense of +;;; the Condition to the second via a closure variable. (defun trace-start-breakpoint-fun (info) (let (conditionp) (values @@ -322,11 +323,11 @@ (values-list vals)))))) ;;; Trace one function according to the specified options. We copy the -;;; trace info (it was a quoted constant), fill in the functions, and then -;;; install the breakpoints or encapsulation. +;;; trace info (it was a quoted constant), fill in the functions, and +;;; then install the breakpoints or encapsulation. ;;; -;;; If non-null, Definition is the new definition of a function that we are -;;; automatically retracing. +;;; If non-null, DEFINITION is the new definition of a function that +;;; we are automatically retracing. (defun trace-1 (function-or-name info &optional definition) (multiple-value-bind (fun named kind) (if definition @@ -392,11 +393,12 @@ :function-end-cookie cookie-fun))) (setf (trace-info-start-breakpoint info) start) (setf (trace-info-end-breakpoint info) end) - ;; The next two forms must be in the order in which they appear, - ;; since the start breakpoint must run before the function-end - ;; breakpoint's start helper (which calls the cookie function.) - ;; One reason is that cookie function requires that the CONDITIONP - ;; shared closure variable be initialized. + ;; The next two forms must be in the order in which they + ;; appear, since the start breakpoint must run before the + ;; function-end breakpoint's start helper (which calls the + ;; cookie function.) One reason is that cookie function + ;; requires that the CONDITIONP shared closure variable be + ;; initialized. (sb-di:activate-breakpoint start) (sb-di:activate-breakpoint end))))) @@ -406,9 +408,9 @@ ;;;; the TRACE macro -;;; Parse leading trace options off of SPECS, modifying INFO accordingly. The -;;; remaining portion of the list is returned when we encounter a plausible -;;; function name. +;;; Parse leading trace options off of SPECS, modifying INFO +;;; accordingly. The remaining portion of the list is returned when we +;;; encounter a plausible function name. (defun parse-trace-options (specs info) (let ((current specs)) (loop @@ -453,8 +455,8 @@ current)) ;;; Compute the expansion of TRACE in the non-trivial case (arguments -;;; specified.) If there are no :FUNCTION specs, then don't use a LET. This -;;; allows TRACE to be used without the full interpreter. +;;; specified.) If there are no :FUNCTION specs, then don't use a LET. +;;; This allows TRACE to be used without the full interpreter. (defun expand-trace (specs) (collect ((binds) (forms)) diff --git a/src/runtime/breakpoint.h b/src/runtime/breakpoint.h index 798ae21..305fa38 100644 --- a/src/runtime/breakpoint.h +++ b/src/runtime/breakpoint.h @@ -17,7 +17,7 @@ extern void breakpoint_remove(lispobj code_obj, int pc_offset, unsigned long orig_inst); extern void breakpoint_do_displaced_inst(os_context_t *context, - unsigned long orig_inst); + unsigned long orig_inst); extern void handle_breakpoint(int signal, siginfo_t *info, os_context_t *context); extern void *handle_function_end_breakpoint(int signal, siginfo_t *info, diff --git a/src/runtime/bsd-os.h b/src/runtime/bsd-os.h index de568f8..1cdc422 100644 --- a/src/runtime/bsd-os.h +++ b/src/runtime/bsd-os.h @@ -28,6 +28,15 @@ typedef int os_vm_prot_t; * original FreeBSD port of SBCL, that's wrong, it's actually a * ucontext_t. */ typedef ucontext_t os_context_t; +/* KLUDGE: A hack inherited from CMU CL used to be conditional on + * !defined(__linux__), and has now been made conditional on + * CANNOT_GET_TO_SINGLE_STEP_FLAG: if the OS won't let us flip the + * single-step flag bit in the state stored in a signal context, then + * we need to mess around with overwriting preceding code with + * bit-flipping code. This isn't needed in Linux or OpenBSD; I haven't + * been able to test whether it's still needed in FreeBSD, so for + * conservatism it's left in. -- WHN 2000-10-24 */ +#define CANNOT_GET_TO_SINGLE_STEP_FLAG #elif defined __OpenBSD__ typedef struct sigcontext os_context_t; #else diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c index d72c219..aaad2a1 100644 --- a/src/runtime/x86-arch.c +++ b/src/runtime/x86-arch.c @@ -144,8 +144,8 @@ arch_remove_breakpoint(void *pc, unsigned long orig_inst) /* When single stepping, single_stepping holds the original instruction * PC location. */ -unsigned int *single_stepping=NULL; -#ifndef __linux__ +unsigned int *single_stepping = NULL; +#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG unsigned int single_step_save1; unsigned int single_step_save2; unsigned int single_step_save3; @@ -160,9 +160,7 @@ arch_do_displaced_inst(os_context_t *context, unsigned long orig_inst) *((char *)pc) = orig_inst & 0xff; *((char *)pc + 1) = (orig_inst & 0xff00) >> 8; -#ifdef __linux__ - *context_eflags_addr(context) |= 0x100; -#else +#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG /* Install helper instructions for the single step: * pushf; or [esp],0x100; popf. */ single_step_save1 = *(pc-3); @@ -171,11 +169,13 @@ arch_do_displaced_inst(os_context_t *context, unsigned long orig_inst) *(pc-3) = 0x9c909090; *(pc-2) = 0x00240c81; *(pc-1) = 0x9d000001; +#else + *context_eflags_addr(context) |= 0x100; #endif single_stepping = (unsigned int*)pc; -#ifndef __linux__ +#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG *os_context_pc_addr(context) = (char *)pc - 9; #endif } @@ -191,7 +191,7 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) { /* fprintf(stderr,"* single step trap %x\n", single_stepping); */ -#ifndef __linux__ +#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; diff --git a/version.lisp-expr b/version.lisp-expr index 4c3dc83..0deeccc 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string a la "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.7.24" +"0.6.7.26"