X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fshared.lisp;h=3c910ac7e1ffe58b2bddb40cdf0eef83ba4e6033;hb=4cf50b1896b25f5337e7c258b0b560da00d47993;hp=8161f5b0223be5ec2585bd2831e5b7cafe089375;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index 8161f5b..3c910ac 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -15,12 +15,19 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -;;; TO DO: Might it be possible to increase the efficiency of CMU CL's garbage -;;; collection on my large (256Mb) machine by doing larger incremental GC steps -;;; than the default 2 Mb of CMU CL 2.4.9? A quick test 19990729, setting this -;;; to 5E6 showed no significant improvement, but it's possible that more -;;; cleverness might help.. -;#+cmu (setf ext:*bytes-consed-between-gcs* (* 5 (expt 10 6))) +;;; GC tuning has little effect on the x86 due to the generational +;;; collector. For the older stop & copy collector, it assuredly +;;; does. GC time is proportional to the amount of non-grabage +;;; needing collection and copying; when the application involved is +;;; the SBCL compiler, it doesn't take any longer to collect 20Mb than +;;; 2 -dan, 20000819 + +#+sbcl +(progn + (sb-ext:gc-off) + (setf sb-KERNEL::*bytes-consed-between-gcs* (* 20 (expt 10 6))) + (sb-ext:gc-on) + (sb-ext:gc)) ;;; FIXME: I'm now inclined to make all the bootstrap stuff run in CL-USER ;;; instead of SB-COLD. If I do so, I should first take care to @@ -30,11 +37,6 @@ (defpackage "SB-COLD" (:use "CL")) (in-package "SB-COLD") -;;; prefix for source filename stems when cross-compiling -(defvar *src-prefix* "src/") -;;; (We don't bother to specify the source suffix here because ".lisp" is such -;;; a good default value that we never have to specify it explicitly.) - ;;; prefixes for filename stems when cross-compiling. These are quite arbitrary ;;; (although of course they shouldn't collide with anything we don't want to ;;; write over). In particular, they can be either relative path names (e.g. @@ -72,17 +74,18 @@ ;;;; some tools -;;; Take the file named X and make it into a file named Y. Sorta like UNIX, and -;;; unlike Common Lisp's bare RENAME-FILE, we don't allow information -;;; from the original filename to influence the final filename. (The reason -;;; that it's only sorta like UNIX is that in UNIX "mv foo bar/" will work, -;;; but the analogous (RENAME-FILE-A-LA-UNIX "foo" "bar/") should fail.) +;;; Take the file named X and make it into a file named Y. Sorta like +;;; UNIX, and unlike Common Lisp's bare RENAME-FILE, we don't allow +;;; information from the original filename to influence the final +;;; filename. (The reason that it's only sorta like UNIX is that in +;;; UNIX "mv foo bar/" will work, but the analogous +;;; (RENAME-FILE-A-LA-UNIX "foo" "bar/") should fail.) ;;; -;;; (This is a workaround for the weird behavior of Debian CMU CL 2.4.6, where -;;; (RENAME-FILE "dir/x" "dir/y") tries to create a file called "dir/dir/y". -;;; If that behavior goes away, then we should be able to get rid of this -;;; function and use plain RENAME-FILE in the COMPILE-STEM function -;;; above. -- WHN 19990321 +;;; (This is a workaround for the weird behavior of Debian CMU CL +;;; 2.4.6, where (RENAME-FILE "dir/x" "dir/y") tries to create a file +;;; called "dir/dir/y". If that behavior goes away, then we should be +;;; able to get rid of this function and use plain RENAME-FILE in the +;;; COMPILE-STEM function above. -- WHN 19990321 (defun rename-file-a-la-unix (x y) (rename-file x ;; (Note that the TRUENAME expression here is lifted from an @@ -101,20 +104,20 @@ ;;; Compile the source file whose basic name is STEM, using some ;;; standard-for-the-SBCL-build-process procedures to generate the full ;;; pathnames of source file and object file. Return the pathname of the object -;;; file for STEM. Several keyword arguments are accepted: -;;; SRC-PREFIX, SRC-SUFFIX = -;;; strings to be concatenated to STEM to produce source filename -;;; OBJ-PREFIX, OBJ-SUFFIX = -;;; strings to be concatenated to STEM to produce object filename -;;; TMP-OBJ-SUFFIX-SUFFIX -;;; string to be appended to the name of an object file to produce the -;;; name of a temporary object file -;;; COMPILE-FILE, IGNORE-FAILURE-P = -;;; COMPILE-FILE is a function to use for compiling the file (with the -;;; same calling conventions as ANSI CL:COMPILE-FILE). If the third -;;; return value (FAILURE-P) of this function is true, a continuable -;;; error will be signalled, unless IGNORE-FAILURE-P is set, in which -;;; case only a warning will be signalled. +;;; file for STEM. Several &KEY arguments are accepted: +;;; :SRC-PREFIX, :SRC-SUFFIX = +;;; strings to be concatenated to STEM to produce source filename +;;; :OBJ-PREFIX, :OBJ-SUFFIX = +;;; strings to be concatenated to STEM to produce object filename +;;; :TMP-OBJ-SUFFIX-SUFFIX = +;;; string to be appended to the name of an object file to produce +;;; the name of a temporary object file +;;; :COMPILE-FILE, :IGNORE-FAILURE-P = +;;; :COMPILE-FILE is a function to use for compiling the file (with the +;;; same calling conventions as ANSI CL:COMPILE-FILE). If the third +;;; return value (FAILURE-P) of this function is true, a continuable +;;; error will be signalled, unless :IGNORE-FAILURE-P is set, in which +;;; case only a warning will be signalled. (defun compile-stem (stem &key (obj-prefix "") @@ -190,17 +193,6 @@ (pathname obj))) (compile 'compile-stem) -;;; basic tool for building other tools -#+nil -(defun tool-cload-stem (stem) - (load (compile-stem stem - :src-prefix *src-prefix* - :obj-prefix *host-obj-prefix* - :obj-suffix *host-obj-suffix* - :compile-file #'compile-file)) - (values)) -#+nil (compile 'tool-cload-stem) - ;;; other miscellaneous tools (load "src/cold/read-from-file.lisp") (load "src/cold/rename-package-carefully.lisp") @@ -220,8 +212,20 @@ ;;; *SHEBANG-FEATURES* instead of *FEATURES*, and use the #!+ and #!- ;;; readmacros instead of the ordinary #+ and #- readmacros. (setf *shebang-features* - (append (read-from-file "base-target-features.lisp-expr") - (read-from-file "local-target-features.lisp-expr"))) + (let* ((default-features + (append (read-from-file "base-target-features.lisp-expr") + (read-from-file "local-target-features.lisp-expr"))) + (customizer-file-name "customize-target-features.lisp") + (customizer (if (probe-file customizer-file-name) + (compile nil + (read-from-file customizer-file-name)) + #'identity))) + (funcall customizer default-features))) +(let ((*print-length* nil) + (*print-level* nil)) + (format t + "target features *SHEBANG-FEATURES*=~@<~S~:>~%" + *shebang-features*)) ;;;; cold-init-related PACKAGE and SYMBOL tools @@ -252,14 +256,13 @@ ;; :NOT-HOST is also set, since the SBCL assembler doesn't exist ;; while the cross-compiler is being built in the host ANSI Lisp.) :assem - ;; meaning: The COMPILE-STEM keyword argument called - ;; IGNORE-FAILURE-P should be true. (This is a KLUDGE: I'd like to - ;; get rid of it. For now, it exists so that compilation can - ;; proceed through the legacy warnings in - ;; src/compiler/x86/array.lisp, which I've never figured out but - ;; which were apparently acceptable in CMU CL. Eventually, it - ;; would be great to just get rid of all warnings and remove - ;; support for this flag. -- WHN 19990323) + ;; meaning: The #'COMPILE-STEM argument called :IGNORE-FAILURE-P + ;; should be true. (This is a KLUDGE: I'd like to get rid of it. + ;; For now, it exists so that compilation can proceed through the + ;; legacy warnings in src/compiler/x86/array.lisp, which I've + ;; never figured out but which were apparently acceptable in CMU + ;; CL. Eventually, it would be great to just get rid of all + ;; warnings and remove support for this flag. -- WHN 19990323) :ignore-failure-p)) (defparameter *stems-and-flags* (read-from-file "stems-and-flags.lisp-expr")) @@ -272,7 +275,7 @@ ,@body)))) ;;; Check for stupid typos in FLAGS list keywords. -(let ((stems (make-hash-table :test #'equal))) +(let ((stems (make-hash-table :test 'equal))) (for-stems-and-flags (stem flags) (if (gethash stem stems) (error "duplicate stem ~S in stems-and-flags data" stem) @@ -282,15 +285,21 @@ (error "found unexpected flag(s) in *STEMS-AND-FLAGS*: ~S" set-difference))))) -;;;; compiling SBCL sources to create the cross-compiler +;;;; tools to compile SBCL sources to create the cross-compiler ;;; Execute function FN in an environment appropriate for compiling the ;;; cross-compiler's source code in the cross-compilation host. (defun in-host-compilation-mode (fn) - (let ((*features* (cons :sb-xc-host *features*))) + (let ((*features* (cons :sb-xc-host *features*)) + ;; the CROSS-FLOAT-INFINITY-KLUDGE, as documented in + ;; base-target-features.lisp-expr: + (*shebang-features* (set-difference *shebang-features* + '(:sb-propagate-float-type + :sb-propagate-fun-type)))) (with-additional-nickname ("SB-XC" "SB!XC") (funcall fn)))) -(compile 'in-host-compilation-mode) +;;; FIXME: This COMPILE caused problems in sbcl-0.6.11.26. (bug 93) +;;;(compile 'in-host-compilation-mode) ;;; Process a file as source code for the cross-compiler, compiling it ;;; (if necessary) in the appropriate environment, then loading it @@ -299,7 +308,6 @@ (load (in-host-compilation-mode (lambda () (compile-stem stem - :src-prefix *src-prefix* :obj-prefix *host-obj-prefix* :obj-suffix *host-obj-suffix* :compile-file #'cl:compile-file @@ -316,8 +324,8 @@ (load (concatenate 'simple-string *host-obj-prefix* stem *host-obj-suffix*))) (compile 'host-load-stem) -;;;; compiling SBCL sources to create object files which will be used -;;;; to create the target SBCL .core file +;;;; tools to compile SBCL sources to create object files which will +;;;; be used to create the target SBCL .core file ;;; Run the cross-compiler on a file in the source directory tree to ;;; produce a corresponding file in the target object directory tree. @@ -325,7 +333,6 @@ (funcall *in-target-compilation-mode-fn* (lambda () (compile-stem stem - :src-prefix *src-prefix* :obj-prefix *target-obj-prefix* :obj-suffix *target-obj-suffix* :ignore-failure-p ignore-failure-p @@ -337,7 +344,7 @@ ;;; (This function is not used by the build process, but is intended ;;; for interactive use when experimenting with the system. It runs ;;; the cross-compiler on test files with arbitrary filenames, not -;;; necessarily in the source tree, e.g. in "/tmp/".) +;;; necessarily in the source tree, e.g. in "/tmp".) (defun target-compile-file (filename) (funcall *in-target-compilation-mode-fn* (lambda ()