nonlinear LVARs (aka MISC.293)

Bug #309099 reported by Nikodemus Siivola on 2008-12-17
4
Affects Status Importance Assigned to Milestone
SBCL
High
Unassigned

Bug Description

    (defun buu (x)
      (multiple-value-call #'list
        (block foo
          (multiple-value-prog1
              (eval '(values :a :b :c))
            (catch 'bar
              (if (> x 0)
                  (return-from foo
                    (eval `(if (> ,x 1)
                               1
                               (throw 'bar (values 3 4)))))))))))

  (BUU 1) returns garbage.

  The problem is that both EVALs sequentially write to the same LVAR.

Changed in sbcl:
importance: Undecided → High
status: New → Confirmed
Download full text (3.7 KiB)

After some investigation it seems to me that the problem is connected with the wrong cleanup code insertion during the IR1 phase. Consider this part of the code flow:

IR1 block 5 start c52
start stack:
 52> 56: SB-C::%POP-VALUES {GLOBAL-FUNCTION}
 57> 58: '#<SB-C::LVAR 24 {B2FF8F9}>
 59> known combination v56 v58
end stack:
successors c60

Here %POP-VALUES works with the LVAR which is intended to store the return value (and holds a part of it already). The wrong insertion occurs in stack.lisp. As a quick and _very dirty_ workaround, remove the cleanup insertions in discard-unused-values, before the (when (cleanup-code) at the function end:

(defun discard-unused-values (block1 block2)
  (declare (type cblock block1 block2))
  (collect ((cleanup-code))
    (labels ((find-popped (before after)
               ;; Returns (VALUES popped last-popped rest), where
               ;; BEFORE = (APPEND popped rest) and
               ;; (EQ (FIRST rest) (FIRST after))
               (if (null after)
                   (values before (first (last before)) nil)
                   (loop with first-preserved = (car after)
                         for last-popped = nil then maybe-popped
                         for rest on before
                         for maybe-popped = (car rest)
                         while (neq maybe-popped first-preserved)
                         collect maybe-popped into popped
                         finally (return (values popped last-popped rest)))))
             (discard (before-stack after-stack)
               (cond
                 ((eq (car before-stack) (car after-stack))
                  (binding* ((moved-count (mismatch before-stack after-stack)
                                          :exit-if-null)
                             ((moved qmoved)
                              (loop for moved-lvar in before-stack
                                    repeat moved-count
                                    collect moved-lvar into moved
                                    collect `',moved-lvar into qmoved
                                    finally (return (values moved qmoved))))
                             (q-last-moved (car (last qmoved)))
                             ((nil last-nipped rest)
                              (find-popped (nthcdr moved-count before-stack)
                                           (nthcdr moved-count after-stack))))
                    (cleanup-code
                     `(%nip-values ',last-nipped ,q-last-moved
                       ,@qmoved))
                    (discard (nconc moved rest) after-stack)))
                 (t
                  (multiple-value-bind (popped last-popped rest)
                      (find-popped before-stack after-stack)
                    (declare (ignore popped))
                    (cleanup-code `(%pop-values ',last-popped))
                    (discard rest after-stack))))))
      (discard (ir2-block-end-stack (block-info block1))
               (ir2-block-start-stack (block-info block2))))

 ;;check our assumptions about the wrong cleanup code <-----------------------------------------------
 #+nil
 (when (cleanup-code)
      (let* ((block (insert-...

Read more...

The simpler form which suffers from the same issue with %pop-values (and which is a bit easier to track through IR1 phases):

    (defun buu ()
          (multiple-value-prog1
              (values nil nil)
            (catch 'bar
                  (return-from buu
                    (eval '(throw 'bar 1))))))

Returns garbage, just like the original form.

Changed in sbcl:
assignee: nobody → Roman Marynchak (roman-marynchak)

As per the bugs assignment policy discussion on #lisp, I remove the assignment until I have the clear solution of the issue.

Changed in sbcl:
assignee: Roman Marynchak (roman-marynchak) → nobody
Nikodemus Siivola (nikodemus) wrote :

Added stack-analysis tag as I suspect this is related to some of the others holding that tag.

tags: added: stack-analysis
Changed in sbcl:
status: Confirmed → Fix Committed
Changed in sbcl:
status: Fix Committed → Fix Released
To post a comment you must log in.
This report contains Public information  Edit
Everyone can see this information.

Other bug subscribers