X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-alieneval.lisp;h=1f34143ace012a9f1f09860c9794fb2b67e7f810;hb=f3666325b394cc61492be8aaf9621d66e7d9c0bd;hp=21585e6870d025dedc6ee9308f97e9d4b20ca92c;hpb=6fa968aaa8051da23cc3153a1c0e67addbea85f6;p=sbcl.git

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index 21585e6..1f34143 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -446,7 +446,8 @@ allocated using ``malloc'', so it can be passed to foreign functions which use
      (lambda ()
        (alien-funcall
         (extern-alien "free" (function (values) system-area-pointer))
-        alien-sap)))
+        alien-sap))
+     :dont-save t)
     alien))
 
 (defun note-local-alien-type (info alien)
@@ -538,33 +539,38 @@ allocated using ``malloc'', so it can be passed to foreign functions which use
 
 ;;;; NATURALIZE, DEPORT, EXTRACT-ALIEN-VALUE, DEPOSIT-ALIEN-VALUE
 
+(defun coerce-to-interpreted-function (lambda-form)
+  (let (#!+sb-eval
+        (*evaluator-mode* :interpret))
+    (coerce lambda-form 'function)))
+
 (defun naturalize (alien type)
   (declare (type alien-type type))
-  (funcall (coerce (compute-naturalize-lambda type) 'function)
+  (funcall (coerce-to-interpreted-function (compute-naturalize-lambda type))
            alien type))
 
 (defun deport (value type)
   (declare (type alien-type type))
-  (funcall (coerce (compute-deport-lambda type) 'function)
+  (funcall (coerce-to-interpreted-function (compute-deport-lambda type))
            value type))
 
 (defun deport-alloc (value type)
   (declare (type alien-type type))
-  (funcall (coerce (compute-deport-alloc-lambda type) 'function)
+  (funcall (coerce-to-interpreted-function (compute-deport-alloc-lambda type))
            value type))
 
 (defun extract-alien-value (sap offset type)
   (declare (type system-area-pointer sap)
            (type unsigned-byte offset)
            (type alien-type type))
-  (funcall (coerce (compute-extract-lambda type) 'function)
+  (funcall (coerce-to-interpreted-function (compute-extract-lambda type))
            sap offset type))
 
 (defun deposit-alien-value (sap offset type value)
   (declare (type system-area-pointer sap)
            (type unsigned-byte offset)
            (type alien-type type))
-  (funcall (coerce (compute-deposit-lambda type) 'function)
+  (funcall (coerce-to-interpreted-function (compute-deposit-lambda type))
            sap offset type value))
 
 ;;;; ALIEN-FUNCALL, DEFINE-ALIEN-ROUTINE
@@ -787,6 +793,7 @@ ENTER-ALIEN-CALLBACK pulls the corresponsing trampoline out and calls it.")
                 (vector-push-extend
                  (alien-callback-lisp-trampoline wrapper function)
                  *alien-callback-trampolines*)
+                ;; Assembler-wrapper is static, so sap-taking is safe.
                 (let ((sap (vector-sap assembler-wrapper)))
                   (push (cons sap (make-callback-info :specifier specifier
                                                       :function function