From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 11 Jul 2002 15:17:00 +0000 (+0000)
Subject: 0.7.5.10:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=06c18a339a9883597dc5a96028e7ac983cbb9305;p=sbcl.git

0.7.5.10:
	Begin to fix floating point exceptions on PPC
	... write an os_context_fp_control function
	... use it in CONTEXT-FLOATING-POINT-MODES
	(this, unlike on the SPARC and Alpha ports, doesn't fix all the
		normal-user problems.  After the first return from the Lisp
		debugger on the PPC, the FLOATING-POINT-MODES are (almost)
		cleared, which means that the second bad floating point
		operation is not trapped).
---

diff --git a/src/code/ppc-vm.lisp b/src/code/ppc-vm.lisp
index a8fc742..278fb82 100644
--- a/src/code/ppc-vm.lisp
+++ b/src/code/ppc-vm.lisp
@@ -97,13 +97,9 @@
 
 ;;; Given a signal context, return the floating point modes word in
 ;;; the same format as returned by FLOATING-POINT-MODES.
-(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,
-  ;; this is needs to be rewritten as an alien function.
-  (warn "stub CONTEXT-FLOATING-POINT-MODES")
-  0)
-
+(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/runtime/ppc-linux-os.c b/src/runtime/ppc-linux-os.c
index c5dc7a2..1d0ae66 100644
--- a/src/runtime/ppc-linux-os.c
+++ b/src/runtime/ppc-linux-os.c
@@ -67,6 +67,17 @@ os_context_sigmask_addr(os_context_t *context)
     return &context->uc_sigmask;
 }
 
+unsigned long
+os_context_fp_control(os_context_t *context)
+{
+    /* So this may look like nice, well behaved code. However, closer
+       inspection reveals that gpr is simply the general purpose
+       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]); 
+}
+
 void os_flush_icache(os_vm_address_t address, os_vm_size_t length)
 {
     /* see ppc-arch.c */
diff --git a/version.lisp-expr b/version.lisp-expr
index e645084..f9b47fc 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.9"
+"0.7.5.10"