mescc: Bugfix for break in switch not in compound.
* module/language/c99/compiler.mes (clause->jump-info): Rename from case->jump-info. (statements->clauses): New function. (ast->info): Use it. Fixes switch statement with break in a case outside of a compound. * scaffold/t.c (swits): Test it.
This commit is contained in:
parent
f5372bdeff
commit
6dc19bd040
|
@ -858,7 +858,7 @@
|
||||||
(let ((s (string-drop o (string-length prefix))))
|
(let ((s (string-drop o (string-length prefix))))
|
||||||
(map byte->hex (string-split s #\space))))))
|
(map byte->hex (string-split s #\space))))))
|
||||||
|
|
||||||
(define (case->jump-info info)
|
(define (clause->jump-info info)
|
||||||
(define (jump n)
|
(define (jump n)
|
||||||
(wrap-as (i386:Xjump n)))
|
(wrap-as (i386:Xjump n)))
|
||||||
(define (jump-nz n)
|
(define (jump-nz n)
|
||||||
|
@ -1092,6 +1092,49 @@
|
||||||
(define (local? o) ;; formals < 0, locals > 0
|
(define (local? o) ;; formals < 0, locals > 0
|
||||||
(positive? (local:id o)))
|
(positive? (local:id o)))
|
||||||
|
|
||||||
|
(define (statements->clauses statements)
|
||||||
|
(let loop ((statements statements) (clauses '()))
|
||||||
|
(if (null? statements) clauses
|
||||||
|
(let ((s (car statements)))
|
||||||
|
(pmatch s
|
||||||
|
((case ,test (compd-stmt (block-item-list . _)))
|
||||||
|
(loop (cdr statements) (append clauses (list s))))
|
||||||
|
((case ,test (break))
|
||||||
|
(loop (cdr statements) (append clauses (list s))))
|
||||||
|
((case ,test) (loop (cdr statements) (append clauses (list s))))
|
||||||
|
|
||||||
|
((case ,test ,statement)
|
||||||
|
(let loop2 ((statement statement) (heads `((case ,test))))
|
||||||
|
(define (heads->case heads statement)
|
||||||
|
(if (null? heads) statement
|
||||||
|
(append (car heads) (list (heads->case (cdr heads) statement)))))
|
||||||
|
(pmatch statement
|
||||||
|
((case ,t2 ,s2) (loop2 s2 (append heads `((case ,t2)))))
|
||||||
|
((default ,s2) (loop2 s2 (append heads `((default)))))
|
||||||
|
((compd-stmt (block-item-list . _)) (loop (cdr statements) (append clauses (list (heads->case heads statement)))))
|
||||||
|
(_ (let loop3 ((statements (cdr statements)) (c (list statement)))
|
||||||
|
(if (null? statements) (loop statements (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@c))))))
|
||||||
|
(let ((s (car statements)))
|
||||||
|
(pmatch s
|
||||||
|
((case . _) (loop statements (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@c)))))))
|
||||||
|
((default _) (loop statements (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@c)))))))
|
||||||
|
((break) (loop (cdr statements) (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@(append c (list s)))))))))
|
||||||
|
(_ (loop3 (cdr statements) (append c (list s))))))))))))
|
||||||
|
((default (compd-stmt (block-item-list _)))
|
||||||
|
(loop (cdr statements) (append clauses (list s))))
|
||||||
|
((default . ,statement)
|
||||||
|
(let loop2 ((statements (cdr statements)) (c statement))
|
||||||
|
(if (null? statements) (loop statements (append clauses (list `(default ,@c))))
|
||||||
|
(let ((s (car statements)))
|
||||||
|
(pmatch s
|
||||||
|
((compd-stmt (block-item-list . _)) (loop (cdr statements) (append clauses (list `(default ,s)))))
|
||||||
|
((case . _) (loop statements (append clauses (list `(default (compd-stmt (block-item-list ,@c)))))))
|
||||||
|
((default _) (loop statements (append clauses (list `(default (compd-stmt (block-item-list ,@c)))))))
|
||||||
|
((break) (loop (cdr statements) (append clauses (list `(default (compd-stmt (block-item-list ,@(append c (list s)))))))))
|
||||||
|
|
||||||
|
(_ (loop2 (cdr statements) (append c (list s)))))))))
|
||||||
|
(_ (error "statements->clauses: unsupported:" s)))))))
|
||||||
|
|
||||||
(define (ast->info info)
|
(define (ast->info info)
|
||||||
(lambda (o)
|
(lambda (o)
|
||||||
(let ((globals (.globals info))
|
(let ((globals (.globals info))
|
||||||
|
@ -1217,16 +1260,17 @@
|
||||||
else-text)
|
else-text)
|
||||||
#:globals (.globals else-info))))
|
#:globals (.globals else-info))))
|
||||||
|
|
||||||
((switch ,expr (compd-stmt (block-item-list . ,cases)))
|
((switch ,expr (compd-stmt (block-item-list . ,statements)))
|
||||||
(let* ((expr ((expr->accu info) expr))
|
(let* ((clauses (statements->clauses statements))
|
||||||
|
(expr ((expr->accu info) expr))
|
||||||
(empty (clone info #:text '()))
|
(empty (clone info #:text '()))
|
||||||
(case-infos (map (case->jump-info empty) cases))
|
(clause-infos (map (clause->jump-info empty) clauses))
|
||||||
(case-lengths (map (lambda (c-j) (length (text->list (.text (c-j 0))))) case-infos))
|
(clause-lengths (map (lambda (c-j) (length (text->list (.text (c-j 0))))) clause-infos))
|
||||||
(cases-info (let loop ((cases cases) (info expr) (lengths case-lengths))
|
(clauses-info (let loop ((clauses clauses) (info expr) (lengths clause-lengths))
|
||||||
(if (null? cases) info
|
(if (null? clauses) info
|
||||||
(let ((c-j ((case->jump-info info) (car cases))))
|
(let ((c-j ((clause->jump-info info) (car clauses))))
|
||||||
(loop (cdr cases) (c-j (apply + (cdr lengths))) (cdr lengths)))))))
|
(loop (cdr clauses) (c-j (apply + (cdr lengths))) (cdr lengths)))))))
|
||||||
cases-info))
|
clauses-info))
|
||||||
|
|
||||||
((for ,init ,test ,step ,body)
|
((for ,init ,test ,step ,body)
|
||||||
(let* ((info (clone info #:text '())) ;; FIXME: goto in body...
|
(let* ((info (clone info #:text '())) ;; FIXME: goto in body...
|
||||||
|
|
|
@ -128,10 +128,8 @@ swits (int c)
|
||||||
}
|
}
|
||||||
case -1:
|
case -1:
|
||||||
case 1:
|
case 1:
|
||||||
{
|
|
||||||
x = 1;
|
x = 1;
|
||||||
break;
|
break;
|
||||||
}
|
|
||||||
default:
|
default:
|
||||||
{
|
{
|
||||||
x = 2;
|
x = 2;
|
||||||
|
|
Loading…
Reference in a new issue