From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Thu, 1 Jul 1993 00:24:28 +0000 (+0000)
Subject: Allow disload to load into a compiler-less image.
X-Git-Tag: 20090517-FFI~8247
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=550d92855195c066f1da6ff76e315afa4b7c4442;p=mit-scheme.git

Allow disload to load into a compiler-less image.
---

diff --git a/v7/src/compiler/etc/disload.scm b/v7/src/compiler/etc/disload.scm
index 0dcd3e8e9..78484b855 100644
--- a/v7/src/compiler/etc/disload.scm
+++ b/v7/src/compiler/etc/disload.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: disload.scm,v 1.1 1993/06/30 23:58:12 gjr Exp $
+$Id: disload.scm,v 1.2 1993/07/01 00:24:28 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -36,18 +36,19 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 
-(define (load-disassembler #!optional directory)
+(define (load-disassembler #!optional directory addressing-granularity)
   (with-working-directory-pathname
     (if (default-object? directory)
-	"/scheme/700/compiler/machine"
+	"/usr/local/lib/mit-scheme/SRC/compiler/machine"
 	directory)
     (lambda ()
-      (let* ((compiler (name->package '(compiler)))
+      (let* ((parent (or (name->package '(compiler))
+			 (find-package '())))
+	     (parenv (package/environment parent))
 	     (disassembler
-	      (package/add-child! compiler
+	      (package/add-child! parent
 				  'disassembler
-				  (eval '(make-environment)
-					(package/environment compiler)))))
+				  (eval '(make-environment) parenv))))
 	(let ((disenv (package/environment disassembler))
 	      (global system-global-environment)
 	      (compinfo (package/environment (find-package '(runtime compiler-info)))))
@@ -56,6 +57,12 @@ MIT in each case. |#
 	  (define (import name)
 	    (environment-link-name disenv compinfo name))
 
+	  (if (not (environment-bound? parenv 'addressing-granularity))
+	      (local-assignment parenv
+				'addressing-granularity
+				(if (default-object? addressing-granularity)
+				    4
+				    addressing-granularity)))
 	  (for-each import
 		    '(compiled-code-block/dbg-info
 		      dbg-info-vector/blocks-vector
@@ -75,10 +82,4 @@ MIT in each case. |#
 		(load "dinstr3")))
 	  (for-each export
 		    '(compiler:write-lap-file
-		      compiler:disassemble)))))))
-	 
-	
-    
-      
-    
-  
\ No newline at end of file
+		      compiler:disassemble)))))))
\ No newline at end of file
diff --git a/v8/src/compiler/etc/disload.scm b/v8/src/compiler/etc/disload.scm
index 0dcd3e8e9..78484b855 100644
--- a/v8/src/compiler/etc/disload.scm
+++ b/v8/src/compiler/etc/disload.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: disload.scm,v 1.1 1993/06/30 23:58:12 gjr Exp $
+$Id: disload.scm,v 1.2 1993/07/01 00:24:28 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -36,18 +36,19 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 
-(define (load-disassembler #!optional directory)
+(define (load-disassembler #!optional directory addressing-granularity)
   (with-working-directory-pathname
     (if (default-object? directory)
-	"/scheme/700/compiler/machine"
+	"/usr/local/lib/mit-scheme/SRC/compiler/machine"
 	directory)
     (lambda ()
-      (let* ((compiler (name->package '(compiler)))
+      (let* ((parent (or (name->package '(compiler))
+			 (find-package '())))
+	     (parenv (package/environment parent))
 	     (disassembler
-	      (package/add-child! compiler
+	      (package/add-child! parent
 				  'disassembler
-				  (eval '(make-environment)
-					(package/environment compiler)))))
+				  (eval '(make-environment) parenv))))
 	(let ((disenv (package/environment disassembler))
 	      (global system-global-environment)
 	      (compinfo (package/environment (find-package '(runtime compiler-info)))))
@@ -56,6 +57,12 @@ MIT in each case. |#
 	  (define (import name)
 	    (environment-link-name disenv compinfo name))
 
+	  (if (not (environment-bound? parenv 'addressing-granularity))
+	      (local-assignment parenv
+				'addressing-granularity
+				(if (default-object? addressing-granularity)
+				    4
+				    addressing-granularity)))
 	  (for-each import
 		    '(compiled-code-block/dbg-info
 		      dbg-info-vector/blocks-vector
@@ -75,10 +82,4 @@ MIT in each case. |#
 		(load "dinstr3")))
 	  (for-each export
 		    '(compiler:write-lap-file
-		      compiler:disassemble)))))))
-	 
-	
-    
-      
-    
-  
\ No newline at end of file
+		      compiler:disassemble)))))))
\ No newline at end of file