From 2a353d15669a83a5b7bc0a9710f81b829667ece7 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Thu, 23 Aug 2012 14:20:14 +0000
Subject: 	* boot/ast.boot ($ffs): New. 	(genImportDeclaration): Update
 it. 	* boot/translator.boot (genModuleFinalization): Tidy. Generate 	code
 to update $dynamicForeignFunctions where necessary. 
 (atLoadOrExecutionTime): New. 	* lisp/core.lisp.in
 (UNBIND-FOREIGN-FUNCTION-SYMBOLS): New. 	(saveCore): Use it. 
 ($dynamicForeignFunctions): New.  Export.

---
 src/lisp/core.lisp.in | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

(limited to 'src/lisp')

diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index becb1390..ae5902c2 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -186,6 +186,7 @@
 	   "$StandardLinking"
 	   "$ECLVersionNumber"
 	   "$FilesToRetain"
+	   "$dynamicForeignFunctions"
 
 	   "getOptionValue"
            "getCommandLineArguments"
@@ -368,6 +369,11 @@
 (defconstant |$FilesToRetain|
   '(@oa_keep_files@))
 
+;; List of foreign function symbols to unload before saving the
+;; Lisp image.  This is meaningful only for those systems not
+;; using standard linking and that delay FFI modules to runtime.
+(defparameter |$dynamicForeignFunctions| nil)
+
 ;; Lisp compiler optimization settings.
 (defconstant |$LispOptimizeOptions|
   '(@oa_optimize_options@))
@@ -817,6 +823,18 @@
   (let ((prologue (|getOptionValue| (|Option| "prologue") options)))
     (if prologue (read-from-string prologue) nil)))
 
+;; This is meaningful only for systems that delay FFI.
+;; Unbind foreign function symbols in case delaying FFI modules
+;; is needed.  Indeed, these systems should not have references to
+;; foreign symbols that cannot be guaranteed to work properly
+;; when the saved image is restarted.
+(defun unbind-foreign-function-symbols ()
+  (when |$delayedFFI|
+    (mapc #'(lambda (s)
+	      (when (fboundp s)
+		(fmakunbound s)))
+	  |$dynamicForeignFunctions|)))
+
 ;; Save current image on disk as executable and quit.
 (defun |saveCore| (core-image &optional (entry-point nil))
   ;; When building the OpenAxiom system, and in many other cases I suspect,
@@ -827,6 +845,7 @@
   (when (consp entry-point)
     (setq entry-point (apply (car entry-point) 
                              (cdr entry-point))))
+  (unbind-foreign-function-symbols)
   #+:sbcl (if (null entry-point)
               (sb-ext::save-lisp-and-die core-image :executable t)
             (sb-ext::save-lisp-and-die core-image 
@@ -995,7 +1014,6 @@
          (args (member "--" all-args :test #'equal)))
     (cons (car all-args) (if args (cdr args) args))))
 
-
 ;; 
 ;; -*- Building Standalone Executable -*-
 ;; 
-- 
cgit v1.2.3