Fix addressing mode bug.

diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index 5c0703d9ba0fd8d3dfd509f682597fccf7d0a464..d6ac536e5d10dfd343c9b8633d2b918f51b1c98d 100644 (file)
--- 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))))))
 \f
-(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 21a8f5aa669785c09ddc324b7951b37fa88586c6..c0036f139ad2adf00b8a376d211dcc63523d168e 100644 (file)
--- 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))))))