@@ -4338,7 +4338,7 @@ f(x) = yt(x)
4338
4338
(car s)
4339
4339
(loop (cdr s))))))
4340
4340
`(pop_exception ,restore-token))))
4341
- (define (emit-return x )
4341
+ (define (emit-return tail x )
4342
4342
(define (emit- x )
4343
4343
(let* ((tmp (if ((if (null? catch-token-stack) valid-ir-return? simple-atom?) x)
4344
4344
#f
@@ -4347,8 +4347,12 @@ f(x) = yt(x)
4347
4347
(begin (emit `(= ,tmp ,x)) tmp)
4348
4348
x)))
4349
4349
(define (actually-return x )
4350
- (let* ((x (if rett
4351
- (compile (convert-for-type-decl (emit- x) rett #t lam) '() #t #f )
4350
+ (let* ((x (begin0 (emit- x)
4351
+ ; ; if we are adding an implicit return then mark it as having no location
4352
+ (if (not (eq? tail 'explicit ))
4353
+ (emit ' (line #f )))))
4354
+ (x (if rett
4355
+ (compile (convert-for-type-decl x rett #t lam) '() #t #f )
4352
4356
x))
4353
4357
(x (emit- x)))
4354
4358
(let ((pexc (pop-exc-expr catch-token-stack '() )))
@@ -4487,7 +4491,7 @@ f(x) = yt(x)
4487
4491
(eq? (car e) 'globalref ))
4488
4492
(underscore-symbol? (cadr e)))))
4489
4493
(error (string " all-underscore identifier used as rvalue" (format-loc current-loc))))
4490
- (cond (tail (emit-return e1))
4494
+ (cond (tail (emit-return tail e1))
4491
4495
(value e1)
4492
4496
((symbol? e1) (emit e1) #f ) ; ; keep symbols for undefined-var checking
4493
4497
((and (pair? e1) (eq? (car e1) 'outerref )) (emit e1) #f ) ; ; keep globals for undefined-var checking
@@ -4533,7 +4537,7 @@ f(x) = yt(x)
4533
4537
(else
4534
4538
(compile-args (cdr e) break-labels))))
4535
4539
(callex (cons (car e) args)))
4536
- (cond (tail (emit-return callex))
4540
+ (cond (tail (emit-return tail callex))
4537
4541
(value callex)
4538
4542
(else (emit callex)))))
4539
4543
((=)
@@ -4550,7 +4554,7 @@ f(x) = yt(x)
4550
4554
(if (not (eq? rr rhs))
4551
4555
(emit `(= ,rr ,rhs)))
4552
4556
(emit `(= ,lhs ,rr))
4553
- (if tail (emit-return rr))
4557
+ (if tail (emit-return tail rr))
4554
4558
rr)
4555
4559
(emit-assignment lhs rhs))))))
4556
4560
((block)
@@ -4603,7 +4607,7 @@ f(x) = yt(x)
4603
4607
(if file-diff (set! filename last-fname))
4604
4608
v)))
4605
4609
((return)
4606
- (compile (cadr e) break-labels #t #t )
4610
+ (compile (cadr e) break-labels #t 'explicit )
4607
4611
#f )
4608
4612
((unnecessary)
4609
4613
; ; `unnecessary` marks expressions generated by lowering that
@@ -4618,7 +4622,8 @@ f(x) = yt(x)
4618
4622
(let ((v1 (compile (caddr e) break-labels value tail)))
4619
4623
(if val (emit-assignment val v1))
4620
4624
(if (and (not tail) (or (length> e 3 ) val))
4621
- (emit end-jump))
4625
+ (begin (emit `(line #f ))
4626
+ (emit end-jump)))
4622
4627
(let ((elselabel (make&mark-label)))
4623
4628
(for-each (lambda (test )
4624
4629
(set-car! (cddr test) elselabel))
@@ -4630,7 +4635,7 @@ f(x) = yt(x)
4630
4635
(if (not tail)
4631
4636
(set-car! (cdr end-jump) (make&mark-label))
4632
4637
(if (length= e 3 )
4633
- (emit-return v2)))
4638
+ (emit-return tail v2)))
4634
4639
val))))
4635
4640
((_while)
4636
4641
(let* ((endl (make-label))
@@ -4672,7 +4677,7 @@ f(x) = yt(x)
4672
4677
(emit `(label ,m))
4673
4678
(put! label-map (cadr e) (make&mark-label)))
4674
4679
(if tail
4675
- (emit-return ' (null))
4680
+ (emit-return tail ' (null))
4676
4681
(if value (error " misplaced label" )))))
4677
4682
((symbolicgoto)
4678
4683
(let* ((m (get label-map (cadr e) #f ))
@@ -4712,7 +4717,7 @@ f(x) = yt(x)
4712
4717
(begin (if els
4713
4718
(begin (if (and (not val) v1) (emit v1))
4714
4719
(emit ' (leave 1 )))
4715
- (if v1 (emit-return v1)))
4720
+ (if v1 (emit-return tail v1)))
4716
4721
(if (not finally) (set! endl #f )))
4717
4722
(begin (emit ' (leave 1 ))
4718
4723
(emit `(goto ,(or els endl)))))
@@ -4744,7 +4749,7 @@ f(x) = yt(x)
4744
4749
(emit `(= ,tmp (call (core ===) ,finally ,(caar actions))))
4745
4750
(emit `(gotoifnot ,tmp ,skip))))
4746
4751
(let ((ac (cdar actions)))
4747
- (cond ((eq? (car ac) 'return ) (emit-return (cadr ac)))
4752
+ (cond ((eq? (car ac) 'return ) (emit-return tail (cadr ac)))
4748
4753
((eq? (car ac) 'break ) (emit-break (cadr ac)))
4749
4754
(else ; ; assumed to be a rethrow
4750
4755
(emit ac))))
@@ -4783,8 +4788,8 @@ f(x) = yt(x)
4783
4788
(set! global-const-error current-loc))
4784
4789
(emit e))))
4785
4790
((atomic) (error " misplaced atomic declaration" ))
4786
- ((isdefined) (if tail (emit-return e) e))
4787
- ((boundscheck) (if tail (emit-return e) e))
4791
+ ((isdefined) (if tail (emit-return tail e) e))
4792
+ ((boundscheck) (if tail (emit-return tail e) e))
4788
4793
4789
4794
((method)
4790
4795
(if (not (null? (cadr lam)))
@@ -4805,20 +4810,20 @@ f(x) = yt(x)
4805
4810
l))))
4806
4811
(emit `(method ,(or (cadr e) ' (false)) ,sig ,lam))
4807
4812
(if value (compile ' (null) break-labels value tail)))
4808
- (cond (tail (emit-return e))
4813
+ (cond (tail (emit-return tail e))
4809
4814
(value e)
4810
4815
(else (emit e)))))
4811
4816
((lambda)
4812
4817
(let ((temp (linearize e)))
4813
- (cond (tail (emit-return temp))
4818
+ (cond (tail (emit-return tail temp))
4814
4819
(value temp)
4815
4820
(else (emit temp)))))
4816
4821
4817
4822
; ; top level expressions
4818
4823
((thunk module)
4819
4824
(check-top-level e)
4820
4825
(emit e)
4821
- (if tail (emit-return ' (null)))
4826
+ (if tail (emit-return tail ' (null)))
4822
4827
' (null))
4823
4828
((toplevel-only)
4824
4829
(check-top-level (cdr e))
@@ -4828,7 +4833,7 @@ f(x) = yt(x)
4828
4833
(check-top-level e)
4829
4834
(let ((val (make-ssavalue)))
4830
4835
(emit `(= ,val ,e))
4831
- (if tail (emit-return val))
4836
+ (if tail (emit-return tail val))
4832
4837
val))
4833
4838
4834
4839
; ; other top level expressions
@@ -4837,7 +4842,7 @@ f(x) = yt(x)
4837
4842
(emit e)
4838
4843
(let ((have-ret? (and (pair? code) (pair? (car code)) (eq? (caar code) 'return ))))
4839
4844
(if (and tail (not have-ret?))
4840
- (emit-return ' (null))))
4845
+ (emit-return tail ' (null))))
4841
4846
' (null))
4842
4847
4843
4848
((gc_preserve_begin)
@@ -4861,7 +4866,7 @@ f(x) = yt(x)
4861
4866
(else
4862
4867
(emit e)))
4863
4868
(if (and tail (not have-ret?))
4864
- (emit-return ' (null)))
4869
+ (emit-return tail ' (null)))
4865
4870
' (null)))
4866
4871
4867
4872
; ; unsupported assignment operators
@@ -4979,6 +4984,7 @@ f(x) = yt(x)
4979
4984
(labltable (table))
4980
4985
(ssavtable (table))
4981
4986
(current-loc 0 )
4987
+ (nowhere #f )
4982
4988
(current-file file)
4983
4989
(current-line line)
4984
4990
(locstack '() )
@@ -4991,25 +4997,32 @@ f(x) = yt(x)
4991
4997
(set! current-loc 1 )))
4992
4998
(set! code (cons e code))
4993
4999
(set! i (+ i 1 ))
4994
- (set! locs (cons current-loc locs)))
5000
+ (set! locs (cons (if nowhere 0 current-loc) locs))
5001
+ (set! nowhere #f ))
4995
5002
(let loop ((stmts (cdr body)))
4996
5003
(if (pair? stmts)
4997
5004
(let ((e (car stmts)))
4998
5005
(cond ((atom? e) (emit e))
4999
5006
((eq? (car e) 'line )
5000
- (if (and (= current-line 0 ) (length= e 2 ) (pair? linetable))
5001
- ; ; (line n) after push_loc just updates the line for the new file
5002
- (begin (set-lineno! (car linetable) (cadr e))
5003
- (set! current-line (cadr e)))
5004
- (begin
5005
- (set! current-line (cadr e))
5006
- (if (pair? (cddr e))
5007
- (set! current-file (caddr e)))
5008
- (set! linetable (cons (if (null? locstack)
5009
- (make-lineinfo name current-file current-line)
5010
- (make-lineinfo name current-file current-line (caar locstack)))
5011
- linetable))
5012
- (set! current-loc (- (length linetable) 1 )))))
5007
+ (cond ((and (length= e 2 ) (not (cadr e)))
5008
+ ; ; (line #f) marks that we are entering a generated statement
5009
+ ; ; that should not be counted as belonging to the previous marked location,
5010
+ ; ; for example `return` after a not-executed `if` arm in tail position.
5011
+ (set! nowhere #t ))
5012
+ ((and (= current-line 0 ) (length= e 2 ) (pair? linetable))
5013
+ ; ; (line n) after push_loc just updates the line for the new file
5014
+ (begin (set-lineno! (car linetable) (cadr e))
5015
+ (set! current-line (cadr e))))
5016
+ (else
5017
+ (begin
5018
+ (set! current-line (cadr e))
5019
+ (if (pair? (cddr e))
5020
+ (set! current-file (caddr e)))
5021
+ (set! linetable (cons (if (null? locstack)
5022
+ (make-lineinfo name current-file current-line)
5023
+ (make-lineinfo name current-file current-line (caar locstack)))
5024
+ linetable))
5025
+ (set! current-loc (- (length linetable) 1 ))))))
5013
5026
((and (length> e 2 ) (eq? (car e) 'meta ) (eq? (cadr e) 'push_loc ))
5014
5027
(set! locstack (cons (list current-loc current-line current-file) locstack))
5015
5028
(set! current-file (caddr e))
0 commit comments