From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 16 Jul 2002 13:48:02 +0000 (+0000)
Subject: 0.7.5.13:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=637371f800e71ac4449e01d59571c9d10f6bde26;hp=b84b7f3a3c58909c6e252aba8c97148c9ad917b7;p=sbcl.git

0.7.5.13:
	Linux floating point fixes
	... define an os_restore_fp_control() function in the runtime, and
		use it in signal handlers (protected by #ifdef
		LISP_FEATURE_LINUX in non-Linux-specific code)
	... write useful definitions of it
		... for x86 (probably correct)
		... for ppc (works, but could do with fixing)
	... delete a SET_FPU_CONTROL_WORD from initialization
		... dunno why it was there; no observable symptoms. Shout
			if some early x86/Linux system no longer works.
	... export to C (via sbcl.h) Lisp's view of the floating point
		control word
	... delete some floating-point-related stale symbols and comments
		from package-data-list.lisp-expr
	Now floating point stuff mostly works (I think) on x86/Linux and
		ppc/Linux, as well as sparc/SunOS. Other platforms still
		probably don't work.
---

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 7be4e32..f632013 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -552,11 +552,6 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
              ;; WITH-STANDARD-IO-SYNTAX or something.)
              "*ERROR-PRINT-LENGTH*" "*ERROR-PRINT-LEVEL*" "*ERROR-PRINT-LINES*"
 
-             ;; KLUDGE: CMU CL had
-             ;; "*IGNORE-FLOATING-POINT-UNDERFLOW*", which seemed
-             ;; like a reasonable idea but doesn't seem to be supported
-             ;; now? -- WHN 19991206
-
              ;; extended declarations..
              "FREEZE-TYPE" "INHIBIT-WARNINGS"
              "MAYBE-INLINE"
@@ -586,7 +581,6 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
              ;; want to do this stuff.
              "FLOAT-DENORMALIZED-P"
              "FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P"
-             "FLOATING-POINT-INVALID"
              "FLOAT-INFINITY-P"
              "SHORT-FLOAT-NEGATIVE-INFINITY"
              "SHORT-FLOAT-POSITIVE-INFINITY"
diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp
index 2d68335..21c2f47 100644
--- a/src/code/x86-vm.lisp
+++ b/src/code/x86-vm.lisp
@@ -235,6 +235,7 @@
 
 ;;; Given a signal context, return the floating point modes word in
 ;;; the same format as returned by FLOATING-POINT-MODES.
+#!-linux
 (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,
@@ -255,6 +256,11 @@
     (logior (ash (logand sw #xffff) 16) (logxor (logand cw #xffff) #x3f)))
 
   0)
+
+#!+linux
+(define-alien-routine ("os_context_fp_control" context-floating-point-modes)
+    (sb!alien:unsigned 32)
+  (context (* os-context-t)))
 
 ;;;; INTERNAL-ERROR-ARGS
 
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index fad92a9..8640884 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -2747,6 +2747,14 @@
   ;; pseudo-atomic-trap-number or pseudo-atomic-magic-constant
   ;; [possibly applicable to other platforms])
 
+  (dolist (symbol '(sb!vm::float-traps-byte sb!vm::float-exceptions-byte sb!vm::float-sticky-bits sb!vm::float-rounding-mode))
+    (format t "#define ~A_POSITION ~A /* ~:*0x~X */~%"
+	    (substitute #\_ #\- (symbol-name symbol))
+	    (sb!xc:byte-position (symbol-value symbol)))
+    (format t "#define ~A_MASK 0x~X /* ~:*~A */~%"
+	    (substitute #\_ #\- (symbol-name symbol))
+	    (sb!xc:mask-field (symbol-value symbol) -1)))
+
   ;; writing primitive object layouts
   (let ((structs (sort (copy-list sb!vm:*primitive-objects*) #'string<
 		       :key (lambda (obj)
diff --git a/src/runtime/alpha-arch.c b/src/runtime/alpha-arch.c
index 27ea9ee..03cf3c7 100644
--- a/src/runtime/alpha-arch.c
+++ b/src/runtime/alpha-arch.c
@@ -280,6 +280,10 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
 {
     unsigned int code;
 
+#ifdef LISP_FEATURE_LINUX
+    os_restore_fp_control(context);
+#endif
+
     /* Don't disallow recursive breakpoint traps.  Otherwise, we can't */
     /* use debugger breakpoints anywhere in here. */
     sigset_t *mask=(os_context_sigmask_addr(context));
diff --git a/src/runtime/alpha-linux-os.c b/src/runtime/alpha-linux-os.c
index 249136d..45c9ffb 100644
--- a/src/runtime/alpha-linux-os.c
+++ b/src/runtime/alpha-linux-os.c
@@ -74,6 +74,22 @@ os_context_fp_control(os_context_t *context)
     return ieee_fpcr_to_swcr((context->uc_mcontext).sc_fpcr);
 }
 
+void
+os_restore_fp_control(os_context_t *context)
+{
+    /* FIXME (in two parts):
+       Firstly, what happens in alpha linux inside the signal handler?
+       Does the floating point control state get cleared as in other
+       Linuxes?
+    
+       Secondly, how do we put it back if so? It will probably involve
+       something to do with
+    
+       context->uc_mcontext.sc_fpcr
+
+       (maybe a simple assembly statement will be enough)
+    */ 
+}
 
 void os_flush_icache(os_vm_address_t address, os_vm_size_t length)
 {
diff --git a/src/runtime/alpha-linux-os.h b/src/runtime/alpha-linux-os.h
index c270f2e..63858cf 100644
--- a/src/runtime/alpha-linux-os.h
+++ b/src/runtime/alpha-linux-os.h
@@ -7,4 +7,6 @@ static inline os_context_t *arch_os_get_context(void **void_context) {
   return (os_context_t *) *void_context;
 }
 
+unsigned long os_context_fp_control(os_context_t *context);
+
 #endif /* _ALPHA_LINUX_OS_H */
diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 5b20451..1eb49ca 100644
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -347,23 +347,12 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 #endif
     union interrupt_handler handler;
 
-    /* FIXME: The CMU CL we forked off of had this Linux-only
-     * operation here. Newer CMU CLs (e.g. 18c) have hairier
-     * Linux/i386-only logic here. SBCL seems to be more reliable
-     * without anything here. However, if we start supporting code
-     * which sets the rounding mode, then we may want to do something
-     * special to force the rounding mode back to some standard value
-     * here, so that ISRs can have a standard environment. (OTOH, if
-     * rounding modes are under user control, then perhaps we should
-     * leave this up to the user.)
-     *
-     * In the absence of a test case to show that this is really a
-     * problem, we just suppress this code completely (just like the
-     * parallel code in maybe_now_maybe_later).
-     * #ifdef __linux__
-     *    SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
-     * #endif */
-
+#ifdef LISP_FEATURE_LINUX
+    /* Under Linux, we appear to have to restore the fpu control word
+       from the context, as after the signal is delivered we appear to
+       have a null fpu control word. */
+    os_restore_fp_control(context);
+#endif 
     handler = interrupt_handlers[signal];
 
     if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) {
@@ -446,12 +435,12 @@ maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
      * interrupt time which should be ported into SBCL. Also see the
      * analogous logic at the head of interrupt_handle_now for
      * more related FIXME stuff. 
-     *
-     * For now, we just suppress this code completely.
-     * #ifdef __linux__
-     *    SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
-     * #endif */
-
+     */
+    
+#ifdef LISP_FEATURE_LINUX
+    os_restore_fp_control(context);
+#endif 
+    
     /* see comments at top of code/signal.lisp for what's going on here
      * with INTERRUPTS_ENABLED/INTERRUPT_HANDLE_NOW 
      */
diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c
index d44f19f..bef7006 100644
--- a/src/runtime/linux-os.c
+++ b/src/runtime/linux-os.c
@@ -80,16 +80,17 @@ void os_init(void)
     }
 
     os_vm_page_size = getpagesize();
-   /* This could just as well be in arch_init(), but it's not. */
+    /* This could just as well be in arch_init(), but it's not. */
 #ifdef __i386__
-    SET_FPU_CONTROL_WORD(0x1372|4|8|16|32); /* no interrupts */
+    /* FIXME: This used to be here.  However, I have just removed it
+       with no apparent ill effects (it may be that earlier kernels
+       started up a process with a different set of traps, or
+       something?) Find out what this was meant to do, and reenable it
+       or delete it if possible. -- CSR, 2002-07-15 */
+    /* SET_FPU_CONTROL_WORD(0x1372|4|8|16|32); /* no interrupts */
 #endif
 }
 
-/* various os_context_*_addr accessors moved to {x86,alpha}-linux-os.c 
- * -dan 20010125
- */
-
 /* In Debian CMU CL ca. 2.4.9, it was possible to get an infinite
  * cascade of errors from do_mmap(..). This variable is a counter to
  * prevent that; when it counts down to zero, an error in do_mmap
diff --git a/src/runtime/linux-os.h b/src/runtime/linux-os.h
index 267929f..ed8733d 100644
--- a/src/runtime/linux-os.h
+++ b/src/runtime/linux-os.h
@@ -32,13 +32,9 @@ typedef size_t os_vm_size_t;
 typedef off_t os_vm_offset_t;
 typedef int os_vm_prot_t;
 
-/* typedef struct ucontext os_context_t;*/
-
 #define OS_VM_PROT_READ    PROT_READ
 #define OS_VM_PROT_WRITE   PROT_WRITE
 #define OS_VM_PROT_EXECUTE PROT_EXEC
 
-#define SET_FPU_CONTROL_WORD(cw) asm("fldcw %0" : : "m" (cw))
-
 /* /usr/include/asm/sigcontext.h  */
 typedef long os_context_register_t ;
diff --git a/src/runtime/ppc-arch.c b/src/runtime/ppc-arch.c
index eac4013..2d62424 100644
--- a/src/runtime/ppc-arch.c
+++ b/src/runtime/ppc-arch.c
@@ -137,6 +137,9 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
     int badinst;
     u32 code;
     sigset_t *mask;
+#ifdef LISP_FEATURE_LINUX
+    os_restore_fp_control(context);
+#endif
     mask=(os_context_sigmask_addr(context));
     sigsetmask(mask); 
     code=*((u32 *)(*os_context_pc_addr(context)));
diff --git a/src/runtime/ppc-linux-os.c b/src/runtime/ppc-linux-os.c
index 1d0ae66..14411f6 100644
--- a/src/runtime/ppc-linux-os.c
+++ b/src/runtime/ppc-linux-os.c
@@ -75,10 +75,41 @@ os_context_fp_control(os_context_t *context)
        registers, and PT_FPSCR is an offset that is larger than 32
        (the number of ppc registers), but that happens to get the
        right answer. -- CSR, 2002-07-11 */
-    return &((context->uc_mcontext.regs)->gpr[PT_FPSCR]); 
+    return context->uc_mcontext.regs->gpr[PT_FPSCR]; 
 }
 
-void os_flush_icache(os_vm_address_t address, os_vm_size_t length)
+void 
+os_restore_fp_control(os_context_t *context)
+{
+    unsigned long control;
+    
+    control = os_context_fp_control(context) & 
+      /* FIXME: Should we preserve the user's requested rounding mode?
+
+         Note that doing 
+
+	 ~(FLOAT_STICKY_BITS_MASK | FLOAT_EXCEPTIONS_BYTE_MASK)
+
+	 here leads to infinite SIGFPE for invalid operations, as
+	 there are bits in the control register that need to be
+	 cleared that are let through by that mask. -- CSR, 2002-07-16 */
+      FLOAT_TRAPS_BYTE_MASK;
+    
+    /* FIXME: Shoot me now.
+       
+       Hardcoded nastiness: the "0"s below refer to the first floating
+       point registers -- we should let gcc deal with that. The 8(31)
+       refers to the position on the stack, less one, of control (we
+       need for control to be the high word of the double loaded by
+       lfd; how do I know that r31 contains the stack? I don't, I'm
+       just guessing. The 255, on the other hand, is a valid constant
+       -- it says "move everything in the upper word into the floating
+       point control register. -- CSR, 2002-07-16 */
+    asm ("stw %0, 12(31); lfd 0, 8(31); mtfsf 255, 0" : : "r" (control) : "r31");
+}
+
+void 
+os_flush_icache(os_vm_address_t address, os_vm_size_t length)
 {
     /* see ppc-arch.c */
     ppc_flush_icache(address,length);
diff --git a/src/runtime/ppc-linux-os.h b/src/runtime/ppc-linux-os.h
index e057ad3..28dad76 100644
--- a/src/runtime/ppc-linux-os.h
+++ b/src/runtime/ppc-linux-os.h
@@ -7,4 +7,7 @@ static inline os_context_t *arch_os_get_context(void **void_context) {
   return (os_context_t *) *void_context;
 }
 
+unsigned long os_context_fp_control(os_context_t *context);
+void os_restore_fp_control(os_context_t *context);
+
 #endif /* _PPC_LINUX_OS_H */
diff --git a/src/runtime/sparc-arch.c b/src/runtime/sparc-arch.c
index c2bfd22..6a79854 100644
--- a/src/runtime/sparc-arch.c
+++ b/src/runtime/sparc-arch.c
@@ -62,7 +62,7 @@ os_vm_address_t arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *contex
 	return 0;
 
     rs1 = (badinst>>14)&0x1f;
-
+    
     if (badinst & (1<<13)) {
 	/* r[rs1] + simm(13) */
 	int simm13 = badinst & 0x1fff;
@@ -71,54 +71,54 @@ os_vm_address_t arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *contex
 	    simm13 |= -1<<13;
 
 	return (os_vm_address_t)
-	  (*os_context_register_addr(context, rs1)+simm13);
+	    (*os_context_register_addr(context, rs1)+simm13);
     }
     else {
 	/* r[rs1] + r[rs2] */
 	int rs2 = badinst & 0x1f;
 
 	return (os_vm_address_t)
-	  (*os_context_register_addr(context, rs1) + 
-	   *os_context_register_addr(context, rs2));
+	    (*os_context_register_addr(context, rs1) + 
+	     *os_context_register_addr(context, rs2));
     }
 }
 
 void arch_skip_instruction(os_context_t *context)
 {
-  ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context));
-  ((char *) *os_context_npc_addr(context)) += 4;
+    ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context));
+    ((char *) *os_context_npc_addr(context)) += 4;
 }
 
 unsigned char *arch_internal_error_arguments(os_context_t *context)
 {
-  return (unsigned char *)(*os_context_pc_addr(context) + 4);
+    return (unsigned char *)(*os_context_pc_addr(context) + 4);
 }
 
 boolean arch_pseudo_atomic_atomic(os_context_t *context)
 {
-  return ((*os_context_register_addr(context,reg_ALLOC)) & 4);
+    return ((*os_context_register_addr(context,reg_ALLOC)) & 4);
 }
 
 void arch_set_pseudo_atomic_interrupted(os_context_t *context)
 {
-  *os_context_register_addr(context,reg_ALLOC) |=  1;
+    *os_context_register_addr(context,reg_ALLOC) |=  1;
 }
 
 unsigned long arch_install_breakpoint(void *pc)
 {
-  unsigned long *ptr = (unsigned long *)pc;
-  unsigned long result = *ptr;
-  *ptr = trap_Breakpoint;
-  
-  os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
+    unsigned long *ptr = (unsigned long *)pc;
+    unsigned long result = *ptr;
+    *ptr = trap_Breakpoint;
   
-  return result;
+    os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
+    
+    return result;
 }
 
 void arch_remove_breakpoint(void *pc, unsigned long orig_inst)
 {
-  *(unsigned long *)pc = orig_inst;
-  os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
+    *(unsigned long *)pc = orig_inst;
+    os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
 }
 
 static unsigned long *skipped_break_addr, displaced_after_inst;
@@ -126,223 +126,228 @@ static sigset_t orig_sigmask;
 
 void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
 {
-  unsigned long *pc = (unsigned long *)(*os_context_pc_addr(context));
-  /* FIXME */
-  unsigned long *npc = (unsigned long *)(*os_context_npc_addr(context));
+    unsigned long *pc = (unsigned long *)(*os_context_pc_addr(context));
+    unsigned long *npc = (unsigned long *)(*os_context_npc_addr(context));
 
   /*  orig_sigmask = context->sigmask;
       sigemptyset(&context->sigmask); */
   /* FIXME!!! */
   /* FILLBLOCKSET(&context->uc_sigmask);*/
 
-  *pc = orig_inst;
-  os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
-  skipped_break_addr = pc;
-  displaced_after_inst = *npc;
-  *npc = trap_AfterBreakpoint;
-  os_flush_icache((os_vm_address_t) npc, sizeof(unsigned long));
-
+    *pc = orig_inst;
+    os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
+    skipped_break_addr = pc;
+    displaced_after_inst = *npc;
+    *npc = trap_AfterBreakpoint;
+    os_flush_icache((os_vm_address_t) npc, sizeof(unsigned long));
+    
 }
 
 static int pseudo_atomic_trap_p(os_context_t *context)
 {
-  unsigned int* pc;
-  unsigned int badinst;
-  int result;
-  
-  
-  pc = (unsigned int*) *os_context_pc_addr(context);
-  badinst = *pc;
-  result = 0;
-
-  /* Check to see if the current instruction is a pseudo-atomic-trap */
-  if (((badinst >> 30) == 2) && (((badinst >> 19) & 0x3f) == 0x3a)
-      && (((badinst >> 13) & 1) == 1) && ((badinst & 0x7f) == PSEUDO_ATOMIC_TRAP))
-    {
-      unsigned int previnst;
-      previnst = pc[-1];
-      /*
-       * Check to see if the previous instruction was an andcc alloc-tn,
-       * 3, zero-tn instruction.
-       */
-      if (((previnst >> 30) == 2) && (((previnst >> 19) & 0x3f) == 0x11)
-          && (((previnst >> 14) & 0x1f) == reg_ALLOC)
-          && (((previnst >> 25) & 0x1f) == reg_ZERO)
-          && (((previnst >> 13) & 1) == 1)
-          && ((previnst & 0x1fff) == 3))
-        {
-          result = 1;
-        }
-      else
-        {
-          fprintf(stderr, "Oops!  Got a PSEUDO-ATOMIC-TRAP without a preceeding andcc!\n");
-        }
-    }
-  return result;
+    unsigned int* pc;
+    unsigned int badinst;
+    int result;
+    
+    
+    pc = (unsigned int*) *os_context_pc_addr(context);
+    badinst = *pc;
+    result = 0;
+    
+    /* Check to see if the current instruction is a pseudo-atomic-trap */
+    if (((badinst >> 30) == 2) && (((badinst >> 19) & 0x3f) == 0x3a)
+	&& (((badinst >> 13) & 1) == 1) && ((badinst & 0x7f) == PSEUDO_ATOMIC_TRAP))
+	{
+	    unsigned int previnst;
+	    previnst = pc[-1];
+	    /*
+	     * Check to see if the previous instruction was an andcc alloc-tn,
+	     * 3, zero-tn instruction.
+	     */
+	    if (((previnst >> 30) == 2) && (((previnst >> 19) & 0x3f) == 0x11)
+		&& (((previnst >> 14) & 0x1f) == reg_ALLOC)
+		&& (((previnst >> 25) & 0x1f) == reg_ZERO)
+		&& (((previnst >> 13) & 1) == 1)
+		&& ((previnst & 0x1fff) == 3))
+		{
+		    result = 1;
+		}
+	    else
+		{
+		    fprintf(stderr, "Oops!  Got a PSEUDO-ATOMIC-TRAP without a preceeding andcc!\n");
+		}
+	}
+    return result;
 }
 
 static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context)
 {
-  os_context_t *context = arch_os_get_context(&void_context);
-
-  sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
-
-  if ((siginfo->si_code) == ILL_ILLOPC
+    os_context_t *context = arch_os_get_context(&void_context);
 #ifdef LISP_FEATURE_LINUX
-      || (early_kernel && (siginfo->si_code == 2))
+    /* FIXME: Check that this is necessary -- CSR, 2002-07-15 */
+    os_restore_fp_control(context);
 #endif
-      ) {
-    int trap;
-    unsigned int inst;
-    unsigned int* pc = (unsigned int*) siginfo->si_addr;
-
-    inst = *pc;
-    trap = inst & 0x3fffff;
+    sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
     
-    switch (trap) {
-    case trap_PendingInterrupt:
-      arch_skip_instruction(context);
-      interrupt_handle_pending(context);
-      break;
-
-    case trap_Halt:
-      fake_foreign_function_call(context);
-      lose("%%primitive halt called; the party is over.\n");
-      
-    case trap_Error:
-    case trap_Cerror:
-      interrupt_internal_error(signal, siginfo, context, trap == trap_Cerror);
-      break;
-
-    case trap_Breakpoint:
-      handle_breakpoint(signal, siginfo, context);
-      break;
-
-    case trap_FunEndBreakpoint:
-      *os_context_pc_addr(context) = (int) handle_fun_end_breakpoint(signal, siginfo, context);
-      *os_context_npc_addr(context) = *os_context_pc_addr(context) + 4;
-      break;
-
-    case trap_AfterBreakpoint:
-      *skipped_break_addr = trap_Breakpoint;
-      skipped_break_addr = NULL;
-      *(unsigned long *) os_context_pc_addr(context) = displaced_after_inst;
-      /* context->sigmask = orig_sigmask; */
-      os_flush_icache((os_vm_address_t) os_context_pc_addr(context), sizeof(unsigned long));
-      break;
-      
-    default:
-      interrupt_handle_now(signal, siginfo, context);
-      break;
+    if ((siginfo->si_code) == ILL_ILLOPC
+#ifdef LISP_FEATURE_LINUX
+	|| (early_kernel && (siginfo->si_code == 2))
+#endif
+	) {
+	int trap;
+	unsigned int inst;
+	unsigned int* pc = (unsigned int*) siginfo->si_addr;
+
+	inst = *pc;
+	trap = inst & 0x3fffff;
+	
+	switch (trap) {
+	case trap_PendingInterrupt:
+	    arch_skip_instruction(context);
+	    interrupt_handle_pending(context);
+	    break;
+	    
+	case trap_Halt:
+	    fake_foreign_function_call(context);
+	    lose("%%primitive halt called; the party is over.\n");
+	    
+	case trap_Error:
+	case trap_Cerror:
+	    interrupt_internal_error(signal, siginfo, context, trap == trap_Cerror);
+	    break;
+	    
+	case trap_Breakpoint:
+	    handle_breakpoint(signal, siginfo, context);
+	    break;
+	    
+	case trap_FunEndBreakpoint:
+	    *os_context_pc_addr(context) = (int) handle_fun_end_breakpoint(signal, siginfo, context);
+	    *os_context_npc_addr(context) = *os_context_pc_addr(context) + 4;
+	    break;
+	    
+	case trap_AfterBreakpoint:
+	    *skipped_break_addr = trap_Breakpoint;
+	    skipped_break_addr = NULL;
+	    *(unsigned long *) os_context_pc_addr(context) = displaced_after_inst;
+	    /* context->sigmask = orig_sigmask; */
+	    os_flush_icache((os_vm_address_t) os_context_pc_addr(context), sizeof(unsigned long));
+	    break;
+	    
+	default:
+	    interrupt_handle_now(signal, siginfo, context);
+	    break;
+	}
     }
-  }
-  else if ((siginfo->si_code) == ILL_ILLTRP
+    else if ((siginfo->si_code) == ILL_ILLTRP
 #ifdef LISP_FEATURE_LINUX
-	   || (early_kernel && (siginfo->si_code) == 192)
+	     || (early_kernel && (siginfo->si_code) == 192)
 #endif
-	   ) {
-    if (pseudo_atomic_trap_p(context)) {
-      /* A trap instruction from a pseudo-atomic.  We just need
-	 to fixup up alloc-tn to remove the interrupted flag,
-	 skip over the trap instruction, and then handle the
-	 pending interrupt(s). */
-      *os_context_register_addr(context, reg_ALLOC) &= ~7;
-      arch_skip_instruction(context);
-      interrupt_handle_pending(context);
+	     ) {
+	if (pseudo_atomic_trap_p(context)) {
+	    /* A trap instruction from a pseudo-atomic.  We just need
+	       to fixup up alloc-tn to remove the interrupted flag,
+	       skip over the trap instruction, and then handle the
+	       pending interrupt(s). */
+	    *os_context_register_addr(context, reg_ALLOC) &= ~7;
+	    arch_skip_instruction(context);
+	    interrupt_handle_pending(context);
+	}
+	else {
+	    interrupt_internal_error(signal, siginfo, context, 0);
+	}
     }
     else {
-      interrupt_internal_error(signal, siginfo, context, 0);
+	interrupt_handle_now(signal, siginfo, context);
     }
-  }
-  else {
-    interrupt_handle_now(signal, siginfo, context);
-  }
 }
 
 static void sigemt_handler(int signal, siginfo_t *siginfo, void *void_context)
 {
-  unsigned long badinst;
-  boolean subtract, immed;
-  int rd, rs1, op1, rs2, op2, result;
-  os_context_t *context = arch_os_get_context(&void_context);
-
-  badinst = *(unsigned long *)os_context_pc_addr(context);
-  if ((badinst >> 30) != 2 || ((badinst >> 20) & 0x1f) != 0x11) {
-    /* It wasn't a tagged add.  Pass the signal into lisp. */
-    interrupt_handle_now(signal, siginfo, context);
-    return;
-  }
-
-  fprintf(stderr, "SIGEMT trap handler with tagged op instruction!\n");
-  
-  /* Extract the parts of the inst. */
-  subtract = badinst & (1<<19);
-  rs1 = (badinst>>14) & 0x1f;
-  op1 = *os_context_register_addr(context, rs1);
-  
-  /* If the first arg is $ALLOC then it is really a signal-pending note */
-  /* for the pseudo-atomic noise. */
-  if (rs1 == reg_ALLOC) {
-    /* Perform the op anyway. */
-    op2 = badinst & 0x1fff;
-    if (op2 & (1<<12))
-      op2 |= -1<<13;
-    if (subtract)
-      result = op1 - op2;
-    else
-      result = op1 + op2;
-    *os_context_register_addr(context, reg_ALLOC) = result & ~7;
-    arch_skip_instruction(context);
-    interrupt_handle_pending(context);
-    return;
-  }
-
-  if ((op1 & 3) != 0) {
-    /* The first arg wan't a fixnum. */
-    interrupt_internal_error(signal, siginfo, context, 0);
-    return;
-  }
-
-  if (immed = badinst & (1<<13)) {
-    op2 = badinst & 0x1fff;
-    if (op2 & (1<<12))
-      op2 |= -1<<13;
-  }
-  else {
-    rs2 = badinst & 0x1f;
-    op2 = *os_context_register_addr(context, rs2);
-  }
-
-  if ((op2 & 3) != 0) {
-    /* The second arg wan't a fixnum. */
-    interrupt_internal_error(signal, siginfo, context, 0);
-    return;
-  }
-
-  rd = (badinst>>25) & 0x1f;
-  if (rd != 0) {
-    /* Don't bother computing the result unless we are going to use it. */
-    if (subtract)
-      result = (op1>>2) - (op2>>2);
-    else
-      result = (op1>>2) + (op2>>2);
+    unsigned long badinst;
+    boolean subtract, immed;
+    int rd, rs1, op1, rs2, op2, result;
+    os_context_t *context = arch_os_get_context(&void_context);
+#ifdef LISP_FEATURE_LINUX
+    os_restore_fp_control(context);
+#endif
     
-    dynamic_space_free_pointer =
-      (lispobj *) *os_context_register_addr(context, reg_ALLOC);
-
-    *os_context_register_addr(context, rd) = alloc_number(result);
+    badinst = *(unsigned long *)os_context_pc_addr(context);
+    if ((badinst >> 30) != 2 || ((badinst >> 20) & 0x1f) != 0x11) {
+	/* It wasn't a tagged add.  Pass the signal into lisp. */
+	interrupt_handle_now(signal, siginfo, context);
+	return;
+    }
     
-    *os_context_register_addr(context, reg_ALLOC) =
-      (unsigned long) dynamic_space_free_pointer;
-  }
-
-  arch_skip_instruction(context);
+    fprintf(stderr, "SIGEMT trap handler with tagged op instruction!\n");
+    
+    /* Extract the parts of the inst. */
+    subtract = badinst & (1<<19);
+    rs1 = (badinst>>14) & 0x1f;
+    op1 = *os_context_register_addr(context, rs1);
+    
+    /* If the first arg is $ALLOC then it is really a signal-pending note */
+    /* for the pseudo-atomic noise. */
+    if (rs1 == reg_ALLOC) {
+	/* Perform the op anyway. */
+	op2 = badinst & 0x1fff;
+	if (op2 & (1<<12))
+	    op2 |= -1<<13;
+	if (subtract)
+	    result = op1 - op2;
+	else
+	    result = op1 + op2;
+	*os_context_register_addr(context, reg_ALLOC) = result & ~7;
+	arch_skip_instruction(context);
+	interrupt_handle_pending(context);
+	return;
+    }
+    
+    if ((op1 & 3) != 0) {
+	/* The first arg wan't a fixnum. */
+	interrupt_internal_error(signal, siginfo, context, 0);
+	return;
+    }
+    
+    if (immed = badinst & (1<<13)) {
+	op2 = badinst & 0x1fff;
+	if (op2 & (1<<12))
+	    op2 |= -1<<13;
+    }
+    else {
+	rs2 = badinst & 0x1f;
+	op2 = *os_context_register_addr(context, rs2);
+    }
+    
+    if ((op2 & 3) != 0) {
+	/* The second arg wan't a fixnum. */
+	interrupt_internal_error(signal, siginfo, context, 0);
+	return;
+    }
+    
+    rd = (badinst>>25) & 0x1f;
+    if (rd != 0) {
+	/* Don't bother computing the result unless we are going to use it. */
+	if (subtract)
+	    result = (op1>>2) - (op2>>2);
+	else
+	    result = (op1>>2) + (op2>>2);
+	
+	dynamic_space_free_pointer =
+	    (lispobj *) *os_context_register_addr(context, reg_ALLOC);
+	
+	*os_context_register_addr(context, rd) = alloc_number(result);
+	
+	*os_context_register_addr(context, reg_ALLOC) =
+	    (unsigned long) dynamic_space_free_pointer;
+    }
+    
+    arch_skip_instruction(context);
 }
 
 void arch_install_interrupt_handlers()
 {
-  undoably_install_low_level_interrupt_handler(SIGILL , sigill_handler);
-  undoably_install_low_level_interrupt_handler(SIGEMT, sigemt_handler);
+    undoably_install_low_level_interrupt_handler(SIGILL , sigill_handler);
+    undoably_install_low_level_interrupt_handler(SIGEMT, sigemt_handler);
 }
 
 
diff --git a/src/runtime/sparc-linux-os.c b/src/runtime/sparc-linux-os.c
index 60c1bc5..9d4d683 100644
--- a/src/runtime/sparc-linux-os.c
+++ b/src/runtime/sparc-linux-os.c
@@ -75,7 +75,22 @@ os_context_sigmask_addr(os_context_t *context)
     return &(context->si_mask);
 }
 
-void os_flush_icache(os_vm_address_t address, os_vm_size_t length)
+void 
+os_restore_fp_control(os_context_t *context)
+{
+    /* Included here, for reference, is an attempt at the PPC
+       variant. If it weren't the case that SPARC/Linux gave a Bus
+       Error on floating point exceptions, something like this would
+       have to be done. -- CSR, 2002-07-13
+
+    asm ("msfsf $255, %0" : : "m" 
+	 (os_context_fp_control(context) & 
+	  ~ (FLOAT_STICKY_BITS_MASK | FLOAT_EXCEPTIONS_BYTE_MASK)));
+    */
+}
+
+void 
+os_flush_icache(os_vm_address_t address, os_vm_size_t length)
 {
     /* This is the same for linux and solaris, so see sparc-assem.S */
     sparc_flush_icache(address,length);
diff --git a/src/runtime/sparc-linux-os.h b/src/runtime/sparc-linux-os.h
index a8305f3..98413e8 100644
--- a/src/runtime/sparc-linux-os.h
+++ b/src/runtime/sparc-linux-os.h
@@ -8,4 +8,7 @@ static inline os_context_t *arch_os_get_context(void **void_context) {
   return (os_context_t *) (void_context + 37);
 }
 
+unsigned long os_context_fp_control(os_context_t *context);
+void os_restore_fp_control(os_context_t *context);
+
 #endif /* _SPARC_LINUX_OS_H */
diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c
index 96d3bcd..5063c98 100644
--- a/src/runtime/x86-arch.c
+++ b/src/runtime/x86-arch.c
@@ -217,6 +217,16 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context)
     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
+
     /* On entry %eip points just after the INT3 byte and aims at the
      * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a
      * number of bytes will follow, the first is the length of the byte
diff --git a/src/runtime/x86-linux-os.c b/src/runtime/x86-linux-os.c
index 560babb..3d6e8a3 100644
--- a/src/runtime/x86-linux-os.c
+++ b/src/runtime/x86-linux-os.c
@@ -79,18 +79,8 @@ os_context_sp_addr(os_context_t *context)
 unsigned long
 os_context_fp_control(os_context_t *context)
 {
-    /* probably the code snippet
-     * #ifdef __linux__
-     *    SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
-     * #endif 
-     * is relevant to implementing this correctly */
-
-    /* Note that currently this is not called, as there is an analogous
-     * stub in lisp-land (x86-vm.lisp), also returning 0, with the old
-     * lisp fp-control code. This is here more as a signpost of a possible
-     * way of restoring functionality, and if it is the way to go would
-     * need to be included for other architectures as well. */
-    return 0;
+    return ((((context->uc_mcontext.fpregs->cw) & 0xffff) ^ 0x3f) |
+	    (((context->uc_mcontext.fpregs->sw) & 0xffff) << 16));
 }
 
 sigset_t *
@@ -100,6 +90,12 @@ os_context_sigmask_addr(os_context_t *context)
 }
 
 void
+os_restore_fp_control(os_context_t *context)
+{
+    asm ("fldcw %0" : : "m" (context->uc_mcontext.fpregs->cw));
+}
+
+void
 os_flush_icache(os_vm_address_t address, os_vm_size_t length)
 {
 }
diff --git a/src/runtime/x86-linux-os.h b/src/runtime/x86-linux-os.h
index 02cdfc1..8db9207 100644
--- a/src/runtime/x86-linux-os.h
+++ b/src/runtime/x86-linux-os.h
@@ -7,4 +7,7 @@ static inline os_context_t *arch_os_get_context(void **void_context) {
   return (os_context_t *) *void_context;
 }
 
+unsigned long os_context_fp_control(os_context_t *context);
+void os_restore_fp_control(os_context_t *context);
+
 #endif /* _X86_LINUX_OS_H */
diff --git a/version.lisp-expr b/version.lisp-expr
index e70fd5b..51c2d9d 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.5.12"
+"0.7.5.13"