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
ast.scm
;; AST utilities
;; deparser
(define (deparse-arglist l (sep ", "))
(if (has-parameters? l)
(string (string.join (map deparse (cdr l)) sep)
(if (length= (cdr l) 1) "," "")
(deparse (car l)))
(string.join (map deparse l) sep)))
(define (deparse-prefix-call head args opn cls)
(string (if (or (decl? head) (eq? head ':))
(string "(" (deparse head) ")")
(deparse head))
opn (deparse-arglist args) cls))
(define (deparse-generator e)
(if (eq? (car e) 'flatten)
(deparse-flatten e '())
(string (deparse (cadr e)) " for " (deparse-arglist (cddr e) ", "))))
(define (deparse-flatten e iters (flat #t))
(cond ((and flat (pair? e) (eq? (car e) 'generator))
(deparse-flatten (cadr e) (cons (deparse-arglist (cddr e) ", ") iters) #f))
((and flat (pair? e) (eq? (car e) 'flatten))
(let ((e (cadr e)))
(deparse-flatten (cadr e) (cons (deparse-arglist (cddr e) ", ") iters) #t)))
(else
(string (deparse e) " for " (string.join (reverse iters) " for ")))))
(define (indented-block lst ilvl)
(string
(string.join (map (lambda (ex) (string (string.rep " " (+ ilvl 1))
(deparse ex (+ ilvl 1))))
lst)
"\n")
(if (null? lst) "" "\n")))
(define (deparse-block head lst ilvl)
(string head "\n" (indented-block lst ilvl)
(string.rep " " ilvl) "end"))
(define (deparse-colon-dot e)
(if (dotop? e)
(string ":" (deparse e))
(deparse e)))
(define (deparse-import-path e)
(cond ((and (pair? e) (eq? (car e) '|.|))
(let loop ((lst (cdr e))
(ndots 0))
(if (or (null? lst)
(not (eq? (car lst) '|.|)))
(string (string.rep "." ndots)
(string.join (map deparse lst) "."))
(loop (cdr lst) (+ ndots 1)))))
((and (pair? e) (eq? (car e) ':))
(string (deparse-import-path (cadr e)) ": "
(string.join (map deparse-import-path (cddr e)) ", ")))
(else
(string e))))
(define (deparse-semicolons n)
; concatenate n semicolons
(if (<= n 0)
""
(string ";" (deparse-semicolons (1- n)))))
(define (deparse e (ilvl 0))
(cond ((or (symbol? e) (number? e)) (string e))
((string? e) (print-to-string e))
((eq? (typeof e) 'julia_value)
(let ((s (string e)))
(if (string.find s "#<julia: ")
;; successfully printed as a julia value
(string.sub s 9 (string.dec s (length s)))
s)))
((char? e) (string "'" e "'"))
((atom? e) (string e))
((eq? (car e) '|.|)
(if (length= e 2)
(string "(." (deparse (cadr e)) ")")
(string (deparse (cadr e)) '|.|
(cond ((and (pair? (caddr e)) (memq (caaddr e) '(quote inert)))
(deparse-colon-dot (cadr (caddr e))))
((and (pair? (caddr e)) (eq? (caaddr e) 'copyast))
(deparse-colon-dot (cadr (cadr (caddr e)))))
(else
(string #\( (deparse (caddr e)) #\)))))))
((memq (car e) '(... |'|))
(string (deparse (cadr e)) (car e)))
((or (syntactic-op? (car e)) (eq? (car e) '|<:|) (eq? (car e) '|>:|) (eq? (car e) '-->))
(if (length= e 2)
(string (car e) (deparse (cadr e)))
(string (deparse (cadr e)) " " (car e) " " (deparse (caddr e)))))
((eq? (car e) 'as)
(string (deparse-import-path (cadr e)) " as " (deparse (caddr e))))
(else
(case (car e)
((null) "nothing")
((true) "true")
((false) "false")
;; calls and operators
((call)
(cond ((and (eq? (cadr e) ':) (or (length= e 4) (length= e 5)))
(string (deparse (caddr e)) ': (deparse (cadddr e))
(if (length> e 4)
(string ': (deparse (caddddr e)))
"")))
((and (length= e 4) (operator? (cadr e)))
(string #\( (deparse (caddr e)) " " (cadr e) " " (deparse (cadddr e)) #\) ))
(else
(deparse-prefix-call (cadr e) (cddr e) #\( #\)))))
(($ &) (if (and (pair? (cadr e))
(not (memq (caadr e)
'(outerref null true false tuple $ vect braces))))
(string (car e) "(" (deparse (cadr e)) ")")
(string (car e) (deparse (cadr e)))))
((|::|) (if (length= e 2)
(string (car e) (deparse (cadr e)))
(string (deparse (cadr e)) (car e) (deparse (caddr e)))))
((comparison) (string.join (map deparse (cdr e)) " "))
((macrocall) (string (cadr e) " " (deparse-arglist (cddr e) " ")))
((kw) (string (deparse (cadr e)) " = " (deparse (caddr e))))
((where) (string (deparse (cadr e)) " where "
(if (length= e 3)
(deparse (caddr e))
(deparse (cons 'braces (cddr e))))))
((parameters) (string "; " (deparse-arglist (cdr e))))
;; bracket forms
((tuple)
(string #\( (deparse-arglist (cdr e))
(if (length= e 2) #\, "")
#\)))
((ref) (deparse-prefix-call (cadr e) (cddr e) #\[ #\]))
((curly) (deparse-prefix-call (cadr e) (cddr e) #\{ #\}))
((vect) (string #\[ (deparse-arglist (cdr e) ", ") #\]))
((vcat) (string #\[ (deparse-arglist (cdr e) "; ") #\]))
((typed_vcat) (string (deparse (cadr e))
(deparse (cons 'vcat (cddr e)))))
((hcat) (string #\[ (deparse-arglist (cdr e) " ") #\]))
((typed_hcat) (string (deparse (cadr e))
(deparse (cons 'hcat (cddr e)))))
((ncat) (string #\[ (deparse-arglist (cddr e) (string (deparse-semicolons (cadr e)) " "))
(if (<= (length (cddr e)) 1)
(deparse-semicolons (cadr e))
"") #\]))
((typed_ncat) (string (deparse (cadr e))
(deparse (cons 'ncat (cddr e)))))
((row) (deparse-arglist (cdr e) " "))
((nrow) (deparse-arglist (cddr e) (string (deparse-semicolons (cadr e)) " ")))
((braces) (string #\{ (deparse-arglist (cdr e) ", ") #\}))
((bracescat) (string #\{ (deparse-arglist (cdr e) "; ") #\}))
((string)
(string #\"
(string.join
(map (lambda (s)
(cond ((string? s) s)
((symbol? s) (string "$" s))
(else (string "$(" (deparse s) ")"))))
(cdr e))
"")
#\"))
;; comprehensions and generators
((generator) (string "(" (deparse-generator e) ")"))
((flatten) (string "(" (deparse-generator e) ")"))
((filter) (string (deparse (caddr e)) " if " (deparse (cadr e))))
((comprehension) (string "[ " (deparse-generator (cadr e)) " ]"))
((typed_comprehension)
(string (deparse (cadr e))
(deparse (cons 'comprehension (cddr e)))))
;; block forms
((block) (deparse-block "begin" (cdr e) ilvl))
((toplevel) (string.join (map deparse (cdr e)) "\n"))
((function macro for while)
(define (block-stmts e)
(if (and (pair? e) (eq? (car e) 'block))
(cdr e)
(list e)))
(deparse-block (string (car e) " " (deparse (cadr e)))
(if (null? (cddr e)) '() (block-stmts (caddr e)))
ilvl))
((return) (string "return " (deparse (cadr e))))
((break continue) (string (car e)))
((if elseif)
(define (if-cond e)
(if (eq? (car e) 'elseif)
(caddr (cadr e))
(cadr e)))
(if (length= e 3)
(deparse-block (string (car e) " " (deparse (if-cond e)))
(cdr (caddr e)) ilvl)
(string (car e) " " (deparse (if-cond e)) "\n"
(indented-block (cdr (caddr e)) ilvl)
(let ((els (cadddr e)))
(if (and (pair? els) (eq? (car els) 'elseif))
(deparse els)
(deparse-block "else" (cdr els) ilvl))))))
((let)
(deparse-block (string "let " (string.join (map deparse (cdadr e)) ", "))
(cdr (caddr e)) ilvl))
((try)
(string "try\n"
(indented-block (cdr (cadr e)) ilvl)
(if (and (pair? (cadddr e)) (eq? (car (cadddr e)) 'block))
(string (string.rep " " ilvl) "catch"
(if (equal? (caddr e) '(false))
""
(string " " (caddr e)))
"\n"
(indented-block (cdr (cadddr e)) ilvl))
"")
(if (length> e 5)
(let ((els (cadddddr e)))
(if (and (pair? els) (eq? (car els) 'block))
(string (string.rep " " ilvl) "else\n"
(indented-block (cdr els) ilvl))
""))
"")
(if (length> e 4)
(let ((fin (caddddr e)))
(if (and (pair? fin) (eq? (car fin) 'block))
(string (string.rep " " ilvl) "finally\n"
(indented-block (cdr fin) ilvl))
""))
"")
(string.rep " " ilvl) "end"))
((do)
(let ((call (cadr e))
(args (cdr (cadr (caddr e))))
(body (caddr (caddr e))))
(deparse-block (string (deparse call) " do" (if (null? args) "" " ")
(deparse-arglist args))
(cdr body) ilvl)))
((struct)
(string (if (equal? (cadr e) '(true)) "mutable " "")
"struct "
(deparse-block (deparse (caddr e)) (cdr (cadddr e)) ilvl)))
((abstract)
(string "abstract type " (deparse (cadr e)) " end"))
((primitive)
(string "primitive type " (deparse (cadr e)) " " (deparse (caddr e)) " end"))
((module)
(string (if (equal? (cadr e) '(true)) "module " "baremodule ")
(caddr e) "\n"
(string.join (map deparse (cdr (cadddr e))) "\n") "\n"
"end"))
;; misc syntax forms
((import using)
(string (car e) " " (string.join (map deparse-import-path (cdr e)) ", ")))
((global local export public) (string (car e) " " (string.join (map deparse (cdr e)) ", ")))
((const) (string "const " (deparse (cadr e))))
((top) (deparse (cadr e)))
((core) (string "Core." (deparse (cadr e))))
((globalref) (string (deparse (cadr e)) "." (deparse-colon-dot (caddr e))))
((outerref) (string (deparse (cadr e))))
((ssavalue) (string "SSAValue(" (cadr e) ")"))
((line) (if (length= e 2)
(string "# line " (cadr e))
(string "# " (caddr e) ", line " (cadr e))))
((copyast) (deparse (cadr e)))
((quote inert)
(if (and (symbol? (cadr e))
(not (memv (string.char (string (cadr e)) 0)
'(#\= #\:))))
(string ":" (deparse (cadr e)))
(string ":(" (deparse (cadr e)) ")")))
(else
(string e))))))
;; custom gensyms
(define *gensyms* '())
(define *current-gensyms* '())
(define *gensy-counter* 1)
(define (gensy)
(if (null? *current-gensyms*)
(let ((g (symbol (string "#s" *gensy-counter*))))
(set! *gensy-counter* (+ *gensy-counter* 1))
(set! *gensyms* (cons g *gensyms*))
g)
(begin0 (car *current-gensyms*)
(set! *current-gensyms* (cdr *current-gensyms*)))))
(define (named-gensy name)
(let ((g (symbol (string "#" *gensy-counter* "#" name))))
(set! *gensy-counter* (+ *gensy-counter* 1))
g))
(define (reset-gensyms)
(set! *current-gensyms* *gensyms*))
(define make-ssavalue
(let ((ssavalue-counter 0))
(lambda ()
(begin0 `(ssavalue ,ssavalue-counter)
(set! ssavalue-counter (+ 1 ssavalue-counter))))))
;; predicates and accessors
(define (quoted? e)
(memq (car e) '(quote top core globalref outerref line break inert meta inbounds inline noinline loopinfo)))
(define (quotify e) `',e)
(define (unquote e)
(if (and (pair? e) (memq (car e) '(quote inert)))
(cadr e)
e))
(define (quoted-sym? e)
(and (length= e 2) (memq (car e) '(quote inert))
(symbol? (cadr e))))
(define (lam:args x) (cadr x))
(define (lam:argnames x) (llist-vars (lam:args x)))
(define (lam:vinfo x) (caddr x))
(define (lam:body x) (cadddr x))
(define (lam:sp x) (cadddr (lam:vinfo x)))
(define (bad-formal-argument v)
(error (string #\" (deparse v) #\" " is not a valid function argument name")))
(define (valid-name? s)
(not (memq s '(ccall cglobal))))
(define (arg-name v)
(cond ((and (symbol? v) (valid-name? v))
v)
((not (pair? v))
(bad-formal-argument v))
(else
(case (car v)
((...)
(arg-name (cadr v)) ;; to check for errors
(decl-var (cadr v)))
((|::|)
(if (not (symbol? (cadr v)))
(bad-formal-argument (cadr v)))
(decl-var v))
((meta) ;; allow certain per-argument annotations
(if (nospecialize-meta? v #t)
(arg-name (caddr v))
(bad-formal-argument v)))
((kw)
(arg-name (cadr v)))
(else (bad-formal-argument v))))))
(define (arg-type v)
(cond ((symbol? v) '(core Any))
((not (pair? v))
(bad-formal-argument v))
(else
(case (car v)
((...) (if (eq? (length v) 3)
`(... ,(decl-type (cadr v)) ,(caddr v))
`(... ,(decl-type (cadr v)))))
((|::|)
(if (not (symbol? (cadr v)))
(bad-formal-argument (cadr v)))
(decl-type v))
((meta) ;; allow certain per-argument annotations
(if (nospecialize-meta? v #t)
(arg-type (caddr v))
(bad-formal-argument v)))
((kw)
(arg-type (cadr v)))
(else (bad-formal-argument v))))))
;; convert a lambda list into a list of just symbols
(define (llist-vars lst)
(map arg-name (filter (lambda (a) (not (and (pair? a)
(eq? (car a) 'parameters))))
lst)))
;; get just argument types
(define (llist-types lst) (map arg-type lst))
(define (decl? e)
(and (pair? e) (eq? (car e) '|::|)))
(define (symdecl? e)
(or (symbol? e) (decl? e)))
(define (eventually-decl? e)
(or (symbol? e) (and (pair? e) (memq (car e) '(|::| atomic const)) (eventually-decl? (cadr e)))))
(define (make-decl n t) `(|::| ,n ,t))
(define (ssavalue? e)
(and (pair? e) (eq? (car e) 'ssavalue)))
(define (slot? e)
(and (pair? e) (eq? (car e) 'slot)))
(define (globalref? e)
(and (pair? e) (eq? (car e) 'globalref)))
(define (outerref? e)
(and (pair? e) (eq? (car e) 'outerref)))
(define (nothing? e)
(and (pair? e) (eq? (car e) 'null)))
(define (symbol-like? e)
(or (symbol? e) (ssavalue? e)))
(define (simple-atom? x)
(or (number? x) (string? x) (char? x)
(and (pair? x) (memq (car x) '(ssavalue null true false thismodule)))
(eq? (typeof x) 'julia_value)))
;; identify some expressions that are safe to repeat
(define (effect-free? e)
(or (not (pair? e)) (ssavalue? e) (sym-dot? e) (quoted? e) (memq (car e) '(null true false))))
;; get the variable name part of a declaration, x::int => x
(define (decl-var v)
(if (decl? v) (cadr v) v))
(define (decl-type v)
(if (decl? v) (caddr v) '(core Any)))
(define (sym-dot? e)
(and (length= e 3) (eq? (car e) '|.|)
(symbol-like? (cadr e))))
(define (undot-name e)
(if (and (pair? e) (eq? (car e) '|.|))
(cadr (caddr e))
e))
(define (identifier-name e)
(cond ((symbol? e) e)
((globalref? e) (caddr e))
(else e)))
(define (dotop-named? e) (dotop? (identifier-name e)))
;; convert '.xx to 'xx
(define (undotop op)
(if (globalref? op)
`(globalref ,(cadr op) ,(undotop (caddr op)))
(let ((str (string op)))
(assert (eqv? (string.char str 0) #\.))
(symbol (string.sub str 1 (length str))))))
;; raise an error for using .op as a function name
(define (check-dotop e)
(if (dotop-named? e)
(error (string "invalid function name \"" (deparse e) "\""))
(if (pair? e)
(if (and (eq? (car e) '|.|) (length= e 3))
(check-dotop (caddr e))
(if (quoted? e)
(check-dotop (cadr e))))))
e)
(define (vararg? x) (and (pair? x) (eq? (car x) '...)))
(define (vararg-type-expr? x)
(or (eq? x 'Vararg)
(and (length> x 1)
(or (and (eq? (car x) 'curly)
(vararg-type-expr? (cadr x)))
(and (eq? (car x) 'where)
(vararg-type-expr? (cadr x)))))))
(define (varargexpr? x)
(and (pair? x)
(eq? (car x) '::)
(vararg-type-expr? (caddr x))))
(define (linenum? x) (and (pair? x) (eq? (car x) 'line)))
(define (make-assignment l r) `(= ,l ,r))
(define (assignment? e) (and (pair? e) (eq? (car e) '=)))
(define (return? e) (and (pair? e) (eq? (car e) 'return)))
(define (tuple-call? e)
(and (length> e 1)
(eq? (car e) 'call)
(equal? (cadr e) '(core tuple))))
(define (eq-sym? a b)
(or (eq? a b) (and (ssavalue? a) (ssavalue? b) (eqv? (cdr a) (cdr b)))))
(define (blockify e (lno #f))
(set! lno (if lno (list lno) '()))
(if (and (pair? e) (eq? (car e) 'block))
(if (null? (cdr e))
`(block ,@lno (null))
(if (null? lno) e `(block ,@lno ,@(cdr e))))
`(block ,@lno ,e)))
(define (make-var-info name) (list name '(core Any) 0))
(define vinfo:name car)
(define vinfo:type cadr)
(define (vinfo:set-type! v t) (set-car! (cdr v) t))
(define (vinfo:capt v) (< 0 (logand (caddr v) 1)))
(define (vinfo:asgn v) (< 0 (logand (caddr v) 2)))
(define (vinfo:never-undef v) (< 0 (logand (caddr v) 4)))
(define (vinfo:read v) (< 0 (logand (caddr v) 8)))
(define (vinfo:sa v) (< 0 (logand (caddr v) 16)))
(define (set-bit x b val) (if val (logior x b) (logand x (lognot b))))
;; record whether var is captured
(define (vinfo:set-capt! v c) (set-car! (cddr v) (set-bit (caddr v) 1 c)))
;; whether var is assigned
(define (vinfo:set-asgn! v a) (set-car! (cddr v) (set-bit (caddr v) 2 a)))
;; whether the assignments to var are known to dominate its usages
(define (vinfo:set-never-undef! v a) (set-car! (cddr v) (set-bit (caddr v) 4 a)))
;; whether var is ever read
(define (vinfo:set-read! v a) (set-car! (cddr v) (set-bit (caddr v) 8 a)))
;; whether var is assigned once
(define (vinfo:set-sa! v a) (set-car! (cddr v) (set-bit (caddr v) 16 a)))
;; occurs undef: mask 32
;; whether var is called (occurs in function call head position)
(define (vinfo:set-called! v a) (set-car! (cddr v) (set-bit (caddr v) 64 a)))
(define var-info-for assq)
(define (assignment-like? e)
(and (pair? e) (is-prec-assignment? (car e))))
(define (kwarg? e)
(and (pair? e) (eq? (car e) 'kw)))
(define (nospecialize-meta? e (one #f))
(and (if one (length= e 3) (length> e 2))
(eq? (car e) 'meta) (memq (cadr e) '(nospecialize specialize))))
(define (meta? e)
(and (length> e 1) (eq? (car e) 'meta)))
(define (method-meta-sym? x)
(memq x '(inline noinline aggressive_constprop no_constprop propagate_inbounds)))
(define (propagate-method-meta e)
`(meta ,@(filter (lambda (x)
(or (method-meta-sym? x)
(and (pair? x) (eq? (car x) 'purity))))
(cdr e))))
(define (argwide-nospecialize-meta? e)
(and (length= e 2) (eq? (car e) 'meta) (memq (cadr e) '(nospecialize specialize))))
(define (if-generated? e)
(and (length= e 4) (eq? (car e) 'if) (equal? (cadr e) '(generated))))
(define (generated-meta? e)
(and (length= e 3) (eq? (car e) 'meta) (eq? (cadr e) 'generated)))
(define (generated_only-meta? e)
(and (length= e 2) (eq? (car e) 'meta) (eq? (cadr e) 'generated_only)))
(define (function-def? e)
(and (pair? e) (or (eq? (car e) 'function) (eq? (car e) '->)
(and (eq? (car e) '=) (length= e 3)
(eventually-call? (cadr e))))))
;; flatten nested expressions with the given head
;; (op (op a b) c) => (op a b c)
(define (flatten-ex head e)
(if (atom? e)
e
(cons (car e)
(apply append!
(map (lambda (x)
(if (and (pair? x) (eq? (car x) head))
(cdr (flatten-ex head x))
(list x)))
(cdr e))))))
(define (flatten-blocks e) (flatten-ex 'block e))
Computing file changes ...
