From: Joe Marshall <edu/mit/csail/zurich/jrm>
Date: Wed, 15 Jun 1988 20:47:59 +0000 (+0000)
Subject: Changes to reflect changes in infutl
X-Git-Tag: 20090517-FFI~12711
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=99528b726c72907d170f02cfe8e4e45e5ef64a97;p=mit-scheme.git

Changes to reflect changes in infutl
---

diff --git a/v7/src/compiler/machines/bobcat/dassm1.scm b/v7/src/compiler/machines/bobcat/dassm1.scm
index 65c75d38b..15fa1bfb6 100644
--- a/v7/src/compiler/machines/bobcat/dassm1.scm
+++ b/v7/src/compiler/machines/bobcat/dassm1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm1.scm,v 4.5 1988/06/14 08:46:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm1.scm,v 4.6 1988/06/15 20:47:59 jrm Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -83,17 +83,26 @@ MIT in each case. |#
 (define disassembler/base-address)
 
 (define (disassembler/write-compiled-entry entry)
-  (let ((the-block (compiled-code-address->block entry)))
-    (fluid-let ((disassembler/write-offsets? true)
-		(disassembler/write-addresses? true)
-		(disassembler/base-address (object-datum the-block)))
-      (newline)
-      (newline)
-      (disassembler/write-compiled-code-block
-       the-block
-       (->compiler-info
-	(system-vector-ref the-block
-			   (-  (system-vector-length the-block) 2)))))))
+  (define (do-it the-block)
+    (compiler-info/with-on-demand-loading ;force compiler info loading
+     (lambda ()
+       (compiled-code-block->compiler-info the-block
+         (lambda (info)
+	   (fluid-let ((disassembler/write-offsets? 	true)
+		       (disassembler/write-addresses? 	true)
+		       (disassembler/base-address (primitive-datum the-block)))
+	     (newline)
+	     (newline)
+	     (disassembler/write-compiled-code-block the-block info)))
+	 (lambda () (error "No compiler info for entry" entry))))))
+
+  (compiled-entry->block-and-offset entry
+    (lambda (block offset) offset (do-it block))
+    (lambda (manifest-block manifest-offset block offset)
+      manifest-block manifest-offset offset
+      (write-string "Writing MANIFEST-CLOSURE")
+      (do-it block))
+    (lambda () (error "Cannot disassemble entry" entry))))
 
 ;;; Operations exported from the disassembler package