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
(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
#!+(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
(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
(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*)
;;; 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,
;; 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)))
#include <sys/ucontext.h>
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
*((char *)pc + 1) = (orig_inst & 0xff00) >> 8;
}
\f
-/* 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)
/* 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
}
\f
void
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
*((char *)pc + 1) = (orig_inst & 0xff00) >> 8;
}
\f
-/* 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)
/* 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
}
\f
+
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
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);
+}
(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))
;;; 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)))
EOF
SBCL_PID=$!
-WAITED=0
+WAITED=x
echo "Waiting for SBCL to finish stress-testing finalizers"
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
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
;;; 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"
projects / sbcl.git / commitdiff