[armedbear-cvs] r14116 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Aug 18 03:36:44 2012
New Revision: 14116

Log:
Make compile-file generate a file with EXPORTed symbols
so we can use it in COMPILE-SYSTEM.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Sat Aug 18 03:35:03 2012	(r14115)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Sat Aug 18 03:36:44 2012	(r14116)
@@ -41,6 +41,7 @@
 
 (defvar *toplevel-functions*)
 (defvar *toplevel-macros*)
+(defvar *toplevel-exports*)
 
 
 (defun base-classname (&optional (output-file-pathname *output-file-pathname*))
@@ -281,6 +282,16 @@
       (eval form)))
   nil)
 
+(declaim (ftype (function (t t t) t) process-toplevel-export))
+(defun process-toplevel-export (form stream compile-time-too)
+  (when (eq (car (second form)) 'QUOTE) ;; constant export list
+    (let ((sym-or-syms (second (second form))))
+      (setf *toplevel-exports*
+            (append  *toplevel-exports* (if (listp sym-or-syms)
+                                            sym-or-syms
+                                            (list sym-or-syms))))))
+  (precompile-toplevel-form form stream compile-time-too))
+
 (declaim (ftype (function (t t t) t) process-toplevel-mop.ensure-method))
 (defun process-toplevel-mop.ensure-method (form stream compile-time-too)
   (declare (ignore stream))
@@ -561,7 +572,7 @@
                 (DEFUN process-toplevel-defun)
                 (DEFVAR process-toplevel-defvar/defparameter)
                 (EVAL-WHEN process-toplevel-eval-when)
-                (EXPORT precompile-toplevel-form)
+                (EXPORT process-toplevel-export)
                 (IMPORT process-toplevel-import)
                 (IN-PACKAGE process-toplevel-defpackage/in-package)
                 (LOCALLY process-toplevel-locally)
@@ -697,7 +708,7 @@
 
 (defun compile-from-stream (in output-file temp-file temp-file2
                             extract-toplevel-funcs-and-macros
-                            functions-file macros-file)
+                            functions-file macros-file exports-file)
   (let* ((*compile-file-pathname* (make-pathname :defaults (pathname in)
                                                  :version nil))
          (*compile-file-truename* (make-pathname :defaults (truename in)
@@ -776,7 +787,20 @@
                                    :if-does-not-exist :create
                                    :if-exists :supersede)
               (let ((*package* (find-package :keyword)))
-                (write *toplevel-macros* :stream m-out)))))
+                (write *toplevel-macros* :stream m-out))))
+          (setf *toplevel-exports*
+                (remove-if-not (lambda (sym)
+                                 (if (symbolp sym)
+                                     (symbol-package sym)
+                                     T))
+                               (remove-duplicates *toplevel-exports*)))
+          (when *toplevel-exports*
+            (with-open-file (e-out exports-file
+                                   :direction :output
+                                   :if-does-not-exist :create
+                                   :if-exists :supersede)
+              (let ((*package* (find-package :keyword)))
+                (write *toplevel-exports* :stream e-out)))))
         (with-open-file (in temp-file :direction :input)
           (with-open-file (out temp-file2 :direction :output
                                :if-does-not-exist :create
@@ -863,14 +887,16 @@
            (temp-file2 (pathname-with-type output-file type "-tmp2"))
            (functions-file (pathname-with-type output-file "funcs"))
            (macros-file (pathname-with-type output-file "macs"))
+           (exports-file (pathname-with-type output-file "exps"))
            *toplevel-functions*
            *toplevel-macros*
+           *toplevel-exports*
            (warnings-p nil)
            (failure-p nil))
       (with-open-file (in input-file :direction :input)
         (compile-from-stream in output-file temp-file temp-file2
                              extract-toplevel-funcs-and-macros
-                             functions-file macros-file))
+                             functions-file macros-file exports-file))
       (values (truename output-file) warnings-p failure-p))))
 
 (defun compile-file-if-needed (input-file &rest allargs &key force-compile