mescc: Remove jump calculation, use labels: switch.
* module/language/c99/compiler.mes (expr->accu): Refactor (switch ...). (clause->info): Refactor.
This commit is contained in:
Jan Nieuwenhuizen
parent
36e0219af3
commit
7d7126bf0d
|
|
@ -1006,18 +1006,17 @@
|
|||
(let ((s (string-drop o (string-length prefix))))
|
||||
(map byte->hex (string-split s #\space))))))
|
||||
|
||||
(define (clause->jump-info info)
|
||||
(define (jump n)
|
||||
(wrap-as (i386:Xjump n)))
|
||||
(define (jump-nz n)
|
||||
(wrap-as (i386:Xjump-nz n)))
|
||||
(define (jump-z n)
|
||||
(wrap-as (i386:Xjump-z n)))
|
||||
(define (statement->info info body-length)
|
||||
(lambda (o)
|
||||
(pmatch o
|
||||
((break) (append-text info (jump body-length)))
|
||||
(_ ((ast->info info) o)))))
|
||||
(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 `(#:local ,label))))
|
||||
(define (jump-nz label)
|
||||
(wrap-as (i386:jump-label-nz `(#:local ,label))))
|
||||
(define (jump-z label)
|
||||
(wrap-as (i386:jump-label-z `(#:local ,label))))
|
||||
(define (test->text test)
|
||||
(let ((value (pmatch test
|
||||
(0 0)
|
||||
|
|
@ -1026,42 +1025,41 @@
|
|||
((p-expr (fixed ,value)) (cstring->number value))
|
||||
((neg (p-expr (fixed ,value))) (- (cstring->number value)))
|
||||
(_ (error "case test: unsupported: " test)))))
|
||||
(lambda (n)
|
||||
(append (wrap-as (i386:accu-cmp-value value))
|
||||
(jump-z (+ (length (object->list (jump 0)))
|
||||
(if (= n 0) 0
|
||||
(* n (length (object->list ((test->text 0) 0)))))))))))
|
||||
(define (cases+jump cases clause-length)
|
||||
(append-text info
|
||||
(append
|
||||
(append-map (lambda (t i) (t i)) cases (reverse (iota (length cases))))
|
||||
(if (null? cases) '()
|
||||
(jump clause-length)))))
|
||||
(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 (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)
|
||||
(lambda (body-length)
|
||||
(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))
|
||||
((compd-stmt (block-item-list))
|
||||
(loop '() cases clause))
|
||||
((compd-stmt (block-item-list . ,elements))
|
||||
(let ((clause (or clause (cases+jump cases 0))))
|
||||
(loop `(compd-stmt (block-item-list ,@(cdr elements))) cases
|
||||
((statement->info clause body-length) (car elements)))))
|
||||
(()
|
||||
(let* ((cases-length (length (.text (cases+jump cases 0))))
|
||||
(clause-text (list-tail (.text clause) cases-length))
|
||||
(clause-length (length (object->list clause-text))))
|
||||
(clone clause #:text
|
||||
(append (.text (cases+jump cases clause-length))
|
||||
clause-text))))
|
||||
(_
|
||||
(let ((clause (or clause (cases+jump cases 0))))
|
||||
(loop '() cases
|
||||
((statement->info clause body-length) 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))
|
||||
((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 clause) (car elements)))))
|
||||
(()
|
||||
(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-label `(#:local ,next-body-label))))))))
|
||||
(_
|
||||
(let ((clause (or clause (cases+jump info cases))))
|
||||
(loop '() cases
|
||||
((ast->info clause) o))))))))
|
||||
|
||||
(define (test->jump->info info)
|
||||
(define (jump type . test)
|
||||
|
|
@ -1403,7 +1401,9 @@
|
|||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(if ,test (ellipsis))))))
|
||||
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||
(here (number->string (length text)))
|
||||
(break-label (string-append (.function info) "_break_" here))
|
||||
(label (string-append (.function info) "_" here "_"))
|
||||
(break-label (string-append label "break"))
|
||||
(else-label (string-append label "else"))
|
||||
(info ((test-jump-label->info info break-label) test))
|
||||
(info ((ast->info info) then))
|
||||
(info (append-text info (wrap-as (i386:jump-label `(#:local ,break-label)))))
|
||||
|
|
@ -1415,8 +1415,9 @@
|
|||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(if ,test (ellipsis) (ellipsis))))))
|
||||
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||
(here (number->string (length text)))
|
||||
(else-label (string-append (.function info) "_else_" here))
|
||||
(break-label (string-append (.function info) "_break_" here))
|
||||
(label (string-append (.function info) "_" here "_"))
|
||||
(break-label (string-append label "break"))
|
||||
(else-label (string-append label "else"))
|
||||
(info ((test-jump-label->info info else-label) test))
|
||||
(info ((ast->info info) then))
|
||||
(info (append-text info (wrap-as (i386:jump-label `(#:local ,break-label)))))
|
||||
|
|
@ -1431,8 +1432,9 @@
|
|||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(cond-expr ,test (ellipsis) (ellipsis))))))
|
||||
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||
(here (number->string (length text)))
|
||||
(else-label (string-append (.function info) "_else_" here))
|
||||
(break-label (string-append (.function info) "_break_" here))
|
||||
(label (string-append (.function info) "_" here "_"))
|
||||
(else-label (string-append label "else"))
|
||||
(break-label (string-append label "break"))
|
||||
(info ((test-jump-label->info info else-label) test))
|
||||
(info ((ast->info info) then))
|
||||
(info (append-text info (wrap-as (i386:jump-label `(#:local ,break-label)))))
|
||||
|
|
@ -1442,25 +1444,31 @@
|
|||
info))
|
||||
|
||||
((switch ,expr (compd-stmt (block-item-list . ,statements)))
|
||||
(let* ((clauses (statements->clauses statements))
|
||||
(expr ((expr->accu info) expr))
|
||||
(empty (clone info #:text '()))
|
||||
(clause-infos (map (clause->jump-info empty) clauses))
|
||||
(clause-lengths (map (lambda (c-j) (length (object->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))
|
||||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(switch ,expr (compd-stmt (block-item-list (ellipsis))))))))
|
||||
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||
(here (number->string (length text)))
|
||||
(label (string-append (.function info) "_" here "_"))
|
||||
(break-label (string-append label "break"))
|
||||
(clauses (statements->clauses statements))
|
||||
(info ((expr->accu info) expr))
|
||||
(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))))))
|
||||
(info (append-text info (wrap-as `(#:label ,break-label)))))
|
||||
(clone info
|
||||
#:locals locals
|
||||
#:break (cdr (.break info)))))
|
||||
|
||||
((for ,init ,test ,step ,body)
|
||||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(for ,init ,test ,step (ellipsis))))))
|
||||
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||
(here (number->string (length text)))
|
||||
(loop-label (string-append (.function info) "_loop_" here))
|
||||
(continue-label (string-append (.function info) "_continue_" here))
|
||||
(initial-skip-label (string-append (.function info) "_initial_skip_" here))
|
||||
(break-label (string-append (.function info) "_break_" here))
|
||||
(label (string-append (.function info) "_" here "_"))
|
||||
(break-label (string-append label "break"))
|
||||
(loop-label (string-append label "loop"))
|
||||
(continue-label (string-append label "continue"))
|
||||
(initial-skip-label (string-append label "initial_skip"))
|
||||
(info ((ast->info info) init))
|
||||
(info (clone info #:break (cons break-label (.break info))))
|
||||
(info (clone info #:continue (cons continue-label (.continue info))))
|
||||
|
|
@ -1482,9 +1490,10 @@
|
|||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(while ,test (ellipsis))))))
|
||||
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||
(here (number->string (length text)))
|
||||
(loop-label (string-append (.function info) "_loop_" here))
|
||||
(continue-label (string-append (.function info) "_continue_" here))
|
||||
(break-label (string-append (.function info) "_break_" here))
|
||||
(label (string-append (.function info) "_" here "_"))
|
||||
(break-label (string-append label "break"))
|
||||
(loop-label (string-append label "loop"))
|
||||
(continue-label (string-append label "continue"))
|
||||
(info (append-text info (wrap-as (i386:jump-label `(#:local ,continue-label)))))
|
||||
(info (clone info #:break (cons break-label (.break info))))
|
||||
(info (clone info #:continue (cons continue-label (.continue info))))
|
||||
|
|
@ -1503,9 +1512,10 @@
|
|||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(do-while ,test (ellipsis))))))
|
||||
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||
(here (number->string (length text)))
|
||||
(loop-label (string-append (.function info) "_loop_" here))
|
||||
(continue-label (string-append (.function info) "_continue_" here))
|
||||
(break-label (string-append (.function info) "_break_" here))
|
||||
(label (string-append (.function info) "_" here "_"))
|
||||
(break-label (string-append label "break"))
|
||||
(loop-label (string-append label "loop"))
|
||||
(continue-label (string-append label "continue"))
|
||||
(info (clone info #:break (cons break-label (.break info))))
|
||||
(info (clone info #:continue (cons continue-label (.continue info))))
|
||||
(info (append-text info (wrap-as `(#:label ,loop-label))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue