From 6dc19bd040ee2aab62166b47442f3fd830db988c Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 6 May 2017 08:39:04 +0200 Subject: [PATCH] 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. --- module/language/c99/compiler.mes | 64 +++++++++++++++++++++++++++----- scaffold/t.c | 6 +-- 2 files changed, 56 insertions(+), 14 deletions(-) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 30980adc..a5b8db2a 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -858,7 +858,7 @@ (let ((s (string-drop o (string-length prefix)))) (map byte->hex (string-split s #\space)))))) -(define (case->jump-info info) +(define (clause->jump-info info) (define (jump n) (wrap-as (i386:Xjump n))) (define (jump-nz n) @@ -1092,6 +1092,49 @@ (define (local? o) ;; formals < 0, locals > 0 (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) (lambda (o) (let ((globals (.globals info)) @@ -1217,16 +1260,17 @@ else-text) #:globals (.globals else-info)))) - ((switch ,expr (compd-stmt (block-item-list . ,cases))) - (let* ((expr ((expr->accu info) expr)) + ((switch ,expr (compd-stmt (block-item-list . ,statements))) + (let* ((clauses (statements->clauses statements)) + (expr ((expr->accu info) expr)) (empty (clone info #:text '())) - (case-infos (map (case->jump-info empty) cases)) - (case-lengths (map (lambda (c-j) (length (text->list (.text (c-j 0))))) case-infos)) - (cases-info (let loop ((cases cases) (info expr) (lengths case-lengths)) - (if (null? cases) info - (let ((c-j ((case->jump-info info) (car cases)))) - (loop (cdr cases) (c-j (apply + (cdr lengths))) (cdr lengths))))))) - cases-info)) + (clause-infos (map (clause->jump-info empty) clauses)) + (clause-lengths (map (lambda (c-j) (length (text->list (.text (c-j 0))))) clause-infos)) + (clauses-info (let loop ((clauses clauses) (info expr) (lengths clause-lengths)) + (if (null? clauses) info + (let ((c-j ((clause->jump-info info) (car clauses)))) + (loop (cdr clauses) (c-j (apply + (cdr lengths))) (cdr lengths))))))) + clauses-info)) ((for ,init ,test ,step ,body) (let* ((info (clone info #:text '())) ;; FIXME: goto in body... diff --git a/scaffold/t.c b/scaffold/t.c index 8e8fa8b2..c4c6f0b0 100644 --- a/scaffold/t.c +++ b/scaffold/t.c @@ -128,10 +128,8 @@ swits (int c) } case -1: case 1: - { - x = 1; - break; - } + x = 1; + break; default: { x = 2;