Move REGISTER-TYPES-COMPATIBLE? to arch-independent file.

diff --git a/v7/src/compiler/back/lapgn2.scm b/v7/src/compiler/back/lapgn2.scm
index 17f833e3e3b012fd2955e2bc288c83da478894c6..626d62c9aa9c873e1d18eea00c6b26fba48187e3 100644 (file)
--- a/v7/src/compiler/back/lapgn2.scm
+++ b/v7/src/compiler/back/lapgn2.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: lapgn2.scm,v 1.23 2003/02/14 18:28:00 cph Exp $
+$Id: lapgn2.scm,v 1.24 2004/07/01 01:19:57 cph Exp $
 
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright 1987,1988,1989,1990,1991,1993 Massachusetts Institute of Technology
+Copyright 1994,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -163,6 +164,16 @@ USA.
       (and (register-type? register type) register)
       (maybe-need-register!
        (pseudo-register-alias *register-map* type register))))
+
+(define (guarantee-registers-compatible r1 r2)
+  (if (not (registers-compatible? r1 r2))
+      (error "Incompatible register types:" source target)))
+
+(define (registers-compatible? r1 r2)
+  (register-types-compatible? (register-type r1) (register-type r2)))
+
+(define (register-types-compatible? type1 type2)
+  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
 \f
 (define (load-alias-register! register type)
   ;; Returns an alias for `register', of the given `type'.  If no such

diff --git a/v7/src/compiler/machines/C/lapgen.scm b/v7/src/compiler/machines/C/lapgen.scm
index 3a6ee36dd0db74a597734c707839960ba6fc09a7..34b3d24122049236b47fb7b18301daeaf732375d 100644 (file)
--- a/v7/src/compiler/machines/C/lapgen.scm
+++ b/v7/src/compiler/machines/C/lapgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.16 2003/02/14 18:28:02 cph Exp $
+$Id: lapgen.scm,v 1.17 2004/07/01 01:19:57 cph Exp $
 
-Copyright (c) 1992-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1993,1998,2001,2002,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -523,9 +523,6 @@ USA.
 (define-integrable (word-register? reg)
   (eq? (register-type reg) 'WORD))
 
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
-
 (define (register-reference num)
   (comp-internal-error "Should not be using register allocator"
                       'REGISTER-REFERENCE num))

diff --git a/v7/src/compiler/machines/alpha/lapgen.scm b/v7/src/compiler/machines/alpha/lapgen.scm
index 98de0206f86acbfdba76ddf415f20a10b0d3178c..8e259289efef63bb3a8126982cd5b711120b8983 100644 (file)
--- a/v7/src/compiler/machines/alpha/lapgen.scm
+++ b/v7/src/compiler/machines/alpha/lapgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.11 2003/02/14 18:28:02 cph Exp $
+$Id: lapgen.scm,v 1.12 2004/07/01 01:19:57 cph Exp $
 
-Copyright (c) 1992-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1992,1993,1998,2001,2002,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -31,8 +31,7 @@ USA.
 ;;;; Register-Allocator Interface
 
 (define (register->register-transfer source target)
-  (if (not (register-types-compatible? source target))
-      (error "Moving between incompatible register types" source target))
+  (guarantee-registers-compatible source target)
   (case (register-type source)
     ((GENERAL) (copy source target))
     ((FLOAT) (fp-copy source target))
@@ -104,9 +103,6 @@ USA.
 
 (define-integrable (word-register? register)
   (eq? (register-type register) 'GENERAL))
-      
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
 
 (define (register-type register)
   (cond ((machine-register? register)

diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index b4253cc75b478b10cf8edbe009a277fd93d4dfc8..2689b1acc2f9b4ba39134aad306c5c1d4a413825 100644 (file)
--- a/v7/src/compiler/machines/bobcat/lapgen.scm
+++ b/v7/src/compiler/machines/bobcat/lapgen.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 4.55 2003/02/14 18:28:02 cph Exp $
+$Id: lapgen.scm,v 4.56 2004/07/01 01:19:58 cph Exp $
 
-Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
+Copyright 1992,1993,1998,2001,2002,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -62,9 +63,6 @@ USA.
        a0 a1 a2 a3
        fp0 fp1 fp2 fp3 fp4 fp5 fp6 fp7))
 
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
-
 (define (register-type register)
   (cond ((machine-register? register)
         (vector-ref
@@ -119,8 +117,7 @@ USA.
        (value-class=word? (pseudo-register-value-class register))))
 
 (define (machine->machine-register source target)
-  (if (not (register-types-compatible? source target))
-      (error "Moving between incompatible register types" source target))
+  (guarantee-registers-compatible source target)
   (if (float-register? source)
       (LAP (FMOVE ,(register-reference source)
                  ,(register-reference target)))

diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index 43cd777f0c515f8ce4470475a68521c75656b771..b70affd4fbd9f2e38b04f3cb5df842b7ba6733b7 100644 (file)
--- a/v7/src/compiler/machines/i386/lapgen.scm
+++ b/v7/src/compiler/machines/i386/lapgen.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.34 2003/02/14 18:28:03 cph Exp $
+$Id: lapgen.scm,v 1.35 2004/07/01 01:19:58 cph Exp $
 
 Copyright 1992,1993,1998,2001,2002,2003 Massachusetts Institute of Technology
+Copyright 2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -66,9 +67,6 @@ USA.
        (else
         (error "unable to determine register type" register))))
 
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
-
 (define register-reference
   (let ((references (make-vector number-of-machine-registers)))
     (let loop ((i 0))
@@ -136,8 +134,7 @@ USA.
 ;;;; Utilities for the register allocator interface
 
 (define-integrable (machine->machine-register source target)
-  (if (not (register-types-compatible? source target))
-      (error "Moving between incompatible register types" source target))
+  (guarantee-registers-compatible source target)
   (if (not (float-register? source))
       (LAP (MOV W ,(register-reference target) ,(register-reference source)))
       (let ((ssti (floreg->sti source))

diff --git a/v7/src/compiler/machines/mips/lapgen.scm b/v7/src/compiler/machines/mips/lapgen.scm
index d7e2d53ca9043e0ac98e4c9490ec434c19d53f53..92a5912c2ba5972191a36717d9e3b2cbd38e117f 100644 (file)
--- a/v7/src/compiler/machines/mips/lapgen.scm
+++ b/v7/src/compiler/machines/mips/lapgen.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.20 2003/02/14 18:28:03 cph Exp $
+$Id: lapgen.scm,v 1.21 2004/07/01 01:19:58 cph Exp $
 
-Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1990,1991,1992,1993,1997,1998 Massachusetts Institute of Technology
+Copyright 2001,2002,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -31,8 +32,7 @@ USA.
 ;;;; Register-Allocator Interface
 
 (define (register->register-transfer source target)
-  (if (not (register-types-compatible? source target))
-      (error "Moving between incompatible register types" source target))
+  (guarantee-registers-compatible source target)
   (case (register-type source)
     ((GENERAL) (copy source target))
     ((FLOAT) (fp-copy source target))
@@ -95,9 +95,6 @@ USA.
 
 (define-integrable (word-register? register)
   (eq? (register-type register) 'GENERAL))
-      
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
 
 (define (register-type register)
   (cond ((machine-register? register)

diff --git a/v7/src/compiler/machines/sparc/lapgen.scm b/v7/src/compiler/machines/sparc/lapgen.scm
index 26f0291d4353513c72f3e483bf9632b6e2e5912e..dedbdf9c2b959ef31cd6ec8bf4281b481cdb04e7 100644 (file)
--- a/v7/src/compiler/machines/sparc/lapgen.scm
+++ b/v7/src/compiler/machines/sparc/lapgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.7 2003/02/14 18:28:06 cph Exp $
+$Id: lapgen.scm,v 1.8 2004/07/01 01:19:59 cph Exp $
 
-Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1993,1998,2001,2002,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -31,8 +31,7 @@ USA.
 ;;;; Register-Allocator Interface
 
 (define (register->register-transfer source target)
-  (if (not (register-types-compatible? source target))
-      (error "Moving between incompatible register types" source target))
+  (guarantee-registers-compatible source target)
   (case (register-type source)
     ((GENERAL) (copy source target))
     ((FLOAT) (fp-copy source target))
@@ -100,9 +99,6 @@ USA.
 
 (define-integrable (word-register? register)
   (eq? (register-type register) 'GENERAL))
-      
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
 
 (define (register-type register)
   (cond ((machine-register? register)

diff --git a/v7/src/compiler/machines/spectrum/lapgen.scm b/v7/src/compiler/machines/spectrum/lapgen.scm
index 9893291ca05c16bf71971c02ae343ba5b9063cf3..cf47c7d4167d8939684266b53a73468f274788ae 100644 (file)
--- a/v7/src/compiler/machines/spectrum/lapgen.scm
+++ b/v7/src/compiler/machines/spectrum/lapgen.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 4.52 2003/02/14 18:28:07 cph Exp $
+$Id: lapgen.scm,v 4.53 2004/07/01 01:19:59 cph Exp $
 
-Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1986,1987,1990,1991,1992,1993 Massachusetts Institute of Technology
+Copyright 1994,1998,2001,2002,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -31,8 +32,7 @@ USA.
 ;;;; Register-Allocator Interface
 
 (define (register->register-transfer source target)
-  (if (not (register-types-compatible? source target))
-      (error "Moving between incompatible register types" source target))
+  (guarantee-registers-compatible source target)
   (case (register-type source)
     ((GENERAL) (copy source target))
     ((FLOAT) (fp-copy source target))
@@ -106,9 +106,6 @@ USA.
 
 (define-integrable (word-register? register)
   (eq? (register-type register) 'GENERAL))
-      
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
 
 (define (register-type register)
   (cond ((machine-register? register)

diff --git a/v7/src/compiler/machines/vax/lapgen.scm b/v7/src/compiler/machines/vax/lapgen.scm
index f7fa307b2ffc209fdc5a6a09640d69943e9aa9b7..d2ed16a5ef0f2037d29e557b32d4c7c5da791118 100644 (file)
--- a/v7/src/compiler/machines/vax/lapgen.scm
+++ b/v7/src/compiler/machines/vax/lapgen.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 4.20 2003/02/14 18:28:07 cph Exp $
+$Id: lapgen.scm,v 4.21 2004/07/01 01:19:59 cph Exp $
 
-Copyright (c) 1987-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1988,1989,1991,1992,1998,2002 Massachusetts Institute of Technology
+Copyright 2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -59,9 +60,6 @@ USA.
   ;; r14 is sp and r15 is pc.
   (list r0 r1 r2 r3 r4 r5 r6 r7 r8))
 
-(define (register-types-compatible? type1 type2)
-  (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
-
 (define (register-type register)
   ;; This will have to be changed when floating point support is added.
   (if (or (machine-register? register)