mescc: Remove jump calculation, use labels: do while.

* module/language/c99/compiler.mes (ast->info): Refactor (do-while
  ...)  using test-jump-label->info.
This commit is contained in:
Jan Nieuwenhuizen 2017-06-12 19:00:24 +02:00
parent 42ca62b075
commit 0f19aba1a8

View file

@ -1541,27 +1541,24 @@
#:continue (cdr (.continue info))))) #:continue (cdr (.continue info)))))
((do-while ,body ,test) ((do-while ,body ,test)
(let* ((text-length (length text)) (let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(do-while ,test (ellipsis))))))
(info (append-text info (wrap-as `(#:comment ,source))))
(body-info ((ast->info info) body)) (here (number->string (length text)))
(body-text (list-tail (.text body-info) text-length)) (loop-label (string-append (.function info) "_loop_" here))
(body-length (length (object->list body-text))) (continue-label (string-append (.function info) "_continue_" here))
(break-label (string-append (.function info) "_break_" here))
(empty (clone info #:text '())) (info (clone info #:break (cons break-label (.break info))))
(test-jump->info ((test->jump->info empty) test)) (info (clone info #:continue (cons continue-label (.continue info))))
(test+jump-info (test-jump->info 0)) (info (append-text info (wrap-as `(#:label ,loop-label))))
(test-length (length (object->list (.text test+jump-info)))) (info ((ast->info info) body))
(info (append-text info (wrap-as `(#:label ,continue-label))))
(jump-text (wrap-as (i386:Xjump (- (+ body-length test-length))))) (info ((test-jump-label->info info break-label) test))
(jump-length (length (object->list jump-text))) (info (append-text info (wrap-as (i386:jump-label `(#:local ,loop-label)))))
(info (append-text info (wrap-as `(#:label ,break-label)))))
(test-text (.text (test-jump->info jump-length)))) (clone info
(clone info #:text #:locals locals
(append #:break (cdr (.break info))
(.text body-info) #:continue (cdr (.continue info)))))
test-text
jump-text)
#:globals (.globals body-info))))
((labeled-stmt (ident ,label) ,statement) ((labeled-stmt (ident ,label) ,statement)
(let ((info (append-text info `((#:label ,label))))) (let ((info (append-text info `((#:label ,label)))))