3m bug fix for function calls chained with &&, ||, etc
svn: r4072
This commit is contained in:
Matthew Flatt
parent
6cedffd7c0
commit
87e78e0f96
|
|
@ -612,16 +612,24 @@
|
|||
""
|
||||
"SET_GC_VARIABLE_STACK(__gc_var_stack__), ")
|
||||
"__gc_var_stack__[1] = (void *)x)~n"))
|
||||
|
||||
|
||||
;; Debugging support:
|
||||
(printf "#ifdef MZ_3M_CHECK_VAR_STACK\n")
|
||||
(printf "static int _bad_var_stack_() { *(long *)0x0 = 1; return 0; }\n")
|
||||
(printf "# define CHECK_GC_V_S ((GC_VARIABLE_STACK == __gc_var_stack__) ? 0 : _bad_var_stack_()),\n")
|
||||
(printf "#else\n")
|
||||
(printf "# define CHECK_GC_V_S /*empty*/\n")
|
||||
(printf "#endif\n")
|
||||
|
||||
;; Call a function where the number of registered variables can change in
|
||||
;; nested blocks:
|
||||
(printf "#define FUNCCALL_each(setup, x) (setup, x)~n")
|
||||
;; nested blocks:
|
||||
(printf "#define FUNCCALL_each(setup, x) (CHECK_GC_V_S setup, x)~n")
|
||||
;; The same, but a "tail" call:
|
||||
(printf "#define FUNCCALL_EMPTY_each(x) FUNCCALL_each(SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]), x)~n")
|
||||
(printf "#define FUNCCALL_EMPTY_each(x) (SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]), x)~n")
|
||||
;; The same, but the number of registered variables for this call is definitely
|
||||
;; the same as for the previous call:
|
||||
(printf (if callee-restore?
|
||||
"#define FUNCCALL_AGAIN_each(x) x~n"
|
||||
"#define FUNCCALL_AGAIN_each(x) (CHECK_GC_V_S x)~n"
|
||||
"#define FUNCCALL_AGAIN_each(x) FUNCCALL_each(SET_GC_VARIABLE_STACK(__gc_var_stack__), x)~n"))
|
||||
|
||||
;; As above, but when the number of registered variables never changes
|
||||
|
|
@ -3091,11 +3099,11 @@
|
|||
;; because they're blessed by the lifter]
|
||||
(let ([e- (reverse e)]
|
||||
[orig-num-calls (live-var-info-num-calls live-vars)])
|
||||
(let loop ([e- e-][result null][live-vars live-vars])
|
||||
(let loop ([e- e-][result null][live-vars live-vars][converted-sub? #f])
|
||||
(cond
|
||||
[(null? e-) (values result live-vars)]
|
||||
[(ignored-stuff? e-)
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars)]
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars converted-sub?)]
|
||||
[(eq? 'return (tok-n (car e-)))
|
||||
;; Look forward in result to semicolon, and wrap that:
|
||||
(let rloop ([result result][l null])
|
||||
|
|
@ -3107,16 +3115,21 @@
|
|||
(if (null? l)
|
||||
(cons (make-tok RET_NOTHING (tok-line (car e-)) (tok-file (car e-)))
|
||||
result)
|
||||
(let ([has-empty-funccall? (let loop ([l l])
|
||||
(cond
|
||||
[(null? l) #f]
|
||||
[(and (call? (car l))
|
||||
(null? (call-live (car l))))
|
||||
#t]
|
||||
[(seq? (car l))
|
||||
(or (loop (seq->list (seq-in (car l))))
|
||||
(loop (cdr l)))]
|
||||
[else #f]))])
|
||||
(let ([has-empty-funccall?
|
||||
;; All calls must be empty calls, otherwise
|
||||
;; the result might not depend on the empty call
|
||||
;; (e.g., f() && empty(f()) )
|
||||
(let loop ([l l][one? #f])
|
||||
(cond
|
||||
[(null? l) one?]
|
||||
[(call? (car l))
|
||||
(if (null? (call-live (car l)))
|
||||
(loop (cdr l) #t)
|
||||
#f)]
|
||||
[(seq? (car l))
|
||||
(and (loop (seq->list (seq-in (car l))) one?)
|
||||
(loop (cdr l) one?))]
|
||||
[else #f]))])
|
||||
(list* (make-tok (if has-empty-funccall?
|
||||
RET_VALUE_EMPTY_START
|
||||
RET_VALUE_START)
|
||||
|
|
@ -3129,7 +3142,8 @@
|
|||
RET_VALUE_END)
|
||||
(tok-line (car e-)) (tok-file (car e-)))
|
||||
result)))
|
||||
live-vars)]
|
||||
live-vars
|
||||
converted-sub?)]
|
||||
[else (rloop (cdr result) (cons (car result) l))]))]
|
||||
[(looks-like-call? e-)
|
||||
;; Looks like a function call, maybe a cast:
|
||||
|
|
@ -3141,7 +3155,8 @@
|
|||
(convert-paren-interior (car e-) vars &-vars c++-class live-vars complain-not-in #f)])
|
||||
(loop (cddr e-)
|
||||
(list* (cadr e-) v result)
|
||||
live-vars)))
|
||||
live-vars
|
||||
#t)))
|
||||
(lambda ()
|
||||
;; It's a function call; find the start
|
||||
(let-values ([(args) (car e-)]
|
||||
|
|
@ -3246,7 +3261,8 @@
|
|||
(or (and (null? (cdr func))
|
||||
(memq (tok-n (car func)) non-returning-functions))
|
||||
(and (pair? rest-)
|
||||
(eq? 'return (tok-n (car rest-)))))
|
||||
(eq? 'return (tok-n (car rest-)))
|
||||
(not converted-sub?)))
|
||||
;; no arrays of pointers in this scope, or addresses of
|
||||
;; local vars taken in the function.
|
||||
(not (or (ormap (lambda (var)
|
||||
|
|
@ -3316,11 +3332,15 @@
|
|||
(+ (if non-returning? 1 0)
|
||||
(live-var-info-num-noreturn-calls live-vars))
|
||||
(or this-nonempty?
|
||||
(live-var-info-nonempty-calls? live-vars)))))))))]
|
||||
(live-var-info-nonempty-calls? live-vars)))
|
||||
(or converted-sub?
|
||||
(null? rest-)
|
||||
(not (memq (tok-n (car rest-)) '(return else))))))))))]
|
||||
[(eq? 'goto (tok-n (car e-)))
|
||||
;; Goto - assume all vars are live
|
||||
(loop (cdr e-) (cons (car e-) result)
|
||||
(replace-live-vars live-vars vars))]
|
||||
(replace-live-vars live-vars vars)
|
||||
#t)]
|
||||
[(eq? '= (tok-n (car e-)))
|
||||
;; Check for assignments where the LHS can move due to
|
||||
;; a function call on the RHS. [Note that special support
|
||||
|
|
@ -3369,7 +3389,8 @@
|
|||
(live-var-info-pushed-vars live-vars)
|
||||
(live-var-info-num-calls live-vars)
|
||||
(live-var-info-num-noreturn-calls live-vars)
|
||||
(live-var-info-nonempty-calls? live-vars))))
|
||||
(live-var-info-nonempty-calls? live-vars))
|
||||
#t))
|
||||
(begin
|
||||
(when (and (not (null? assignee))
|
||||
(or (if (brackets? (car assignee))
|
||||
|
|
@ -3402,8 +3423,8 @@
|
|||
(log-warning "[ASSIGN] ~a in ~a: suspicious assignment with a function call, LHS ends ~s."
|
||||
(tok-line (car e-)) (tok-file (car e-))
|
||||
(tok-n (cadr e-))))
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars)))))
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars))]
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars #t)))))
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars #t))]
|
||||
[(and (braces? (car e-)) (not braces-are-aggregates?))
|
||||
(let*-values ([(v) (car e-)]
|
||||
;; do/while/for: we'll need a fixpoint for live-vars
|
||||
|
|
@ -3490,7 +3511,8 @@
|
|||
(seq-close v)
|
||||
(list->seq e)))
|
||||
result)
|
||||
(filter-live-vars live-vars)))]
|
||||
(filter-live-vars live-vars)
|
||||
#t))]
|
||||
[(seq? (car e-))
|
||||
;; Do nested body.
|
||||
;; For (v = new x, ...) parens, check for special conversion
|
||||
|
|
@ -3505,7 +3527,7 @@
|
|||
(and (brackets? (car e-))
|
||||
"array access"))
|
||||
#f)])
|
||||
(loop (cdr e-) (cons v result) live-vars)))]
|
||||
(loop (cdr e-) (cons v result) live-vars #t)))]
|
||||
[(and (assq (tok-n (car e-)) vars)
|
||||
(not (assq (tok-n (car e-)) (live-var-info-vars live-vars))))
|
||||
;; Add a live variable:
|
||||
|
|
@ -3513,7 +3535,8 @@
|
|||
(cons (car e-) result)
|
||||
(replace-live-vars live-vars
|
||||
(cons (assq (tok-n (car e-)) vars)
|
||||
(live-var-info-vars live-vars))))]
|
||||
(live-var-info-vars live-vars)))
|
||||
#t)]
|
||||
[(and (memq (tok-n (car e-)) '(while do for))
|
||||
(case (tok-n (car e-))
|
||||
[(do)
|
||||
|
|
@ -3525,7 +3548,7 @@
|
|||
(braces? (cadr result))))]))
|
||||
(log-error "[LOOP] ~a in ~a: while/do/for with body not in braces."
|
||||
(tok-line (car e-)) (tok-file (car e-)))
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars)]
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars #t)]
|
||||
[else
|
||||
(when (and check-arith? (not memcpy?)
|
||||
(positive? (live-var-info-num-calls live-vars)))
|
||||
|
|
@ -3544,7 +3567,7 @@
|
|||
(log-warning "[ARITH] ~a in ~a: suspicious arithmetic, LHS ends ~s."
|
||||
(tok-line (car e-)) (tok-file (car e-))
|
||||
(tok-n (cadr e-))))))
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars)]))))
|
||||
(loop (cdr e-) (cons (car e-) result) live-vars converted-sub?)]))))
|
||||
|
||||
(define (convert-seq-interior v comma-sep? vars &-vars c++-class live-vars complain-not-in memcpy?)
|
||||
(let ([e (seq->list (seq-in v))])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user