Ignore:
Timestamp:
12/25/09 21:52:23 (12 years ago)
Author:
ehuelsmann
Message:

Land fast-boot-preloading branch on trunk.

Note: things to do include

  1. Applying the same strategy to macro functions
  2. Applying the same strategy to functions which get loaded during

EVAL-WHEN when compiling

File:
1 edited

Legend:

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

    r12229 r12306  
    161161                      (setf form
    162162                            `(fset ',name
    163                                    (load-compiled-function ,(file-namestring classfile))
     163                                   (proxy-preloaded-function ',name ,(file-namestring classfile))
    164164                                   ,*source-position*
    165165                                   ',lambda-list
     
    485485         (temp-file (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp"))
    486486                                     output-file))
     487         (temp-file2 (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp2"))
     488                                     output-file))
    487489         (warnings-p nil)
    488490         (failure-p nil))
     
    511513              (jvm::with-saved-compiler-policy
    512514                  (jvm::with-file-compilation
    513                       (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
    514                     (%stream-terpri out)
    515                     (let ((*package* (find-package '#:cl)))
    516                       (write (list 'init-fasl :version *fasl-version*)
    517                              :stream out)
    518                       (%stream-terpri out)
    519                       (write (list 'setq '*source* *compile-file-truename*)
    520                              :stream out)
    521                       (%stream-terpri out))
    522515                    (handler-bind ((style-warning #'(lambda (c)
    523516                                                      (setf warnings-p t)
     
    545538                    (dolist (name *fbound-names*)
    546539                      (fmakunbound name)))))))
    547         (rename-file temp-file output-file)
     540        (with-open-file (in temp-file :direction :input)
     541          (with-open-file (out temp-file2 :direction :output
     542                               :if-does-not-exist :create
     543                               :if-exists :supersede)
     544            ;; write header
     545            (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
     546            (%stream-terpri out)
     547            (let ((*package* (find-package '#:cl))
     548                  (count-sym (gensym)))
     549              (write (list 'init-fasl :version *fasl-version*)
     550                     :stream out)
     551              (%stream-terpri out)
     552              (write (list 'setq '*source* *compile-file-truename*)
     553                     :stream out)
     554              (%stream-terpri out)
     555              (dump-form `(dotimes (,count-sym ,*class-number*)
     556                            (function-preload
     557                             (%format nil "~A-~D.cls" ,(pathname-name output-file)
     558                                      (1+ ,count-sym)))) out)
     559              (%stream-terpri out))
     560
     561
     562            ;; copy remaining content
     563            (loop for line = (read-line in nil :eof)
     564               while (not (eq line :eof))
     565               do (write-line line out))))
     566        (delete-file temp-file)
     567        (rename-file temp-file2 output-file)
    548568
    549569        (when *compile-file-zip*
Note: See TracChangeset for help on using the changeset viewer.