From 35eaa9feff429a746140a63752fbfe607e2722e6 Mon Sep 17 00:00:00 2001
From: dybvig <dyb@scheme.com>
Date: Sun, 7 Aug 2016 23:36:40 -0400
Subject: [PATCH] - fixed a bug in cpvalid resulting in it leaving behind a
 cpvalid-defer   form for later passes to choke on.  also fixed cp0 to print
 the correct   name for cpvalid when it does this.     cpvalid.ss, cp0.ss,    
 misc.ms - updated the prototype for s_ee_write_char to match the definition  
   expeditor.c - updated LOG and release_notes - rebuilt boot files due to
 s-directory changes

original commit: 50aa8b34774a9e65e96481ae329a3f329fad7aca
---
 LOG                              |  7 +++++++
 c/expeditor.c                    |  2 +-
 mats/misc.ms                     | 17 +++++++++++++++++
 release_notes/release_notes.stex |  8 ++++++++
 s/cp0.ss                         |  2 +-
 s/cpvalid.ss                     | 11 ++++++-----
 6 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/LOG b/LOG
index d34fbb6c05..73bf15452f 100644
--- a/LOG
+++ b/LOG
@@ -280,3 +280,10 @@
   S_create_thread_object to allow it to report either Sactivate_thread
   or fork-thread led to the error.
     externs.h, schsig.c, scheme.c, thread.c
+- fixed a bug in cpvalid resulting in it leaving behind a cpvalid-defer
+  form for later passes to choke on.  also fixed cp0 to print the correct
+  name for cpvalid when it does this.
+    cpvalid.ss, cp0.ss,
+    misc.ms
+- updated the prototype for s_ee_write_char to match the definition
+    expeditor.c
diff --git a/c/expeditor.c b/c/expeditor.c
index 8541f26bdb..b83cd51113 100644
--- a/c/expeditor.c
+++ b/c/expeditor.c
@@ -21,7 +21,7 @@
 /* locally defined functions */
 static IBOOL s_ee_init_term(void);
 static ptr s_ee_read_char(IBOOL blockp);
-static void s_ee_write_char(INT c);
+static void s_ee_write_char(wchar_t c);
 static void s_ee_flush(void);
 static ptr s_ee_get_screen_size(void);
 static void s_ee_raw(void);
diff --git a/mats/misc.ms b/mats/misc.ms
index 37dc2b07aa..cce1af9e1d 100644
--- a/mats/misc.ms
+++ b/mats/misc.ms
@@ -1474,6 +1474,23 @@
            (define x (f))
            x)))
     '17)
+  ; check for regression: cpvalid leaving behind a cpvalid-defer form
+  (equivalent-expansion?
+    (parameterize ([run-cp0 (lambda (cp0 x) x)]
+                   [optimize-level 2])
+      (expand/optimize '(letrec* ([f (letrec ([x x]) (lambda () x))]) 0)))
+    '(let ([f (let ([valid? #f])
+                (let ([x (#2%void)])
+                  (set! x
+                    (begin
+                      (if valid?
+                          (#2%void)
+                          (#2%$source-violation #f #f #t
+                            "attempt to reference undefined variable ~s" 'x))
+                      x))
+                  (set! valid? #t)
+                  (lambda () x)))])
+       0))
 )
 
 (mat compile-profile
diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex
index 43f153e859..06b3942ddb 100644
--- a/release_notes/release_notes.stex
+++ b/release_notes/release_notes.stex
@@ -1428,6 +1428,14 @@ in fasl files does not generally make sense.
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
+\subsection{Compiler error: leaked or unexpected \protect\scheme{cpvalid-defer} form (9.4.1)}
+
+A bug in the pass of the compiler that inserts valid checks for
+\scheme{letrec} and \scheme{letrec*} bindings has been fixed.
+The bug resulted in an internal compiler exception with a condition
+message regarding a leaked or unexpected \scheme{cpvalid-defer} form.
+[This bug dated back to Version 6.9c.]
+
 \subsection{\protect\scheme{string->number} and reader numeric syntax issues (9.4)}
 
 \scheme{string->number} and the reader previously treated all complex
diff --git a/s/cp0.ss b/s/cp0.ss
index e61a583d5d..e790f6813f 100644
--- a/s/cp0.ss
+++ b/s/cp0.ss
@@ -4635,7 +4635,7 @@
                        [else #f])))]
              [else (void)])))
        `(cte-optimization-loc ,box ,e)]
-      [(cpvalid-defer ,e) (sorry! who "np-valid leaked a cpvalid-defer form ~s" ir)]
+      [(cpvalid-defer ,e) (sorry! who "cpvalid leaked a cpvalid-defer form ~s" ir)]
       [(profile ,src) ir]
       [else ($oops who "unrecognized record ~s" ir)])
     (begin
diff --git a/s/cpvalid.ss b/s/cpvalid.ss
index ae32495586..223a74d578 100644
--- a/s/cpvalid.ss
+++ b/s/cpvalid.ss
@@ -424,11 +424,12 @@
                      (set-prelex-assigned! valid-flag #t)
                      (build-let (list valid-flag) (list `(quote #f))
                        (first-value
-                         (defer-or-not (or dl? body-dl?)
-                           (build-letrec x* e*
-                             `(seq
-                                (set! #f ,valid-flag (quote #t))
-                                ,body))))))
+                         (let-values ([(body body-dl?) (defer-or-not body-dl?
+                                                         `(seq
+                                                            (set! #f ,valid-flag (quote #t))
+                                                            ,body))])
+                           (defer-or-not (or dl? body-dl?)
+                             (build-letrec x* e* body))))))
                    (build-letrec x* e* body))))))]
       [(letrec* ([,x* ,e*] ...) ,body)
        ; - we do unprotected parts of each rhs plus unsafe lambda pieces