From f35f14479a64dd97f93d2d91dc154bdc141d6842 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Fri, 7 Apr 2006 12:49:59 +0000 Subject: [PATCH] 0.9.11.19: Make the test suite pass on Solaris/x86. * Fix a number of bashisms in test/*.sh * :ENCAPSULATE NIL tracing: ... In the breakpoint handling internals use the signal context FP/PC directly to construct the frame, instead of walking through the backtrace until a matching frame is found. ... Kill the single-stepper remains in x86(-64)-arch.c. Turning on processor single-stepping with signal context frobbing was causing extra trace traps, and the code for handling those was presumably already lost a long time ago. * Floating point exception handling: ... Define os_context_fp_control, and use it instead of the stub implementation in x86-vm.lisp. * Mark the usual backtrace tests as expected to fail on this OS too --- src/code/debug-int.lisp | 23 ++++++++++------- src/code/x86-vm.lisp | 16 ++---------- src/runtime/bsd-os.h | 5 ---- src/runtime/x86-64-arch.c | 57 ----------------------------------------- src/runtime/x86-arch.c | 60 +------------------------------------------- src/runtime/x86-sunos-os.c | 11 ++++++++ tests/debug.impure.lisp | 7 ++++-- tests/finalize.test.sh | 6 ++--- tests/foreign.test.sh | 8 +++--- version.lisp-expr | 2 +- 10 files changed, 41 insertions(+), 154 deletions(-) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 47dc215..accddcb 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -3128,7 +3128,7 @@ register." (unless (member data *executing-breakpoint-hooks*) (let ((*executing-breakpoint-hooks* (cons data *executing-breakpoint-hooks*))) - (invoke-breakpoint-hooks breakpoints component offset))) + (invoke-breakpoint-hooks breakpoints signal-context))) ;; At this point breakpoints may not hold the same list as ;; BREAKPOINT-DATA-BREAKPOINTS since invoking hooks may have allowed ;; a breakpoint deactivation. In fact, if all breakpoints were @@ -3151,10 +3151,8 @@ register." #!+(and sparc solaris) (error "BREAKPOINT-DO-DISPLACED-INST returned?"))) -(defun invoke-breakpoint-hooks (breakpoints component offset) - (let* ((debug-fun (debug-fun-from-pc component offset)) - (frame (do ((f (top-frame) (frame-down f))) - ((eq debug-fun (frame-debug-fun f)) f)))) +(defun invoke-breakpoint-hooks (breakpoints signal-context) + (let* ((frame (signal-context-frame signal-context))) (dolist (bpt breakpoints) (funcall (breakpoint-hook-fun bpt) frame @@ -3166,6 +3164,16 @@ register." (breakpoint-unknown-return-partner bpt) bpt))))) +(defun signal-context-frame (signal-context) + (let* ((scp + (locally + (declare (optimize (inhibit-warnings 3))) + (sb!alien:sap-alien signal-context (* os-context-t)))) + (cfp (int-sap (sb!vm:context-register scp sb!vm::cfp-offset)))) + (compute-calling-frame cfp + (sb!vm:context-pc scp) + nil))) + (defun handle-fun-end-breakpoint (offset component context) (let ((data (breakpoint-data component offset nil))) (unless data @@ -3186,10 +3194,7 @@ register." (locally (declare (optimize (inhibit-warnings 3))) (sb!alien:sap-alien signal-context (* os-context-t)))) - (frame (do ((cfp (sb!vm:context-register scp sb!vm::cfp-offset)) - (f (top-frame) (frame-down f))) - ((= cfp (sap-int (frame-pointer f))) f) - (declare (type (unsigned-byte #.sb!vm:n-word-bits) cfp)))) + (frame (signal-context-frame signal-context)) (component (breakpoint-data-component data)) (cookie (gethash component *fun-end-cookies*))) (remhash component *fun-end-cookies*) diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp index 041007b..789efa0 100644 --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@ -255,7 +255,7 @@ ;;; Given a signal context, return the floating point modes word in ;;; the same format as returned by FLOATING-POINT-MODES. -#!-linux +#!-(or linux sunos) (defun context-floating-point-modes (context) ;; FIXME: As of sbcl-0.6.7 and the big rewrite of signal handling for ;; POSIXness and (at the Lisp level) opaque signal contexts, @@ -263,21 +263,9 @@ ;; alien function. (declare (ignore context)) ; stub! (warn "stub CONTEXT-FLOATING-POINT-MODES") - - ;; old code for Linux: - #+nil - (let ((cw (slot (deref (slot context 'fpstate) 0) 'cw)) - (sw (slot (deref (slot context 'fpstate) 0) 'sw))) - ;;(format t "cw = ~4X~%sw = ~4X~%" cw sw) - ;; NOT TESTED -- Clear sticky bits to clear interrupt condition. - (setf (slot (deref (slot context 'fpstate) 0) 'sw) (logandc2 sw #x3f)) - ;;(format t "new sw = ~X~%" (slot (deref (slot context 'fpstate) 0) 'sw)) - ;; Simulate floating-point-modes VOP. - (logior (ash (logand sw #xffff) 16) (logxor (logand cw #xffff) #x3f))) - 0) -#!+linux +#!+(or linux sunos) (define-alien-routine ("os_context_fp_control" context-floating-point-modes) (sb!alien:unsigned 32) (context (* os-context-t))) diff --git a/src/runtime/bsd-os.h b/src/runtime/bsd-os.h index 4f72a66..474f686 100644 --- a/src/runtime/bsd-os.h +++ b/src/runtime/bsd-os.h @@ -49,11 +49,6 @@ typedef struct sigaltstack stack_t; #include typedef ucontext_t os_context_t; -/* As the sbcl-devel message from Raymond Wiker 2000-12-01, FreeBSD - * (unlike Linux and OpenBSD) doesn't let us tweak the CPU's single - * step flag bit by messing with the flags stored in a signal context, - * so we need to implement single stepping in a more roundabout way. */ -#define CANNOT_GET_TO_SINGLE_STEP_FLAG #define SIG_MEMORY_FAULT SIGSEGV /* Sometime in late 2005 FreeBSD was changed to signal SIGSEGV instead * of SIGBUS for memory faults, as required by POSIX. In order to diff --git a/src/runtime/x86-64-arch.c b/src/runtime/x86-64-arch.c index 91143d5..a0d8276 100644 --- a/src/runtime/x86-64-arch.c +++ b/src/runtime/x86-64-arch.c @@ -162,14 +162,6 @@ arch_remove_breakpoint(void *pc, unsigned int orig_inst) *((char *)pc + 1) = (orig_inst & 0xff00) >> 8; } -/* When single stepping, single_stepping holds the original instruction - * PC location. */ -unsigned int *single_stepping = NULL; -#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG -unsigned long single_step_save1; -unsigned long single_step_save2; -unsigned long single_step_save3; -#endif void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) @@ -179,25 +171,6 @@ arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) /* Put the original instruction back. */ *((char *)pc) = orig_inst & 0xff; *((char *)pc + 1) = (orig_inst & 0xff00) >> 8; - -#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG - /* Install helper instructions for the single step: - * pushf; or [esp],0x100; popf. */ - single_step_save1 = *(pc-3); - single_step_save2 = *(pc-2); - single_step_save3 = *(pc-1); - *(pc-3) = 0x9c909090; - *(pc-2) = 0x00240c81; - *(pc-1) = 0x9d000001; -#else - *context_eflags_addr(context) |= 0x100; -#endif - - single_stepping = pc; - -#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG - *os_context_pc_addr(context) = (char *)pc - 9; -#endif } void @@ -207,41 +180,11 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) os_context_t *context = (os_context_t*)void_context; unsigned int trap; - 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; - } - /* This is just for info in case the monitor wants to print an * approximation. */ current_control_stack_pointer = (lispobj *)*os_context_sp_addr(context); - /* FIXME: CMUCL puts the float control restoration code here. - Thus, it seems to me that single-stepping won't restore the - float control. Since SBCL currently doesn't support - single-stepping (as far as I can tell) this is somewhat moot, - but it might be worth either moving this code up or deleting - the single-stepping code entirely. -- CSR, 2002-07-15 */ #ifdef LISP_FEATURE_LINUX os_restore_fp_control(context); #endif diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c index 9d76b93..1cb0de3 100644 --- a/src/runtime/x86-arch.c +++ b/src/runtime/x86-arch.c @@ -169,14 +169,6 @@ arch_remove_breakpoint(void *pc, unsigned int orig_inst) *((char *)pc + 1) = (orig_inst & 0xff00) >> 8; } -/* When single stepping, single_stepping holds the original instruction - * PC location. */ -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; -#endif void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) @@ -186,70 +178,20 @@ arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) /* Put the original instruction back. */ *((char *)pc) = orig_inst & 0xff; *((char *)pc + 1) = (orig_inst & 0xff00) >> 8; - -#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG - /* Install helper instructions for the single step: - * pushf; or [esp],0x100; popf. */ - single_step_save1 = *(pc-3); - single_step_save2 = *(pc-2); - single_step_save3 = *(pc-1); - *(pc-3) = 0x9c909090; - *(pc-2) = 0x00240c81; - *(pc-1) = 0x9d000001; -#else - *context_eflags_addr(context) |= 0x100; -#endif - - single_stepping = pc; - -#ifdef CANNOT_GET_TO_SINGLE_STEP_FLAG - *os_context_pc_addr(context) = (char *)pc - 9; -#endif } + 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; - } -#endif - /* This is just for info in case the monitor wants to print an * approximation. */ current_control_stack_pointer = (lispobj *)*os_context_sp_addr(context); - /* FIXME: CMUCL puts the float control restoration code here. - Thus, it seems to me that single-stepping won't restore the - float control. Since SBCL currently doesn't support - single-stepping (as far as I can tell) this is somewhat moot, - but it might be worth either moving this code up or deleting - the single-stepping code entirely. -- CSR, 2002-07-15 */ #ifdef LISP_FEATURE_LINUX os_restore_fp_control(context); #endif diff --git a/src/runtime/x86-sunos-os.c b/src/runtime/x86-sunos-os.c index fd11cf5..4569063 100644 --- a/src/runtime/x86-sunos-os.c +++ b/src/runtime/x86-sunos-os.c @@ -79,3 +79,14 @@ os_context_sigmask_addr(os_context_t *context) void os_flush_icache(os_vm_address_t address, os_vm_size_t length) { } + +unsigned long +os_context_fp_control(os_context_t *context) +{ + int *state = context->uc_mcontext.fpregs.fp_reg_set.fpchip_state.state; + /* The STATE array is in the format used by the x86 instruction FNSAVE, + * so the FPU control word is in the first 16 bits */ + int cw = (state[0] & 0xffff); + int sw = context->uc_mcontext.fpregs.fp_reg_set.fpchip_state.status; + return (cw ^ 0x3f) | (sw << 16); +} diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index 0377334..bd9526d 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -190,7 +190,10 @@ (list '(flet test) #'not-optimized)))))) (with-test (:name (:throw :no-such-tag) - :fails-on '(or (and :x86 :linux) (and :x86 :freebsd) :alpha :mips)) + :fails-on '(or + (and :x86 (or :linux :freebsd sunos)) + :alpha + :mips)) (progn (defun throw-test () (throw 'no-such-tag t)) @@ -233,7 +236,7 @@ ;;; FIXME: This test really should be broken into smaller pieces (with-test (:name (:backtrace :misc) - :fails-on '(and :x86 :linux)) + :fails-on '(and :x86 (or :linux :sunos))) (macrolet ((with-details (bool &body body) `(let ((sb-debug:*show-entry-point-details* ,bool)) ,@body))) diff --git a/tests/finalize.test.sh b/tests/finalize.test.sh index 3ba4997..d19df75 100644 --- a/tests/finalize.test.sh +++ b/tests/finalize.test.sh @@ -41,7 +41,7 @@ ${SBCL:-sbcl} < /dev/null & EOF SBCL_PID=$! -WAITED=0 +WAITED=x echo "Waiting for SBCL to finish stress-testing finalizers" while true; do @@ -55,8 +55,8 @@ while true; do exit 1 # Failure fi sleep 1 - WAITED=$(($WAITED+1)) - if (($WAITED>60)); then + WAITED="x$WAITED" + if [ $WAITED = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ]; then echo echo "timeout, killing SBCL" kill -9 $SBCL_PID diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh index 40ed2ae..ea05cbc 100644 --- a/tests/foreign.test.sh +++ b/tests/foreign.test.sh @@ -23,20 +23,20 @@ PUNT=104 testfilestem=${TMPDIR:-/tmp}/sbcl-foreign-test-$$ -## Make a little shared object files to test with. +## Make some shared object files to test with. build_so() { echo building $1.so - if [ "$(uname -m)" = x86_64 ]; then + if [ "`uname -m`" = x86_64 ]; then CFLAGS="$CFLAGS -fPIC" fi - if [ "$(uname)" = Darwin ]; then + if [ "`uname`" = Darwin ]; then SO_FLAGS="-bundle" else SO_FLAGS="-shared" fi cc -c $1.c -o $1.o $CFLAGS - ld $SO_FLAGS -o $1.so $1.o + ld $SO_FLAGS -o $1.so $1.o } echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c diff --git a/version.lisp-expr b/version.lisp-expr index b8c2988..e43a8e4 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".) -"0.9.11.18" +"0.9.11.19" -- 1.7.10.4