0.8.16.27:
[sbcl.git] / 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 (do-stems-and-flags (stem flags)
35   (unless (position :not-target flags)
36     (let ((srcname (concatenate 'string stem ".lisp"))
37           (objname (concatenate 'string
38                                 *target-obj-prefix*
39                                 stem
40                                 *target-obj-suffix*)))
41       (unless (output-up-to-date-wrt-input-p objname srcname)
42         (target-compile-stem stem
43                              :assem-p (find :assem flags)
44                              :ignore-failure-p (find :ignore-failure-p flags))))))