From 30f34bea95a76130f283c8d589b57fb1d3d205ce Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 30 Mar 1997 23:33:24 +0000 Subject: [PATCH] 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. --- v7/src/compiler/base/make.scm | 6 +- v7/src/compiler/machines/mips/lapgen.scm | 80 ++++++++++++++++-------- v7/src/compiler/machines/mips/rulfix.scm | 6 +- 3 files changed, 62 insertions(+), 30 deletions(-) diff --git a/v7/src/compiler/base/make.scm b/v7/src/compiler/base/make.scm index 09ac9bd30..56a51a381 100644 --- a/v7/src/compiler/base/make.scm +++ b/v7/src/compiler/base/make.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: make.scm,v 4.106 1994/02/02 03:26:21 gjr Exp $ +$Id: make.scm,v 4.107 1997/03/30 23:33:24 cph Exp $ -Copyright (c) 1988-1994 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 @@ -54,5 +54,5 @@ MIT in each case. |# (initialize-package! '(COMPILER DECLARATIONS))) (add-system! (make-system (string-append "Liar (" architecture-name ")") - 4 106 + 4 107 '()))) \ No newline at end of file diff --git a/v7/src/compiler/machines/mips/lapgen.scm b/v7/src/compiler/machines/mips/lapgen.scm index 09d5ae3c8..3a5085db2 100644 --- a/v7/src/compiler/machines/mips/lapgen.scm +++ b/v7/src/compiler/machines/mips/lapgen.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: lapgen.scm,v 1.13 1993/12/18 08:49:05 cph Exp $ +$Id: lapgen.scm,v 1.14 1997/03/30 23:33:17 cph Exp $ -Copyright (c) 1988-1992 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 @@ -396,13 +396,20 @@ MIT in each case. |# ; Branch if immediate source (let ((cc (invert-condition-noncommutative comp))) ;; This machine does register immediate; you can - ;; now think of cc in this way + ;; now think of cc in this way. (if (zero? immediate) - (begin - (branch-generator! cc - `(BEQ 0 ,source) `(BLTZ ,source) `(BGTZ ,source) - `(BNE 0 ,source) `(BGEZ ,source) `(BLEZ ,source)) - (LAP)) + (let ((use-cc + (lambda (cc) + (branch-generator! cc + `(BEQ 0 ,source) `(BLTZ ,source) `(BGTZ ,source) + `(BNE 0 ,source) `(BGEZ ,source) `(BLEZ ,source)) + (LAP)))) + (case cc + ((<<) (compare-false)) + ((>>=) (compare-true)) + ((<<=) (use-cc '=)) + ((>>) (use-cc '<>)) + (else (use-cc cc)))) (with-values (lambda () (immediate->register immediate)) (lambda (prefix alias) (LAP ,@prefix @@ -411,32 +418,51 @@ MIT in each case. |# (define (compare condition r1 r2) ; Branch if r1 r2 (if (= r1 r2) - (let ((branch - (lambda (label) (LAP (BGEZ 0 (@PCR ,label)) (NOP)))) - (dont-branch - (lambda (label) label (LAP)))) - (if (memq condition '(< > <>)) - (set-current-branches! dont-branch branch) - (set-current-branches! branch dont-branch)) - (LAP)) - (let ((temp (and (memq condition '(< > <= >=)) (standard-temporary!)))) + (if (memq condition '(< > <> << >>)) + (compare-false) + (compare-true)) + (let ((temp + (and (memq condition '(< > <= >= << >> <<= >>=)) + (standard-temporary!)))) (branch-generator! condition `(BEQ ,r1 ,r2) `(BNE ,temp 0) `(BNE ,temp 0) `(BNE ,r1 ,r2) `(BEQ ,temp 0) `(BEQ ,temp 0)) (case condition ((= <>) (LAP)) ((< >=) (LAP (SLT ,temp ,r1 ,r2))) - ((> <=) (LAP (SLT ,temp ,r2 ,r1))))))) - + ((> <=) (LAP (SLT ,temp ,r2 ,r1))) + ((<< >>=) (LAP (SLTU ,temp ,r1 ,r2))) + ((>> <<=) (LAP (SLTU ,temp ,r2 ,r1))))))) + +(define (compare-true) + (set-current-branches! + (lambda (label) (LAP (BGEZ 0 (@PCR ,label)) (NOP))) + (lambda (label) label (LAP))) + (LAP)) + +(define (compare-false) + (set-current-branches! + (lambda (label) label (LAP)) + (lambda (label) (LAP (BGEZ 0 (@PCR ,label)) (NOP)))) + (LAP)) + (define (branch-generator! cc = < > <> >= <=) (let ((forward (case cc - ((=) =) ((<) <) ((>) >) - ((<>) <>) ((>=) >=) ((<=) <=))) + ((=) =) + ((< <<) <) + ((> >>) >) + ((<>) <>) + ((>= >>=) >=) + ((<= <<=) <=))) (inverse (case cc - ((=) <>) ((<) >=) ((>) <=) - ((<>) =) ((>=) <) ((<=) >)))) + ((=) <>) + ((< <<) >=) + ((> >>) <=) + ((<>) =) + ((>= >>=) <) + ((<= <<=) >)))) (set-current-branches! (lambda (label) (LAP (,@forward (@PCR ,label)) (NOP))) @@ -463,7 +489,11 @@ MIT in each case. |# (> <= <) (<> = <>) (<= > >=) - (>= < <=))) + (>= < <=) + (<< >>= >>) + (>> <<= <<) + (<<= >> >>=) + (>>= << <<=))) ;;;; Miscellaneous @@ -624,7 +654,7 @@ MIT in each case. |# ;; Jump to scheme-to-interface (LAP (JR ,regnum:scheme-to-interface) (ADDI ,regnum:interface-index 0 ,(* 4 code)))) - + (define (load-interface-args! first second third fourth) (let ((clear-regs (apply clear-registers! diff --git a/v7/src/compiler/machines/mips/rulfix.scm b/v7/src/compiler/machines/mips/rulfix.scm index 647c093e9..fee8c27f0 100644 --- a/v7/src/compiler/machines/mips/rulfix.scm +++ b/v7/src/compiler/machines/mips/rulfix.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rulfix.scm,v 1.9 1993/01/08 00:04:44 cph Exp $ +$Id: rulfix.scm,v 1.10 1997/03/30 23:33:06 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 @@ -612,4 +612,6 @@ MIT in each case. |# ((EQUAL-FIXNUM?) '=) ((LESS-THAN-FIXNUM?) '<) ((GREATER-THAN-FIXNUM?) '>) + ((UNSIGNED-LESS-THAN-FIXNUM?) '<<) + ((UNSIGNED-GREATER-THAN-FIXNUM?) '>>) (else (error "unknown fixnum predicate" predicate)))) \ No newline at end of file -- 2.25.1