Fix format words generated by svm1 compiler for internal procedures.

Continuation parser relies on the next-continuation-offset for
internal procedures in interrupt frames.

diff --git a/src/compiler/machines/svm/lapgen.scm b/src/compiler/machines/svm/lapgen.scm
index 05ef09b59b594e9ee65030dc15738d8e4fdda2d9..7da34905ed95e013ac1bc91db02e9cfda785c941 100644 (file)
--- a/src/compiler/machines/svm/lapgen.scm
+++ b/src/compiler/machines/svm/lapgen.scm
@@ -111,10 +111,16 @@ USA.
   (make-external-label internal-label (encode-procedure-type min max)))
 
 (define (make-internal-procedure-label label)
-  (make-external-label label #xFFFD))
+  (let ((offset
+        (rtl-procedure/next-continuation-offset (label->object label))))
+    (make-external-label label (encode-continuation-offset offset #xFFFD))))
 
 (define (make-continuation-label entry-label label)
-  (make-external-label label (encode-continuation-offset entry-label #xFFFC)))
+  (let ((offset
+        (and entry-label
+             (rtl-continuation/next-continuation-offset
+              (label->object entry-label)))))
+    (make-external-label label (encode-continuation-offset offset #xFFFC))))
 
 (define (encode-procedure-type min-frame max-frame)
   (let ((n-required (-1+ min-frame))
@@ -131,18 +137,14 @@ USA.
            (fix:or (fix:lsh n-optional 7)
                    (if rest? #x4000 0)))))
 
-(define (encode-continuation-offset label default)
-  (let ((offset
-        (if label
-            (rtl-continuation/next-continuation-offset (label->object label))
-            0)))
-    (if offset
-       (begin
-         (guarantee exact-nonnegative-integer? offset)
-         (if (not (< offset #x7FF8))
-             (error "Can't encode continuation offset:" offset))
-         (+ offset #x8000))
-       default)))
+(define (encode-continuation-offset offset default)
+  (if offset
+      (begin
+       (guarantee exact-nonnegative-integer? offset)
+       (if (not (< offset #x7FF8))
+           (error "Can't encode continuation offset:" offset))
+       (+ offset #x8000))
+      default))
 \f
 ;;;; Utilities for the rules