Changeset 14116

Timestamp:

08/18/12 10:36:44 (9 years ago)

Author:

ehuelsmann

Message:

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

File:

• trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (modified) (7 diffs)

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

@@ -42 +42 @@
 (defvar *toplevel-functions*)
 (defvar *toplevel-macros*)
+(defvar *toplevel-exports*)
 
 
@@ -281 +282 @@
       (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))
@@ -562 +573 @@
                 (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)
@@ -698 +709 @@
 (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))
@@ -777 +788 @@
                                    :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
@@ -864 +888 @@
            (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))
@@ -871 +897 @@
         (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))))