From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 18 Jun 2007 23:58:40 +0000 (+0000)
Subject: Prevent liarc from recompiling files that are up to date.
X-Git-Tag: 20090517-FFI~517
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=86b8c681ad51800281b252472f2c572cef34baf0;p=mit-scheme.git

Prevent liarc from recompiling files that are up to date.
---

diff --git a/v7/src/etc/compile.scm b/v7/src/etc/compile.scm
index 5493a1769..12cf08f08 100644
--- a/v7/src/etc/compile.scm
+++ b/v7/src/etc/compile.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: compile.scm,v 1.25 2007/06/13 13:37:03 cph Exp $
+$Id: compile.scm,v 1.26 2007/06/18 23:58:40 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -86,7 +86,7 @@ USA.
   (in-liarc
    (lambda ()
      (compile-boot-dirs c-compile-dir)
-     (cf "microcode/utabmd"))))
+     (cf-conditionally "microcode/utabmd"))))
 
 (define (native-prepare)
   (load-option 'SF)
@@ -98,7 +98,7 @@ USA.
 	(load make-file))))
   (fluid-let ((compiler:cross-compiling? #t))
     (compile-boot-dirs compile-dir)
-    (sf "microcode/utabmd")))
+    (sf-conditionally "microcode/utabmd")))
 
 (define (compiler-make-file)
   (string-append
@@ -110,13 +110,16 @@ USA.
   (in-liarc
    (lambda ()
      (compile-all-dirs c-compile-dir)
-     (cf "microcode/utabmd")
-     (cbf "edwin/edwin.bld"))))
+     (cf-conditionally "microcode/utabmd")
+     (cbf-conditionally "edwin/edwin.bld"))))
 
 (define (in-liarc thunk)
-  (fluid-let ((compiler:invoke-c-compiler? #f))
+  (fluid-let ((compiler:invoke-c-compiler? #f)
+	      (in-liarc? #t))
     (thunk)))
-  
+
+(define in-liarc? #f)
+
 (define (c-compile-dir name)
   (compile-dir name)
   (c-compile-pkgs name))
@@ -130,9 +133,22 @@ USA.
       (lambda ()
 	(let ((compile-pkg
 	       (lambda (os)
-		 (let ((name (string-append root "-" os ".pkd")))
-		   (if (file-exists? name)
-		       (cbf name))))))
+		 (cbf-conditionally (string-append root "-" os ".pkd")))))
 	  (compile-pkg "unx")
 	  (compile-pkg "w32")
-	  (compile-pkg "os2"))))))
\ No newline at end of file
+	  (compile-pkg "os2"))))))
+
+(define (cbf-conditionally pathname)
+  (let ((input (pathname-default-type pathname "bin")))
+    (if (file-modification-time<? (compiler-output-pathname pathname)
+				  input)
+	(cbf input output))))
+
+(define (cf-conditionally pathname)
+  (let ((input (pathname-default-type pathname "scm")))
+    (if (file-modification-time<? (compiler-output-pathname pathname)
+				  input)
+	(cf input))))
+
+(define (compiler-output-pathname pathname)
+  (pathname-new-type pathname (if in-liarc? "c" "com")))
\ No newline at end of file