From: Taylor R. Campbell <net/mumble/campbell>
Date: Sun, 15 Apr 2007 07:49:50 +0000 (+0000)
Subject: Use liarc built-in objects only for LOAD, not for FASLOAD.  When we're
X-Git-Tag: 20090517-FFI~654
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c4bc216d5196f1a3148712ca98122013dca57de0;p=mit-scheme.git

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 3b62b5417..f64311b8a 100644
--- 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))))