source: branches/streams/abcl/src/org/armedbear/lisp/fasl-concat.lisp

Last change on this file was 14460, checked in by ehuelsmann, 12 years ago
  • Rename FASL entry point inside the fasl from "<fasl>._" to "loader._" in case of zipped fasls. In case of "directory fasls", the loader is (still) called "<fasl>.abcl".
  • Delete temporary directory after repackaging fasls.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 4.1 KB
Line 
1;;; fasl-concat.lisp
2;;;
3;;; Copyright (C) 2013 Erik Huelsmann
4;;; $Id: fasl-concat.lisp 14460 2013-04-03 21:34:53Z ehuelsmann $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19;;;
20;;; As a special exception, the copyright holders of this library give you
21;;; permission to link this library with independent modules to produce an
22;;; executable, regardless of the license terms of these independent
23;;; modules, and to copy and distribute the resulting executable under
24;;; terms of your choice, provided that you also meet, for each linked
25;;; independent module, the terms and conditions of the license of that
26;;; module.  An independent module is a module which is not derived from
27;;; or based on this library.  If you modify this library, you may extend
28;;; this exception to your version of the library, but you are not
29;;; obligated to do so.  If you do not wish to do so, delete this
30;;; exception statement from your version.
31
32
33(in-package #:system)
34
35
36(export '(concatenate-fasls))
37
38
39(defun pathname-directory-p (pathname)
40  (and (null (pathname-type pathname))
41       (null (pathname-name pathname))
42       (null (pathname-version pathname))))
43
44(defun load-concatenated-fasl (sub-fasl)
45  (let ((fasl-path (merge-pathnames (make-pathname :directory (list :relative
46                                                                    sub-fasl)
47                                                   :name "__loader__"
48                                                   :type "_")
49                                    *load-truename-fasl*)))
50    (load fasl-path)))
51
52(defun concatenate-fasls (inputs output)
53  (let ((directory (ext:make-temp-directory))
54        paths)
55    (unwind-protect
56         (let* ((unpacked (mapcan #'(lambda (input)
57                                      (sys:unzip input
58                                                 (ensure-directories-exist
59                                                  (sub-directory directory
60                                                                 (pathname-name  input)))))
61                                   inputs))
62                (chain-loader (make-pathname :name "__loader__"
63                                             :type "_"
64                                             :defaults directory)))
65           (with-open-file (f chain-loader
66                              :direction :output
67                              :if-does-not-exist :create
68                              :if-exists :overwrite)
69             (write-string
70              ";; loader code to delegate loading of the embedded fasls below" f)
71             (terpri f)
72             (sys::dump-form `(sys:init-fasl :version ,sys:*fasl-version*) f)
73             (terpri f)
74             (dolist (input inputs)
75               (sys::dump-form `(load-concatenated-fasl ,(pathname-name input)) f)
76               (terpri f)))
77           (setf paths
78                 (directory (merge-pathnames
79                             (make-pathname :directory '(:relative
80                                                         :wild-inferiors)
81                                            :name "*"
82                                            :type "*")
83                             directory)))
84           (sys:zip output (remove-if #'pathname-directory-p paths) directory)
85           (values directory unpacked chain-loader))
86      (dolist (path paths)
87        (ignore-errors (delete-file path)))
88      (ignore-errors (delete-file directory)))))
89
90(defun sub-directory (directory name)
91  (merge-pathnames (make-pathname :directory (list :relative name))
92                   directory))
Note: See TracBrowser for help on using the repository browser.