Use liarc built-in objects only for LOAD, not for FASLOAD. When we're

actually loading code for execution, we need them; when we're loading
code for data (e.g., when loading scode for the compiler -- especially
when it is compiling itself, or other parts of the system that are
loaded into the compiler image), we need the file and not the compiled
expression statically linked into the microcode.

This is a kludge, but it is necessary for bootstrapping liarc.  I
don't know whether there is any code that relies on FASLOAD yielding
built-in objects, however; I suspect not.

diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm
index 3b62b5417f432941e01c0f3e8a5c9cc328ffe01f..f64311b8a878f4026a2f52a453a1bc6ee2b1b2c9 100644 (file)
--- a/v7/src/runtime/load.scm
+++ b/v7/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: load.scm,v 14.88 2007/04/14 03:52:43 cph Exp $
+$Id: load.scm,v 14.89 2007/04/15 07:49:50 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -95,7 +95,7 @@ USA.
         (let ((kernel
                (lambda (filename last-file?)
                  (receive (pathname loader)
-                     (find-pathname filename load/default-types)
+                     (find-pathname filename load/default-types #t)
                    (with-eval-unit (pathname->uri pathname)
                      (lambda ()
                        (let ((load-it
@@ -118,7 +118,7 @@ USA.
 
 (define (fasload filename #!optional suppress-loading-message?)
   (receive (pathname loader)
-      (find-pathname filename fasload/default-types)
+      (find-pathname filename fasload/default-types #f)
     (loader pathname
            (if (default-object? suppress-loading-message?)
                load/suppress-loading-message?
@@ -164,7 +164,7 @@ USA.
   (fluid-let ((load/default-find-pathname-with-type find-latest-file))
     (apply fasload args)))
 
-(define (find-pathname filename default-types)
+(define (find-pathname filename default-types built-in?)
   (let ((pathname (merge-pathnames filename))
        (find-loader
         (lambda (extension)
@@ -180,7 +180,8 @@ USA.
                                                find-pathname
                                                (list filename default-types))
                          default-types))))
-    (cond ((built-in-object-file pathname)
+    (cond ((and built-in?
+               (built-in-object-file pathname))
           => (lambda (value)
                (values pathname
                        ((find-loader #f) value))))