mescc: Tinycc support: Switch with heterogeneous body, non-last default.
* module/language/c99/compiler.mes (switch->info): New function. (ast->info): Use it for switch. (clause->info, statements->clauses): Remove. * scaffold/tests/44-switch.c (default_first): Test it.
This commit is contained in:
Jan Nieuwenhuizen
parent
8f8a4be83d
commit
7dfc88e22c
|
|
@ -1375,63 +1375,6 @@
|
|||
(define (comment? o)
|
||||
(and (pair? o) (pair? (car o)) (eq? (caar o) #:comment)))
|
||||
|
||||
(define (clause->info info i label last?)
|
||||
(define clause-label
|
||||
(string-append label "clause" (number->string i)))
|
||||
(define body-label
|
||||
(string-append label "body" (number->string i)))
|
||||
(define (jump label)
|
||||
(wrap-as (i386:jump label)))
|
||||
(define (jump-nz label)
|
||||
(wrap-as (i386:jump-nz label)))
|
||||
(define (jump-z label)
|
||||
(wrap-as (i386:jump-z label)))
|
||||
(define (test->text test)
|
||||
(let ((value (pmatch test
|
||||
(0 0)
|
||||
((p-expr (char ,value)) (char->integer (car (string->list value))))
|
||||
((p-expr (ident ,constant)) (assoc-ref (.constants info) constant))
|
||||
((p-expr (fixed ,value)) (cstring->number value))
|
||||
((neg (p-expr (fixed ,value))) (- (cstring->number value)))
|
||||
(_ (error "case test: not supported: " test)))))
|
||||
(append (wrap-as (i386:accu-cmp-value value))
|
||||
(jump-z body-label))))
|
||||
(define (cases+jump info cases)
|
||||
(let* ((info (append-text info (wrap-as `((#:label ,clause-label)))))
|
||||
(next-clause-label (if last? (string-append label "break")
|
||||
(string-append label "clause" (number->string (1+ i)))))
|
||||
(info (append-text info (apply append cases)))
|
||||
(info (if (null? cases) info
|
||||
(append-text info (jump next-clause-label))))
|
||||
(info (append-text info (wrap-as `((#:label ,body-label))))))
|
||||
info))
|
||||
|
||||
(lambda (o)
|
||||
(let loop ((o o) (cases '()) (clause #f))
|
||||
(pmatch o
|
||||
((case ,test ,statement)
|
||||
(loop statement (append cases (list (test->text test))) clause))
|
||||
((default ,statement)
|
||||
(loop statement cases clause))
|
||||
((default . ,statements)
|
||||
(loop `(compd-stmt (block-item-list ,@statements)) cases clause))
|
||||
((compd-stmt (block-item-list))
|
||||
(loop '() cases clause))
|
||||
((compd-stmt (block-item-list . ,elements))
|
||||
(let ((clause (or clause (cases+jump info cases))))
|
||||
(loop `(compd-stmt (block-item-list ,@(cdr elements))) cases
|
||||
(ast->info (car elements) clause))))
|
||||
(()
|
||||
(let ((clause (or clause (cases+jump info cases))))
|
||||
(if last? clause
|
||||
(let ((next-body-label (string-append label "body"
|
||||
(number->string (1+ i)))))
|
||||
(append-text clause (wrap-as (i386:jump next-body-label)))))))
|
||||
(_
|
||||
(let ((clause (or clause (cases+jump info cases))))
|
||||
(loop '() cases
|
||||
(ast->info o clause))))))))
|
||||
|
||||
(define (test-jump-label->info info label)
|
||||
(define (jump type . test)
|
||||
(lambda (o)
|
||||
|
|
@ -1622,49 +1565,6 @@
|
|||
((pointer (pointer (pointer))) 3)
|
||||
(_ (error "ptr-declr->rank not supported: " 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: not supported:" s)))))))
|
||||
|
||||
(define (ast->info o info)
|
||||
(let ((functions (.functions info))
|
||||
(globals (.globals info))
|
||||
|
|
@ -1751,16 +1651,36 @@
|
|||
info))
|
||||
|
||||
((switch ,expr (compd-stmt (block-item-list . ,statements)))
|
||||
(define (clause? o)
|
||||
(pmatch o
|
||||
((case . _) 'case)
|
||||
((default . _) 'default)
|
||||
((labeled-stmt _ ,statement) (clause? statement))
|
||||
(_ #f)))
|
||||
(define clause-number
|
||||
(let ((i 0))
|
||||
(lambda (o)
|
||||
(let ((n i))
|
||||
(when (clause? (car o))
|
||||
(set! i (1+ i)))
|
||||
n))))
|
||||
(let* ((info (append-text info (ast->comment `(switch ,expr (compd-stmt (block-item-list (ellipsis)))))))
|
||||
(here (number->string (length text)))
|
||||
(label (string-append "_" (.function info) "_" here "_"))
|
||||
(break-label (string-append label "break"))
|
||||
(clauses (statements->clauses statements))
|
||||
(info (expr->accu expr info))
|
||||
(info (clone info #:break (cons break-label (.break info))))
|
||||
(info (let loop ((clauses clauses) (i 0) (info info))
|
||||
(if (null? clauses) info
|
||||
(loop (cdr clauses) (1+ i) ((clause->info info i label (null? (cdr clauses))) (car clauses))))))
|
||||
(count (length (filter clause? statements)))
|
||||
(default? (find (cut eq? <> 'default) (map clause? statements)))
|
||||
(info (fold (cut switch->info #t label (1- count) <> <> <>) info statements
|
||||
(unfold null? clause-number cdr statements)))
|
||||
(last-clause-label (string-append label "clause" (number->string count)))
|
||||
(default-label (string-append label "default"))
|
||||
(info (if (not default?) info
|
||||
(append-text info (wrap-as (i386:jump break-label)))))
|
||||
(info (append-text info (wrap-as `((#:label ,last-clause-label)))))
|
||||
(info (if (not default?) info
|
||||
(append-text info (wrap-as (i386:jump default-label)))))
|
||||
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
||||
(clone info
|
||||
#:locals locals
|
||||
|
|
@ -1872,6 +1792,91 @@
|
|||
(define (ast-list->info o info)
|
||||
(fold ast->info info o))
|
||||
|
||||
(define (switch->info clause? label count o i info)
|
||||
(let* ((i-string (number->string i))
|
||||
(i+1-string (number->string (1+ i)))
|
||||
(body-label (string-append label "body" i-string))
|
||||
(clause-label (string-append label "clause" i-string))
|
||||
(last? (= i count))
|
||||
(break-label (string-append label "break"))
|
||||
(next-clause-label (string-append label "clause" i+1-string))
|
||||
(default-label (string-append label "default")))
|
||||
(define (jump label)
|
||||
(wrap-as (i386:jump label)))
|
||||
(pmatch o
|
||||
((case ,test)
|
||||
(define (jump-nz label)
|
||||
(wrap-as (i386:jump-nz label)))
|
||||
(define (jump-z label)
|
||||
(wrap-as (i386:jump-z label)))
|
||||
(define (test->text test)
|
||||
(let ((value (pmatch test
|
||||
(0 0)
|
||||
((p-expr (char ,value)) (char->integer (car (string->list value))))
|
||||
((p-expr (ident ,constant)) (assoc-ref (.constants info) constant))
|
||||
((p-expr (fixed ,value)) (cstring->number value))
|
||||
((neg (p-expr (fixed ,value))) (- (cstring->number value)))
|
||||
(_ (error "case test: not supported: " test)))))
|
||||
(append (wrap-as (i386:accu-cmp-value value))
|
||||
(jump-z body-label))))
|
||||
(let ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info)))
|
||||
(append-text info (test->text test))))
|
||||
((case ,test (case . ,case1))
|
||||
(let ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info)))
|
||||
(fold (cut switch->info #f label count <> i <>) info (cons `(case ,test) `((case ,@case1))))))
|
||||
((case ,test (default . ,rest))
|
||||
(let ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info)))
|
||||
(fold (cut switch->info #f label count <> i <>) info (cons `(case ,test) `(default ,@rest)))))
|
||||
((case ,test ,statement)
|
||||
(let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info))
|
||||
(info (switch->info #f label count `(case ,test) i info))
|
||||
(info (append-text info (jump next-clause-label)))
|
||||
(info (append-text info (wrap-as `((#:label ,body-label))))))
|
||||
(ast->info statement info)))
|
||||
((case ,test (case . ,case1) . ,rest)
|
||||
(let ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info)))
|
||||
(fold (cut switch->info #f label count <> i <>) info (cons `(case ,test) `((case ,@case1) ,@rest)))))
|
||||
((default (case . ,case1) . ,rest)
|
||||
(let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info))
|
||||
(info (if last? info
|
||||
(append-text info (jump next-clause-label))))
|
||||
(info (append-text info (wrap-as `((#:label ,default-label)))))
|
||||
(info (append-text info (jump body-label))))
|
||||
(fold (cut switch->info #f label count <> i <>) info `((case ,@case1) ,@rest))))
|
||||
(default
|
||||
(let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info))
|
||||
(info (if last? info
|
||||
(append-text info (jump next-clause-label))))
|
||||
(info (append-text info (wrap-as `((#:label ,default-label))))))
|
||||
(append-text info (jump body-label))))
|
||||
((default ,statement)
|
||||
(let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info))
|
||||
(info (if last? info
|
||||
(append-text info (jump next-clause-label))))
|
||||
(info (append-text info (wrap-as `((#:label ,body-label)))))
|
||||
(info (append-text info (wrap-as `((#:label ,default-label))))))
|
||||
(ast->info statement info)))
|
||||
((default ,statement ,rest)
|
||||
(let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
|
||||
info))
|
||||
(info (if last? info
|
||||
(append-text info (jump next-clause-label))))
|
||||
(info (append-text info (wrap-as `((#:label ,body-label)))))
|
||||
(info (append-text info (wrap-as `((#:label ,default-label))))))
|
||||
(fold ast->info (ast->info statement info) rest)))
|
||||
((labeled-stmt (ident ,goto-label) ,statement)
|
||||
(let ((info (append-text info `(((#:label ,(string-append "_" (.function info) "_label_" goto-label)))))))
|
||||
(switch->info clause? label count statement i info)))
|
||||
(_ (ast->info o info)))))
|
||||
|
||||
(define (global->static function)
|
||||
(lambda (o)
|
||||
(cons (car o) (set-field (cdr o) (global:function) function))))
|
||||
|
|
|
|||
|
|
@ -30,10 +30,10 @@ swits (int c)
|
|||
|
||||
switch (c)
|
||||
{
|
||||
case TCHAR: {goto next;}
|
||||
case 1: {goto next;}
|
||||
case 2: {goto next;}
|
||||
default: {goto next;}
|
||||
case TCHAR: {puts ("TCHAR\n"); goto next;}
|
||||
case 1: {puts ("1\n"); goto next;}
|
||||
case 2: {puts ("2\n"); goto next;}
|
||||
default: {puts ("default\n"); goto next;}
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
|
@ -42,6 +42,7 @@ swits (int c)
|
|||
{
|
||||
case 0:
|
||||
{
|
||||
puts ("0\n");
|
||||
x = 0;
|
||||
c = 34;
|
||||
break;
|
||||
|
|
@ -52,9 +53,11 @@ swits (int c)
|
|||
case 2:
|
||||
case -1:
|
||||
case 1:
|
||||
puts ("5..1, -1\n");
|
||||
x = 1;
|
||||
break;
|
||||
default:
|
||||
puts ("default\n");
|
||||
x = 2;
|
||||
x = 2;
|
||||
break;
|
||||
|
|
@ -62,21 +65,92 @@ swits (int c)
|
|||
return x;
|
||||
}
|
||||
|
||||
int
|
||||
default_first (int c)
|
||||
{
|
||||
int a;
|
||||
switch (c)
|
||||
{
|
||||
here:
|
||||
default:
|
||||
a = 1;
|
||||
{
|
||||
}
|
||||
a = 2;
|
||||
return a;
|
||||
there:
|
||||
case 0:
|
||||
;
|
||||
{}
|
||||
return 0;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
int
|
||||
test ()
|
||||
{
|
||||
puts ("\n");
|
||||
puts ("t: switch 0\n");
|
||||
if (swits (0) != 0) return swits (0);
|
||||
int i = swits (0);
|
||||
if (i != 0)
|
||||
return i;
|
||||
|
||||
puts ("t: switch 1\n");
|
||||
if (swits (1) != 1) return 1;
|
||||
if (swits (1) != 1)
|
||||
return 10;
|
||||
|
||||
puts ("t: switch -1\n");
|
||||
if (swits (-1) != 1) return 1;
|
||||
if (swits (-1) != 1)
|
||||
return 11;
|
||||
|
||||
puts ("t: switch -1\n");
|
||||
if (swits (-2) != 2) return 1;
|
||||
if (swits (-2) != 2)
|
||||
return 12;
|
||||
|
||||
return 0;
|
||||
if (default_first (1) != 2)
|
||||
return 13;
|
||||
|
||||
if (default_first (0) != 0)
|
||||
return 14;
|
||||
|
||||
i = 15;
|
||||
switch (i)
|
||||
{
|
||||
case 0:
|
||||
case 1:
|
||||
case 2:
|
||||
case 3:
|
||||
case 4:
|
||||
i = 15;
|
||||
break;
|
||||
}
|
||||
if (i != 15)
|
||||
return 15;
|
||||
|
||||
i = 16;
|
||||
switch (i)
|
||||
{
|
||||
case 1:
|
||||
default:
|
||||
case 0:
|
||||
i = 0;
|
||||
break;
|
||||
}
|
||||
|
||||
if (i!= 0)
|
||||
return 16;
|
||||
|
||||
i = 2;
|
||||
switch (i)
|
||||
{
|
||||
default:
|
||||
case 0:
|
||||
i = 17;
|
||||
break;
|
||||
case 2:
|
||||
i = 0;
|
||||
}
|
||||
|
||||
return i;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue