X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fshared.lisp;h=62299010701d0a5122b2e686d3b5b4fdad265f0a;hb=ba7659c92f2b7fac7e9532a3db9114c5bdc4ab55;hp=18e71e4d9c38834659d2dda9052915dc9e721cb0;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index 18e71e4..6229901 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -17,15 +17,22 @@ ;;; 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 +;;; does. GC time is proportional to the amount of non-garbage ;;; 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 +;;; the SBCL compiler, it doesn't take any longer to collect 20 Mb than +;;; to collect 2 Mb. -dan, 20000819 +;;; +;;; Actually, tweaking *BYTES-CONSED-BETWEEN-GCS* to 20Mb instead of +;;; the default 2 seemed to make SBCL rebuild O(25%) faster on my 256 +;;; Mb K6/3, so I think it does have some effect on X86/GENCGC. I +;;; haven't looked into why this would be, though. Also, I'm afraid +;;; that using 20Mb here might be unfriendly to people using more-reasonable +;;; machines (like old laptops with 48Mb of memory..) so I've +;;; suppressed this tweak except for Alpha. -- WHN 2001-05-11 +#+(and sbcl alpha) ; SBCL/Alpha uses stop-and-copy, and Alphas have lotso RAM. (progn (sb-ext:gc-off) - (setf sb-KERNEL::*bytes-consed-between-gcs* (* 20 (expt 10 6))) + (setf (sb-ext:bytes-consed-between-gcs) (* 20 (expt 10 6))) (sb-ext:gc-on) (sb-ext:gc)) @@ -37,11 +44,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. @@ -52,13 +54,14 @@ (defvar *host-obj-prefix*) (defvar *target-obj-prefix*) -;;; suffixes for filename stems when cross-compiling. Everything should work -;;; fine for any arbitrary string values here. With more work maybe we -;;; could cause these automatically to become the traditional extensions for -;;; whatever host and target architectures (e.g. ".x86f" or ".axpf") we're -;;; currently doing. That would make it easier for a human looking at the -;;; temporary files to figure out what they're for, but it's not necessary for -;;; the compilation process to work, so we haven't bothered. +;;; suffixes for filename stems when cross-compiling. Everything +;;; should work fine for any arbitrary string values here. With more +;;; work maybe we could cause these automatically to become the +;;; traditional extensions for whatever host and target architectures +;;; (e.g. ".x86f" or ".axpf") we're currently doing. That would make +;;; it easier for a human looking at the temporary files to figure out +;;; what they're for, but it's not necessary for the compilation +;;; process to work, so we haven't bothered. (defvar *host-obj-suffix* ".lisp-obj") (defvar *target-obj-suffix* ".lisp-obj") @@ -93,12 +96,12 @@ ;;; 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 - ;; example in the ANSI spec for TRUENAME.) + ;; (Note that the TRUENAME expression here is lifted + ;; from an example in the ANSI spec for TRUENAME.) (with-open-file (stream y :direction :output) (close stream) - ;; From the ANSI spec: "In this case, the file is closed - ;; when the truename is tried, so the truename + ;; From the ANSI spec: "In this case, the file is + ;; closed when the truename is tried, so the truename ;; information is reliable." (truename stream)))) (compile 'rename-file-a-la-unix) @@ -107,9 +110,9 @@ ;;; the procedure for finding full filenames from "stems" ;;; ;;; 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 &KEY arguments are accepted: +;;; 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 &KEY arguments are accepted: ;;; :SRC-PREFIX, :SRC-SUFFIX = ;;; strings to be concatenated to STEM to produce source filename ;;; :OBJ-PREFIX, :OBJ-SUFFIX = @@ -118,11 +121,12 @@ ;;; 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. +;;; :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 "") @@ -133,7 +137,7 @@ (compile-file #'compile-file) ignore-failure-p) - (let* (;; KLUDGE: Note that this CONCATENATE 'STRING stuff is not The Common + (let* (;; KLUDGE: Note that this CONCATENATE 'STRING stuff is not The Common ;; Lisp Way, although it works just fine for common UNIX environments. ;; Should it come to pass that the system is ported to environments ;; where version numbers and so forth become an issue, it might become @@ -145,57 +149,57 @@ (obj (concatenate 'string obj-prefix stem obj-suffix)) (tmp-obj (concatenate 'string obj tmp-obj-suffix-suffix))) - (ensure-directories-exist obj :verbose t) - - ;; We're about to set about building a new object file. First, we - ;; delete any preexisting object file in order to avoid confusing - ;; ourselves later should we happen to bail out of compilation with an - ;; error. - (when (probe-file obj) - (delete-file obj)) - - ;; Work around a bug in CLISP 1999-01-08 #'COMPILE-FILE: CLISP mangles - ;; relative pathnames passed as :OUTPUT-FILE arguments, but works OK - ;; with absolute pathnames. - #+clisp - (setf tmp-obj - ;; (Note that this idiom is taken from the ANSI documentation - ;; for TRUENAME.) - (with-open-file (stream tmp-obj :direction :output) - (close stream) - (truename stream))) - - ;; Try to use the compiler to generate a new temporary object file. - (multiple-value-bind (output-truename warnings-p failure-p) - (funcall compile-file src :output-file tmp-obj) - (declare (ignore warnings-p)) - (cond ((not output-truename) - (error "couldn't compile ~S" src)) - (failure-p - (if ignore-failure-p - (warn "ignoring FAILURE-P return value from compilation of ~S" - src) - (unwind-protect - (progn - ;; FIXME: This should have another option, redoing - ;; compilation. - (cerror "Continue, using possibly-bogus ~S." - "FAILURE-P was set when creating ~S." - obj) - (setf failure-p nil)) - ;; Don't leave failed object files lying around. - (when (and failure-p (probe-file tmp-obj)) - (delete-file tmp-obj) - (format t "~&deleted ~S~%" tmp-obj))))) - ;; Otherwise: success, just fall through. - (t nil))) - - ;; If we get to here, compilation succeeded, so it's OK to rename the - ;; temporary output file to the permanent object file. - (rename-file-a-la-unix tmp-obj obj) - - ;; nice friendly traditional return value - (pathname obj))) + (ensure-directories-exist obj :verbose t) + + ;; We're about to set about building a new object file. First, we + ;; delete any preexisting object file in order to avoid confusing + ;; ourselves later should we happen to bail out of compilation + ;; with an error. + (when (probe-file obj) + (delete-file obj)) + + ;; Work around a bug in CLISP 1999-01-08 #'COMPILE-FILE: CLISP + ;; mangles relative pathnames passed as :OUTPUT-FILE arguments, + ;; but works OK with absolute pathnames. + #+clisp + (setf tmp-obj + ;; (Note that this idiom is taken from the ANSI + ;; documentation for TRUENAME.) + (with-open-file (stream tmp-obj :direction :output) + (close stream) + (truename stream))) + + ;; Try to use the compiler to generate a new temporary object file. + (multiple-value-bind (output-truename warnings-p failure-p) + (funcall compile-file src :output-file tmp-obj) + (declare (ignore warnings-p)) + (cond ((not output-truename) + (error "couldn't compile ~S" src)) + (failure-p + (if ignore-failure-p + (warn "ignoring FAILURE-P return value from compilation of ~S" + src) + (unwind-protect + (progn + ;; FIXME: This should have another option, + ;; redoing compilation. + (cerror "Continue, using possibly-bogus ~S." + "FAILURE-P was set when creating ~S." + obj) + (setf failure-p nil)) + ;; Don't leave failed object files lying around. + (when (and failure-p (probe-file tmp-obj)) + (delete-file tmp-obj) + (format t "~&deleted ~S~%" tmp-obj))))) + ;; Otherwise: success, just fall through. + (t nil))) + + ;; If we get to here, compilation succeeded, so it's OK to rename + ;; the temporary output file to the permanent object file. + (rename-file-a-la-unix tmp-obj obj) + + ;; nice friendly traditional return value + (pathname obj))) (compile 'compile-stem) ;;; other miscellaneous tools @@ -270,9 +274,9 @@ ;; warnings and remove support for this flag. -- WHN 19990323) :ignore-failure-p)) -(defparameter *stems-and-flags* (read-from-file "stems-and-flags.lisp-expr")) +(defparameter *stems-and-flags* (read-from-file "build-order.lisp-expr")) -(defmacro for-stems-and-flags ((stem flags) &body body) +(defmacro do-stems-and-flags ((stem flags) &body body) (let ((stem-and-flags (gensym "STEM-AND-FLAGS-"))) `(dolist (,stem-and-flags *stems-and-flags*) (let ((,stem (first ,stem-and-flags)) @@ -281,9 +285,9 @@ ;;; Check for stupid typos in FLAGS list keywords. (let ((stems (make-hash-table :test 'equal))) - (for-stems-and-flags (stem flags) + (do-stems-and-flags (stem flags) (if (gethash stem stems) - (error "duplicate stem ~S in stems-and-flags data" stem) + (error "duplicate stem ~S in *STEMS-AND-FLAGS*" stem) (setf (gethash stem stems) t)) (let ((set-difference (set-difference flags *expected-stem-flags*))) (when set-difference @@ -303,21 +307,21 @@ :sb-propagate-fun-type)))) (with-additional-nickname ("SB-XC" "SB!XC") (funcall fn)))) -;;; FIXME: This COMPILE caused problems in sbcl-0.6.11.26. (bug 93) -;;;(compile 'in-host-compilation-mode) +(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 ;;; into the cross-compilation host Common lisp. (defun host-cload-stem (stem &key ignore-failure-p) - (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 - :ignore-failure-p ignore-failure-p))))) + (let ((compiled-filename (in-host-compilation-mode + (lambda () + (compile-stem + stem + :obj-prefix *host-obj-prefix* + :obj-suffix *host-obj-suffix* + :compile-file #'cl:compile-file + :ignore-failure-p ignore-failure-p))))) + (load compiled-filename))) (compile 'host-cload-stem) ;;; Like HOST-CLOAD-STEM, except that we don't bother to compile. @@ -339,7 +343,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