From 7a4ab12a52d21eb5b043c9f58cf67a1d4889eab7 Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Tue, 14 Feb 1995 00:58:08 +0000
Subject: [PATCH] Added a patch to ensure that out-of-line hooks are not called
 with a constructed continuation.

	  (call 'hook (call %make-stack-closure ...) x y)
	=>
	  (call %invoke-continuation
	        (call %make-stack-closure ...)
		(call 'hook '#F x y))

This is required because out-of-line hooks have to generate their own
continuation to do the restoring, and the code merges with a control
flow path from somewhere prior to the call so that this continuation
is part of the same rgraph, i.e. the RTL graph sblock for an
INVOKE-SPECIAL-PRIMITIVE is connected to the bblock for the
continuation.  This means that RTL pseudo register value classes must
agree across this boundary, which is not so if we generate one from
%make-stack-closure.

Also tidies a few things.
---
 v8/src/compiler/midend/compat.scm | 45 ++++++++++++++++++++++---------
 1 file changed, 32 insertions(+), 13 deletions(-)

diff --git a/v8/src/compiler/midend/compat.scm b/v8/src/compiler/midend/compat.scm
index 092837af9..14ed6c710 100644
--- a/v8/src/compiler/midend/compat.scm
+++ b/v8/src/compiler/midend/compat.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: compat.scm,v 1.4 1994/11/26 00:24:08 jmiller Exp $
+$Id: compat.scm,v 1.5 1995/02/14 00:58:08 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -93,12 +93,12 @@ MIT in each case. |#
 (define-macro (define-compatibility-rewrite keyword bindings . body)
   (let ((proc-name (symbol-append 'COMPAT/ keyword)))
     (call-with-values
-     (lambda () (%matchup (cdr bindings) '(handler env) '(cdr form)))
-     (lambda (names code)
-       `(define ,proc-name
-	  (let ((handler (lambda ,(cons (car bindings) names) ,@body)))
-	    (named-lambda (,proc-name env form)
-	      (compat/remember ,code form))))))))
+	(lambda () (%matchup (cdr bindings) '(handler env) '(cdr form)))
+      (lambda (names code)
+	`(DEFINE ,proc-name
+	   (LET ((HANDLER (LAMBDA ,(cons (car bindings) names) ,@body)))
+	     (NAMED-LAMBDA (,proc-name ENV FORM)
+	       (COMPAT/REMEMBER ,code FORM))))))))
 
 (define-compatibility-rewrite LOOKUP (env name)
   (let ((place (assq name env)))
@@ -156,8 +156,7 @@ MIT in each case. |#
 	   ,(compat/expr env cont)
 	   ,@(compat/expr* env rands)))
 
-  (cond ((or (not (pair? rator))
-	     (not (eq? (car rator) 'QUOTE)))
+  (cond ((not (QUOTE/? rator))
 	 (possibly-pass-some-args-on-stack))
 	((rewrite-operator/compat? (quote/text rator))
 	 => (lambda (handler)
@@ -165,13 +164,12 @@ MIT in each case. |#
 	#| Hooks into the compiler interface, when they must tail
 	into another computation, are now called with the default
 	(args. in registers) calling convention.  This is not a
-	problem because they have fixed arity.
+	problem because they have fixed arity. |#
 	((and (operator/satisfies? (quote/text rator) '(OUT-OF-LINE-HOOK))
 	      (not (operator/satisfies? (quote/text rator)
 					'(SPECIAL-INTERFACE)))
 	      (not (equal? cont '(QUOTE #F))))
 	 (compat/out-of-line env rator cont rands))
-	|#
 	(else
 	 (dont-split-cookie-call))))
 
@@ -395,8 +393,7 @@ MIT in each case. |#
 	   (QUOTE #F)
 	   ,(compat/expr env
 			 (let ((vector-arg  (first rands)))
-			   (if (and (pair? vector-arg)
-				    (eq? (car vector-arg) 'QUOTE))
+			   (if (QUOTE/? vector-arg)
 			       (cond ((assq (quote/text vector-arg) env)
 				      => (lambda (old.new)
 					   `(QUOTE ,(second old.new))))
@@ -593,6 +590,28 @@ MIT in each case. |#
       'ok
       (internal-error "Unexpected continuation to out-of-line hook" cont)))
 
+
+(define (compat/out-of-line env rator cont rands)
+  ;; We should not get complex continuations for the out-of-line operators,
+  ;; but we do, so we have to cope.
+  (define (normal)
+    `(CALL ,(compat/expr env rator)
+	   ,(compat/expr env cont)
+	   ,@(compat/expr* env rands)))
+  (cond ((QUOTE/? cont) (normal))
+	((LOOKUP/? cont)  (normal))
+	((CALL/%stack-closure-ref? cont) (normal))
+	(else
+	 (if compiler:guru?
+	     (internal-warning "Unexpected continuation for hook"
+			       `(CALL ,rator ,cont ,@rands)))
+	 `(CALL (QUOTE ,%invoke-continuation)
+		,(compat/expr env cont)
+		(CALL ,(compat/expr env rator)
+		      (QUOTE #F)
+		      ,@(compat/expr* env rands))))))
+
+
 (let ((known-operator->primitive
        (lambda (env rator cont rands)
 	 (compat/->stack-closure
-- 
2.25.1