Just forgot a few things for the rtl-constructor stuff.

diff --git a/v7/src/compiler/rtlbase/rtlty1.scm b/v7/src/compiler/rtlbase/rtlty1.scm
index f583d15e07437e953ae96eb67e362bb05f7b87d9..36f379c7178363828731034e821e8cbebb35051d 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlty1.scm
+++ b/v7/src/compiler/rtlbase/rtlty1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.8 1988/08/22 20:10:18 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.9 1988/08/24 16:29:46 markf Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -36,6 +36,36 @@ 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)