From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Tue, 11 Aug 1992 02:25:29 +0000 (+0000)
Subject: Flush spurious assignments.
X-Git-Tag: 20090517-FFI~9149
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b6a652c91f07c8ee3996f18fb394d3b88e96e06f;p=mit-scheme.git

Flush spurious assignments.
---

diff --git a/v7/src/compiler/machines/bobcat/dassm2.scm b/v7/src/compiler/machines/bobcat/dassm2.scm
index 742ca59c7..2efb0dfa6 100644
--- a/v7/src/compiler/machines/bobcat/dassm2.scm
+++ b/v7/src/compiler/machines/bobcat/dassm2.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.18 1991/05/07 13:46:04 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.19 1992/08/11 02:25:29 jinx Exp $
 
-Copyright (c) 1988-1991 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -36,58 +36,50 @@ MIT in each case. |#
 ;;; package: (compiler disassembler)
 
 (declare (usual-integrations))
-
-(set! compiled-code-block/bytes-per-object 4)
-(set! compiled-code-block/objects-per-procedure-cache 2)
-(set! compiled-code-block/objects-per-variable-cache 1)
 
-(set! disassembler/read-variable-cache
-      (lambda (block index)
-	(let-syntax ((ucode-type
-		      (macro (name) (microcode-type name)))
-		     (ucode-primitive
-		      (macro (name arity)
-			(make-primitive-procedure name arity))))
-	  ((ucode-primitive primitive-object-set-type 2)
-	   (ucode-type quad)
-	   (system-vector-ref block index)))))
-
-(set! disassembler/read-procedure-cache
-      (lambda (block index)
-	(fluid-let ((*block block))
-	  (let* ((offset (compiled-code-block/index->offset index)))
-	    (let ((opcode (read-unsigned-integer offset 16))
-		  (arity (read-unsigned-integer (+ offset 6) 16)))
-	      (case opcode
-		((#x4ef9)		; JMP <value>.L
-		 ;; *** This should learn how to decode
-		 ;; the new trampolines. ***
-		 (vector 'COMPILED
-			 (read-procedure (+ offset 2))
-			 arity))
-		(else
-		 (error "disassembler/read-procedure-cache: Unknown opcode"
-			opcode block index))))))))
+(define (disassembler/read-variable-cache block index)
+  (let-syntax ((ucode-type
+		(macro (name) (microcode-type name)))
+	       (ucode-primitive
+		(macro (name arity)
+		  (make-primitive-procedure name arity))))
+    ((ucode-primitive primitive-object-set-type 2)
+     (ucode-type quad)
+     (system-vector-ref block index))))
+
+(define (disassembler/read-procedure-cache block index)
+  (fluid-let ((*block block))
+    (let* ((offset (compiled-code-block/index->offset index)))
+      (let ((opcode (read-unsigned-integer offset 16))
+	    (arity (read-unsigned-integer (+ offset 6) 16)))
+	(case opcode
+	  ((#x4ef9)			; JMP <value>.L
+	   ;; This should learn how to decode the new trampolines.
+	   (vector 'COMPILED
+		   (read-procedure (+ offset 2))
+		   arity))
+	  (else
+	   (error "disassembler/read-procedure-cache: Unknown opcode"
+		  opcode block index)))))))
 
-(set! disassembler/instructions
-  (lambda (block start-offset end-offset symbol-table)
-    (let loop ((offset start-offset) (state (disassembler/initial-state)))
-      (if (and end-offset (< offset end-offset))
-	  (disassemble-one-instruction block offset symbol-table state
-	    (lambda (offset* instruction state)
-	      (make-instruction offset
-				instruction
-				(lambda () (loop offset* state)))))
-	  '()))))
-
-(set! disassembler/instructions/null?
-  null?)
-
-(set! disassembler/instructions/read
-  (lambda (instruction-stream receiver)
-    (receiver (instruction-offset instruction-stream)
-	      (instruction-instruction instruction-stream)
-	      (instruction-next instruction-stream))))
+(define (disassembler/instructions block start-offset end-offset symbol-table)
+  (let loop ((offset start-offset) (state (disassembler/initial-state)))
+    (if (and end-offset (< offset end-offset))
+	(disassemble-one-instruction
+	 block offset symbol-table state
+	 (lambda (offset* instruction state)
+	   (make-instruction offset
+			     instruction
+			     (lambda () (loop offset* state)))))
+	'())))
+
+(define (disassembler/instructions/null? obj)
+  (null? obj))
+
+(define (disassembler/instructions/read instruction-stream receiver)
+  (receiver (instruction-offset instruction-stream)
+	    (instruction-instruction instruction-stream)
+	    (instruction-next instruction-stream)))
 
 (define-structure (instruction (type vector))
   (offset false read-only true)
@@ -145,12 +137,11 @@ MIT in each case. |#
       'EXTERNAL-LABEL
       'INSTRUCTION))
 
-(set! disassembler/lookup-symbol
-  (lambda (symbol-table offset)
-    (and symbol-table
-	 (let ((label (dbg-labels/find-offset symbol-table offset)))
-	   (and label 
-		(dbg-label/name label))))))
+(define (disassembler/lookup-symbol symbol-table offset)
+  (and symbol-table
+       (let ((label (dbg-labels/find-offset symbol-table offset)))
+	 (and label 
+	      (dbg-label/name label)))))
 
 (define (external-label-marker? symbol-table offset state)
   (if symbol-table
@@ -375,4 +366,14 @@ MIT in each case. |#
   '())
 
 (define (undefined)
-  undefined-instruction)
\ No newline at end of file
+  undefined-instruction)
+
+;; These are used by dassm1.scm
+
+(define compiled-code-block/procedure-cache-offset 0)
+(define compiled-code-block/objects-per-procedure-cache 2)
+(define compiled-code-block/objects-per-variable-cache 1)
+
+;; global variable used by runtime/udata.scm -- Moby yuck!
+
+(set! compiled-code-block/bytes-per-object 4)
\ No newline at end of file