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

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

Work in progress (tested).

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