Added generic arithmetic rtl types and overflow-test predicate.

Added fixnum->address and address->fixnum since we have changed the
way fixnum's are handled (i.e. we shift them to the left by 8 bits now).
Removed rtl-constructor stuff since we don't have the expand phase anymore.

diff --git a/v7/src/compiler/rtlbase/rtlty1.scm b/v7/src/compiler/rtlbase/rtlty1.scm
index 9b1be0a96119e83fae5f69a94e0b9d202a131ef2..3455072e098ce60140a32a1fc216d2632a0d5490 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlty1.scm
+++ b/v7/src/compiler/rtlbase/rtlty1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.10 1988/09/01 19:18:58 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.11 1988/10/20 18:15:40 markf Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -36,36 +36,6 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-(package (define-rtl-constructor get-rtl-constructor)
-
-;; Calls to define-rtl-constructor are generated by the define-rtl-...
-;; macros used below.
-
-(define rtl-type->constructors '())
-(define entry-rtl-type car)
-(define entry-constructor cdr)
-
-(define (put-rtl-constructor rtl-type constructor)
-  (let ((entry (assq rtl-type rtl-type->constructors)))
-    (if entry
-       (set-cdr! entry constructor)
-       (set! rtl-type->constructors
-             (cons (cons rtl-type constructor) rtl-type->constructors)))))
-
-(define-export (define-rtl-constructor rtl-type constructor)
-  (if (pair? rtl-type)
-      (for-each (lambda (rtl-type)
-                 (put-constructor rtl-type constructor))
-               rtl-type)
-      (put-rtl-constructor rtl-type constructor)))
-
-(define-export (get-rtl-constructor rtl-type)
-    (let ((entry (assq rtl-type rtl-type->constructors)))
-      (if entry
-         (entry-constructor entry)
-         (error "No constructor found for this rtl type:" rtl-type))))
-) ;; end package
-\f
 (define-rtl-expression char->ascii rtl: expression)
 (define-rtl-expression byte-offset rtl: register number)
 (define-rtl-expression register % number)
@@ -75,6 +45,8 @@ MIT in each case. |#
 (define-rtl-expression object->fixnum rtl: expression)
 (define-rtl-expression object->unsigned-fixnum rtl: expression)
 (define-rtl-expression fixnum->object rtl: expression)
+(define-rtl-expression fixnum->address rtl: expression)
+(define-rtl-expression address->fixnum rtl: expression)
 (define-rtl-expression offset rtl: register number)
 (define-rtl-expression pre-increment rtl: register number)
 (define-rtl-expression post-increment rtl: register number)
@@ -88,14 +60,14 @@ MIT in each case. |#
 (define-rtl-expression offset-address rtl: register number)
 (define-rtl-expression unassigned rtl:)
 
-(define-rtl-expression generic-unary rtl: operator operand)
-(define-rtl-expression generic-binary rtl: operator operand-1 operand-2)
-
 (define-rtl-expression fixnum-1-arg rtl: operator operand)
 (define-rtl-expression fixnum-2-args rtl: operator operand-1 operand-2)
 
 (define-rtl-predicate fixnum-pred-1-arg % predicate operand)
 (define-rtl-predicate fixnum-pred-2-args % predicate operand-1 operand-2)
+(define-rtl-expression generic-unary rtl: operator operand)
+(define-rtl-expression generic-binary rtl: operator operand-1 operand-2)
+
 (define-rtl-predicate eq-test % expression-1 expression-2)
 (define-rtl-predicate true-test % expression)
 (define-rtl-predicate type-test % expression type)