runtime/ffi: Do not dynamic-wind around callouts and callbacks.

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 64f6cf17249def688734ca35b04a9c48d653d857..511c4426169f58bf39a0c6a6609e3f6a014a4942 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -370,9 +370,10 @@ USA.
    (lambda ()
      (without-interrupts
       (lambda ()
-       (flo:preserving-environment
-        (lambda ()
-          (call-alien* alien-function args))))))))
+       (let* ((saved (flo:environment))
+              (value (call-alien* alien-function args)))
+         (flo:set-environment! saved)
+         value))))))
 
 #;(define-integrable (call-alien* alien-function args)
   (apply (ucode-primitive c-call -1) alien-function args))
@@ -529,15 +530,13 @@ USA.
   ;; by a callback trampoline.  The callout should have already masked
   ;; all but the GC interrupts.
 
-  (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)))))
+  (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))