From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Sat, 15 Feb 1992 14:31:42 +0000 (+0000)
Subject: Fix addressing mode bug.
X-Git-Tag: 20090517-FFI~9736
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=36fd5e3e8301eb6808e1b724feae2394d6680df4;p=mit-scheme.git

Fix addressing mode bug.
---

diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index 5c0703d9b..d6ac536e5 100644
--- a/v7/src/compiler/machines/i386/lapgen.scm
+++ b/v7/src/compiler/machines/i386/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.13 1992/02/15 14:17:23 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.14 1992/02/15 14:31:42 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/lapgen.scm,v 4.42 1991/05/28 19:14:26 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -290,11 +290,13 @@ MIT in each case. |#
 	 (LAP (CMP W ,(source-register-reference reg1)
 		   ,(any-reference reg2))))))
 
-(define (target-register-reference target)
+(define (target-register target)
   (delete-dead-registers!)
-  (register-reference
-   (or (register-alias target 'GENERAL)
-       (allocate-alias-register! target 'GENERAL))))
+  (or (register-alias target 'GENERAL)
+      (allocate-alias-register! target 'GENERAL)))  
+
+(define-integrable (target-register-reference target)
+  (register-reference (target-register target)))
 
 (define-integrable (temporary-register-reference)
   (reference-temporary-register! 'GENERAL))
diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm
index 21a8f5aa6..c0036f139 100644
--- a/v7/src/compiler/machines/i386/rules3.scm
+++ b/v7/src/compiler/machines/i386/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.12 1992/02/15 14:16:59 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.13 1992/02/15 14:31:27 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.31 1991/05/28 19:14:55 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -421,7 +421,8 @@ MIT in each case. |#
 ;; the last component of closures with any entry points.
 
 (define (generate/cons-closure target procedure-label min max size)
-  (let* ((target (target-register-reference target))
+  (let* ((mtarget (target-register target))
+	 (target (register-reference mtarget))
 	 (temp (temporary-register-reference)))
     (LAP ,@(load-pc-relative-address
 	    temp
@@ -439,13 +440,14 @@ MIT in each case. |#
 	 (MOV W (@RO B ,regnum:free-pointer 9) ,temp) ; displacement
 	 (ADD W (R ,regnum:free-pointer) (& ,(* 4 (+ 5 size))))
 	 (LEA ,temp (@RO UW
-			 ,target
+			 ,mtarget
 			 ,(make-non-pointer-literal (ucode-type compiled-entry)
 						    0)))
 	 (MOV W (@RO B ,regnum:free-pointer -4) ,temp))))
 
 (define (generate/cons-multiclosure target nentries size entries)
-  (let* ((target (target-register-reference target))
+  (let* ((mtarget (target-register target))
+	 (target (register-reference mtarget))
 	 (temp (temporary-register-reference)))
     (with-pc
       (lambda (pc-label pc-reg)
@@ -482,7 +484,7 @@ MIT in each case. |#
 		  (& ,(+ (* 4 size) (if (odd? nentries) 7 5))))
 	     (LEA ,temp
 		  (@RO UW
-		       ,target
+		       ,mtarget
 		       ,(make-non-pointer-literal (ucode-type compiled-entry)
 						  0)))
 	     (MOV W (@RO B ,regnum:free-pointer -4) ,temp))))))