From 7dd568fb64927be78556ac27f1f0dc60e79cf942 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Mon, 20 Aug 2001 18:09:16 +0000 Subject: [PATCH] 0.pre7.14.flaky4.2: don't need to load src/cold/shared.lisp twice in make-host-1.sh corrected the sense of #!-SB-INTERPRETER case of INTERNAL-APPLY-LOOP hack in debug-int.lisp --- make-host-1.sh | 1 - src/code/debug-int.lisp | 7 +- src/cold/defun-load-or-cload-xcompiler.lisp | 8 ++ src/cold/shared.lisp | 138 ++++++++++++++------------- version.lisp-expr | 2 +- 5 files changed, 85 insertions(+), 71 deletions(-) diff --git a/make-host-1.sh b/make-host-1.sh index 9892fa1..cb551ac 100644 --- a/make-host-1.sh +++ b/make-host-1.sh @@ -33,7 +33,6 @@ $SBCL_XC_HOST <<-'EOF' || exit 1 (load "src/cold/shared.lisp") (in-package "SB-COLD") (setf *host-obj-prefix* "obj/from-host/") - (load "src/cold/shared.lisp") (load "src/cold/set-up-cold-packages.lisp") (load "src/cold/defun-load-or-cload-xcompiler.lisp") (load-or-cload-xcompiler #'host-cload-stem) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index c61ab78..a63c1ba 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -967,9 +967,10 @@ ;;; to replace FRAME. The interpreted frame points to FRAME. (defun possibly-an-interpreted-frame (frame up-frame) (if (or (not frame) - #!+sb-interpreter - (not (eq (debug-function-name (frame-debug-function frame)) - 'sb!eval::internal-apply-loop)) + #!+sb-interpreter (not (eq (debug-function-name (frame-debug-function + frame)) + 'sb!eval::internal-apply-loop)) + #!-sb-interpreter t *debugging-interpreter* (compiled-frame-escaped frame)) frame diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp index d195581..2a178e0 100644 --- a/src/cold/defun-load-or-cload-xcompiler.lisp +++ b/src/cold/defun-load-or-cload-xcompiler.lisp @@ -13,6 +13,8 @@ ;;; cross-compilation host Common Lisp. (defun load-or-cload-xcompiler (load-or-cload-stem) + (format t "~&/entering LOAD-OR-CLOAD-XCOMPILER~%") ; REMOVEME + ;; The running-in-the-host-Lisp Python cross-compiler defines its ;; own versions of a number of functions which should not overwrite ;; host-Lisp functions. Instead we put them in a special package. @@ -120,6 +122,8 @@ "WITH-COMPILATION-UNIT")) (export (intern name package-name) package-name))) + (format t "~&/made SB-XC~%") ; REMOVEME + ;; Build a version of Python to run in the host Common Lisp, to be ;; used only in cross-compilation. ;; @@ -130,10 +134,13 @@ ;; order to make the compiler aware of the definitions of assembly ;; routines. (do-stems-and-flags (stem flags) + (format t "~&/STEM=~S FLAGS=~S~%" stem flags) ; REMOVEME (unless (find :not-host flags) + (format t "~&/FUNCALLing ~S~%" load-or-cload-stem) ; REMOVEME (funcall load-or-cload-stem stem :ignore-failure-p (find :ignore-failure-p flags)) + (format t "~&/back from FUNCALL~%") ; REMOVEME #!+sb-show (warn-when-cl-snapshot-diff *cl-snapshot*))) ;; If the cross-compilation host is SBCL itself, we can use the @@ -144,6 +151,7 @@ ;; (in the ordinary build procedure anyway) essentially everything ;; which is reachable at this point will remain reachable for the ;; entire run. + (format t "~&/doing PURIFY~%") ; REMOVEME #+sbcl (sb-ext:purify) (values)) diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index 7523ab3..40f1eba 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -109,9 +109,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 = @@ -120,11 +120,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 "") @@ -135,7 +136,9 @@ (compile-file #'compile-file) ignore-failure-p) - (let* (;; KLUDGE: Note that this CONCATENATE 'STRING stuff is not The Common + (format t "~&/entering COMPILE-STEM~%") ; REMOVEME + + (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 @@ -147,57 +150,59 @@ (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) + + (format t "~&/nearly done with COMPILE-STEM~%") ; REMOVEME + + ;; nice friendly traditional return value + (pathname obj))) (compile 'compile-stem) ;;; other miscellaneous tools @@ -312,13 +317,14 @@ ;;; (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) + (format t "~&/entering HOST-CLOAD-STEM ~S ~S" stem ignore-failure-p) ; REMOVEME (load (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))))) + (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))))) (compile 'host-cload-stem) ;;; Like HOST-CLOAD-STEM, except that we don't bother to compile. diff --git a/version.lisp-expr b/version.lisp-expr index a3deaef..d28c192 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -16,4 +16,4 @@ ;;; four numeric fields, is used for versions which aren't released ;;; but correspond only to CVS tags or snapshots. -"0.pre7.14.flaky4.1" +"0.pre7.14.flaky4.2" -- 1.7.10.4