From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 30 Mar 1997 23:27:07 +0000 (+0000)
Subject: Fix bug in code generation for the HEAP-AVAILABLE? primitive.  The
X-Git-Tag: 20090517-FFI~5229
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=39f250075626c32f82942621fb360d83367795a9;p=mit-scheme.git

Fix bug in code generation for the HEAP-AVAILABLE? primitive.  The
primitive compares addresses using an unsigned comparison, but the
compiled code was using a signed comparison.  This was the cause of
sporadic failures that have been seen while running Edwin with a large
heap on OS/2; it could have happened on any operating system when
Edwin was run with a sufficiently large heap.  This fix changes the
compiled code to use an unsigned comparison.
---

diff --git a/v7/src/compiler/machines/i386/rulfix.scm b/v7/src/compiler/machines/i386/rulfix.scm
index abedcddf3..1263c261d 100644
--- a/v7/src/compiler/machines/i386/rulfix.scm
+++ b/v7/src/compiler/machines/i386/rulfix.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rulfix.scm,v 1.27 1993/07/17 04:59:41 gjr Exp $
+$Id: rulfix.scm,v 1.28 1997/03/30 23:26:56 cph Exp $
 
-Copyright (c) 1992-1993 Massachusetts Institute of Technology
+Copyright (c) 1992-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -653,6 +653,8 @@ MIT in each case. |#
     ((EQUAL-FIXNUM?) 'EQUAL-FIXNUM?)
     ((LESS-THAN-FIXNUM?) 'GREATER-THAN-FIXNUM?)
     ((GREATER-THAN-FIXNUM?) 'LESS-THAN-FIXNUM?)
+    ((UNSIGNED-LESS-THAN-FIXNUM?) 'UNSIGNED-GREATER-THAN-FIXNUM?)
+    ((UNSIGNED-GREATER-THAN-FIXNUM?) 'UNSIGNED-LESS-THAN-FIXNUM?)
     (else
      (error "commute-fixnum-predicate: Unknown predicate"
 	    predicate))))
@@ -671,6 +673,16 @@ MIT in each case. |#
 			      (LAP (JG (@PCR ,label))))
 			    (lambda (label)
 			      (LAP (JLE (@PCR ,label))))))
+    ((UNSIGNED-LESS-THAN-FIXNUM?)
+     (set-current-branches! (lambda (label)
+			      (LAP (JB (@PCR ,label))))
+			    (lambda (label)
+			      (LAP (JAE (@PCR ,label))))))
+    ((UNSIGNED-GREATER-THAN-FIXNUM?)
+     (set-current-branches! (lambda (label)
+			      (LAP (JA (@PCR ,label))))
+			    (lambda (label)
+			      (LAP (JBE (@PCR ,label))))))
     ((NEGATIVE-FIXNUM?)
      (set-current-branches! (lambda (label)
 			      (LAP (JS (@PCR ,label))))
diff --git a/v7/src/compiler/machines/spectrum/rulfix.scm b/v7/src/compiler/machines/spectrum/rulfix.scm
index 0963d0b58..a0a19a3e1 100644
--- a/v7/src/compiler/machines/spectrum/rulfix.scm
+++ b/v7/src/compiler/machines/spectrum/rulfix.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rulfix.scm,v 4.46 1993/08/12 05:33:14 gjr Exp $
+$Id: rulfix.scm,v 4.47 1997/03/30 23:27:07 cph Exp $
 
-Copyright (c) 1989-1993 Massachusetts Institute of Technology
+Copyright (c) 1989-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -650,10 +650,7 @@ MIT in each case. |#
 		       (delta (* (-1+ factor) fixnum-1))
 		       (fits? (fits-in-11-bits-signed? delta))
 		       (temp (and (not fits?) (standard-temporary!))))
-	 
-		  (LAP ,@(if fits?
-			     (LAP)
-			     (load-immediate delta temp))
+		  (LAP ,@(if fits? (LAP) (load-immediate delta temp))
 		       (ADD (>=) 0 ,src ,tgt)
 		       ,@(if fits?
 			     (LAP (ADDI () ,delta ,tgt ,tgt))
@@ -754,6 +751,8 @@ MIT in each case. |#
     ((ZERO-FIXNUM? EQUAL-FIXNUM?) '=)
     ((NEGATIVE-FIXNUM? LESS-THAN-FIXNUM?) '<)
     ((POSITIVE-FIXNUM? GREATER-THAN-FIXNUM?) '>)
+    ((UNSIGNED-LESS-THAN-FIXNUM?) '<<)
+    ((UNSIGNED-GREATER-THAN-FIXNUM?) '>>)
     (else
      (error "fixnum-pred->cc: unknown predicate" predicate))))
 
diff --git a/v7/src/compiler/rtlgen/opncod.scm b/v7/src/compiler/rtlgen/opncod.scm
index 322ec39e6..fa8c25078 100644
--- a/v7/src/compiler/rtlgen/opncod.scm
+++ b/v7/src/compiler/rtlgen/opncod.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: opncod.scm,v 4.62 1993/11/10 21:31:13 jmiller Exp $
+$Id: opncod.scm,v 4.63 1997/03/30 23:26:29 cph Exp $
 
-Copyright (c) 1988-1993 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -326,9 +326,7 @@ MIT in each case. |#
 		       (scfg-append!
 			(generate-primitive primitive-name
 					    (length expressions)
-					    expressions
-					    setup
-					    label)
+					    expressions setup label)
 			cleanup
 			(if error-finish
 			    (error-finish (rtl:make-fetch register:value))
@@ -347,9 +345,7 @@ MIT in each case. |#
 			      (scfg*scfg->scfg!
 			       (generate-primitive primitive-name
 						   (length expressions)
-						   expressions
-						   setup
-						   label)
+						   expressions setup label)
 			       cleanup)))
 			 (make-scfg (cfg-entry-node scfg) '()))
 		       |#
@@ -794,7 +790,7 @@ MIT in each case. |#
 	 (lambda (locative)
 	   (finish
 	    (rtl:make-fixnum-pred-2-args
-	     'LESS-THAN-FIXNUM?
+	     'UNSIGNED-LESS-THAN-FIXNUM?
 	     (rtl:make-address->fixnum (rtl:make-address locative))
 	     (rtl:make-address->fixnum
 	      (rtl:make-fetch register:memory-top))))))