Fix compiler bug which caused out-of-line internal continuation frame…

…s to have incorrect frame descriptors.
feeley · Jan 15, 2010 · 02c1427 · 02c1427
1 parent 3bdc64f
commit 02c1427
Show file tree

Hide file tree

Showing 4 changed files with 192 additions and 72 deletions.
diff --git a/gsc/_t-c-2.scm b/gsc/_t-c-2.scm
@@ -1,8 +1,8 @@
 ;;;============================================================================
 
-;;; File: "_t-c-2.scm", Time-stamp: <2009-06-08 06:36:56 feeley>
+;;; File: "_t-c-2.scm", Time-stamp: <2010-01-14 19:40:12 feeley>
 
-;;; Copyright (c) 1994-2009 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2010 by Marc Feeley, All Rights Reserved.
 
 (include "fixnum.scm")
 
@@ -937,11 +937,9 @@
                                                (length regs))))
                       (list return-var)
                       (extend-vars '()
-                                   (- (- (targ-align-frame
-                                          (+ (+ targ-nb-gvm-regs 1)
-                                             targ-frame-reserve))
-                                         targ-frame-reserve)
-                                      (+ targ-nb-gvm-regs 1)))))
+                                   (let ((n (+ targ-nb-gvm-regs 1)))
+                                     (- (targ-align-frame-without-reserve n)
+                                        n)))))
              (gc-map
               (targ-build-gc-map
                vars

diff --git a/gsc/_t-c-3.scm b/gsc/_t-c-3.scm
@@ -1,8 +1,8 @@
 ;;;============================================================================
 
-;;; File: "_t-c-3.scm", Time-stamp: <2008-04-12 10:08:26 feeley>
+;;; File: "_t-c-3.scm", Time-stamp: <2010-01-14 19:40:19 feeley>
 
-;;; Copyright (c) 1994-2008 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2010 by Marc Feeley, All Rights Reserved.
 
 (include "generic.scm")
 
@@ -476,14 +476,22 @@
 
 (define (targ-actual-fs kind fs)
   (if (eq? kind 'internal)
-    (+ (targ-align-frame fs) (+ targ-nb-gvm-regs 1))
-    fs))
+      (targ-internal-fs fs)
+      fs))
+
+(define (targ-internal-fs fs)
+  (+ (targ-align-frame fs)
+     (targ-align-frame-without-reserve (+ targ-nb-gvm-regs 1))))
 
 (define (targ-align-frame fs)
   (* (quotient (+ fs (- targ-frame-alignment 1))
                targ-frame-alignment)
      targ-frame-alignment))
 
+(define (targ-align-frame-without-reserve fs)
+  (- (targ-align-frame (+ fs targ-frame-reserve))
+     targ-frame-reserve))
+
 (define targ-min-word-size-in-bits
   (* targ-min-word-size targ-bits-per-byte))
 

diff --git a/include/stamp.h b/include/stamp.h
@@ -2,5 +2,5 @@
  * Time stamp of last source code repository commit.
  */
 
-#define ___STAMP_YMD 20100107
-#define ___STAMP_HMS 170955
+#define ___STAMP_YMD 20100115
+#define ___STAMP_HMS 40636