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

Last change on this file since 10241 was 10241, checked in by piso, 16 years ago

GROVEL-JAVA-DEFINITIONS: look in "JAVA" package too.

File size: 13.2 KB
Line 
1;;; compile-system.lisp
2;;;
3;;; Copyright (C) 2004-2005 Peter Graves
4;;; $Id: compile-system.lisp,v 1.63 2005-10-27 17:30:40 piso Exp $
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(in-package #:system)
21
22(require '#:loop)
23(require '#:collect)
24(require '#:compile-file)
25
26(defun check-lisp-home ()
27  (loop
28    (cond ((and *lisp-home*
29                (probe-directory (pathname *lisp-home*)))
30           (return))
31          (t
32           (cerror "Continue"
33                   "*LISP-HOME* is NIL or invalid.~%  Please set *LISP-HOME* to the full pathname of the directory containing the Lisp system files.")))))
34
35(defun grovel-java-definitions-in-file (file out)
36  (with-open-file (in file)
37    (let ((system-package (find-package "SYSTEM"))
38          (line-number 1))
39      (loop
40        (let ((text (read-line in nil)))
41          (when (null text)
42            (return))
43          (let ((position (search "###" text)))
44            (when position
45                 (let* ((name (string (read-from-string (subseq text (+ position 3)))))
46                        (symbol (or (find-symbol name system-package) ; uses CL and EXT
47                                    (find-symbol name (find-package "MOP"))
48                                    (find-symbol name (find-package "JAVA")))))
49                   (when symbol
50                     ;; Force the symbol's package prefix to be written out
51                     ;; with "::" instead of ":" so there won't be a reader
52                     ;; error if a symbol that's external now is no longer
53                     ;; external when we read the tags file.
54                     (%format out "~A::~A ~S ~S~%"
55                              (package-name (symbol-package symbol))
56                              name
57                              file line-number)))))
58          (incf line-number))))))
59
60(defun grovel-java-definitions ()
61  (check-lisp-home)
62  (time
63   (let ((files (directory (merge-pathnames "*.java" *lisp-home*))))
64     (with-open-file (stream (merge-pathnames "tags" *lisp-home*)
65                             :direction :output :if-exists :supersede)
66       (dolist (file files)
67         (grovel-java-definitions-in-file file stream))))))
68
69(defun %compile-system ()
70  (let ((*default-pathname-defaults* (pathname *lisp-home*))
71         (*warn-on-redefinition* nil))
72    (load (compile-file-if-needed "precompiler.lisp"))
73    (load (compile-file-if-needed "source-transform.lisp"))
74    (load (compile-file-if-needed "compiler-macro.lisp"))
75    (load (compile-file-if-needed "opcodes.lisp"))
76    (load (compile-file-if-needed "dump-form.lisp"))
77    (load (compile-file-if-needed "jvm.lisp"))
78    (load (compile-file-if-needed "compile-file.lisp"))
79    ;; FIXME We need to load clos.lisp before we can compile clos.lisp.
80    (load "clos.lisp")
81    ;; Order matters for these files.
82    (mapc #'compile-file-if-needed '("collect.lisp"
83                                     "macros.lisp"
84                                     "loop.lisp"))
85    (load (compile-file-if-needed "backquote.lisp"))
86    (load (compile-file-if-needed "early-defuns.lisp"))
87    (load (compile-file-if-needed "typep.lisp"))
88    (load (compile-file-if-needed "subtypep.lisp"))
89    (load (compile-file-if-needed "find.lisp"))
90    (load (compile-file-if-needed "print.lisp"))
91    (load (compile-file-if-needed "pprint-dispatch.lisp"))
92    (load (compile-file-if-needed "pprint.lisp"))
93    (load (compile-file-if-needed "format.lisp"))
94    (load (compile-file-if-needed "delete.lisp"))
95    (load (compile-file-if-needed "coerce.lisp"))
96    (load (compile-file-if-needed "concatenate.lisp"))
97    (load (compile-file-if-needed "make-sequence.lisp"))
98    (load (compile-file-if-needed "ldb.lisp"))
99    ;; But not for these.
100    (mapc #'compile-file-if-needed '("adjoin.lisp"
101                                     "and.lisp"
102                                     "apropos.lisp"
103                                     "arrays.lisp"
104                                     "asdf.lisp"
105                                     "assert.lisp"
106                                     "assoc.lisp"
107                                     ;;"autoloads.lisp"
108                                     "aver.lisp"
109                                     ;;"backquote.lisp"
110                                     "bit-array-ops.lisp"
111                                     "boole.lisp"
112                                     ;;"boot.lisp"
113                                     "butlast.lisp"
114                                     "byte-io.lisp"
115                                     "case.lisp"
116                                     "chars.lisp"
117                                     "check-type.lisp"
118                                     "clos.lisp"
119                                     ;;"coerce.lisp"
120                                     ;;"compile-file.lisp"
121                                     "compile-file-pathname.lisp"
122                                     "compile-system.lisp"
123                                     "compiler-error.lisp"
124                                     ;;"compiler-macro.lisp"
125                                     ;;"concatenate.lisp"
126                                     "cond.lisp"
127                                     "copy-list.lisp"
128                                     "copy-seq.lisp"
129                                     "copy-symbol.lisp"
130                                     "count.lisp"
131                                     "debug.lisp"
132                                     "define-modify-macro.lisp"
133                                     "define-symbol-macro.lisp"
134                                     "defmacro.lisp"
135                                     "defpackage.lisp"
136                                     "defsetf.lisp"
137                                     "defstruct.lisp"
138                                     "deftype.lisp"
139                                     "delete-duplicates.lisp"
140                                     ;;"delete.lisp"
141                                     "deposit-field.lisp"
142                                     "describe.lisp"
143                                     "destructuring-bind.lisp"
144                                     "directory.lisp"
145                                     "disassemble.lisp"
146                                     "do-all-symbols.lisp"
147                                     "do-external-symbols.lisp"
148                                     "do-symbols.lisp"
149                                     "do.lisp"
150                                     "dolist.lisp"
151                                     "dotimes.lisp"
152                                     "dribble.lisp"
153                                     "dump-class.lisp"
154                                     ;;"early-defuns.lisp"
155                                     "ed.lisp"
156                                     "enough-namestring.lisp"
157                                     "ensure-directories-exist.lisp"
158                                     "error.lisp"
159                                     "featurep.lisp"
160                                     "fdefinition.lisp"
161                                     "fill.lisp"
162                                     "find-all-symbols.lisp"
163                                     ;;"find.lisp"
164                                     "gentemp.lisp"
165                                     "gray-streams.lisp"
166                                     "inspect.lisp"
167                                     ;;"j.lisp"
168                                     "java.lisp"
169                                     "known-functions.lisp"
170                                     "late-setf.lisp"
171                                     "lcm.lisp"
172                                     ;;"ldb.lisp"
173                                     "ldiff.lisp"
174                                     "list-length.lisp"
175                                     "list.lisp"
176                                     "load.lisp"
177                                     "make-hash-table.lisp"
178                                     "make-load-form-saving-slots.lisp"
179                                     ;;"make-sequence.lisp"
180                                     "make-string-output-stream.lisp"
181                                     "make-string.lisp"
182                                     "map-into.lisp"
183                                     "map.lisp"
184                                     "map1.lisp"
185                                     "maphash.lisp"
186                                     "mask-field.lisp"
187                                     "member-if.lisp"
188                                     "mismatch.lisp"
189                                     "multiple-value-bind.lisp"
190                                     "multiple-value-list.lisp"
191                                     "multiple-value-setq.lisp"
192                                     "nsubstitute.lisp"
193                                     "nth-value.lisp"
194                                     "numbers.lisp"
195                                     "open.lisp"
196                                     "or.lisp"
197                                     "parse-integer.lisp"
198                                     "parse-lambda-list.lisp"
199                                     "pathnames.lisp"
200                                     ;;"print.lisp"
201                                     ;;"print-object.lisp"
202                                     "print-unreadable-object.lisp"
203                                     "proclaim.lisp"
204                                     "profiler.lisp"
205                                     "prog.lisp"
206                                     "psetf.lisp"
207                                     "query.lisp"
208                                     "read-conditional.lisp"
209                                     "read-from-string.lisp"
210                                     "read-sequence.lisp"
211                                     "reduce.lisp"
212                                     "remf.lisp"
213                                     "remove-duplicates.lisp"
214                                     "remove.lisp"
215                                     "replace.lisp"
216                                     "require.lisp"
217                                     "restart.lisp"
218                                     "revappend.lisp"
219                                     "rotatef.lisp"
220                                     "rt.lisp"
221                                     ;;"run-benchmarks.lisp"
222                                     "run-shell-command.lisp"
223                                     ;;"runtime-class.lisp"
224                                     "search.lisp"
225                                     "sequences.lisp"
226                                     "setf.lisp"
227                                     "sets.lisp"
228                                     "shiftf.lisp"
229                                     "signal.lisp"
230                                     "socket.lisp"
231                                     "sort.lisp"
232                                     "step.lisp"
233                                     "strings.lisp"
234                                     "sublis.lisp"
235                                     "subst.lisp"
236                                     "substitute.lisp"
237                                     ;;"subtypep.lisp"
238                                     "tailp.lisp"
239                                     "time.lisp"
240                                     "top-level.lisp"
241                                     "trace.lisp"
242                                     "tree-equal.lisp"
243                                     ;;"typep.lisp"
244                                     "upgraded-complex-part-type.lisp"
245                                     "with-accessors.lisp"
246                                     "with-hash-table-iterator.lisp"
247                                     "with-input-from-string.lisp"
248                                     "with-open-file.lisp"
249                                     "with-output-to-string.lisp"
250                                     "with-package-iterator.lisp"
251                                     "with-slots.lisp"
252                                     "with-standard-io-syntax.lisp"
253                                     "with-thread-lock.lisp"
254                                     "write-sequence.lisp"))
255    (mapc #'compile-file-if-needed '("swank-protocol.lisp"
256                                     "slime.lisp"
257                                     "swank-abcl.lisp"
258                                     "swank.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.