source: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp @ 13303

Last change on this file since 13303 was 13303, checked in by Mark Evenson, 10 years ago

Automagically find contrib via (REQUIRE :ABCL-CONTRIB).

REQUIREing :ABCL-CONTRIB will look for a 'abcl-contrib.jar' in the
same directory as 'abcl.jar'. If found, all the ASDF definitions one
level deep will be added to the ASDF search path, allowing contribs to
be loaded via REQUIRE or ASDF:LOAD-SYSTEM.

No longer compile contribs as ASDF will do this for us. Since we
moved to ASDF2, the contrib FASLs have been compiled but not packaged,
so this doesn't change any behavior except making packaging shorter.
When we figure out how to package FASLs with ASDF systems in jar
files, we will revisit this topic.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.2 KB
Line 
1;;; compile-system.lisp
2;;;
3;;; Copyright (C) 2004-2008 Peter Graves
4;;; $Id: compile-system.lisp 13303 2011-05-27 14:13:18Z mevenson $
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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, 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(in-package "SYSTEM")
33
34(require "LOOP")
35(require "COLLECT")
36(require "COMPILE-FILE")
37
38(defun check-lisp-home ()
39  (loop
40    (cond ((and *lisp-home*
41                (probe-directory (pathname *lisp-home*)))
42           (return))
43          (t
44           (cerror "Continue"
45                   "*LISP-HOME* is NIL or invalid.~%  Please set *LISP-HOME* to the full pathname of the directory containing the Lisp system files.")))))
46
47(defun grovel-java-definitions-in-file (file out)
48  (with-open-file (in file)
49    (declare (type stream in))
50    (let ((system-package (find-package "SYSTEM"))
51          (line-number 1))
52      (loop
53        (let ((text (read-line in nil)))
54          (when (null text)
55            (return))
56          (let ((position (search "###" text)))
57            (when position
58                 (let* ((name (string (read-from-string (subseq text (+ position 3)))))
59                        (symbol (or (find-symbol name system-package) ; uses CL and EXT
60                                    (find-symbol name (find-package "MOP"))
61                                    (find-symbol name (find-package "JAVA")))))
62                   (when symbol
63                     ;; Force the symbol's package prefix to be written out
64                     ;; with "::" instead of ":" so there won't be a reader
65                     ;; error if a symbol that's external now is no longer
66                     ;; external when we read the tags file.
67                     (%format out "~A::~A ~S ~S~%"
68                              (package-name (symbol-package symbol))
69                              name
70                              file line-number)))))
71          (incf line-number))))))
72
73(defun grovel-java-definitions ()
74  (check-lisp-home)
75  (time
76   (let ((files (directory (merge-pathnames "*.java" *lisp-home*))))
77     (with-open-file (stream (merge-pathnames "tags" *lisp-home*)
78                             :direction :output :if-exists :supersede)
79       (dolist (file files)
80         (grovel-java-definitions-in-file file stream))))))
81
82(defun %compile-system (&key output-path)
83  (let ((*default-pathname-defaults* (pathname *lisp-home*))
84        (*warn-on-redefinition* nil))
85    (unless output-path
86      (setf output-path *default-pathname-defaults*))
87    (flet ((do-compile (file)
88             (let ((out (make-pathname :type "abcl"
89                                       :defaults (merge-pathnames
90                                                  file output-path))))
91               (compile-file-if-needed file :output-file out))))
92      (load (do-compile "coerce.lisp"))
93      (load (do-compile "open.lisp"))
94      (load (do-compile "dump-form.lisp"))
95      (load (do-compile "compiler-types.lisp"))
96      (load (do-compile "compile-file.lisp"))
97      (load (do-compile "precompiler.lisp"))
98      (load (do-compile "compiler-pass1.lisp"))
99      (load (do-compile "compiler-pass2.lisp"))
100      (load (do-compile "jvm-class-file.lisp"))
101      (load (do-compile "jvm.lisp"))
102      (load (do-compile "source-transform.lisp"))
103      (load (do-compile "compiler-macro.lisp"))
104      (load (do-compile "jvm-instructions.lisp"))
105      (load (do-compile "setf.lisp"))
106      (load (do-compile "extensible-sequences-base.lisp"))
107      (load (do-compile "require.lisp"))
108      (load (do-compile "substitute.lisp"))
109      (load (do-compile "clos.lisp"))
110      ;; Order matters for these files.
111      (mapc #'do-compile '("collect.lisp"
112                           "macros.lisp"
113                           "loop.lisp"))
114      (load (do-compile "backquote.lisp"))
115      (load (do-compile "early-defuns.lisp"))
116      (load (do-compile "typep.lisp"))
117      (load (do-compile "subtypep.lisp"))
118      (load (do-compile "find.lisp"))
119      (load (do-compile "print.lisp"))
120      (load (do-compile "pprint-dispatch.lisp"))
121      (load (do-compile "pprint.lisp"))
122      (load (do-compile "format.lisp"))
123      (load (do-compile "delete.lisp"))
124      (load (do-compile "concatenate.lisp"))
125      (load (do-compile "ldb.lisp"))
126      (load (do-compile "destructuring-bind.lisp"))
127      (load (do-compile "asdf.lisp"))
128      ;; But not for these.
129      (mapc #'do-compile '("abcl-contrib.lisp"
130         "adjoin.lisp"
131                           "and.lisp"
132                           "apropos.lisp"
133                           "arrays.lisp"
134                           "assert.lisp"
135                           "assoc.lisp"
136                           "autoloads.lisp"
137                           "aver.lisp"
138                           "bit-array-ops.lisp"
139                           "boole.lisp"
140                           ;;"boot.lisp"
141                           "butlast.lisp"
142                           "byte-io.lisp"
143                           "case.lisp"
144                           "chars.lisp"
145                           "check-type.lisp"
146                           "compile-file-pathname.lisp"
147                           "compile-system.lisp"
148                           "compiler-error.lisp"
149                           "cond.lisp"
150                           "copy-seq.lisp"
151                           "copy-symbol.lisp"
152                           "count.lisp"
153                           "debug.lisp"
154                           "define-modify-macro.lisp"
155                           "define-symbol-macro.lisp"
156                           "defmacro.lisp"
157                           "defpackage.lisp"
158                           "defsetf.lisp"
159                           "defstruct.lisp"
160                           "deftype.lisp"
161                           "delete-duplicates.lisp"
162                           "deposit-field.lisp"
163                           "describe.lisp"
164                           "describe-compiler-policy.lisp"
165                           "directory.lisp"
166                           "disassemble.lisp"
167                           "do-all-symbols.lisp"
168                           "do-external-symbols.lisp"
169                           "do-symbols.lisp"
170                           "do.lisp"
171                           "dolist.lisp"
172                           "dotimes.lisp"
173                           "dribble.lisp"
174                           "dump-class.lisp"
175                           "ed.lisp"
176                           "enough-namestring.lisp"
177                           "ensure-directories-exist.lisp"
178                           "error.lisp"
179         "extensible-sequences.lisp"
180                           "featurep.lisp"
181                           "fdefinition.lisp"
182                           "fill.lisp"
183                           "find-all-symbols.lisp"
184                           "gentemp.lisp"
185                           "gray-streams.lisp"
186         "gui.lisp"
187                           "inline.lisp"
188                           "inspect.lisp"
189                           ;;"j.lisp"
190                           "java.lisp"
191                           "java-collections.lisp"
192                           "known-functions.lisp"
193                           "known-symbols.lisp"
194                           "late-setf.lisp"
195                           "lcm.lisp"
196                           "ldiff.lisp"
197                           "list-length.lisp"
198                           "list.lisp"
199                           "load.lisp"
200                           "make-hash-table.lisp"
201                           "make-load-form-saving-slots.lisp"
202                           "make-sequence.lisp"
203                           "make-string-output-stream.lisp"
204                           "make-string.lisp"
205                           "map-into.lisp"
206                           "map.lisp"
207                           "map1.lisp"
208                           "mask-field.lisp"
209                           "member-if.lisp"
210                           "mismatch.lisp"
211                           "multiple-value-bind.lisp"
212                           "multiple-value-list.lisp"
213                           "multiple-value-setq.lisp"
214                           "nsubstitute.lisp"
215                           "nth-value.lisp"
216                           "numbers.lisp"
217                           "or.lisp"
218                           "parse-integer.lisp"
219                           "parse-lambda-list.lisp"
220                           "package.lisp"
221                           "pathnames.lisp"
222                           "print-object.lisp"
223                           "print-unreadable-object.lisp"
224                           "proclaim.lisp"
225                           "profiler.lisp"
226                           "prog.lisp"
227                           "psetf.lisp"
228                           "query.lisp"
229                           "read-circle.lisp"
230                           "read-conditional.lisp"
231                           "read-from-string.lisp"
232                           "read-sequence.lisp"
233                           "reduce.lisp"
234                           "remf.lisp"
235                           "remove-duplicates.lisp"
236                           "remove.lisp"
237                           "replace.lisp"
238                           "restart.lisp"
239                           "revappend.lisp"
240                           "rotatef.lisp"
241                           ;;"run-benchmarks.lisp"
242                           "run-program.lisp"
243                           "run-shell-command.lisp"
244                           ;;"runtime-class.lisp"
245                           "search.lisp"
246                           "sequences.lisp"
247                           "sets.lisp"
248                           "shiftf.lisp"
249                           "signal.lisp"
250                           "socket.lisp"
251                           "sort.lisp"
252                           "step.lisp"
253                           "strings.lisp"
254                           "sublis.lisp"
255                           "subst.lisp"
256                           "tailp.lisp"
257                           "threads.lisp"
258                           "time.lisp"
259                           "top-level.lisp"
260                           "trace.lisp"
261                           "tree-equal.lisp"
262                           "upgraded-complex-part-type.lisp"
263                           "with-accessors.lisp"
264                           "with-hash-table-iterator.lisp"
265                           "with-input-from-string.lisp"
266                           "with-open-file.lisp"
267                           "with-output-to-string.lisp"
268                           "with-package-iterator.lisp"
269                           "with-slots.lisp"
270                           "with-standard-io-syntax.lisp"
271                           "write-sequence.lisp")))
272    t))
273
274(defun compile-system (&key quit (zip t) output-path)
275  (let ((status -1))
276    (check-lisp-home)
277    (time
278     (with-compilation-unit ()
279       (let ((*compile-file-zip* zip)
280             failure-p)
281         (handler-bind (((or warning
282                             compiler-error)
283                         #'(lambda (c)
284                             (declare (ignore c))
285                             (setf failure-p t)
286                             ;; only register that we had this type of signal
287                             ;; defer the actual handling to another handler
288                             nil)))
289           (%compile-system :output-path output-path))
290         (unless failure-p
291           (setf status 0)))))
292    (create-system-logical-translations output-path)
293    (when quit
294      (quit :status status))))
295
296(defun create-system-logical-translations (output-path)
297  (let* ((dir (directory-namestring (pathname output-path)))
298         (system (merge-pathnames "system.lisp" dir))
299         (home (pathname *lisp-home*))
300         (src (format nil "~A**/*.*" home))
301         (java (format nil "~A../../../**/*.*" home)))
302    (with-open-file (s system :direction :output 
303                       :if-exists :supersede)
304      (pprint `(setf (logical-pathname-translations "sys")
305                    '(("SYS:SRC;**;*.*" ,src)
306                      ("SYS:JAVA;**;*.*" ,java)))
307       s))))
308     
Note: See TracBrowser for help on using the repository browser.