From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 1 Jul 2004 01:19:59 +0000 (+0000)
Subject: Move REGISTER-TYPES-COMPATIBLE? to arch-independent file.
X-Git-Tag: 20090517-FFI~1632
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4bb2a05cac1a9c9eba92c933fbea48bbcb3fd4ad;p=mit-scheme.git

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 17f833e3e..626d62c9a 100644
--- 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)))
 
 (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 3a6ee36dd..34b3d2412 100644
--- 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 98de0206f..8e259289e 100644
--- 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 b4253cc75..2689b1acc 100644
--- 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 43cd777f0..b70affd4f 100644
--- 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 d7e2d53ca..92a5912c2 100644
--- 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 26f0291d4..dedbdf9c2 100644
--- 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 9893291ca..cf47c7d41 100644
--- 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 f7fa307b2..d2ed16a5e 100644
--- 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)