From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 20 May 2007 01:55:52 +0000 (+0000)
Subject: Make sure that notifications for built-in object files are
X-Git-Tag: 20090517-FFI~557
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7de2acae87fbd859265101753c4ca56eb7e6b3cd;p=mit-scheme.git

Make sure that notifications for built-in object files are
"initialized" rather than "loaded".
---

diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm
index 0acdd7ce7..380d9007d 100644
--- a/v7/src/runtime/load.scm
+++ b/v7/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: load.scm,v 14.93 2007/04/15 17:50:37 cph Exp $
+$Id: load.scm,v 14.94 2007/05/20 01:55:52 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -313,11 +313,9 @@ USA.
 
 (define (wrapper/fasload/built-in value)
   (lambda (pathname suppress-loading-message?)
-    (with-loading-message pathname
-      (lambda ()
-	(fasload/update-debugging-info! value pathname)
-	value)
-      suppress-loading-message?)))
+    (fasload/update-debugging-info! value pathname)
+    (write-init-message pathname suppress-loading-message?)
+    value))
 
 (define (load-object-file pathname environment purify? load-noisily?)
   load-noisily?		; ignored
@@ -329,10 +327,10 @@ USA.
 (define (wrapper/load/built-in scode)
   (lambda (pathname environment purify? load-noisily?)
     load-noisily?			; ignored
-    (with-loading-message pathname
-      (lambda ()
-	(fasload/update-debugging-info! scode pathname)
-	(load-scode-end scode environment purify?)))))
+    (fasload/update-debugging-info! scode pathname)
+    (let ((value (load-scode-end scode environment purify?)))
+      (write-init-message pathname)
+      value)))
 
 (define (load-scode-end scode environment purify?)
   (if purify? (purify (load/purification-root scode)))
@@ -386,6 +384,15 @@ USA.
 			   (write (enough-namestring pathname) port))
 	thunk)))
 
+(define (write-init-message pathname #!optional suppress-message?)
+  (if (not (if (default-object? suppress-message?)
+	       load/suppress-loading-message?
+	       suppress-message?))
+      (write-notification-line
+       (lambda (port)
+	 (write-string "Initialized " port)
+	 (write (enough-namestring pathname) port)))))
+
 (define *purification-root-marker*)
 
 (define (load/purification-root object)