source: trunk/j/src/org/armedbear/lisp/compile-system.lisp @ 11455

Last change on this file since 11455 was 11455, checked in by vvoutilainen, 13 years ago

Split up the compiler in three separate parts in
preparation to further cleanups.

  • 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 11455 2008-12-20 13:43:29Z vvoutilainen $
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 ()
83  (let ((*default-pathname-defaults* (pathname *lisp-home*))
84         (*warn-on-redefinition* nil))
85    (load (compile-file-if-needed "coerce.lisp"))
86    (load (compile-file-if-needed "open.lisp"))
87    (load (compile-file-if-needed "dump-form.lisp"))
88    (load (compile-file-if-needed "compiler-types.lisp"))
89    (load (compile-file-if-needed "compile-file.lisp"))
90    (load (compile-file-if-needed "precompiler.lisp"))
91    (load (compile-file-if-needed "compiler-pass1.lisp"))
92    (load (compile-file-if-needed "compiler-pass2.lisp"))
93    (load (compile-file-if-needed "jvm.lisp"))
94    (load (compile-file-if-needed "source-transform.lisp"))
95    (load (compile-file-if-needed "compiler-macro.lisp"))
96    (load (compile-file-if-needed "opcodes.lisp"))
97    (load (compile-file-if-needed "setf.lisp"))
98    (load (compile-file-if-needed "substitute.lisp"))
99    (load (compile-file-if-needed "clos.lisp"))
100    ;; Order matters for these files.
101    (mapc #'compile-file-if-needed '("collect.lisp"
102                                     "macros.lisp"
103                                     "loop.lisp"))
104    (load (compile-file-if-needed "backquote.lisp"))
105    (load (compile-file-if-needed "early-defuns.lisp"))
106    (load (compile-file-if-needed "typep.lisp"))
107    (load (compile-file-if-needed "subtypep.lisp"))
108    (load (compile-file-if-needed "find.lisp"))
109    (load (compile-file-if-needed "print.lisp"))
110    (load (compile-file-if-needed "pprint-dispatch.lisp"))
111    (load (compile-file-if-needed "pprint.lisp"))
112    (load (compile-file-if-needed "format.lisp"))
113    (load (compile-file-if-needed "delete.lisp"))
114    (load (compile-file-if-needed "concatenate.lisp"))
115    (load (compile-file-if-needed "ldb.lisp"))
116    (load (compile-file-if-needed "destructuring-bind.lisp"))
117    ;; But not for these.
118    (mapc #'compile-file-if-needed '("adjoin.lisp"
119                                     "and.lisp"
120                                     "apropos.lisp"
121                                     "arrays.lisp"
122                                     "asdf.lisp"
123                                     "assert.lisp"
124                                     "assoc.lisp"
125                                     "autoloads.lisp"
126                                     "aver.lisp"
127                                     "bit-array-ops.lisp"
128                                     "boole.lisp"
129                                     ;;"boot.lisp"
130                                     "butlast.lisp"
131                                     "byte-io.lisp"
132                                     "case.lisp"
133                                     "chars.lisp"
134                                     "check-type.lisp"
135                                     "compile-file-pathname.lisp"
136                                     "compile-system.lisp"
137                                     "compiler-error.lisp"
138                                     "cond.lisp"
139                                     "copy-seq.lisp"
140                                     "copy-symbol.lisp"
141                                     "count.lisp"
142                                     "debug.lisp"
143                                     "define-modify-macro.lisp"
144                                     "define-symbol-macro.lisp"
145                                     "defmacro.lisp"
146                                     "defpackage.lisp"
147                                     "defsetf.lisp"
148                                     "defstruct.lisp"
149                                     "deftype.lisp"
150                                     "delete-duplicates.lisp"
151                                     "deposit-field.lisp"
152                                     "describe.lisp"
153                                     "describe-compiler-policy.lisp"
154                                     "directory.lisp"
155                                     "disassemble.lisp"
156                                     "do-all-symbols.lisp"
157                                     "do-external-symbols.lisp"
158                                     "do-symbols.lisp"
159                                     "do.lisp"
160                                     "dolist.lisp"
161                                     "dotimes.lisp"
162                                     "dribble.lisp"
163                                     "dump-class.lisp"
164                                     "ed.lisp"
165                                     "enough-namestring.lisp"
166                                     "ensure-directories-exist.lisp"
167                                     "error.lisp"
168                                     "featurep.lisp"
169                                     "fdefinition.lisp"
170                                     "fill.lisp"
171                                     "find-all-symbols.lisp"
172                                     "gentemp.lisp"
173                                     "gray-streams.lisp"
174                                     "inline.lisp"
175                                     "inspect.lisp"
176                                     ;;"j.lisp"
177                                     "java.lisp"
178                                     "known-functions.lisp"
179                                     "known-symbols.lisp"
180                                     "late-setf.lisp"
181                                     "lcm.lisp"
182                                     "ldiff.lisp"
183                                     "list-length.lisp"
184                                     "list.lisp"
185                                     "load.lisp"
186                                     "make-hash-table.lisp"
187                                     "make-load-form-saving-slots.lisp"
188                                     "make-sequence.lisp"
189                                     "make-string-output-stream.lisp"
190                                     "make-string.lisp"
191                                     "map-into.lisp"
192                                     "map.lisp"
193                                     "map1.lisp"
194                                     "mask-field.lisp"
195                                     "member-if.lisp"
196                                     "mismatch.lisp"
197                                     "multiple-value-bind.lisp"
198                                     "multiple-value-list.lisp"
199                                     "multiple-value-setq.lisp"
200                                     "nsubstitute.lisp"
201                                     "nth-value.lisp"
202                                     "numbers.lisp"
203                                     "or.lisp"
204                                     "parse-integer.lisp"
205                                     "parse-lambda-list.lisp"
206                                     "pathnames.lisp"
207                                     "package.lisp"
208                                     "print-object.lisp"
209                                     "print-unreadable-object.lisp"
210                                     "proclaim.lisp"
211                                     "profiler.lisp"
212                                     "prog.lisp"
213                                     "psetf.lisp"
214                                     "query.lisp"
215                                     "read-conditional.lisp"
216                                     "read-from-string.lisp"
217                                     "read-sequence.lisp"
218                                     "reduce.lisp"
219                                     "remf.lisp"
220                                     "remove-duplicates.lisp"
221                                     "remove.lisp"
222                                     "replace.lisp"
223                                     "require.lisp"
224                                     "restart.lisp"
225                                     "revappend.lisp"
226                                     "rotatef.lisp"
227                                     "rt.lisp"
228                                     ;;"run-benchmarks.lisp"
229                                     "run-shell-command.lisp"
230                                     ;;"runtime-class.lisp"
231                                     "search.lisp"
232                                     "sequences.lisp"
233                                     "sets.lisp"
234                                     "shiftf.lisp"
235                                     "signal.lisp"
236                                     "socket.lisp"
237                                     "sort.lisp"
238                                     "step.lisp"
239                                     "strings.lisp"
240                                     "sublis.lisp"
241                                     "subst.lisp"
242                                     "tailp.lisp"
243                                     "time.lisp"
244                                     "top-level.lisp"
245                                     "trace.lisp"
246                                     "tree-equal.lisp"
247                                     "upgraded-complex-part-type.lisp"
248                                     "with-accessors.lisp"
249                                     "with-hash-table-iterator.lisp"
250                                     "with-input-from-string.lisp"
251                                     "with-mutex.lisp"
252                                     "with-open-file.lisp"
253                                     "with-output-to-string.lisp"
254                                     "with-package-iterator.lisp"
255                                     "with-slots.lisp"
256                                     "with-standard-io-syntax.lisp"
257                                     "with-thread-lock.lisp"
258                                     "write-sequence.lisp"))
259    t))
260
261(defun compile-system (&key quit (zip t))
262  (let ((status -1))
263    (check-lisp-home)
264    (time
265     (with-compilation-unit ()
266       (let ((*compile-file-zip* zip))
267         (%compile-system))
268       (when (zerop (+ jvm::*errors* jvm::*warnings*))
269         (setf status 0))))
270    (when quit
271      (quit :status status))))
Note: See TracBrowser for help on using the repository browser.