* 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.

4 files changed, 44 insertions, 10 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index a617910b..c3ed8f75 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2012-08-23  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* 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.
+
 2012-08-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/br-search.boot (getTemporaryDirectory): Search TMPDIR first.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index c898c6d8..6410b524 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1919,6 +1919,9 @@ genCLOZUREnativeTranslation(op,s,t,op') ==
   -- Finally, return the definition form
   [["DEFUN", op, parms, call]]
 
+++ List of foreign function symbols defined in this module.
+$ffs := nil
+  
 ++ Generate an import declaration for `op' as equivalent of the
 ++ foreign signature `sig'.  Here, `foreign' operationally means that
 ++ the entity is from the C language world. 
@@ -1926,6 +1929,7 @@ genImportDeclaration(op, sig) ==
   sig isnt ["%Signature", op', m] => coreError '"invalid signature"
   m isnt ["%Mapping", t, s] => coreError '"invalid function type"
   if s ~= nil and symbol? s then s := [s]
+  $ffs := [op,:$ffs]
 
   %hasFeature KEYWORD::GCL => genGCLnativeTranslation(op,s,t,op')
   %hasFeature KEYWORD::SBCL => genSBCLnativeTranslation(op,s,t,op')
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 5ade6ce3..bed6328c 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -53,17 +53,15 @@ reallyPrettyPrint(x,st == _*STANDARD_-OUTPUT_*) ==
   writeNewline st
 
 genModuleFinalization(stream) ==
+  $ffs = nil => nil
+  $currentModuleName = nil => coreError '"current module has no name"
+  setFFS := ["SETQ","$dynamicForeignFunctions",
+              ["append!",quote $ffs,"$dynamicForeignFunctions"]]
+  reallyPrettyPrint(atLoadOrExecutionTime setFFS,stream)
   %hasFeature KEYWORD::CLISP =>
     $foreignsDefsForCLisp = nil => nil
-    $currentModuleName = nil =>
-       coreError '"current module has no name"
-    init := 
-      ["EVAL-WHEN", [KEYWORD::LOAD_-TOPLEVEL,KEYWORD::EXECUTE],
-        ["PROGN",
-          ["MAPC",["FUNCTION", "FMAKUNBOUND"],
-            quote [second d for d in $foreignsDefsForCLisp]],
-            :[["EVAL",quote d] for d in $foreignsDefsForCLisp]]]
-    reallyPrettyPrint(init,stream)
+    init := ["PROGN", :[["EVAL",quote d] for d in $foreignsDefsForCLisp]]
+    reallyPrettyPrint(atLoadOrExecutionTime init,stream)
   nil
 
 genOptimizeOptions stream ==
@@ -403,6 +401,9 @@ inAllContexts x ==
                   KEYWORD::LOAD_-TOPLEVEL,
                     KEYWORD::EXECUTE], x]
 
+atLoadOrExecutionTime x ==
+  ["EVAL-WHEN",[KEYWORD::LOAD_-TOPLEVEL,KEYWORD::EXECUTE],x]
+
 exportNames ns ==
   ns = nil => nil
   [inAllContexts ["EXPORT",quote ns]]
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 -*-
 ;;