From: Mark Friedman <edu/mit/csail/zurich/markf>
Date: Thu, 20 Oct 1988 18:15:40 +0000 (+0000)
Subject: Added generic arithmetic rtl types and overflow-test predicate.
X-Git-Tag: 20090517-FFI~12502
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=25b0c63d4436df4cc288822d58f48e2fd715ea86;p=mit-scheme.git

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 9b1be0a96..3455072e0 100644
--- 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))
 
-(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
-
 (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)