From bea440cfd115940798c7a6ce1d27e21b9bdaae04 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 7 Jan 2019 06:42:18 +0000 Subject: [PATCH] Fix format words generated by svm1 compiler for internal procedures. Continuation parser relies on the next-continuation-offset for internal procedures in interrupt frames. --- src/compiler/machines/svm/lapgen.scm | 30 +++++++++++++++------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/src/compiler/machines/svm/lapgen.scm b/src/compiler/machines/svm/lapgen.scm index 05ef09b59..7da34905e 100644 --- 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)) ;;;; Utilities for the rules -- 2.25.1