Changeset 14116


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r14111 r14116  
    4242(defvar *toplevel-functions*)
    4343(defvar *toplevel-macros*)
     44(defvar *toplevel-exports*)
    4445
    4546
     
    281282      (eval form)))
    282283  nil)
     284
     285(declaim (ftype (function (t t t) t) process-toplevel-export))
     286(defun process-toplevel-export (form stream compile-time-too)
     287  (when (eq (car (second form)) 'QUOTE) ;; constant export list
     288    (let ((sym-or-syms (second (second form))))
     289      (setf *toplevel-exports*
     290            (append  *toplevel-exports* (if (listp sym-or-syms)
     291                                            sym-or-syms
     292                                            (list sym-or-syms))))))
     293  (precompile-toplevel-form form stream compile-time-too))
    283294
    284295(declaim (ftype (function (t t t) t) process-toplevel-mop.ensure-method))
     
    562573                (DEFVAR process-toplevel-defvar/defparameter)
    563574                (EVAL-WHEN process-toplevel-eval-when)
    564                 (EXPORT precompile-toplevel-form)
     575                (EXPORT process-toplevel-export)
    565576                (IMPORT process-toplevel-import)
    566577                (IN-PACKAGE process-toplevel-defpackage/in-package)
     
    698709(defun compile-from-stream (in output-file temp-file temp-file2
    699710                            extract-toplevel-funcs-and-macros
    700                             functions-file macros-file)
     711                            functions-file macros-file exports-file)
    701712  (let* ((*compile-file-pathname* (make-pathname :defaults (pathname in)
    702713                                                 :version nil))
     
    777788                                   :if-exists :supersede)
    778789              (let ((*package* (find-package :keyword)))
    779                 (write *toplevel-macros* :stream m-out)))))
     790                (write *toplevel-macros* :stream m-out))))
     791          (setf *toplevel-exports*
     792                (remove-if-not (lambda (sym)
     793                                 (if (symbolp sym)
     794                                     (symbol-package sym)
     795                                     T))
     796                               (remove-duplicates *toplevel-exports*)))
     797          (when *toplevel-exports*
     798            (with-open-file (e-out exports-file
     799                                   :direction :output
     800                                   :if-does-not-exist :create
     801                                   :if-exists :supersede)
     802              (let ((*package* (find-package :keyword)))
     803                (write *toplevel-exports* :stream e-out)))))
    780804        (with-open-file (in temp-file :direction :input)
    781805          (with-open-file (out temp-file2 :direction :output
     
    864888           (functions-file (pathname-with-type output-file "funcs"))
    865889           (macros-file (pathname-with-type output-file "macs"))
     890           (exports-file (pathname-with-type output-file "exps"))
    866891           *toplevel-functions*
    867892           *toplevel-macros*
     893           *toplevel-exports*
    868894           (warnings-p nil)
    869895           (failure-p nil))
     
    871897        (compile-from-stream in output-file temp-file temp-file2
    872898                             extract-toplevel-funcs-and-macros
    873                              functions-file macros-file))
     899                             functions-file macros-file exports-file))
    874900      (values (truename output-file) warnings-p failure-p))))
    875901
Note: See TracChangeset for help on using the changeset viewer.