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 0dcd3e8e9e50a138ff41c6a6149e24b79fcbebd1..78484b85534a05b4d614f86c30734c790ee930e9 100644 (file)
--- 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))
 \f
-(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 0dcd3e8e9e50a138ff41c6a6149e24b79fcbebd1..78484b85534a05b4d614f86c30734c790ee930e9 100644 (file)
--- 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))
 \f
-(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