X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fshared.lisp;h=9fe9f42721b15dcd5363b335e52fbef601fbc7ee;hb=cfff13b268daf51fd05214b60e67a2b62f340d16;hp=f17fedf2034ef2b071973a32a1e6e22c4f4f33be;hpb=e8f173ff44bc069db48585c8844f2d1097bb47d2;p=sbcl.git diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index f17fedf..9fe9f42 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -46,7 +46,8 @@ ;; that we never explicitly refer to host object file suffixes, ;; only to the result of CL:COMPILE-FILE-PATHNAME. #+lispworks ".ufsl" ; as per Lieven Marchand sbcl-devel 2002-02-01 - #+openmcl ".pfsl" + #+(and openmcl (not darwin)) ".pfsl" + #+(and openmcl darwin) ".dfsl" ;; On most xc hosts, any old extension works, so we use an ;; arbitrary one. ".lisp-obj")) @@ -59,11 +60,12 @@ ;;; a function of one functional argument, which calls its functional argument ;;; in an environment suitable for compiling the target. (This environment ;;; includes e.g. a suitable *FEATURES* value.) +(declaim (type function *in-target-compilation-mode-fn*)) (defvar *in-target-compilation-mode-fn*) -;;; designator for a function with the same calling convention as -;;; CL:COMPILE-FILE, to be used to translate ordinary Lisp source files into -;;; target object files +;;; a function with the same calling convention as CL:COMPILE-FILE, to be +;;; used to translate ordinary Lisp source files into target object files +(declaim (type function *target-compile-file*)) (defvar *target-compile-file*) ;;; designator for a function with the same calling convention as @@ -128,8 +130,11 @@ (src-prefix "") (src-suffix ".lisp") (compile-file #'compile-file) + trace-file ignore-failure-p) + (declare (type function compile-file)) + (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 @@ -151,17 +156,36 @@ (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 + ;; Original comment: + ;; + ;; 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. + ;; + ;; following discussion on cmucl-imp 2002-07 + ;; "COMPILE-FILE-PATHNAME", it would seem safer to deal with + ;; absolute pathnames all the time; it is no longer clear that the + ;; original behaviour in CLISP was wrong or that the current + ;; behaviour is right; and in any case absolutifying the pathname + ;; insulates us against changes of behaviour. -- CSR, 2002-08-09 (setf tmp-obj ;; (Note that this idiom is taken from the ANSI ;; documentation for TRUENAME.) - (with-open-file (stream tmp-obj :direction :output) + (with-open-file (stream tmp-obj + :direction :output + ;; Compilation would overwrite the + ;; temporary object anyway and overly + ;; strict implementations default + ;; to :ERROR. + :if-exists :supersede) (close stream) (truename stream))) - + ;; and some compilers (e.g. OpenMCL) will complain if they're + ;; asked to write over a file that exists already (and isn't + ;; recognizeably a fasl file), so + (when (probe-file tmp-obj) + (delete-file tmp-obj)) + ;; Try to use the compiler to generate a new temporary object file. (flet ((report-recompile-restart (stream) (format stream "Recompile file ~S" src)) @@ -170,7 +194,10 @@ (tagbody retry-compile-file (multiple-value-bind (output-truename warnings-p failure-p) - (funcall compile-file src :output-file tmp-obj) + (if trace-file + (funcall compile-file src :output-file tmp-obj + :trace-file t) + (funcall compile-file src :output-file tmp-obj )) (declare (ignore warnings-p)) (cond ((not output-truename) (error "couldn't compile ~S" src)) @@ -270,11 +297,20 @@ (defparameter *expected-stem-flags* '(;; meaning: This file is not to be compiled when building the - ;; cross-compiler which runs on the host ANSI Lisp. + ;; cross-compiler which runs on the host ANSI Lisp. ("not host + ;; code", i.e. does not execute on host -- but may still be + ;; cross-compiled by the host, so that it executes on the target) :not-host ;; meaning: This file is not to be compiled as part of the target - ;; SBCL. + ;; SBCL. ("not target code" -- but still presumably host code, + ;; used to support the cross-compilation process) :not-target + ;; meaning: The #'COMPILE-STEM argument :TRACE-FILE should be T. + ;; When the compiler is SBCL's COMPILE-FILE or something like it, + ;; compiling "foo.lisp" will generate "foo.trace" which contains lots + ;; of exciting low-level information about representation selection, + ;; VOPs used by the compiler, and bits of assembly. + :trace-file ;; meaning: This file is to be processed with the SBCL assembler, ;; not COMPILE-FILE. (Note that this doesn't make sense unless ;; :NOT-HOST is also set, since the SBCL assembler doesn't exist @@ -292,7 +328,7 @@ (defparameter *stems-and-flags* (read-from-file "build-order.lisp-expr")) (defmacro do-stems-and-flags ((stem flags) &body body) - (let ((stem-and-flags (gensym "STEM-AND-FLAGS-"))) + (let ((stem-and-flags (gensym "STEM-AND-FLAGS"))) `(dolist (,stem-and-flags *stems-and-flags*) (let ((,stem (first ,stem-and-flags)) (,flags (rest ,stem-and-flags))) @@ -314,6 +350,7 @@ ;;; 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) + (declare (type function fn)) (let ((*features* (cons :sb-xc-host *features*)) ;; the CROSS-FLOAT-INFINITY-KLUDGE, as documented in ;; base-target-features.lisp-expr: @@ -354,12 +391,13 @@ ;;; Run the cross-compiler on a file in the source directory tree to ;;; produce a corresponding file in the target object directory tree. -(defun target-compile-stem (stem &key assem-p ignore-failure-p) +(defun target-compile-stem (stem &key assem-p ignore-failure-p trace-file) (funcall *in-target-compilation-mode-fn* (lambda () (compile-stem stem :obj-prefix *target-obj-prefix* :obj-suffix *target-obj-suffix* + :trace-file trace-file :ignore-failure-p ignore-failure-p :compile-file (if assem-p *target-assemble-file*