Revision 6e23543bc477eb46e5fc8d5cab119190b990ed7c authored by Keno Fischer on 24 November 2023, 15:26:51 UTC, committed by GitHub on 24 November 2023, 15:26:51 UTC
This is cherry-picked from #52245. This is an independent bugfix, and looks like #52245 might need another round of discussion. There were two separate off-by-1's in the codegen code that is trying to detect assignments to slots inside try/catch regions. First, it was asking to include the value of the catch label, which is actually the first statement *not* in the try region. Second, there was a confusion of 0 and 1 based indexing in the iteration bounds. The end result of this was that the code was also looking at the first two statements of the catch region. This wasn't a problem before #52245 (other than a potentially over-conservative marking of some slots as volatile), because our catch blocks always had at least two statements (a :leave and a terminator), but with the `:leave` change, it is possible to have catch blocks with only one statement. If these happened to be at the end of the function, things would blow up. As a side node, this code isn't particularly sound, because it assumes that try/catch regions are lexical, which they are not. The assumption happens to work out ok for the code we generate in the frontend and optimized IR doesn't have slots, so we don't use this code, but it is not in general sound.
1 parent a386cd1
utils.scm
;; for debugging, display x and return it
(define (prn x)
(with-output-to *stderr*
(display x) (newline))
x)
;; return the mapping for `elt` in `alst`, or `default` if not found
(define (lookup elt alst default)
(let ((a (assq elt alst)))
(if a (cdr a) default)))
;; items in `s1` and not in `s2`
(define (diff s1 s2)
(cond ((null? s1) '())
((memq (car s1) s2) (diff (cdr s1) s2))
(else (cons (car s1) (diff (cdr s1) s2)))))
(define (intersect s1 s2)
(filter (lambda (x) (memq x s2)) s1))
(define (has-dups lst)
(if (null? lst)
#f
(or (memq (car lst) (cdr lst))
(has-dups (cdr lst)))))
;; does `expr` contain any substructure that satisfies predicate `p`?
(define (contains p expr)
(or (p expr)
(and (pair? expr)
(any (lambda (x) (contains p x))
expr))))
;; does `expr` contain something `eq?` to `x`, excluding list heads and quoted exprs
(define (expr-contains-eq x expr)
(or (eq? expr x)
(and (pair? expr)
(not (quoted? expr))
(any (lambda (y) (expr-contains-eq x y))
(cdr expr)))))
;; same as above, with predicate
(define (expr-contains-p p expr (filt (lambda (x) #t)))
(and (filt expr)
(or (p expr)
(and (pair? expr)
(not (quoted? expr))
(any (lambda (y) (expr-contains-p p y filt))
(cdr expr))))))
;; find all subexprs satisfying `p`, applying `key` to each one
(define (expr-find-all p expr key (filt (lambda (x) #t)))
(if (filt expr)
(let ((found (if (p expr)
(list (key expr))
'())))
(if (or (atom? expr) (quoted? expr))
found
(apply nconc
found
(map (lambda (x) (expr-find-all p x key filt))
(cdr expr)))))
'()))
(define (butlast lst)
(if (or (null? lst) (null? (cdr lst)))
'()
(cons (car lst) (butlast (cdr lst)))))
(define (last lst)
(if (null? (cdr lst))
(car lst)
(last (cdr lst))))
(define (take-while f xs)
(cond ((null? xs) '())
((f (car xs)) (cons (car xs) (take-while f (cdr xs))))
(else '())))
(define (caddddr x) (car (cdr (cdr (cdr (cdr x))))))
(define (cdddddr x) (cdr (cdr (cdr (cdr (cdr x))))))
(define (cadddddr x) (car (cdddddr x)))
(define (table.clone t)
(let ((nt (table)))
(table.foldl (lambda (k v z) (put! nt k v))
() t)
nt))
;; `any`, but call predicate on every element in order no matter what
(define (eager-any pred lst)
(let loop ((lst lst)
(any #f))
(if (null? lst)
any
(loop (cdr lst)
(or (pred (car lst)) any)))))
;; construct a table mapping each element of `lst` to its index (1-indexed)
(define (symbol-to-idx-map lst)
(let ((tbl (table)))
(let loop ((xs lst) (i 1))
(if (pair? xs)
(begin (put! tbl (car xs) i)
(loop (cdr xs) (+ i 1)))))
tbl))
;; keep at most the first element matching a given predicate
(define (keep-first pred lst)
(cond ((null? lst) lst)
((pred (car lst))
(cons (car lst) (filter (lambda (x) (not (pred x))) (cdr lst))))
(else
(cons (car lst) (keep-first pred (cdr lst))))))
Computing file changes ...
