artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Fix switch statements' fallthrough

Browse source 
Flattens case structures as nyacc is giving consecutive cases as a
nested block like:

    (case testA
      (case testB
        (case testC BODY)))

We convert to:

    ((case testA (expr-stmt))
     (case testB (expr-stmt))
     (case testC BODY))

And then treat them as independent cases. For the fallthrough we just
add a jump to each case's body right before its clause (each of the case
blocks is responsible of adding its own jump to its body):

        // This doesn't have it because it's the first
    CASE1:
        testA
    CASE1_BODY:

        goto CASE2_BODY
    CASE2:
        testB
    CASE2_BODY:

        goto CASE3_BODY
    CASE3:
        testB
    CASE3_BODY:

This enables complex fallthrough schemes comparing to what was done
before.

* module/mescc/compile.scm (ast->info)[switch]{flatten-cases}: New
variable.
(ast->info)[switch]{statements}: Use flatten-cases on it.
(switch->expr): Remove unneeded matchers and add jumps to body.
* build-aux/check-mescc.sh(xfail-tests): Remove
lib/tests/scaffold/66-local-char-array.c.
This commit is contained in:
Ekaitz Zarraga 2023-09-12 14:07:04 +02:00 committed by Janneke Nieuwenhuizen
parent 85f97b6881
commit 47cffc5d2a
2 changed files with 28 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
build-aux/check-mescc.sh
View file

@ -253,7 +253,6 @@ if test $compiler = mescc; then
xfail_tests="$xfail_tests
lib/tests/scaffold/17-compare-unsigned-char-le.c
lib/tests/scaffold/17-compare-unsigned-short-le.c
lib/tests/scaffold/66-local-char-array.c
lib/tests/scaffold/70-ternary-arithmetic-argument.c
lib/tests/mes/90-abtod.c
lib/tests/mes/90-dtoab.c

43
module/mescc/compile.scm
View file

@ -1790,7 +1790,31 @@
(when (clause? (car o))
(set! i (1+ i)))
n))))
(define (flatten-cases c)
(define (flatten-case o)
(pmatch o
((case ,test (case . ,body))
(cons `(case ,test (expr-stmt)) (flatten-case `(case ,@body))))
((case ,test ,case-body (case . ,body))
(cons `(case ,test ,case-body) (flatten-case `(case ,@body))))
((default (case . ,body))
(cons `(default (expr-stmt)) (flatten-case `(case ,@body))))
((default ,default-body (case . ,body))
(cons `(default ,default-body) (flatten-case `(case ,@body))))
((case ,test (default . ,body))
(cons `(case ,test (expr-stmt)) (flatten-case `(default ,@body))))
((default ,rest)
(list o))
((case ,test)
(list o))
((case ,test ,expr)
(list o))
(,s (list s))))
(fold (lambda (x acc) (append acc (flatten-case x))) '() c))
(let* ((info (append-text info (ast->comment `(switch ,expr (compd-stmt (block-item-list (ellipsis)))))))
(statements (flatten-cases statements))
(here (number->string (length text)))
(label (string-append "_" (.function info) "_" here "_"))
(break-label (string-append label "break"))
@ -1926,8 +1950,8 @@
(let* ((i-string (number->string i))
(i+1-string (number->string (1+ i)))
(body-label (string-append label "body" i-string))
(next-body-label (string-append label "body" i+1-string))
(clause-label (string-append label "clause" i-string))
(first? (= i 0))
(last? (= i count))
(break-label (string-append label "break"))
(next-clause-label (string-append label "clause" i+1-string))
@ -1953,30 +1977,19 @@
(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))))
(let* ((info (if first? info (append-text info (jump body-label)))) ; Enables fallthrough
(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)))))
(info (ast->info statement info))
;; 66-local-char-array -- fallthrough FIXME
;; (info (if last? info
;; (append-text info (jump next-body-label))))
)
(info (ast->info statement info)))
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))