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 62c2a1ec7cbee36bdf9b69445f219da22cbfe9a9..668d4b604120507f3cf169e6a2c3437a9585381a 100644 (file)
--- 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 a45ea39eb8f4b6a6e3e7dbbded300fcb6257a6e0..ddba25784fa58f6fe91eab3ff905b33a24c2ad57 100644 (file)
--- 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 0e9655337a5c6eb05ac7e290250d9b4470deb44d..91476d3e43ba7aeb25354db9d4993b7dbc5b4141 100644 (file)
--- 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))))