Suppress "loading" and "dumping" messages for compiler.

diff --git a/v7/src/compiler/base/asstop.scm b/v7/src/compiler/base/asstop.scm
index cfc23b5f062bfe34d81a39df83fa87aa633dda90..185b07fd949d4c2bc0340e775aa1ac55f78bf110 100644 (file)
--- a/v7/src/compiler/base/asstop.scm
+++ b/v7/src/compiler/base/asstop.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: asstop.scm,v 1.17 2007/01/05 21:19:20 cph Exp $
+$Id: asstop.scm,v 1.18 2007/04/14 05:52:28 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -35,7 +35,7 @@ USA.
 (define compiled-output-extension "com")
 
 (define (compiler-file-output object pathname)
-  (fasdump object pathname))
+  (fasdump object pathname #t))
 
 (define (compiler-output->procedure scode environment)
   (scode-eval scode environment))
@@ -278,14 +278,14 @@ USA.
 ;;; Various ways of dumping an info file
 
 (define (compiler:dump-inf-file binf pathname)
-  (fasdump binf pathname))
+  (compiler-file-output binf pathname))
 
 (define (compiler:dump-bif/bsm-files binf pathname)
   (let ((bif-path (pathname-new-type pathname "bif"))
        (bsm-path (pathname-new-type pathname "bsm")))
     (let ((bsm (split-inf-structure! binf bsm-path)))
-      (fasdump binf bif-path)
-      (fasdump bsm bsm-path))))
+      (compiler-file-output binf bif-path)
+      (compiler-file-output bsm bsm-path))))
   
 (define (compiler:dump-bci/bcs-files binf pathname)
   (let ((bci-path (pathname-new-type pathname "bci"))
@@ -306,7 +306,7 @@ USA.
     (lambda ()
       (call-with-temporary-filename
        (lambda (temp)
-         (fasdump object temp #t)
+         (compiler-file-output object temp)
          (compress temp path))))))
 
 (define compiler:dump-info-file

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index 0de85a1970b2bbefe4cf420d52c1dd94ab288dd0..ef7ae7710fc4d952b4394556b7967d9a280c8b78 100644 (file)
--- a/v7/src/compiler/base/toplev.scm
+++ b/v7/src/compiler/base/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 4.71 2007/04/14 03:52:22 cph Exp $
+$Id: toplev.scm,v 4.72 2007/04/14 05:52:53 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -204,7 +204,7 @@ USA.
 
 (define (compiler-fasload pathname)
   (let ((scode
-        (let ((scode (fasload pathname)))
+        (let ((scode (fasload pathname #t)))
           (if (scode/comment? scode)
               (scode/comment-expression scode)
               scode))))

diff --git a/v7/src/sf/toplev.scm b/v7/src/sf/toplev.scm
index ad1e288c8808a212c3b858f354b824ca13a51af3..67cef9a4fb7116472afa34529b5a2b84485c553d 100644 (file)
--- a/v7/src/sf/toplev.scm
+++ b/v7/src/sf/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 4.31 2007/01/05 21:19:29 cph Exp $
+$Id: toplev.scm,v 4.32 2007/04/14 05:53:17 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -147,7 +147,8 @@ USA.
                               ,(decoded-time/second start-date)))
                       (sf/file->scode input-pathname bin-pathname
                                       environment declarations))
-                     bin-pathname)))))
+                     bin-pathname
+                     #t)))))
     (if sf:noisy?
        (let ((message
               (lambda (port)
@@ -188,7 +189,7 @@ USA.
   (let ((pathname (merge-pathnames pathname sf/default-externs-pathname)))
     (let ((namestring (->namestring pathname)))
       (if (file-exists? pathname)
-         (let ((object (fasload pathname))
+         (let ((object (fasload pathname #t))
                (wrong-version
                 (lambda (version)
                   (warn (string-append
@@ -216,14 +217,15 @@ USA.
                  (else
                   (error "Not an externs file:" namestring))))
          (begin
-           (warn "Nonexistent externs file:" namestring)
+           (warn "Missing externs file:" namestring)
            (values #f '()))))))
 
 (define (write-externs-file pathname externs-block externs)
   (cond ((not (null? externs))
         (fasdump (vector externs-file-tag externs-file-version
                          externs-block externs)
-                 pathname))
+                 pathname
+                 #t))
        ((file-exists? pathname)
         (delete-file pathname))))