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 abedcddf355e248f3c70f743a806e14a5bb22032..1263c261d03a53dab5d7207d38c49fe97781d4b9 100644 (file)
--- 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 0963d0b58df53846d16bfcc17a21eed788bcbacd..a0a19a3e15da3c023f36e215c2bd4b0e93b4f54f 100644 (file)
--- 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))))
 \f

diff --git a/v7/src/compiler/rtlgen/opncod.scm b/v7/src/compiler/rtlgen/opncod.scm
index 322ec39e6adad3b8f4038207428f9500f81aade5..fa8c2507874cf4588133d659f92a0316ff33afea 100644 (file)
--- 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))))))