From: Mark Friedman <edu/mit/csail/zurich/markf>
Date: Wed, 24 Aug 1988 16:29:46 +0000 (+0000)
Subject: Just forgot a few things for the rtl-constructor stuff.
X-Git-Tag: 20090517-FFI~12587
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=17ec32cdb999172c0c8c44f745e70a3f6e3c7c9f;p=mit-scheme.git

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 f583d15e0..36f379c71 100644
--- 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))
 
+(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)