| 1 | ;;; compile-system.lisp |
|---|
| 2 | ;;; |
|---|
| 3 | ;;; Copyright (C) 2004-2008 Peter Graves |
|---|
| 4 | ;;; $Id: compile-system.lisp 14457 2013-04-03 19:40:11Z ehuelsmann $ |
|---|
| 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 | (export '(grovel-java-definitions-in-file compile-system)) |
|---|
| 39 | |
|---|
| 40 | |
|---|
| 41 | (defun check-lisp-home () |
|---|
| 42 | (loop |
|---|
| 43 | (cond ((and *lisp-home* |
|---|
| 44 | (probe-directory (pathname *lisp-home*))) |
|---|
| 45 | (return)) |
|---|
| 46 | (t |
|---|
| 47 | (cerror "Continue" |
|---|
| 48 | "*LISP-HOME* is NIL or invalid.~% Please set *LISP-HOME* to the full pathname of the directory containing the Lisp system files."))))) |
|---|
| 49 | |
|---|
| 50 | (defun grovel-java-definitions-in-file (file out) |
|---|
| 51 | (with-open-file (in file) |
|---|
| 52 | (declare (type stream in)) |
|---|
| 53 | (let ((system-package (find-package "SYSTEM")) |
|---|
| 54 | (line-number 1)) |
|---|
| 55 | (loop |
|---|
| 56 | (let ((text (read-line in nil))) |
|---|
| 57 | (when (null text) |
|---|
| 58 | (return)) |
|---|
| 59 | (let ((position (search "###" text))) |
|---|
| 60 | (when position |
|---|
| 61 | (let* ((name (string (read-from-string (subseq text (+ position 3))))) |
|---|
| 62 | (symbol (or (find-symbol name system-package) ; uses CL and EXT |
|---|
| 63 | (find-symbol name (find-package "MOP")) |
|---|
| 64 | (find-symbol name (find-package "JAVA"))))) |
|---|
| 65 | (when symbol |
|---|
| 66 | ;; Force the symbol's package prefix to be written out |
|---|
| 67 | ;; with "::" instead of ":" so there won't be a reader |
|---|
| 68 | ;; error if a symbol that's external now is no longer |
|---|
| 69 | ;; external when we read the tags file. |
|---|
| 70 | (%format out "~A::~A ~S ~S~%" |
|---|
| 71 | (package-name (symbol-package symbol)) |
|---|
| 72 | name |
|---|
| 73 | file line-number))))) |
|---|
| 74 | (incf line-number)))))) |
|---|
| 75 | |
|---|
| 76 | (defun grovel-java-definitions () |
|---|
| 77 | (check-lisp-home) |
|---|
| 78 | (time |
|---|
| 79 | (let ((files (directory (merge-pathnames "*.java" *lisp-home*)))) |
|---|
| 80 | (with-open-file (stream (merge-pathnames "tags" *lisp-home*) |
|---|
| 81 | :direction :output :if-exists :supersede) |
|---|
| 82 | (dolist (file files) |
|---|
| 83 | (grovel-java-definitions-in-file file stream)))))) |
|---|
| 84 | |
|---|
| 85 | |
|---|
| 86 | ;; |
|---|
| 87 | ;; Functions to generate autoloads.lisp |
|---|
| 88 | ;; |
|---|
| 89 | |
|---|
| 90 | (defun packages-from-combos (combos) |
|---|
| 91 | (remove-duplicates (mapcar #'symbol-package |
|---|
| 92 | (mapcar #'sys:fdefinition-block-name |
|---|
| 93 | (mapcar #'second combos))))) |
|---|
| 94 | |
|---|
| 95 | (defun remove-multi-combo-symbols (combos) |
|---|
| 96 | (princ "; Removing multi-homed symbols") |
|---|
| 97 | (let ((sym-hash (make-hash-table :size (* 2 (length combos))))) |
|---|
| 98 | (dolist (combo combos) |
|---|
| 99 | (incf (gethash (second combo) sym-hash 0))) |
|---|
| 100 | (print (remove-if-not (lambda (x) |
|---|
| 101 | (< 1 (gethash x sym-hash))) |
|---|
| 102 | combos |
|---|
| 103 | :key #'second)) |
|---|
| 104 | (remove-if (lambda (x) |
|---|
| 105 | (< 1 (gethash x sym-hash))) |
|---|
| 106 | combos |
|---|
| 107 | :key #'second))) |
|---|
| 108 | |
|---|
| 109 | (defun set-equal (set1 set2 &key test) |
|---|
| 110 | (or (eq set1 set2) |
|---|
| 111 | (equal set1 set2) |
|---|
| 112 | (and (subsetp set2 set1 :test test) |
|---|
| 113 | (subsetp set1 set2 :test test)))) |
|---|
| 114 | |
|---|
| 115 | (defun combos-to-symbol-filesets (combos) |
|---|
| 116 | (let (filesets) |
|---|
| 117 | (dolist (combo combos) |
|---|
| 118 | (pushnew (list (second combo)) filesets :test #'equal :key #'first) |
|---|
| 119 | (pushnew (first combo) |
|---|
| 120 | (cdr (assoc (second combo) filesets :test #'equal)) |
|---|
| 121 | :test #'string=)) |
|---|
| 122 | filesets)) |
|---|
| 123 | |
|---|
| 124 | (defun combos-to-fileset-symbols (combos) |
|---|
| 125 | (let (fileset-symbols) |
|---|
| 126 | (dolist (symbol-fileset (combos-to-symbol-filesets combos)) |
|---|
| 127 | (pushnew (list (cdr symbol-fileset)) fileset-symbols |
|---|
| 128 | :test (lambda (x y) (set-equal x y :test #'string=)) |
|---|
| 129 | :key #'first) |
|---|
| 130 | (pushnew (first symbol-fileset) |
|---|
| 131 | (cdr (assoc (cdr symbol-fileset) fileset-symbols |
|---|
| 132 | :test (lambda (x y) |
|---|
| 133 | (set-equal x y :test #'string=)))))) |
|---|
| 134 | fileset-symbols)) |
|---|
| 135 | |
|---|
| 136 | (defun write-autoloader (stream package type fileset-symbols) |
|---|
| 137 | (when fileset-symbols |
|---|
| 138 | (write `(in-package ,package) :stream stream) |
|---|
| 139 | (terpri stream) |
|---|
| 140 | (let ((*package* (find-package package))) |
|---|
| 141 | (write `(dolist (fs ',fileset-symbols) |
|---|
| 142 | (funcall #',type (cdr fs) (car (car fs)))) :stream stream) |
|---|
| 143 | (terpri stream)))) |
|---|
| 144 | |
|---|
| 145 | (defun write-package-filesets (stream package type filesets-symbols) |
|---|
| 146 | (let* ((filter-package (find-package package)) |
|---|
| 147 | (filtered-filesets |
|---|
| 148 | (remove-if (lambda (x) |
|---|
| 149 | (null (cdr x))) |
|---|
| 150 | (mapcar (lambda (x) |
|---|
| 151 | (cons (car x) |
|---|
| 152 | (remove-if-not (lambda (x) |
|---|
| 153 | (and (symbolp x) |
|---|
| 154 | (eq (symbol-package x) |
|---|
| 155 | filter-package))) |
|---|
| 156 | (cdr x)))) |
|---|
| 157 | filesets-symbols)))) |
|---|
| 158 | (write-autoloader stream package type filtered-filesets))) |
|---|
| 159 | |
|---|
| 160 | (defun load-combos (path-spec) |
|---|
| 161 | (let (all-functions) |
|---|
| 162 | (dolist (functions-file (directory path-spec) |
|---|
| 163 | all-functions) |
|---|
| 164 | ;; every file has 1 form: the list of functions in it. |
|---|
| 165 | (let ((base-name (pathname-name functions-file))) |
|---|
| 166 | (unless (member base-name '("asdf" "gray-streams") :test #'string=) |
|---|
| 167 | ;; exclude ASDF and GRAY-STREAMS: they have external |
|---|
| 168 | ;; symbols we don't have until we load them, but we need |
|---|
| 169 | ;; those symbols to read the symbols files |
|---|
| 170 | (with-open-file (f functions-file |
|---|
| 171 | :direction :input) |
|---|
| 172 | (dolist (function-name (read f)) |
|---|
| 173 | (push (list base-name function-name) all-functions)))))))) |
|---|
| 174 | |
|---|
| 175 | (defun generate-autoloads (symbol-files-pathspec) |
|---|
| 176 | (labels ((filter-combos (combos) |
|---|
| 177 | (remove-multi-combo-symbols |
|---|
| 178 | (remove-if (lambda (x) |
|---|
| 179 | ;; exclude the symbols from the files |
|---|
| 180 | ;; below: putting autoloaders on some of |
|---|
| 181 | ;; the symbols conflicts with the bootstrapping |
|---|
| 182 | ;; Primitives which have been defined Java-side |
|---|
| 183 | (member x '( ;; function definitions to be excluded |
|---|
| 184 | "fdefinition" "early-defuns" |
|---|
| 185 | "require" "signal" "restart" |
|---|
| 186 | |
|---|
| 187 | ;; extensible sequences override |
|---|
| 188 | ;; lots of default functions; |
|---|
| 189 | ;; java-collections implements |
|---|
| 190 | ;; extensible sequences |
|---|
| 191 | "extensible-sequences-base" |
|---|
| 192 | "extensible-sequences" "java-collections" |
|---|
| 193 | |
|---|
| 194 | ;; macro definitions to be excluded |
|---|
| 195 | "macros" ;; "backquote" |
|---|
| 196 | "precompiler") |
|---|
| 197 | :test #'string=)) |
|---|
| 198 | combos |
|---|
| 199 | :key #'first))) |
|---|
| 200 | (filter-setf-combos (combos) |
|---|
| 201 | (filter-combos |
|---|
| 202 | (remove-multi-combo-symbols |
|---|
| 203 | (remove-if (lambda (x) (member x '("clos") :test #'string=)) combos :key #'first)))) |
|---|
| 204 | (symbols-pathspec (filespec) |
|---|
| 205 | (merge-pathnames filespec symbol-files-pathspec))) |
|---|
| 206 | (let ((funcs (filter-combos (load-combos (symbols-pathspec "*.funcs")))) |
|---|
| 207 | (macs (filter-combos (load-combos (symbols-pathspec "*.macs")))) |
|---|
| 208 | (setf-functions (filter-setf-combos (load-combos (symbols-pathspec "*.setf-functions")))) |
|---|
| 209 | (setf-expanders (filter-setf-combos (load-combos (symbols-pathspec "*.setf-expanders")))) |
|---|
| 210 | (exps (filter-combos (load-combos (symbols-pathspec "*.exps"))))) |
|---|
| 211 | (with-open-file (f (symbols-pathspec "autoloads-gen.lisp") |
|---|
| 212 | :direction :output :if-does-not-exist :create |
|---|
| 213 | :if-exists :supersede) |
|---|
| 214 | ;; Generate the lisp file. This file will be included after compilation, |
|---|
| 215 | ;; so any comments are just for debugging purposes. |
|---|
| 216 | (terpri f) |
|---|
| 217 | (write-line ";; ---- GENERATED CONTENT BELOW" f) |
|---|
| 218 | (terpri f) |
|---|
| 219 | (dolist (package '(:format :sequence :loop :mop :xp :precompiler |
|---|
| 220 | :profiler :java :jvm :extensions :threads |
|---|
| 221 | :top-level :system :cl)) |
|---|
| 222 | ;; Limit the set of packages: |
|---|
| 223 | ;; During incremental compilation, the packages GRAY-STREAMS |
|---|
| 224 | ;; and ASDF are not being created. Nor are these packages |
|---|
| 225 | ;; vital to the correct operation of the base system. |
|---|
| 226 | |
|---|
| 227 | (let* ((*package* (find-package package)) |
|---|
| 228 | (all-exported-symbols |
|---|
| 229 | (remove-duplicates (mapcar #'second exps))) |
|---|
| 230 | (externals (remove-if-not (lambda (sym) |
|---|
| 231 | (eq (symbol-package sym) |
|---|
| 232 | *package*)) |
|---|
| 233 | all-exported-symbols))) |
|---|
| 234 | (when externals |
|---|
| 235 | (write-line ";; EXPORTS" f) |
|---|
| 236 | (write `(cl:in-package ,package) :stream f) |
|---|
| 237 | (terpri f) |
|---|
| 238 | (write `(cl:export ',externals) :stream f) |
|---|
| 239 | (terpri f))) |
|---|
| 240 | |
|---|
| 241 | |
|---|
| 242 | (terpri f) |
|---|
| 243 | (write-line ";; FUNCTIONS" f) |
|---|
| 244 | (terpri f) |
|---|
| 245 | (write-package-filesets f package 'ext:autoload |
|---|
| 246 | (combos-to-fileset-symbols funcs)) |
|---|
| 247 | (terpri f) |
|---|
| 248 | (write-line ";; MACROS" f) |
|---|
| 249 | (terpri f) |
|---|
| 250 | (write-package-filesets f package 'ext:autoload-macro |
|---|
| 251 | (combos-to-fileset-symbols macs)) |
|---|
| 252 | |
|---|
| 253 | (terpri f) |
|---|
| 254 | |
|---|
| 255 | (write-line ";; SETF-FUNCTIONS" f) |
|---|
| 256 | (terpri f) |
|---|
| 257 | (write-package-filesets f package 'ext:autoload-setf-function |
|---|
| 258 | (combos-to-fileset-symbols setf-functions)) |
|---|
| 259 | (terpri f) |
|---|
| 260 | (write-line ";; SETF-EXPANDERS" f) |
|---|
| 261 | (terpri f) |
|---|
| 262 | (write-package-filesets f package 'ext:autoload-setf-expander |
|---|
| 263 | (combos-to-fileset-symbols setf-expanders))))))) |
|---|
| 264 | |
|---|
| 265 | ;; |
|---|
| 266 | ;; --- End of autoloads.lisp |
|---|
| 267 | ;; |
|---|
| 268 | |
|---|
| 269 | |
|---|
| 270 | (defun %compile-system (&key output-path) |
|---|
| 271 | (let ((*default-pathname-defaults* (pathname *lisp-home*)) |
|---|
| 272 | (*warn-on-redefinition* nil) |
|---|
| 273 | (*prevent-fasl-circle-detection* t)) |
|---|
| 274 | (unless output-path |
|---|
| 275 | (setf output-path *default-pathname-defaults*)) |
|---|
| 276 | (flet ((do-compile (file &key (extract t)) |
|---|
| 277 | (let ((out (make-pathname :type *compile-file-type* |
|---|
| 278 | :defaults (merge-pathnames |
|---|
| 279 | file output-path)))) |
|---|
| 280 | (compile-file-if-needed file |
|---|
| 281 | :output-file out |
|---|
| 282 | :extract-toplevel-funcs-and-macros extract)))) |
|---|
| 283 | (load (do-compile "defstruct.lisp")) |
|---|
| 284 | (load (do-compile "coerce.lisp")) |
|---|
| 285 | (load (do-compile "open.lisp")) |
|---|
| 286 | (load (do-compile "dump-form.lisp")) |
|---|
| 287 | (load (do-compile "compiler-types.lisp")) |
|---|
| 288 | (load (do-compile "compile-file.lisp")) |
|---|
| 289 | (load (do-compile "precompiler.lisp")) |
|---|
| 290 | (load (do-compile "compiler-pass1.lisp")) |
|---|
| 291 | (load (do-compile "compiler-pass2.lisp")) |
|---|
| 292 | (load (do-compile "jvm-class-file.lisp")) |
|---|
| 293 | (load (do-compile "jvm.lisp")) |
|---|
| 294 | (load (do-compile "source-transform.lisp")) |
|---|
| 295 | (load (do-compile "compiler-macro.lisp")) |
|---|
| 296 | (load (do-compile "jvm-instructions.lisp")) |
|---|
| 297 | (load (do-compile "setf.lisp")) |
|---|
| 298 | (load (do-compile "extensible-sequences-base.lisp")) |
|---|
| 299 | (load (do-compile "require.lisp")) |
|---|
| 300 | (load (do-compile "substitute.lisp")) |
|---|
| 301 | (load (do-compile "clos.lisp")) |
|---|
| 302 | (load (do-compile "mop.lisp")) |
|---|
| 303 | ;; Order matters for these files. |
|---|
| 304 | (mapc #'do-compile '("collect.lisp" |
|---|
| 305 | "macros.lisp" |
|---|
| 306 | "loop.lisp")) |
|---|
| 307 | (load (do-compile "backquote.lisp")) |
|---|
| 308 | (load (do-compile "early-defuns.lisp")) |
|---|
| 309 | (load (do-compile "typep.lisp")) |
|---|
| 310 | (load (do-compile "subtypep.lisp")) |
|---|
| 311 | (load (do-compile "find.lisp")) |
|---|
| 312 | (load (do-compile "print.lisp")) |
|---|
| 313 | (load (do-compile "pprint-dispatch.lisp")) |
|---|
| 314 | (load (do-compile "pprint.lisp")) |
|---|
| 315 | (load (do-compile "format.lisp")) |
|---|
| 316 | (load (do-compile "delete.lisp")) |
|---|
| 317 | (load (do-compile "concatenate.lisp")) |
|---|
| 318 | (load (do-compile "ldb.lisp")) |
|---|
| 319 | (load (do-compile "destructuring-bind.lisp")) |
|---|
| 320 | (load (do-compile "asdf.lisp")) |
|---|
| 321 | ;; But not for these. |
|---|
| 322 | (mapc #'do-compile '("abcl-contrib.lisp" |
|---|
| 323 | "adjoin.lisp" |
|---|
| 324 | "and.lisp" |
|---|
| 325 | "apropos.lisp" |
|---|
| 326 | "arrays.lisp" |
|---|
| 327 | "assert.lisp" |
|---|
| 328 | "assoc.lisp" |
|---|
| 329 | "aver.lisp" |
|---|
| 330 | "bit-array-ops.lisp" |
|---|
| 331 | "boole.lisp" |
|---|
| 332 | "butlast.lisp" |
|---|
| 333 | "byte-io.lisp" |
|---|
| 334 | "case.lisp" |
|---|
| 335 | "chars.lisp" |
|---|
| 336 | "check-type.lisp" |
|---|
| 337 | "compile-file-pathname.lisp" |
|---|
| 338 | "compile-system.lisp" |
|---|
| 339 | "compiler-error.lisp" |
|---|
| 340 | "cond.lisp" |
|---|
| 341 | "copy-seq.lisp" |
|---|
| 342 | "copy-symbol.lisp" |
|---|
| 343 | "count.lisp" |
|---|
| 344 | "digest.lisp" |
|---|
| 345 | "debug.lisp" |
|---|
| 346 | "define-modify-macro.lisp" |
|---|
| 347 | "define-symbol-macro.lisp" |
|---|
| 348 | "defmacro.lisp" |
|---|
| 349 | "defpackage.lisp" |
|---|
| 350 | "defsetf.lisp" |
|---|
| 351 | "deftype.lisp" |
|---|
| 352 | "delete-duplicates.lisp" |
|---|
| 353 | "deposit-field.lisp" |
|---|
| 354 | "describe.lisp" |
|---|
| 355 | "describe-compiler-policy.lisp" |
|---|
| 356 | "directory.lisp" |
|---|
| 357 | "disassemble.lisp" |
|---|
| 358 | "do-all-symbols.lisp" |
|---|
| 359 | "do-external-symbols.lisp" |
|---|
| 360 | "do-symbols.lisp" |
|---|
| 361 | "do.lisp" |
|---|
| 362 | "documentation.lisp" |
|---|
| 363 | "dolist.lisp" |
|---|
| 364 | "dotimes.lisp" |
|---|
| 365 | "dribble.lisp" |
|---|
| 366 | "dump-class.lisp" |
|---|
| 367 | "ed.lisp" |
|---|
| 368 | "enough-namestring.lisp" |
|---|
| 369 | "ensure-directories-exist.lisp" |
|---|
| 370 | "error.lisp" |
|---|
| 371 | "extensible-sequences.lisp" |
|---|
| 372 | "fasl-concat.lisp" |
|---|
| 373 | "featurep.lisp" |
|---|
| 374 | "fdefinition.lisp" |
|---|
| 375 | "fill.lisp" |
|---|
| 376 | "find-all-symbols.lisp" |
|---|
| 377 | "gentemp.lisp" |
|---|
| 378 | "gray-streams.lisp" |
|---|
| 379 | "gui.lisp" |
|---|
| 380 | "inline.lisp" |
|---|
| 381 | "inspect.lisp" |
|---|
| 382 | "java.lisp" |
|---|
| 383 | "java-collections.lisp" |
|---|
| 384 | "known-functions.lisp" |
|---|
| 385 | "known-symbols.lisp" |
|---|
| 386 | "late-setf.lisp" |
|---|
| 387 | "lcm.lisp" |
|---|
| 388 | "ldiff.lisp" |
|---|
| 389 | "list-length.lisp" |
|---|
| 390 | "list.lisp" |
|---|
| 391 | "load.lisp" |
|---|
| 392 | "make-hash-table.lisp" |
|---|
| 393 | "make-load-form-saving-slots.lisp" |
|---|
| 394 | "make-sequence.lisp" |
|---|
| 395 | "make-string-output-stream.lisp" |
|---|
| 396 | "make-string.lisp" |
|---|
| 397 | "map-into.lisp" |
|---|
| 398 | "map.lisp" |
|---|
| 399 | "map1.lisp" |
|---|
| 400 | "mask-field.lisp" |
|---|
| 401 | "member-if.lisp" |
|---|
| 402 | "mismatch.lisp" |
|---|
| 403 | "multiple-value-bind.lisp" |
|---|
| 404 | "multiple-value-list.lisp" |
|---|
| 405 | "multiple-value-setq.lisp" |
|---|
| 406 | "nsubstitute.lisp" |
|---|
| 407 | "nth-value.lisp" |
|---|
| 408 | "numbers.lisp" |
|---|
| 409 | "or.lisp" |
|---|
| 410 | "parse-integer.lisp" |
|---|
| 411 | "parse-lambda-list.lisp" |
|---|
| 412 | "package.lisp" |
|---|
| 413 | "pathnames.lisp" |
|---|
| 414 | "print-object.lisp" |
|---|
| 415 | "print-unreadable-object.lisp" |
|---|
| 416 | "proclaim.lisp" |
|---|
| 417 | "profiler.lisp" |
|---|
| 418 | "prog.lisp" |
|---|
| 419 | "psetf.lisp" |
|---|
| 420 | "query.lisp" |
|---|
| 421 | "read-circle.lisp" |
|---|
| 422 | "read-conditional.lisp" |
|---|
| 423 | "read-from-string.lisp" |
|---|
| 424 | "read-sequence.lisp" |
|---|
| 425 | "reduce.lisp" |
|---|
| 426 | "remf.lisp" |
|---|
| 427 | "remove-duplicates.lisp" |
|---|
| 428 | "remove.lisp" |
|---|
| 429 | "replace.lisp" |
|---|
| 430 | "restart.lisp" |
|---|
| 431 | "revappend.lisp" |
|---|
| 432 | "rotatef.lisp" |
|---|
| 433 | "run-program.lisp" |
|---|
| 434 | "run-shell-command.lisp" |
|---|
| 435 | "runtime-class.lisp" |
|---|
| 436 | "search.lisp" |
|---|
| 437 | "sequences.lisp" |
|---|
| 438 | "sets.lisp" |
|---|
| 439 | "shiftf.lisp" |
|---|
| 440 | "signal.lisp" |
|---|
| 441 | "socket.lisp" |
|---|
| 442 | "sort.lisp" |
|---|
| 443 | "step.lisp" |
|---|
| 444 | "strings.lisp" |
|---|
| 445 | "sublis.lisp" |
|---|
| 446 | "subst.lisp" |
|---|
| 447 | "tailp.lisp" |
|---|
| 448 | "threads.lisp" |
|---|
| 449 | "time.lisp" |
|---|
| 450 | "top-level.lisp" |
|---|
| 451 | "trace.lisp" |
|---|
| 452 | "tree-equal.lisp" |
|---|
| 453 | "upgraded-complex-part-type.lisp" |
|---|
| 454 | "with-accessors.lisp" |
|---|
| 455 | "with-hash-table-iterator.lisp" |
|---|
| 456 | "with-input-from-string.lisp" |
|---|
| 457 | "with-open-file.lisp" |
|---|
| 458 | "with-output-to-string.lisp" |
|---|
| 459 | "with-package-iterator.lisp" |
|---|
| 460 | "with-slots.lisp" |
|---|
| 461 | "with-standard-io-syntax.lisp" |
|---|
| 462 | "write-sequence.lisp")) |
|---|
| 463 | ;; With all files compiled, we need to use the symbols collected |
|---|
| 464 | ;; to generate and compile autoloads.lisp |
|---|
| 465 | |
|---|
| 466 | ;; Generate the autoloads-gen file in the build directory in order |
|---|
| 467 | ;; not to clobber the source file - that should keep the system |
|---|
| 468 | ;; buildable |
|---|
| 469 | |
|---|
| 470 | (format t "; Generating autoloads...~%") |
|---|
| 471 | (generate-autoloads output-path) |
|---|
| 472 | ;; Compile the file in the build directory instead of the one in the |
|---|
| 473 | ;; sources directory - the latter being for bootstrapping only. |
|---|
| 474 | (do-compile (merge-pathnames #p"autoloads-gen.lisp" output-path) |
|---|
| 475 | :extract nil) |
|---|
| 476 | (do-compile "autoloads.lisp" |
|---|
| 477 | :extract nil)) |
|---|
| 478 | t)) |
|---|
| 479 | |
|---|
| 480 | (defun compile-system (&key quit (zip t) (cls-ext *compile-file-class-extension*) (abcl-ext *compile-file-type*) output-path) |
|---|
| 481 | (let ((status -1) |
|---|
| 482 | (*compile-file-class-extension* cls-ext) |
|---|
| 483 | (*compile-file-type* abcl-ext)) |
|---|
| 484 | (check-lisp-home) |
|---|
| 485 | (time |
|---|
| 486 | (with-compilation-unit () |
|---|
| 487 | (let ((*compile-file-zip* zip) |
|---|
| 488 | failure-p) |
|---|
| 489 | (handler-bind (((or warning |
|---|
| 490 | compiler-error) |
|---|
| 491 | #'(lambda (c) |
|---|
| 492 | (declare (ignore c)) |
|---|
| 493 | (setf failure-p t) |
|---|
| 494 | ;; only register that we had this type of signal |
|---|
| 495 | ;; defer the actual handling to another handler |
|---|
| 496 | nil))) |
|---|
| 497 | (%compile-system :output-path output-path)) |
|---|
| 498 | (unless failure-p |
|---|
| 499 | (setf status 0))))) |
|---|
| 500 | (create-system-logical-translations output-path) |
|---|
| 501 | (when quit |
|---|
| 502 | (quit :status status)))) |
|---|
| 503 | |
|---|
| 504 | (defun create-system-logical-translations (output-path) |
|---|
| 505 | (let* ((dir (directory-namestring (pathname output-path))) |
|---|
| 506 | (system (merge-pathnames "system.lisp" dir)) |
|---|
| 507 | (home (pathname *lisp-home*)) |
|---|
| 508 | (src (format nil "~A**/*.*" home)) |
|---|
| 509 | (java (format nil "~A../../../**/*.*" home))) |
|---|
| 510 | (with-open-file (s system :direction :output |
|---|
| 511 | :if-exists :supersede) |
|---|
| 512 | (pprint `(setf (logical-pathname-translations "sys") |
|---|
| 513 | '(("SYS:SRC;**;*.*" ,src) |
|---|
| 514 | ("SYS:JAVA;**;*.*" ,java))) |
|---|
| 515 | s)))) |
|---|
| 516 | |
|---|
