From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Tue, 21 Nov 1989 22:21:34 +0000 (+0000)
Subject: Fix a bug in local lexprs.  The dynamic link register was not
X-Git-Tag: 20090517-FFI~11683
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5a7b5d8e6c2ae5f14e85084f4e32f846c9e4a0d8;p=mit-scheme.git

Fix a bug in local lexprs.  The dynamic link register was not
preserved accross the call to lexpr-apply.  On the 68k, a gc in
lexpr-apply would corrupt the dynamic link.  On the portable
interface, it was always corrupted.
---

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index 62c2a1ec7..668d4b604 100644
--- a/v7/src/compiler/machines/bobcat/make.scm-68040
+++ b/v7/src/compiler/machines/bobcat/make.scm-68040
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.59 1989/11/15 02:48:07 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.60 1989/11/21 22:20:51 jinx Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -41,4 +41,4 @@ MIT in each case. |#
 	    ((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
 	  '((COMPILER MACROS)
 	    (COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (Motorola MC68020)" 4 59 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (Motorola MC68020)" 4 60 '()))
\ No newline at end of file
diff --git a/v7/src/compiler/rtlgen/rgcomb.scm b/v7/src/compiler/rtlgen/rgcomb.scm
index a45ea39eb..ddba25784 100644
--- a/v7/src/compiler/rtlgen/rgcomb.scm
+++ b/v7/src/compiler/rtlgen/rgcomb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgcomb.scm,v 4.12 1989/10/26 07:39:03 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgcomb.scm,v 4.13 1989/11/21 22:21:34 jinx Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -90,17 +90,25 @@ MIT in each case. |#
 	    (generate/procedure-entry/inline callee))
 	   (else
 	    (enqueue-procedure! callee)
-	    (if (procedure-rest callee)
-		(rtl:make-invocation:lexpr
-		 (if (stack-block/static-link? (procedure-block callee))
-		     (-1+ frame-size)
-		     frame-size)
-		 continuation
-		 (procedure-label callee))
+	    (if (not (procedure-rest callee))
 		(rtl:make-invocation:jump
 		 frame-size
 		 continuation
-		 (procedure-label callee))))))))
+		 (procedure-label callee))
+		(let* ((callee-block (procedure-block callee))
+		       (core
+			(lambda (frame-size)
+			  (rtl:make-invocation:lexpr
+			   (if (stack-block/static-link? callee-block)
+			       (-1+ frame-size)
+			       frame-size)
+			   continuation
+			   (procedure-label callee)))))
+		  (if (not (block/dynamic-link? callee-block))
+		      (core frame-size)
+		      (scfg*scfg->scfg!
+		       (rtl:make-push-link)
+		       (core (1+ frame-size)))))))))))
 
 (define (invocation/apply model operator frame-size continuation prefix)
   model operator			; ignored
diff --git a/v7/src/compiler/rtlgen/rgproc.scm b/v7/src/compiler/rtlgen/rgproc.scm
index 0e9655337..91476d3e4 100644
--- a/v7/src/compiler/rtlgen/rgproc.scm
+++ b/v7/src/compiler/rtlgen/rgproc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgproc.scm,v 4.8 1989/04/21 17:10:15 markf Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgproc.scm,v 4.9 1989/11/21 22:21:12 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -72,8 +72,13 @@ MIT in each case. |#
 		((procedure-rest procedure)
 		 (with-values (lambda () (procedure-arity-encoding procedure))
 		   (lambda (min max)
-		     (rtl:make-procedure-header (procedure-label procedure)
-						min max))))
+		     (if (open-procedure-needs-dynamic-link? procedure)
+			 (scfg*scfg->scfg!
+			  (rtl:make-procedure-header (procedure-label procedure)
+						     (1+ min) (-1+ max))
+			  (rtl:make-pop-link))
+			 (rtl:make-procedure-header (procedure-label procedure)
+						    min max)))))
 		(else
 		 (rtl:make-open-procedure-header (procedure-label procedure))))
 	  (setup-stack-frame procedure context))))