From 3ce134866be24ffff09d5df9016ec68b275f8e68 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 21 Oct 2020 13:14:54 -0600
Subject: [PATCH] Chez Scheme: repair fasl of deeply nested values

The Racket variant of Chez Scheme includes special treatment of deeply
nested structures to avoid a C-stack overflow on unfasl, but the
relevant callbacks had gotten mangled.

Closes #3454
---
 racket/src/ChezScheme/s/compile.ss | 10 +++++-----
 racket/src/ChezScheme/s/fasl.ss    | 10 +++++-----
 2 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/racket/src/ChezScheme/s/compile.ss b/racket/src/ChezScheme/s/compile.ss
index 2b2b04b735..eed7cfc4e9 100644
--- a/racket/src/ChezScheme/s/compile.ss
+++ b/racket/src/ChezScheme/s/compile.ss
@@ -493,8 +493,8 @@
                            (if omit-rtds? (constant fasl-omit-rtds) 0))])
               (and (not (fx= flags 0)) flags))])
      (c-build-fasl x t a?)
-     ($fasl-start p t situation
-       (lambda (p) (c-faslobj x t p a?)))))
+     ($fasl-start p t situation x
+       (lambda (x p) (c-faslobj x t p a?)))))
 
 (define-record-type visit-chunk
   (nongenerative)
@@ -616,7 +616,7 @@
                             (parameterize ([$target-machine (machine-type)])
                               (let ([t ($fasl-table)])
                                 ($fasl-enter x1 t (constant annotation-all) 0)
-                                ($fasl-start wpoop t (constant fasl-type-visit-revisit) (lambda (p) ($fasl-out x1 p t (constant annotation-all)))))))))))
+                                ($fasl-start wpoop t (constant fasl-type-visit-revisit) x1 (lambda (x p) ($fasl-out x p t (constant annotation-all)))))))))))
                   (let-values ([(rcinfo* lpinfo* final*) (compile-file-help1 x1 source-info-string)])
                     (when hostop
                       ; the host library file contains expander output possibly augmented with
@@ -627,7 +627,7 @@
                           (parameterize ([$target-machine (machine-type)])
                             (let ([t ($fasl-table)])
                               ($fasl-enter x1 t (constant annotation-all) 0)
-                              ($fasl-start hostop t (constant fasl-type-visit-revisit) (lambda (p) ($fasl-out x1 p t (constant annotation-all)))))))))
+                              ($fasl-start hostop t (constant fasl-type-visit-revisit) x1 (lambda (x p) ($fasl-out x p t (constant annotation-all)))))))))
                     (cfh0 (+ n 1) (cons rcinfo* rrcinfo**) (cons lpinfo* rlpinfo**) (cons final* rfinal**)))))))))))
 
 (define library/program-info?
@@ -1610,7 +1610,7 @@
                     (let ([x (fold-left (lambda (outer ir) (with-output-language (Lexpand Outer) `(group ,outer ,ir)))
                                (car ir*) (cdr ir*))])
                       ($fasl-enter x t (constant annotation-all) 0)
-                      ($fasl-start wpoop t (constant fasl-type-visit-revisit) (lambda (p) ($fasl-out x p t (constant annotation-all))))))))))))))
+                      ($fasl-start wpoop t (constant fasl-type-visit-revisit) x (lambda (x p) ($fasl-out x p t (constant annotation-all))))))))))))))
 
   (define build-required-library-list
     (lambda (node* visit-lib*)
diff --git a/racket/src/ChezScheme/s/fasl.ss b/racket/src/ChezScheme/s/fasl.ss
index a6ca341e8b..69dab13321 100644
--- a/racket/src/ChezScheme/s/fasl.ss
+++ b/racket/src/ChezScheme/s/fasl.ss
@@ -662,7 +662,7 @@
 
 (module (start)
   (define start
-    (lambda (p t situation proc)
+    (lambda (p t situation x proc)
       (shift-externals! t)
       (dump-graph)
       (let-values ([(bv* size)
@@ -680,7 +680,7 @@
                                           (proc x p)
                                           (wrf x p t (constant annotation-all))))
                                     begins)))
-                      (proc p)
+                      (proc x p)
                       (extractor))])
         ($write-fasl-bytevectors p bv* size situation (constant fasl-type-fasl)))))
 
@@ -718,7 +718,7 @@
                            (constant fasl-omit-rtds)
                            0))])
          (bld x t a? 0)
-         (start p t (constant fasl-type-visit-revisit) (lambda (p) (wrf x p t a?))))))
+         (start p t (constant fasl-type-visit-revisit) x (lambda (x p) (wrf x p t a?))))))
 
   (define-who fasl-write
     (case-lambda
@@ -760,7 +760,7 @@
     (emit-header p (constant scheme-version) (constant machine-type-any))
     (let ([t (make-table)])
       (bld-graph x t #f 0 #t really-bld-record)
-      (start p t (constant fasl-type-visit-revisit) (lambda (p) (wrf-graph x p t #f really-wrf-record))))))
+      (start p t (constant fasl-type-visit-revisit) x (lambda (x p) (wrf-graph x p t #f really-wrf-record))))))
 
 ($fasl-target (make-target bld-graph bld wrf start make-table wrf-graph fasl-base-rtd fasl-write fasl-file))
 )
@@ -774,7 +774,7 @@
   (set! $fasl-bld-graph (lambda (x t a? d inner? handler) ((target-fasl-bld-graph (fasl-target)) x t a? d inner? handler)))
   (set! $fasl-enter (lambda (x t a? d) ((target-fasl-enter (fasl-target)) x t a? d)))
   (set! $fasl-out (lambda (x p t a?) ((target-fasl-out (fasl-target)) x p t a?)))
-  (set! $fasl-start (lambda (p t situation proc) ((target-fasl-start (fasl-target)) p t situation proc)))
+  (set! $fasl-start (lambda (p t situation x proc) ((target-fasl-start (fasl-target)) p t situation x proc)))
   (set! $fasl-table (case-lambda
                      [() ((target-fasl-table (fasl-target)))]
                      [(external?-pred) ((target-fasl-table (fasl-target)) external?-pred)]))