Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6996/src/runtime

Modified Files:
	x86-64-arch.c x86-64-linux-os.c x86-arch.c 
Log Message:
0.9.1.8:
	* Fix typo (current-dynamic-space-spart -> current-dynamic-space-start)
          in the gencgc branch of the "clean up DYNAMIC-SPACE-START
          and -END ugliness on cheney-platforms" changes in 0.9.1.5.
        * Fix compiling with GCC 4 on x86 and x86-64 (sbcl-devel 
          "Fixes for gcc4", Sascha Wilde).
        * Remove a leftover "with-tn@...)" from x86-64/float.lisp
          (sbcl-devel , James Knight)
        * More x86-64 fp cleanups. (sbcl-devel "x86-64 fp exceptions",
          "x86-64 move-*-float-arg bug", James Knight 2005-05-27/29).


Index: x86-64-arch.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-64-arch.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- x86-64-arch.c	9 Apr 2005 21:28:41 -0000	1.3
+++ x86-64-arch.c	30 May 2005 05:25:45 -0000	1.4
@@ -84,7 +84,7 @@
 	    vlen = *(char*)(*os_context_pc_addr(context))++;
 	    /* Skip Lisp error arg data bytes. */
 	    while (vlen-- > 0) {
-		( (char*)(*os_context_pc_addr(context)) )++;
+		++*os_context_pc_addr(context);
 	    }
 	    break;
 
@@ -264,12 +264,12 @@
 	break;
 
     case trap_Breakpoint:
-	(char*)(*os_context_pc_addr(context)) -= 1;
+	--*os_context_pc_addr(context);
 	handle_breakpoint(signal, info, context);
 	break;
 
     case trap_FunEndBreakpoint:
-	(char*)(*os_context_pc_addr(context)) -= 1;
+	--*os_context_pc_addr(context);
 	*os_context_pc_addr(context) =
 	    (unsigned long)handle_fun_end_breakpoint(signal, info, context);
 	break;
@@ -391,3 +391,57 @@
 }
 
 #endif
+
+/* These setup and check *both* the sse2 and x87 FPUs. While lisp code
+   only uses the sse2 FPU, other code (such as libc) may use the x87 FPU.
+ */
+ 
+unsigned int
+arch_get_fp_modes()
+{
+    unsigned int temp;
+    unsigned int result;
+    /* return the x87 exception flags ored in with the sse2 
+     * control+status flags */
+    asm ("fnstsw %0" : "=m" (temp));
+    result = temp;
+    result &= 0x3F;
+    asm ("stmxcsr %0" : "=m" (temp));
+    result |= temp;
+    /* flip exception mask bits */
+    return result ^ (0x3F << 7);
+}
+
+struct fpenv
+{
+    unsigned short cw;
+    unsigned short unused1;
+    unsigned short sw;
+    unsigned short unused2;
+    unsigned int other_regs[5];
+};
+
+void
+arch_set_fp_modes(unsigned int mxcsr)
+{
+    struct fpenv f_env;
+    unsigned int temp;
+
+    /* turn trap enable bits into exception mask */
+    mxcsr ^= 0x3F << 7;
+    
+    /* set x87 modes */
+    asm ("fnstenv %0" : "=m" (f_env));
+    /* set control word: always long double precision
+     * get traps and rounding from mxcsr word */
+    f_env.cw = 0x300 | ((mxcsr >> 7) & 0x3F) | (((mxcsr >> 13) & 0x3) << 10);
+    /* set status word: only override exception flags, from mxcsr */
+    f_env.sw &= ~0x3F;
+    f_env.sw |= (mxcsr & 0x3F);
+    
+    asm ("fldenv %0" : : "m" (f_env));
+    
+    /* now, simply, load up the mxcsr register */
+    temp = mxcsr;
+    asm ("ldmxcsr %0" : : "m" (temp));
+}

Index: x86-64-linux-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-64-linux-os.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- x86-64-linux-os.c	18 May 2005 02:22:51 -0000	1.4
+++ x86-64-linux-os.c	30 May 2005 05:25:45 -0000	1.5
@@ -129,8 +129,11 @@
 unsigned long
 os_context_fp_control(os_context_t *context)
 {
-    int mxcsr = context->uc_mcontext.fpregs->mxcsr;
-    return ((mxcsr & 0x3F) << 16 | ((mxcsr >> 7) & 0x3F)) ^ 0x3F;
+    /* return the x87 exception flags ored in with the sse2 
+     * control+status flags */
+    unsigned int result = (context->uc_mcontext.fpregs->swd & 0x3F) | context->uc_mcontext.fpregs->mxcsr;
+    /* flip exception mask bits */
+    return result ^ (0x3F << 7);
 }
 
 sigset_t *
@@ -142,7 +145,11 @@
 void
 os_restore_fp_control(os_context_t *context)
 {
-    asm ("ldmxcsr %0" : : "m" (context->uc_mcontext.fpregs->mxcsr));
+    /* reset exception flags and restore control flags on SSE2 FPU */
+    unsigned int temp = (context->uc_mcontext.fpregs->mxcsr) & ~0x3F;
+    asm ("ldmxcsr %0" : : "m" (temp));
+    /* same for x87 FPU. */
+    asm ("fldcw %0" : : "m" (context->uc_mcontext.fpregs->cwd));
 }
 
 void

Index: x86-arch.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-arch.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- x86-arch.c	9 Sep 2004 12:10:15 -0000	1.27
+++ x86-arch.c	30 May 2005 05:25:45 -0000	1.28
@@ -85,7 +85,7 @@
 	    vlen = *(char*)(*os_context_pc_addr(context))++;
 	    /* Skip Lisp error arg data bytes. */
 	    while (vlen-- > 0) {
-		( (char*)(*os_context_pc_addr(context)) )++;
+		++*os_context_pc_addr(context);
 	    }
 	    break;
 
@@ -265,12 +265,12 @@
 	break;
 
     case trap_Breakpoint:
-	(char*)(*os_context_pc_addr(context)) -= 1;
+	--*os_context_pc_addr(context);
 	handle_breakpoint(signal, info, context);
 	break;
 
     case trap_FunEndBreakpoint:
-	(char*)(*os_context_pc_addr(context)) -= 1;
+	--*os_context_pc_addr(context);
 	*os_context_pc_addr(context) =
 	    (int)handle_fun_end_breakpoint(signal, info, context);
 	break;