From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Wed, 12 Apr 1995 19:23:11 +0000 (+0000)
Subject: Fixed RTLGEN/%APPLY-UNCHECKED for tagged entry points.
X-Git-Tag: 20090517-FFI~6468
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0d57d87d1de1b2f18713c17900ce06b989d8b933;p=mit-scheme.git

Fixed RTLGEN/%APPLY-UNCHECKED for tagged entry points.
---

diff --git a/v8/src/compiler/midend/rtlgen.scm b/v8/src/compiler/midend/rtlgen.scm
index 01d8b690b..1d60ce699 100644
--- a/v8/src/compiler/midend/rtlgen.scm
+++ b/v8/src/compiler/midend/rtlgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rtlgen.scm,v 1.22 1995/04/08 19:46:51 adams Exp $
+$Id: rtlgen.scm,v 1.23 1995/04/12 19:23:11 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -1852,12 +1852,18 @@ MIT in each case. |#
     (rtlgen/invoke
      state cont rands
      (lambda (cont-label)
-       (rtlgen/emit!/1
-	`(INVOCATION:REGISTER  ,(+ nargs 1)
-			       ,cont-label
-			       ,rator
-			       #F
-			       (MACHINE-CONSTANT 0)))))))
+       (let ((dest-reg  (if (rtlgen/tagged-entry-points?)
+			    (rtlgen/new-reg)
+			    rator)))
+	 (if (rtlgen/tagged-entry-points?)
+	     (rtlgen/emit!/1
+	      `(ASSIGN ,dest-reg (OBJECT->ADDRESS ,rator))))
+	 (rtlgen/emit!/1
+	  `(INVOCATION:REGISTER  ,(+ nargs 1)
+				 ,cont-label
+				 ,dest-reg
+				 #F
+				 (MACHINE-CONSTANT 0))))))))
 
 (define (rtlgen/invoke-operator-cache state kind name+arity cont rands)
   (if (not (QUOTE/? name+arity))