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

Last change on this file since 8431 was 8431, checked in by piso, 17 years ago

COMPILE-SYSTEM: bind *WARN-ON-REDEFINITION* to NIL.

File size: 12.0 KB
Line 
1;;; compile-system.lisp
2;;;
3;;; Copyright (C) 2004-2005 Peter Graves
4;;; $Id: compile-system.lisp,v 1.38 2005-01-31 17:28:17 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 '#:jvm)
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 in))
41              position)
42          (cond ((eq text in)
43                 (return))
44                ((setf position (search "###" text))
45                 ;; The following code is based on the assumption that all the
46                 ;; Java builtins are accessible in the SYSTEM package (which
47                 ;; uses CL and EXT).
48                 (let* ((name (string (read-from-string (subseq text (+ position 3)))))
49                        (symbol (find-symbol name system-package)))
50                   (when symbol
51                     ;; Force the symbol's package prefix to be written out.
52                     (let ((*package* *keyword-package*))
53                       (format out "~S ~S ~S~%" symbol file line-number))))))
54          (incf line-number))))))
55
56(defun grovel-java-definitions ()
57  (check-lisp-home)
58  (time
59   (let ((files (directory (merge-pathnames "*.java" *lisp-home*))))
60     (with-open-file (stream (merge-pathnames "tags" *lisp-home*)
61                             :direction :output :if-exists :supersede)
62       (dolist (file files)
63         (grovel-java-definitions-in-file file stream))))))
64
65(defun maybe-compile-file (source-file &key force)
66  (if force
67      (compile-file source-file)
68      (let* ((source-write-time (file-write-date source-file))
69             (target-file (compile-file-pathname source-file))
70             (target-write-time (and (probe-file target-file)
71                                     (file-write-date target-file))))
72        (if (or (null target-write-time)
73                (<= target-write-time source-write-time))
74            (compile-file source-file)
75            target-file))))
76
77(defun compile-system ()
78  (check-lisp-home)
79  (time
80   (let ((*default-pathname-defaults* (pathname *lisp-home*))
81         (*warn-on-redefinition* nil))
82     (load (maybe-compile-file "precompiler.lisp"))
83     (load (maybe-compile-file "source-transform.lisp"))
84     (load (maybe-compile-file "opcodes.lisp"))
85     (load (maybe-compile-file "jvm.lisp"))
86     (load (maybe-compile-file "compile-file.lisp"))
87     ;; FIXME We need to load clos.lisp before we can compile clos.lisp.
88     (load "clos.lisp")
89     ;; Order matters for these files.
90     (mapc #'maybe-compile-file '("collect.lisp"
91                                  "macros.lisp"
92                                  "loop.lisp"))
93     (load (maybe-compile-file "backquote.lisp"))
94     (load (maybe-compile-file "early-defuns.lisp"))
95     (load (maybe-compile-file "typep.lisp"))
96     (load (maybe-compile-file "find.lisp"))
97     (load (maybe-compile-file "print.lisp"))
98     (load (maybe-compile-file "pprint-dispatch.lisp"))
99     (load (maybe-compile-file "pprint.lisp"))
100     (load (maybe-compile-file "format.lisp"))
101     (load (maybe-compile-file "delete.lisp"))
102     (load (maybe-compile-file "coerce.lisp"))
103     (load (maybe-compile-file "concatenate.lisp"))
104     (load (maybe-compile-file "make-sequence.lisp"))
105     ;; But not for these.
106     (mapc #'maybe-compile-file '("adjoin.lisp"
107                                  "and.lisp"
108                                  "apropos.lisp"
109                                  "arrays.lisp"
110                                  "asdf.lisp"
111                                  "assert.lisp"
112                                  "assoc.lisp"
113                                  "autoloads.lisp"
114                                  "aver.lisp"
115                                  ;;"backquote.lisp"
116                                  "bit-array-ops.lisp"
117                                  "boole.lisp"
118                                  ;;"boot.lisp"
119                                  "butlast.lisp"
120                                  "byte-io.lisp"
121                                  "case.lisp"
122                                  "chars.lisp"
123                                  "check-type.lisp"
124                                  "clos.lisp"
125                                  ;;"coerce.lisp"
126                                  ;;"compile-file.lisp"
127                                  "compile-file-pathname.lisp"
128                                  "compiler-macro.lisp"
129                                  ;;"concatenate.lisp"
130                                  "cond.lisp"
131                                  "copy-list.lisp"
132                                  "copy-seq.lisp"
133                                  "copy-symbol.lisp"
134                                  "count.lisp"
135                                  "debug.lisp"
136                                  "define-modify-macro.lisp"
137                                  "define-symbol-macro.lisp"
138                                  "defpackage.lisp"
139                                  ;;"defsetf.lisp"
140                                  "defstruct.lisp"
141                                  "deftype.lisp"
142                                  "delete-duplicates.lisp"
143                                  ;;"delete.lisp"
144                                  "deposit-field.lisp"
145                                  "destructuring-bind.lisp"
146                                  "directory.lisp"
147                                  "do-all-symbols.lisp"
148                                  "do-external-symbols.lisp"
149                                  "do-symbols.lisp"
150                                  "do.lisp"
151                                  "documentation.lisp"
152                                  "dolist.lisp"
153                                  "dotimes.lisp"
154                                  "dribble.lisp"
155                                  "dump-class.lisp"
156                                  ;;"early-defuns.lisp"
157                                  "ed.lisp"
158                                  "enough-namestring.lisp"
159                                  "ensure-directories-exist.lisp"
160                                  "error.lisp"
161                                  "fill.lisp"
162                                  "find-all-symbols.lisp"
163                                  ;;"find.lisp"
164                                  "fixme.lisp"
165                                  "gentemp.lisp"
166                                  "gray-streams.lisp"
167                                  "inspect.lisp"
168                                  ;;"j.lisp"
169                                  "java.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                                  "parse-namestring.lisp"
200                                  "pathnames.lisp"
201                                  ;;"print.lisp"
202                                  ;;"print-object.lisp"
203                                  "print-unreadable-object.lisp"
204                                  "profiler.lisp"
205                                  "prog.lisp"
206                                  "psetf.lisp"
207                                  "query.lisp"
208                                  "read-sequence.lisp"
209                                  "reduce.lisp"
210                                  "remf.lisp"
211                                  "remove-duplicates.lisp"
212                                  "remove.lisp"
213                                  "replace.lisp"
214                                  "restart.lisp"
215                                  "revappend.lisp"
216                                  "rotatef.lisp"
217                                  ;;"rt.lisp"
218                                  ;;"run-benchmarks.lisp"
219                                  "run-shell-command.lisp"
220                                  ;;"runtime-class.lisp"
221                                  "search.lisp"
222                                  "sequences.lisp"
223                                  "setf.lisp"
224                                  "sets.lisp"
225                                  "shiftf.lisp"
226                                  "signal.lisp"
227                                  "socket.lisp"
228                                  "sort.lisp"
229                                  "step.lisp"
230                                  "strings.lisp"
231                                  "sublis.lisp"
232                                  "subst.lisp"
233                                  "substitute.lisp"
234                                  "subtypep.lisp"
235                                  "tailp.lisp"
236                                  "time.lisp"
237                                  "top-level.lisp"
238                                  "trace.lisp"
239                                  "translate-logical-pathname.lisp"
240                                  "tree-equal.lisp"
241                                  ;;"typep.lisp"
242                                  "upgraded-complex-part-type.lisp"
243                                  "with-accessors.lisp"
244                                  "with-hash-table-iterator.lisp"
245                                  "with-input-from-string.lisp"
246                                  "with-open-file.lisp"
247                                  "with-output-to-string.lisp"
248                                  "with-package-iterator.lisp"
249                                  "with-slots.lisp"
250                                  "with-standard-io-syntax.lisp"
251                                  "with-thread-lock.lisp"
252                                  "write-sequence.lisp"))
253     (mapc #'maybe-compile-file '("swank-protocol.lisp"
254                                  "slime.lisp"
255                                  "swank-abcl.lisp"
256                                  "swank.lisp"))
257     t)))
Note: See TracBrowser for help on using the repository browser.