Punt fpu inits in i386/x86-64 assembler; add to savres.scm.

diff --git a/src/microcode/cmpauxmd/i386.m4 b/src/microcode/cmpauxmd/i386.m4
index 9d1273e4dbe83aa36971eb1105c70f42ac9e4700..5e56c13eedb5b02418a8c079d76305f20b67f736 100644 (file)
--- a/src/microcode/cmpauxmd/i386.m4
+++ b/src/microcode/cmpauxmd/i386.m4
@@ -406,12 +406,6 @@ ifdef(`VALGRIND_MODE',`',`
        jne     i386_initialize_no_fp
 ')
        OP(inc,l)       REG(eax)                        # 387 available
-       OP(sub,l)       TW(IMM(4),REG(esp))
-       fclex
-       fnstcw          WOF(-2,REG(ebp))
-       OP(and,w)       TW(IMM(HEX(f0e0)),WOF(-2,REG(ebp)))
-       OP(or,w)        TW(IMM(FP_CONTROL_WORD),WOF(-2,REG(ebp)))
-       fldcw           WOF(-2,REG(ebp))
 i386_initialize_no_fp:
 ')
        OP(mov,l)       TW(REG(eax),ABS(EVR(i387_presence)))

diff --git a/src/microcode/cmpauxmd/x86-64.m4 b/src/microcode/cmpauxmd/x86-64.m4
index 864f416e13e3b0c42dc2bd5b403996c3cabecc9b..19010da734241b70dfbe4b9fbae0990d422852d3 100644 (file)
--- a/src/microcode/cmpauxmd/x86-64.m4
+++ b/src/microcode/cmpauxmd/x86-64.m4
@@ -356,24 +356,6 @@ define_double(flonum_one,1.0)
 DECLARE_CODE_SEGMENT()
 declare_alignment(2)
 
-define_c_label(x86_64_interface_initialize)
-       OP(push,q)      REG(rbp)
-       OP(mov,q)       TW(REG(rsp),REG(rbp))
-       OP(sub,q)       TW(IMM(8),REG(rsp))
-       stmxcsr         IND(REG(rsp))
-       # Clear 7 (invalid operation mask)
-       #       8 (denormalized operand mask)
-       #       9 (zero-divide exception mask)
-       #       10 (overflow exception mask)
-       #       11 (underflow exception mask)
-       #       15 (flush-to-zero (if set, gives non-IEEE semantics))
-       OP(and,l)       TW(IMM(HEX(ffff707f)),IND(REG(rsp)))
-       # Set   12 (precision exception mask)
-       OP(or,l)        TW(IMM(HEX(1000)),IND(REG(rsp)))
-       ldmxcsr         IND(REG(rsp))
-       leave
-       ret
-
 # Call a function (rdi) with an argument (rsi) and a stack pointer and
 # frame pointer from inside C.  When it returns, restore the original
 # stack pointer.  This kludge is necessary for operating system

diff --git a/src/microcode/cmpintmd/x86-64.c b/src/microcode/cmpintmd/x86-64.c
index e642ba1fcb784622237550afc709b73286f223bd..e9f3b1b102d4eca3e064b527f49816392b985aba 100644 (file)
--- a/src/microcode/cmpintmd/x86-64.c
+++ b/src/microcode/cmpintmd/x86-64.c
@@ -224,8 +224,6 @@ x86_64_reset_hook (void)
   int offset = (COMPILER_REGBLOCK_N_FIXED * (sizeof (SCHEME_OBJECT)));
   unsigned char * rsi_value = ((unsigned char *) Registers);
 
-  x86_64_interface_initialize ();
-
   /* These must match machines/x86-64/lapgen.scm */
 
   SETUP_REGISTER (asm_scheme_to_interface);            /* 0 */

diff --git a/src/runtime/savres.scm b/src/runtime/savres.scm
index de8f3fa7cc0db95b2c25e83fbdf71d5081f493ce..0310f95fcb3665b0cf065d455cf73f202c893b6e 100644 (file)
--- a/src/runtime/savres.scm
+++ b/src/runtime/savres.scm
@@ -52,28 +52,30 @@ USA.
       (lambda ()
        (call-with-current-continuation
         (lambda (continuation)
-          ;; GC cannot be allowed before the fixed-objects-vector
-          ;; is reset after restoring.
-          (with-absolutely-no-interrupts
-            (lambda ()
-              (let ((fixed-objects (get-fixed-objects-vector)))
-                ((ucode-primitive call-with-current-continuation)
-                 (lambda (restart)
-                   (with-interrupt-mask interrupt-mask/gc-ok
-                     (lambda (interrupt-mask)
-                       interrupt-mask
-                       (gc-flip)
-                       (do ()
-                           (((ucode-primitive dump-band) restart filename))
-                         (with-simple-restart 'RETRY "Try again."
-                           (lambda ()
-                             (error "Disk save failed:" filename))))
-                       (continuation
-                        (lambda ()
-                          (set! time-world-saved time)
-                          (if (string? id) unspecific #f)))))))
-                ((ucode-primitive set-fixed-objects-vector!) fixed-objects))))
-          (read-microcode-tables!)
+          (let ((float-env (flo:environment)))
+            ;; GC cannot be allowed before the fixed-objects-vector
+            ;; is reset after restoring.
+            (with-absolutely-no-interrupts
+              (lambda ()
+                (let ((fixed-objects (get-fixed-objects-vector)))
+                  ((ucode-primitive call-with-current-continuation)
+                   (lambda (restart)
+                     (with-interrupt-mask interrupt-mask/gc-ok
+                       (lambda (interrupt-mask)
+                         interrupt-mask
+                         (gc-flip)
+                         (do ()
+                             (((ucode-primitive dump-band) restart filename))
+                           (with-simple-restart 'RETRY "Try again."
+                             (lambda ()
+                               (error "Disk save failed:" filename))))
+                         (continuation
+                          (lambda ()
+                            (set! time-world-saved time)
+                            (if (string? id) unspecific #f)))))))
+                  ((ucode-primitive set-fixed-objects-vector!) fixed-objects))))
+            (read-microcode-tables!)
+            (flo:set-environment! float-env))
           (lambda ()
             (set! time-world-saved time)
             (fluid-let ((*within-restore-window?* #t))