~ chicken-core (chicken-5) 5a4df9c22e8e6463fa44d9bd19802080118c1989

commit 5a4df9c22e8e6463fa44d9bd19802080118c1989
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Wed Jun 16 08:36:22 2021 +0200
Commit:     megane <meganeka@gmail.com>
CommitDate: Thu Jun 17 15:22:47 2021 +0300

    Replace rest ops with list ops on explicitly consed rest args
    
    When the optimizer detects a "rest op" for a rest parameter which has
    been replaced by an explicitly consed list at the call site, the rest
    op is replaced by car/cdr/length list operations on the now-explicit
    argument.  This is needed because the argvector will not contain those
    extra arguments anymore, so attempting to read them is an access
    outside the argvector's bounds.
    
    This is sometimes detected by the runtime with an error like
    "attempted rest argument access at index 0 but rest list length is 0",
    but in other situations it will cause a segmentation fault, as has
    been reported in #1756.
    
    Signed-off-by: megane <meganeka@gmail.com>

diff --git a/NEWS b/NEWS
index 7c20c0a0..e06914c7 100644
--- a/NEWS
+++ b/NEWS
@@ -57,6 +57,9 @@
   - An `emit-types-file` declaration has been added, which corresponds
     to the compiler flag of the same name (#1644, thanks to Marco Maggi
     for the suggestion).
+  - Fixed a bug caused by a bad interaction between two optimizations:
+    argvector rest ops would be applied even if a procedure already got
+    its rest arg consed at the call site (#1756, thanks to Sandra Snan).
 
 - Build system
   - Auto-configure at build time on most platforms. Cross-compilation
diff --git a/manual/Acknowledgements b/manual/Acknowledgements
index e466b2ae..0489a0eb 100644
--- a/manual/Acknowledgements
+++ b/manual/Acknowledgements
@@ -46,8 +46,8 @@ Otavio Salvador, Burton Samograd, "Sandro", "satori", Aleksej Saushev,
 Oskar Schirmer, Vasilij Schneidermann, Reed Sheridan, Ronald Schröder,
 Spencer Schumann, Ivan Shcheklein, Alexander Shendi, Alex Shinn, Ivan
 Shmakov, "Shmul", Tony Sidaway, Jeffrey B. Siegal, Andrey Sidorenko,
-Michele Simionato, Iruata Souza, Volker Stolz, Jon Strait, Dorai
-Sitaram, Robert Skeels, Jason Songhurst, Clifford Stein, David Steiner,
+Michele Simionato, Iruata Souza, Volker Stolz, Jon Strait, Dorai Sitaram,
+Robert Skeels, Sandra Snan, Jason Songhurst, Clifford Stein, David Steiner,
 "Sunnan", Zbigniew Szadkowski, Rick Taube, Nathan Thern, Mike Thomas, Minh
 Thu, Christian Tismer, Andre van Tonder, John Tobey, Henrik Tramberend,
 Vladimir Tsichevsky, James Ursetto, Neil van Dyke, Sam Varner,
diff --git a/optimizer.scm b/optimizer.scm
index c5bbd50c..c5e40440 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -206,6 +206,7 @@
                      ((eq? '##core#variable (node-class arg)))
                      (var (first (node-parameters arg)))
                      ((not (db-get db var 'captured)))
+                     ((not (db-get db var 'consed-rest-arg)))
                      (info (db-get db var 'rest-cdr))
                      (restvar (car info))
                      (depth (cdr info))
@@ -570,6 +571,22 @@
 		       gae)
 		      n2)))))
 
+          ((##core#rest-cdr ##core#rest-car ##core#rest-null? ##core#rest-length)
+	   (let ((rest-var (first params)))
+	     ;; If rest-arg has been replaced with regular arg which
+	     ;; is explicitly consed at call sites, restore rest ops
+	     ;; as regular car/cdr calls on the rest list variable.
+	     ;; This can be improved, as it can actually introduce
+	     ;; many more cdr calls than necessary.
+	     (cond
+              ((or (test rest-var 'consed-rest-arg))
+	       (touch)
+	       (debugging 'o "resetting rest op for explicitly consed rest parameter" rest-var class)
+
+	       (replace-rest-op-with-list-ops class (varnode rest-var) params))
+
+              (else (walk-generic n class params subs fids gae #f))) ) )
+
 	  (else (walk-generic n class params subs fids gae #f)) ) ) )
     
     (define (walk-generic n class params subs fids gae invgae)
diff --git a/tests/rest-arg-tests.scm b/tests/rest-arg-tests.scm
index 152ac484..54749a15 100644
--- a/tests/rest-arg-tests.scm
+++ b/tests/rest-arg-tests.scm
@@ -29,3 +29,13 @@
 (assert (not (rest-nonnull-optimization 1)))
 (assert (not (rest-nonnull-optimization 1 2)))
 
+;; Regression test to make sure explicitly consed rest args don't get
+;; rest argvector ops for them (#1756)
+(let ()
+  (define mdplus
+    (lambda args
+      (let ((args args))
+        (if (pair? args)
+            (car args)))))
+  (mdplus '1 '2)
+  (mdplus '3 '4))