From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Thu, 16 Jul 1987 10:14:16 +0000 (+0000)
Subject: Bug in NMV header size.
X-Git-Tag: 20090517-FFI~13248
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1ecbb3de0879aec81078359f279b4554af2171b3;p=mit-scheme.git

Bug in NMV header size.
---

diff --git a/v7/src/compiler/back/bittop.scm b/v7/src/compiler/back/bittop.scm
index 4dfb212db..4cb15eec7 100644
--- a/v7/src/compiler/back/bittop.scm
+++ b/v7/src/compiler/back/bittop.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.1 1987/07/15 03:01:03 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.2 1987/07/16 10:14:16 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -44,9 +44,6 @@ MIT in each case. |#
 (define *start-label*)
 (define *end-label*)
 
-(define object-address-width
-  (quotient scheme-object-width addressing-granularity))
-
 ;;; Vector header and NMV header for code section
 
 (define compiler-output-block-number-of-header-words 2)
@@ -114,16 +111,15 @@ MIT in each case. |#
 		(if (interval? val)
 		    (set-binding-value! (cdr pair) (interval-low val)))))
 	    (symbol-table-bindings *the-symbol-table*))
-  (let ((start (symbol-table-value *the-symbol-table* *start-label*))
-	(end (symbol-table-value *the-symbol-table* *end-label*)))
-    (let ((length (- (* addressing-granularity end) starting-pc)))
-      (let ((output-block
-	     (bit-string-allocate (+ scheme-object-width length))))
-	(bit-string-insert!
-	 (make-nmv-header (quotient (- end start) object-address-width))
-	 output-block
-	 length)
-	(assemble-directives! output-block directives length)))))
+  (let* ((length (- (* addressing-granularity
+		       (symbol-table-value *the-symbol-table* *end-label*))
+		    starting-pc))
+	 (output-block (bit-string-allocate (+ scheme-object-width length))))
+    (bit-string-insert!
+     (make-nmv-header (quotient length scheme-object-width))
+     output-block
+     length)
+    (assemble-directives! output-block directives length)))
 
 (define (assemble-objects! block)
   (let ((objects (queue->list *objects*))