mescc: Remove jump calculation, use labels: while.
* module/language/c99/compiler.mes (ast->info): Refactor (while ...) using test-jump-label->info.
This commit is contained in:
parent
5bf3c92938
commit
9843f88d74
|
@ -1369,7 +1369,10 @@
|
||||||
info)
|
info)
|
||||||
|
|
||||||
((break)
|
((break)
|
||||||
(append-text info (wrap-as (i386:Xjump (- (car (.break info)) (length (object->list text)))))))
|
(let ((label (car (.break info))))
|
||||||
|
(if (number? label)
|
||||||
|
(append-text info (wrap-as (i386:Xjump (- label (length (object->list text))))));;REMOVEME
|
||||||
|
(append-text info (wrap-as (i386:jump-label `(#:local ,label)))))))
|
||||||
|
|
||||||
;; FIXME: expr-stmt wrapper?
|
;; FIXME: expr-stmt wrapper?
|
||||||
(trans-unit info)
|
(trans-unit info)
|
||||||
|
@ -1529,40 +1532,20 @@
|
||||||
|
|
||||||
((while ,test ,body)
|
((while ,test ,body)
|
||||||
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(while ,test (ellipsis))))))
|
(let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(while ,test (ellipsis))))))
|
||||||
;;(source (with-output-to-string (lambda () (pretty-print-c99 `(while ,test (compd-stmt (block-item-list)))))))
|
(info (append-text info (wrap-as `(#:comment ,source))))
|
||||||
(skip-info (lambda (body-length test-length)
|
(here (number->string (length text)))
|
||||||
(clone info
|
(while-label (string-append (.function info) "_while_" here))
|
||||||
#:text (append text (wrap-as (i386:Xjump body-length)))
|
(skip-label (string-append (.function info) "_skip_" here))
|
||||||
#:break (cons (+ (length (object->list text)) body-length test-length
|
(break-label (string-append (.function info) "_break_" here))
|
||||||
(length (i386:Xjump 0)))
|
(info (append-text info (wrap-as (i386:jump-label `(#:local ,skip-label)))))
|
||||||
(.break info)))))
|
(info (clone info #:break (cons break-label (.break info))))
|
||||||
(text (.text (skip-info 0 0)))
|
(info (append-text info (wrap-as `(#:label ,while-label))))
|
||||||
(text-length (length text))
|
(info ((ast->info info) body))
|
||||||
(body-info (lambda (body-length test-length)
|
(info (append-text info (wrap-as `(#:label ,skip-label))))
|
||||||
((ast->info (skip-info body-length test-length)) body)))
|
(info ((test-jump-label->info info break-label) test))
|
||||||
|
(info (append-text info (wrap-as (i386:jump-label `(#:local ,while-label)))))
|
||||||
(body-text (list-tail (.text (body-info 0 0)) text-length))
|
(info (append-text info (wrap-as `(#:label ,break-label)))))
|
||||||
(body-length (length (object->list body-text)))
|
(clone info #:break (cdr (.break info)))))
|
||||||
|
|
||||||
(empty (clone info #:text '()))
|
|
||||||
(test-jump->info ((test->jump->info empty) test))
|
|
||||||
(test+jump-info (test-jump->info 0))
|
|
||||||
(test-length (length (object->list (.text test+jump-info))))
|
|
||||||
|
|
||||||
(jump-text (wrap-as (i386:Xjump (- (+ body-length test-length)))))
|
|
||||||
(jump-length (length (object->list jump-text)))
|
|
||||||
|
|
||||||
(test-text (.text (test-jump->info jump-length)))
|
|
||||||
|
|
||||||
(body-info (body-info body-length (length (object->list test-text)))))
|
|
||||||
|
|
||||||
(clone info #:text
|
|
||||||
(append
|
|
||||||
(wrap-as `(#:comment ,source))
|
|
||||||
(.text body-info)
|
|
||||||
test-text
|
|
||||||
jump-text)
|
|
||||||
#:globals (.globals body-info))))
|
|
||||||
|
|
||||||
((do-while ,body ,test)
|
((do-while ,body ,test)
|
||||||
(let* ((text-length (length text))
|
(let* ((text-length (length text))
|
||||||
|
@ -1594,7 +1577,7 @@
|
||||||
((goto (ident ,label))
|
((goto (ident ,label))
|
||||||
(let* ((jump (lambda (n) (i386:XXjump n)))
|
(let* ((jump (lambda (n) (i386:XXjump n)))
|
||||||
(offset (+ (length (jump 0)) (length (object->list text)))))
|
(offset (+ (length (jump 0)) (length (object->list text)))))
|
||||||
(append-text info (list (i386:jump-label `(#:local ,label))))))
|
(append-text info (wrap-as (i386:jump-label `(#:local ,label))))))
|
||||||
|
|
||||||
((return ,expr)
|
((return ,expr)
|
||||||
(let ((info ((expr->accu info) expr)))
|
(let ((info ((expr->accu info) expr)))
|
||||||
|
|
Loading…
Reference in a new issue