From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 18 Dec 1993 08:49:05 +0000 (+0000)
Subject: Work around new bug in variable-width instruction assembly: LW is
X-Git-Tag: 20090517-FFI~7358
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ee2ce7eec68e505b4726f9b78b42e609a76e3c00;p=mit-scheme.git

Work around new bug in variable-width instruction assembly: LW is
being forced to use its long-offset form when the offset is small (in
this case the offset is -4).
---

diff --git a/v7/src/compiler/machines/mips/lapgen.scm b/v7/src/compiler/machines/mips/lapgen.scm
index 07b44529b..09d5ae3c8 100644
--- a/v7/src/compiler/machines/mips/lapgen.scm
+++ b/v7/src/compiler/machines/mips/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.12 1992/12/28 22:01:14 cph Exp $
+$Id: lapgen.scm,v 1.13 1993/12/18 08:49:05 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -185,16 +185,20 @@ MIT in each case. |#
 ;;;; Regularized Machine Instructions
 
 (define (adjusted:high n)
-  (let ((n (->unsigned n)))
-    (if (< (remainder n #x10000) #x8000)
-	(quotient n #x10000)
-	(+ (quotient n #x10000) 1))))
+  (if (fits-in-16-bits-signed? n)
+      0
+      (let ((n (->unsigned n)))
+	(if (< (remainder n #x10000) #x8000)
+	    (quotient n #x10000)
+	    (+ (quotient n #x10000) 1)))))
 
 (define (adjusted:low n)
-  (let ((remainder (remainder (->unsigned n) #x10000)))
-    (if (< remainder #x8000)
-	remainder
-	(- remainder #x10000))))
+  (if (fits-in-16-bits-signed? n)
+      n
+      (let ((remainder (remainder (->unsigned n) #x10000)))
+	(if (< remainder #x8000)
+	    remainder
+	    (- remainder #x10000)))))
 
 (define-integrable (top-16-bits n)
   (quotient (->unsigned n) #x10000))