ffi: Re-alienate the floenv after Scheme is re-entered.

Also, preserve the floenv around callouts, and set it to the default
for callbacks (as for interrupts).  And clean up some trailing
whitespace.

diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c
index 566e07175e7f1831190f2aad696354f814b6b988..d14a06dfc1cda32fd669382fbfc63f082f262b78 100644 (file)
--- a/src/microcode/pruxffi.c
+++ b/src/microcode/pruxffi.c
@@ -719,6 +719,7 @@ callback_run_kernel (long callback_id, CallbackKernel kernel)
   SET_LEXPR_ACTUALS (nargs);
 
   cstack_depth -= 1;
+  alienate_float_environment ();
 }
 
 DEFINE_PRIMITIVE ("RUN-CALLBACK", Prim_run_callback, 0, 0, 0)
@@ -726,7 +727,7 @@ DEFINE_PRIMITIVE ("RUN-CALLBACK", Prim_run_callback, 0, 0, 0)
   /* All the smarts are in the kernel. */
 
   PRIMITIVE_HEADER (0);
-  { 
+  {
     char * tos;
     CallbackKernel kernel;
     int depth;
@@ -1098,7 +1099,7 @@ DEFINE_PRIMITIVE ("OUTF-ERROR", Prim_outf_error, 1, 1, 0)
   /* To avoid the normal IO system when debugging a callback. */
 
   PRIMITIVE_HEADER (1);
-  { 
+  {
     SCM arg = ARG_REF (1);
     if (STRING_P (arg))
       {

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index fe2707ebc44295aa5cf3577b0faa48c02bd653ef..64f6cf17249def688734ca35b04a9c48d653d857 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -228,7 +228,7 @@ USA.
 (define-integrable alien-function/filename %alien-function/filename)
 
 (define-integrable (alien-function/name alienf)
-  (string-tail (%alien-function/name alienf) 4)) 
+  (string-tail (%alien-function/name alienf) 4))
 
 (define (%set-alien-function/address! alienf address)
   (let ((qr (integer-divide address %radix)))
@@ -370,7 +370,9 @@ USA.
    (lambda ()
      (without-interrupts
       (lambda ()
-       (call-alien* alien-function args))))))
+       (flo:preserving-environment
+        (lambda ()
+          (call-alien* alien-function args))))))))
 
 #;(define-integrable (call-alien* alien-function args)
   (apply (ucode-primitive c-call -1) alien-function args))
@@ -527,13 +529,15 @@ USA.
   ;; by a callback trampoline.  The callout should have already masked
   ;; all but the GC interrupts.
 
-  (if (not (< id (vector-length registered-callbacks)))
-      (error:bad-range-argument id 'apply-callback))
-  (let ((procedure (vector-ref registered-callbacks id)))
-    (if (not procedure)
-       (error:bad-range-argument id 'apply-callback))
-    (normalize-aliens! args)
-    (callback-handler* procedure args)))
+  (flo:with-default-environment
+   (lambda ()
+     (if (not (< id (vector-length registered-callbacks)))
+        (error:bad-range-argument id 'apply-callback))
+     (let ((procedure (vector-ref registered-callbacks id)))
+       (if (not procedure)
+          (error:bad-range-argument id 'apply-callback))
+       (normalize-aliens! args)
+       (callback-handler* procedure args)))))
 
 #;(define-integrable (callback-handler* procedure args)
   (apply-callback-proc procedure args))