Restore vaslist optimization with bugfix

src/lisp/kernel/cleavir/translate.lisp

@@ -2155,9 +2155,6 @@ COMPILE-FILE will use the default *clasp-env*."
   (maybe-debug-transformation module :optimize-vars)
   (bir-transformations:meta-evaluate-module module system)
   (maybe-debug-transformation module :meta-evaluate)
-  ;; Broken at the moment - vaslist goes out of extent with e.g.
-  ;; (multiple-value-call (lambda (&rest args) (values-list args)) (values-list '(1 2 3)))
-  #+(or)
   (cc-vaslist:maybe-transform-module module)
   (bir-transformations:module-generate-type-checks module system)
   (cc-bir-to-bmir:reduce-module-instructions module)

src/lisp/kernel/cleavir/vaslist.lisp

@@ -154,6 +154,15 @@
     ((cleavir-primop:cdr) (datum-ok-p (first (bir:outputs inst))))
     (otherwise nil)))
 
+(defun values-list-datum-ok-p (datum)
+  ;; Is the use of a values-list okay? We say all uses are okay EXCEPT returning
+  ;; from the function, since we treat the values as having an extent limited to
+  ;; the function. Using the values list as the input to a call should be okay
+  ;; since by recursive assumption it won't return the values (or store them elsewhere).
+  (and (typep datum 'bir:output)
+       (let ((use (bir:use datum)))
+         (typep use '(not bir:returni)))))
+
 ;;; FIXME: This function only looks for existing derivations, rather than
 ;;; prompting any new ones. More reason this whole file should be part of
 ;;; the data flow analysis proper.
@@ -212,7 +221,8 @@
               (and (= (cl:length args) 1)
                    (eq datum (first args))))
              ((cl:values-list) (and (= (cl:length args) 1)
-                                    (eq datum (first args))))
+                                    (eq datum (first args))
+                                    (values-list-datum-ok-p out)))
              (otherwise nil))))
     (when (and *record-failures* (not result))
       (push inst *failure-reasons*))

src/lisp/regression-tests/misc.lisp

@@ -293,3 +293,14 @@
       (third (second (macroexpand-1 '(formatter "~
 "))))
       ((block nil)))
+
+;;; Problem caused by incorrect vaslist optimization: These can result in
+;;; junk data or segfaults.
+
+(test vaslist-opt-1
+      (restart-case (invoke-restart 'bar 1 2 3) (bar (&rest args) (values-list args)))
+      (1 2 3))
+
+(test vaslist-opt-2
+      (multiple-value-call (lambda (&rest args) (values-list args)) (values-list '(1 2 3)))
+      (1 2 3))