nonlinear LVARs (aka MISC.293)
Bug #309099 reported by
Nikodemus Siivola
Affects | Status | Importance | Assigned to | Milestone | |
---|---|---|---|---|---|
SBCL |
Fix Released
|
High
|
Unassigned |
Bug Description
(defun buu (x)
(
(block foo
(eval '(values :a :b :c))
(catch 'bar
(if (> x 0)
(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 |
Changed in sbcl: | |
assignee: | nobody → Roman Marynchak (roman-marynchak) |
Changed in sbcl: | |
status: | Confirmed → Fix Committed |
Changed in sbcl: | |
status: | Fix Committed → Fix Released |
To post a comment you must log in.
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)
(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)))
(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)))))) end-stack (block-info block1))
(ir2-block- start-stack (block-info 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)
(t
(discard (ir2-block-
;;check our assumptions about the wrong cleanup code <------ ------- ------- ------- ------- ------- ------
#+nil
(when (cleanup-code)
(let* ((block (insert-...