From 36fd5e3e8301eb6808e1b724feae2394d6680df4 Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Sat, 15 Feb 1992 14:31:42 +0000
Subject: [PATCH] Fix addressing mode bug.
---
v7/src/compiler/machines/i386/lapgen.scm | 12 +++++++-----
v7/src/compiler/machines/i386/rules3.scm | 12 +++++++-----
2 files changed, 14 insertions(+), 10 deletions(-)
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))))))
--
2.25.1