From a18d2eff726ed680ea54c56eaa161736fd97644a Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 7 Jan 1989 01:25:15 +0000
Subject: [PATCH] Bug in interaction of continuation-entry setup code and
 invocation of primitive for which the continuation-entry was created: the
 push of extra items (e.g. dynamic link) was happening before the arguments to
 the primitive were stashed in registers.  The result was that arguments that
 depended on the stack pointer were gobbling up the wrong stuff.

---
 v7/src/compiler/rtlgen/opncod.scm | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/v7/src/compiler/rtlgen/opncod.scm b/v7/src/compiler/rtlgen/opncod.scm
index 5bcace211..27c60c464 100644
--- a/v7/src/compiler/rtlgen/opncod.scm
+++ b/v7/src/compiler/rtlgen/opncod.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/opncod.scm,v 4.25 1988/12/30 07:10:49 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/opncod.scm,v 4.26 1989/01/07 01:25:15 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -239,9 +239,9 @@ MIT in each case. |#
 	       (with-values (lambda () (generate-continuation-entry context))
 		 (lambda (label setup cleanup)
 		   (scfg-append!
-		    setup
 		    (generate-primitive (car prim-invocation)
 					(cdr prim-invocation)
+					setup
 					label)
 		    cleanup
 		    (if error-finish
@@ -283,11 +283,13 @@ MIT in each case. |#
 			  identity-procedure)
       (make-null-cfg)))
 
-(define (generate-primitive name arg-list continuation-label)
+(define (generate-primitive name argument-expressions
+			    continuation-setup continuation-label)
   (scfg*scfg->scfg!
-   (let loop ((args arg-list))
+   (let loop ((args argument-expressions))
      (if (null? args)
-	 (rtl:make-push-return continuation-label)
+	 (scfg*scfg->scfg! continuation-setup
+			   (rtl:make-push-return continuation-label))
 	 (load-temporary-register scfg*scfg->scfg! (car args)
 	   (lambda (temporary)
 	     (scfg*scfg->scfg! (loop (cdr args))
@@ -295,7 +297,7 @@ MIT in each case. |#
    (let ((primitive (make-primitive-procedure name true)))
      ((or (special-primitive-handler primitive)
 	  rtl:make-invocation:primitive)
-      (1+ (length arg-list))
+      (1+ (length argument-expressions))
       continuation-label
       primitive))))
 
@@ -670,8 +672,7 @@ MIT in each case. |#
 	     (with-values (lambda () (generate-continuation-entry context))
 	       (lambda (label setup cleanup)
 		 (scfg-append!
-		  setup
-		  (generate-primitive generic-op (cddr expression) label)
+		  (generate-primitive generic-op (list op1 op2) setup label)
 		  cleanup
 		  (if is-pred?
 		      (finish
@@ -737,8 +738,7 @@ MIT in each case. |#
 	     (with-values (lambda () (generate-continuation-entry context))
 	       (lambda (label setup cleanup)
 		 (scfg-append!
-		  setup
-		  (generate-primitive generic-op (cddr expression) label)
+		  (generate-primitive generic-op (cddr expression) setup label)
 		  cleanup
 		  (if is-pred?
 		      (finish
-- 
2.25.1