src/cold/slam.lisp

   1 ;;;; crude selective re-cross-compilation of the target system, like
   2 ;;;; Unix make(1), but much flakier because we don't keep track of the
   3 ;;;; (many!) dependencies between files
   4
   5 ;;;; This software is part of the SBCL system. See the README file for
   6 ;;;; more information.
   7 ;;;;
   8 ;;;; This software is derived from the CMU CL system, which was
   9 ;;;; written at Carnegie Mellon University and released into the
  10 ;;;; public domain. The software is in the public domain and is
  11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  12 ;;;; files for more information.
  13
  14 (in-package :sb-cold)
  15
  16 ;;; (This file is intended to be loaded into an after-xc.lisp core, so
  17 ;;; we don't need to LOAD any machinery (e.g. "src/cold/shared.lisp")
  18 ;;; which was already loaded in the course of setting up the system
  19 ;;; state which was frozen into that core.)
  20
  21 ;;; basic test for up-to-date-ness of output with respect to input in
  22 ;;; the sense of Unix make(1)
  23 (defun output-up-to-date-wrt-input-p (output input)
  24   (and (probe-file output)
  25        ;; (Strict #'> and lax #'>= each have problems here, which
  26        ;; could become more noticeable as computation speed
  27        ;; accelerates while Common Lisp's 1-second granularity remains
  28        ;; the same. We use #'> because it's safer sometimes to
  29        ;; recompile unnecessarily than sometimes bogusly to assume
  30        ;; up-to-date-ness.)
  31        (> (file-write-date output)
  32           (file-write-date input))))
  33
  34 ;;; One possible use-case for slam.sh is to generate a trace-file for
  35 ;;; a file that is suddenly of interest, but was not of interest
  36 ;;; before.  In order for this to work, we need to reload the stems
  37 ;;; and flags from build-order.lisp-expr, the user needs to have added
  38 ;;; :trace-file as a flag.
  39 (setf *stems-and-flags* (read-from-file "build-order.lisp-expr"))
  40
  41 (do-stems-and-flags (stem flags)
  42   (unless (position :not-target flags)
  43     (let ((srcname (stem-source-path stem))
  44           (objname (stem-object-path stem flags :target-compile)))
  45       (unless (and (output-up-to-date-wrt-input-p objname srcname)
  46                    ;; Back to our "new-trace-file" case, also build if
  47                    ;; a trace file is desired but is out-of-date.
  48                    (or (not (position :trace-file flags))
  49                        (output-up-to-date-wrt-input-p
  50                         (concatenate 'string (stem-remap-target stem)
  51                                      ".trace")
  52                         srcname)))
  53         (target-compile-stem stem flags)))))