From 637e2703d8ee1576c7e93c34dfc3d12049f0c23f Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Wed, 24 Jul 1996 03:33:54 +0000
Subject: [PATCH]  . Improved predicates FITS-IN-nn-BITS?.  . Split
 REGISTER-EXPRESSION, extracting CONSTANT-REGISTER-EXPRESSION for the   
 pre-loaded registers.

---
 v8/src/compiler/machines/spectrum/lapgen.scm | 48 ++++++++++++--------
 1 file changed, 29 insertions(+), 19 deletions(-)

diff --git a/v8/src/compiler/machines/spectrum/lapgen.scm b/v8/src/compiler/machines/spectrum/lapgen.scm
index 8972c38a9..ae4da2a8f 100644
--- a/v8/src/compiler/machines/spectrum/lapgen.scm
+++ b/v8/src/compiler/machines/spectrum/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.6 1996/07/19 02:28:32 adams Exp $
+$Id: lapgen.scm,v 1.7 1996/07/24 03:33:54 adams Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -257,6 +257,10 @@ MIT in each case. |#
   ;; (expt 2 11) ***
   2048)
 
+(define (fits-in-ldil-field? value)
+  (and (exact-integer? value)
+       (zero? (remainder value ldil-scale))))
+
 (define (load-immediate i t)
   (if (fits-in-14-bits-signed? i)
       (LAP (LDI () ,i ,t))
@@ -620,27 +624,21 @@ MIT in each case. |#
 (define (standard-move-to-temporary! source)
   (move-to-temporary-register! source (register-type source)))
 
-(define (register-expression expression)
+(define (constant-register-expression expression)
+  ;; returns the register number of a register holding the constant value.
+  ;;  r0 holds 0.
   (case (rtl:expression-type expression)
-    ((REGISTER)
-     (rtl:register-number expression))
     ((CONSTANT)
      (let ((object (rtl:constant-value expression)))
        (cond ((and (zero? (object-type object))
 		   (zero? (object-datum object)))
 	      0)
-	     ((eq? object #F)
-	      regnum:false-value)
-	     ((eq? object '())
-	      regnum:empty-list)
-	     (else
-	      false))))
+	     ((eq? object #F)	 regnum:false-value)
+	     ((eq? object '())	 regnum:empty-list)
+	     (else   	         false))))
     ((MACHINE-CONSTANT)
-     (let ((value (rtl:machine-constant-value expression)))
-       (cond ((zero? value)
-	      0)
-	     (else
-	      false))))
+     (and (zero? (rtl:machine-constant-value expression))
+	  0))
     ((CONS-POINTER)
      (and (let ((type (rtl:cons-pointer-type expression)))
 	    (and (rtl:machine-constant? type)
@@ -650,6 +648,15 @@ MIT in each case. |#
 		 (zero? (rtl:machine-constant-value datum))))
 	  0))
     (else false)))
+
+(define (register-expression expression)
+  ;; returns the register number of a register holding this expression.
+  ;; Use instead of pattern (REGISTER (? regnum))
+  (case (rtl:expression-type expression)
+    ((REGISTER)
+     (rtl:register-number expression))
+    (else
+     (constant-register-expression expression))))
 
 (define (define-arithmetic-method operator methods method)
   (let ((entry (assq operator (cdr methods))))
@@ -666,13 +673,16 @@ MIT in each case. |#
   (assq operator (cdr methods)))  
 
 (define (fits-in-5-bits-signed? value)
-  (<= #x-10 value #xF))
+  (and (fixnum? value)
+       (<= #x-10 value #xF)))
 
 (define (fits-in-11-bits-signed? value)
-  (<= #x-400 value #x3FF))
-
+  (and (fixnum? value)
+       (<= #x-400 value #x3FF)))
+  
 (define (fits-in-14-bits-signed? value)
-  (<= #x-2000 value #x1FFF))
+  (and (fixnum? value)
+       (<= #x-2000 value #x1FFF)))
 
 (define-integrable (ea/mode ea) (car ea))
 (define-integrable (register-ea/register ea) (cadr ea))
-- 
2.25.1