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

mescc: Factor-out append-text.

Browse source 
* module/language/c99/compiler.mes: Use append-text throughout.
This commit is contained in:
Jan Nieuwenhuizen 2017-04-07 09:53:56 +02:00
parent 7ccbc00047
commit 68d90aa645
1 changed files with 193 additions and 294 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

255
module/language/c99/compiler.mes
View file

@ -250,7 +250,7 @@
(define (expr->arg info) (define (expr->arg info)
(lambda (o) (lambda (o)
(let ((info ((expr->accu info) o))) (let ((info ((expr->accu info) o)))
(clone info #:text (append (.text info) (wrap-as (i386:push-accu))))))) (append-text info (wrap-as (i386:push-accu))))))
(define (expr->arg info) ;; FIXME: get Mes curried-definitions (define (expr->arg info) ;; FIXME: get Mes curried-definitions
(lambda (o) (lambda (o)
@ -259,10 +259,10 @@
(pmatch o (pmatch o
((p-expr (string ,string)) ((p-expr (string ,string))
(clone info #:text (append text ((push-global-address info) (add-s:-prefix string))))) (append-text info ((push-global-address info) (add-s:-prefix string))))
((p-expr (ident ,name)) ((p-expr (ident ,name))
(clone info #:text (append text ((push-ident info) name)))) (append-text info ((push-ident info) name)))
((cast (type-name (decl-spec-list (type-spec (fixed-type _))) ((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
(abs-declr (pointer))) (abs-declr (pointer)))
@ -270,14 +270,13 @@
((expr->arg info) cast)) ((expr->arg info) cast))
((de-ref (p-expr (ident ,name))) ((de-ref (p-expr (ident ,name)))
(clone info #:text (append text ((push-ident-de-ref info) name)))) (append-text info ((push-ident-de-ref info) name)))
((ref-to (p-expr (ident ,name))) ((ref-to (p-expr (ident ,name)))
(clone info #:text (append text ((push-ident-address info) name)))) (append-text info ((push-ident-address info) name)))
(_ (let* ((info ((expr->accu info) o)) (_ (append-text ((expr->accu info) o)
(text (.text info))) (wrap-as (i386:push-accu))))))))
(clone info #:text (append text (wrap-as (i386:push-accu))))))))))
;; FIXME: see ident->base ;; FIXME: see ident->base
(define (ident->accu info) (define (ident->accu info)
@ -396,25 +395,22 @@
;; (stderr "expr->accu o=~a\n" o) ;; (stderr "expr->accu o=~a\n" o)
(pmatch o (pmatch o
((p-expr (string ,string)) ((p-expr (string ,string))
(clone info #:text (append text (list (lambda (f g ta t d) (append-text info (list (lambda (f g ta t d)
(i386:global->accu (+ (data-offset (add-s:-prefix string) globals) d))))))) (i386:global->accu (+ (data-offset (add-s:-prefix string) globals) d))))))
((p-expr (fixed ,value)) ((p-expr (fixed ,value))
(clone info #:text (append text (value->accu (cstring->number value))))) (append-text info (value->accu (cstring->number value))))
((p-expr (ident ,name)) ((p-expr (ident ,name))
(clone info #:text (append text ((ident->accu info) name)))) (append-text info ((ident->accu info) name)))
((initzer ,initzer) ((expr->accu info) initzer)) ((initzer ,initzer) ((expr->accu info) initzer))
((ref-to (p-expr (ident ,name))) ((ref-to (p-expr (ident ,name)))
(clone info #:text (append-text info ((ident->accu info) name)))
(append (.text info)
((ident->accu info) name))))
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name)))))) ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
(let* ((type (list "struct" name)) (let* ((type (list "struct" name))
(fields (or (type->description info type) '())) (fields (or (type->description info type) '()))
(size (type->size info type))) (size (type->size info type)))
(clone info #:text (append-text info (wrap-as (i386:value->accu size)))))
(append text (wrap-as (i386:value->accu size))))))
;; c+p expr->arg ;; c+p expr->arg
;; g_cells[<expr>] ;; g_cells[<expr>]
@ -422,8 +418,7 @@
(let* ((info ((expr->accu info) index)) (let* ((info ((expr->accu info) index))
(type (ident->type info array)) (type (ident->type info array))
(size (type->size info type))) (size (type->size info type)))
(clone info #:text (append-text info (append
(append (.text info)
;; immediate: (i386:value->accu (* size index)) ;; immediate: (i386:value->accu (* size index))
;; * size cells: * length * 4 = * 12 ;; * size cells: * length * 4 = * 12
(wrap-as (append (i386:accu->base) (wrap-as (append (i386:accu->base)
@ -445,9 +440,7 @@
(field-size 4) ;; FIXME:4, not fixed (field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(text (.text info))) (text (.text info)))
(clone info #:text (append-text info (append ((ident->accu info) array)
(append text
((ident->accu info) array)
(wrap-as (i386:mem+n->accu offset)))))) (wrap-as (i386:mem+n->accu offset))))))
;; g_cells[10].type ;; g_cells[10].type
@ -460,12 +453,11 @@
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(index (cstring->number index)) (index (cstring->number index))
(text (.text info))) (text (.text info)))
(clone info #:text (append-text info (append
(append text
(wrap-as (append (i386:value->base index) (wrap-as (append (i386:value->base index)
(i386:base->accu) (i386:base->accu)
(if (> count 1) (i386:accu+accu) '()) (if (<= count 1) '() (i386:accu+accu))
(if (= count 3) (i386:accu+base) '()) (if (<= count 2) '() (i386:accu+base))
(i386:accu-shl 2))) (i386:accu-shl 2)))
((ident->base info) array) ((ident->base info) array)
(wrap-as (i386:base-mem+n->accu offset)))))) (wrap-as (i386:base-mem+n->accu offset))))))
@ -479,12 +471,10 @@
(field-size 4) ;; FIXME:4, not fixed (field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(text (.text info))) (text (.text info)))
(clone info #:text (append-text info (append ((ident->base info) index)
(append text
((ident->base info) index)
(wrap-as (append (i386:base->accu) (wrap-as (append (i386:base->accu)
(if (> count 1) (i386:accu+accu) '()) (if (<= count 1) '() (i386:accu+accu))
(if (= count 3) (i386:accu+base) '()) (if (<= count 2) '() (i386:accu+base))
(i386:accu-shl 2))) (i386:accu-shl 2)))
((ident->base info) array) ((ident->base info) array)
(wrap-as (i386:base-mem+n->accu offset)))))) (wrap-as (i386:base-mem+n->accu offset))))))
@ -508,12 +498,10 @@
'()))) '())))
(offset (* field-size (1- (length rest)))) (offset (* field-size (1- (length rest))))
(text (.text info))) (text (.text info)))
(clone info #:text (append-text info (append (.text index)
(append text
(.text index)
(wrap-as (append (i386:accu->base) (wrap-as (append (i386:accu->base)
(if (> count 1) (i386:accu+accu) '()) (if (<= count 1) '() (i386:accu+accu))
(if (= count 3) (i386:accu+base) '()) (if (<= count 2) '() (i386:accu+base))
(i386:accu-shl 2))) (i386:accu-shl 2)))
((ident->base info) array) ((ident->base info) array)
(wrap-as (i386:base-mem+n->accu offset)))))) (wrap-as (i386:base-mem+n->accu offset))))))
@ -521,31 +509,25 @@
;;; FIXME: FROM INFO ...only zero?! ;;; FIXME: FROM INFO ...only zero?!
((p-expr (fixed ,value)) ((p-expr (fixed ,value))
(let ((value (cstring->number value))) (let ((value (cstring->number value)))
(clone info #:text (append-text info (wrap-as (i386:value->accu value)))))
(append text (wrap-as (i386:value->accu value))))))
((p-expr (char ,char)) ((p-expr (char ,char))
(let ((char (char->integer (car (string->list char))))) (let ((char (char->integer (car (string->list char)))))
(clone info #:text (append-text info (wrap-as (i386:value->accu char)))))
(append text (wrap-as (i386:value->accu char))))))
((p-expr (ident ,name)) ((p-expr (ident ,name))
(clone info #:text (append-text info ((ident->accu info) name)))
(append text
((ident->accu info) name))))
((de-ref (p-expr (ident ,name))) ((de-ref (p-expr (ident ,name)))
(let* ((type (ident->type info name)) (let* ((type (ident->type info name))
(size (and type (type->size info type)))) (size (and type (type->size info type))))
(clone info #:text (append-text info (append ((ident->accu info) name)
(append text
((ident->accu info) name)
(wrap-as (if (= size 1) (i386:byte-mem->accu) (wrap-as (if (= size 1) (i386:byte-mem->accu)
(i386:mem->accu))))))) (i386:mem->accu)))))))
((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
(clone info #:text (append text (wrap-as (asm->hex arg0))))) (append-text info (wrap-as (asm->hex arg0))))
(let* ((globals (append globals (filter-map expr->global expr-list))) (let* ((globals (append globals (filter-map expr->global expr-list)))
(info (clone info #:globals globals)) (info (clone info #:globals globals))
(text-length (length text)) (text-length (length text))
@ -592,38 +574,28 @@
((ast->info info) `(expr-stmt ,o))) ((ast->info info) `(expr-stmt ,o)))
((post-inc (p-expr (ident ,name))) ((post-inc (p-expr (ident ,name)))
(clone info #:text (append-text info (append ((ident->accu info) name)
(append text
((ident->accu info) name)
((ident-add info) name 1)))) ((ident-add info) name 1))))
((post-dec (p-expr (ident ,name))) ((post-dec (p-expr (ident ,name)))
(or (assoc-ref locals name) (begin (stderr "i-- ~a\n" name) barf)) (or (assoc-ref locals name) (begin (stderr "i-- ~a\n" name) barf))
(clone info #:text (append-text info (append ((ident->accu info) name)
(append text
((ident->accu info) name)
((ident-add info) name -1)))) ((ident-add info) name -1))))
((pre-inc (p-expr (ident ,name))) ((pre-inc (p-expr (ident ,name)))
(or (assoc-ref locals name) (begin (stderr "++i ~a\n" name) barf)) (or (assoc-ref locals name) (begin (stderr "++i ~a\n" name) barf))
(clone info #:text (append-text info (append ((ident-add info) name 1)
(append text
((ident-add info) name 1)
((ident->accu info) name)))) ((ident->accu info) name))))
((pre-dec (p-expr (ident ,name))) ((pre-dec (p-expr (ident ,name)))
(or (assoc-ref locals name) (begin (stderr "--i ~a\n" name) barf)) (or (assoc-ref locals name) (begin (stderr "--i ~a\n" name) barf))
(clone info #:text (append-text info (append ((ident-add info) name -1)
(append text
((ident-add info) name -1)
((ident->accu info) name)))) ((ident->accu info) name))))
((add (p-expr (ident ,name)) ,b) ((add (p-expr (ident ,name)) ,b)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text base)
(append text
(.text base)
((ident->accu info) name) ((ident->accu info) name)
(wrap-as (i386:accu+base)))))) (wrap-as (i386:accu+base))))))
@ -631,9 +603,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu+base)))))) (wrap-as (i386:accu+base))))))
@ -641,9 +611,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu-base)))))) (wrap-as (i386:accu-base))))))
@ -651,9 +619,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu-or-base)))))) (wrap-as (i386:accu-or-base))))))
@ -661,9 +627,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu<<base)))))) (wrap-as (i386:accu<<base))))))
@ -671,9 +635,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu>>base)))))) (wrap-as (i386:accu>>base))))))
@ -681,9 +643,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu/base)))))) (wrap-as (i386:accu/base))))))
@ -691,9 +651,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text ;;FIXME:empty
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu%base)))))) (wrap-as (i386:accu%base))))))
@ -701,9 +659,7 @@
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text accu)
(append text
(.text accu)
(.text base) (.text base)
(wrap-as (i386:accu*base)))))) (wrap-as (i386:accu*base))))))
@ -715,11 +671,10 @@
#:globals (.globals test-info)))) #:globals (.globals test-info))))
((neg (p-expr (fixed ,value))) ((neg (p-expr (fixed ,value)))
(clone info #:text (append text (value->accu (- (cstring->number value)))))) (append-text info (value->accu (- (cstring->number value)))))
((neg (p-expr (ident ,name))) ((neg (p-expr (ident ,name)))
(clone info #:text (append text (append-text info (append ((ident->base info) name)
((ident->base info) name)
(wrap-as (i386:value->accu 0)) (wrap-as (i386:value->accu 0))
(wrap-as (i386:sub-base))))) (wrap-as (i386:sub-base)))))
@ -742,14 +697,11 @@
barf) barf)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text base)
(append text
(.text base)
((base->ident-address info) name) ((base->ident-address info) name)
((ident->accu info) name) ((ident->accu info) name)
((ident-add info) name 1))))) ((ident-add info) name 1)))))
;; *p-- = b; ;; *p-- = b;
((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b) ((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
(when (not (equal? op "=")) (when (not (equal? op "="))
@ -757,14 +709,11 @@
barf) barf)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append-text info (append (.text base)
(append text
(.text base)
((base->ident-address info) name) ((base->ident-address info) name)
((ident->accu info) name) ((ident->accu info) name)
((ident-add info) name -1))))) ((ident-add info) name -1)))))
;; CAR (x) = 0 ;; CAR (x) = 0
;; TYPE (x) = PAIR; ;; TYPE (x) = PAIR;
((assn-expr (d-sel (ident ,field) . ,d-sel) (op ,op) ,b) ((assn-expr (d-sel (ident ,field) . ,d-sel) (op ,op) ,b)
@ -779,8 +728,7 @@
(size (type->size info type)) (size (type->size info type))
(field-size 4) ;; FIXME:4, not fixed (field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) ) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) )
(clone info #:text (append text (append-text info (append (.text expr)
(.text expr)
(.text base) (.text base)
(wrap-as (i386:base->accu-address)))))) ; FIXME: size (wrap-as (i386:base->accu-address)))))) ; FIXME: size
@ -797,8 +745,7 @@
barf) barf)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append text (append-text info (append (.text base)
(.text base)
(if (equal? op "=") '() (if (equal? op "=") '()
(append ((ident->accu info) name) (append ((ident->accu info) name)
(wrap-as (append (if (equal? op "+=") (i386:accu+base) (wrap-as (append (if (equal? op "+=") (i386:accu+base)
@ -815,8 +762,7 @@
barf) barf)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (append text (append-text info (append (.text base)
(.text base)
;;assign: ;;assign:
((base->ident-address info) array) ((base->ident-address info) array)
(wrap-as (i386:base->accu)))))) (wrap-as (i386:base->accu))))))
@ -831,9 +777,7 @@
(type (ident->type info array)) (type (ident->type info array))
(size (type->size info type)) (size (type->size info type))
(ptr (ident->pointer info array))) (ptr (ident->pointer info array)))
(clone info #:text (append-text info (append
(append (.text info)
(if (eq? size 1) (wrap-as (i386:byte-base->accu-address)) (if (eq? size 1) (wrap-as (i386:byte-base->accu-address))
(append (append
(wrap-as (i386:base-address->accu-address)) (wrap-as (i386:base-address->accu-address))
@ -889,9 +833,7 @@
(let* ((info ((expr->accu info) index)) (let* ((info ((expr->accu info) index))
(type (ident->type info array)) (type (ident->type info array))
(size (type->size info type))) (size (type->size info type)))
(clone info #:text (append-text info (append (wrap-as (append (i386:accu->base)
(append (.text info)
(wrap-as (append (i386:accu->base)
(if (eq? size 1) '() (if (eq? size 1) '()
(append (append
(if (<= size 4) '() (if (<= size 4) '()
@ -912,9 +854,7 @@
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(index (cstring->number index)) (index (cstring->number index))
(text (.text info))) (text (.text info)))
(clone info #:text (append-text info (append (wrap-as (append (i386:value->base index)
(append text
(wrap-as (append (i386:value->base index)
(i386:base->accu) (i386:base->accu)
(if (<= count 1) '() (if (<= count 1) '()
(i386:accu+accu)) (i386:accu+accu))
@ -936,9 +876,7 @@
(field-size 4) ;; FIXME:4, not fixed (field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(text (.text info))) (text (.text info)))
(clone info #:text (append-text info (append ((ident->base info) index)
(append text
((ident->base info) index)
(wrap-as (append (i386:base->accu) (wrap-as (append (i386:base->accu)
(if (<= count 1) '() (if (<= count 1) '()
(i386:accu+accu)) (i386:accu+accu))
@ -958,9 +896,7 @@
(field-size 4) ;; FIXME (field-size 4) ;; FIXME
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(text (.text info))) (text (.text info)))
(clone info #:text (append-text info (append ((ident->accu info) name)
(append text
((ident->accu info) name)
(wrap-as (i386:accu+value offset)))))) (wrap-as (i386:accu+value offset))))))
(_ (_
@ -1020,8 +956,7 @@
(define (statement->info info body-length) (define (statement->info info body-length)
(lambda (o) (lambda (o)
(pmatch o (pmatch o
((break) (clone info #:text (append (.text info) (jump body-length) ((break) (append-text info (jump body-length)))
)))
(_ (_
((ast->info info) o))))) ((ast->info info) o)))))
(lambda (o) (lambda (o)
@ -1033,8 +968,7 @@
(append (wrap-as (i386:accu-cmp-value value)) (append (wrap-as (i386:accu-cmp-value value))
(jump-nz clause-length))) (jump-nz clause-length)))
(let* ((value (assoc-ref (.constants info) constant)) (let* ((value (assoc-ref (.constants info) constant))
(test-info (test-info (append-text info (test->text value 0)))
(clone info #:text (append (.text info) (test->text value 0))))
(text-length (length (.text test-info))) (text-length (length (.text test-info)))
(clause-info (let loop ((elements elements) (info test-info)) (clause-info (let loop ((elements elements) (info test-info))
(if (null? elements) info (if (null? elements) info
@ -1054,8 +988,7 @@
(append (wrap-as (i386:accu-cmp-value value)) (append (wrap-as (i386:accu-cmp-value value))
(jump-nz clause-length))) (jump-nz clause-length)))
(let* ((value (cstring->number value)) (let* ((value (cstring->number value))
(test-info (test-info (append-text info (test->text value 0)))
(clone info #:text (append (.text info) (test->text value 0))))
(text-length (length (.text test-info))) (text-length (length (.text test-info)))
(clause-info (let loop ((elements elements) (info test-info)) (clause-info (let loop ((elements elements) (info test-info))
(if (null? elements) info (if (null? elements) info
@ -1488,21 +1421,19 @@
#:globals (.globals body-info)))) #:globals (.globals body-info))))
((labeled-stmt (ident ,label) ,statement) ((labeled-stmt (ident ,label) ,statement)
(let ((info (clone info #:text (append text (list label))))) (let ((info (append-text info (list label))))
((ast->info info) statement))) ((ast->info info) statement)))
((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 (text->list text))))) (offset (+ (length (jump 0)) (length (text->list text)))))
(clone info #:text (append-text info (append
(append text
(list (lambda (f g ta t d) (list (lambda (f g ta t d)
(jump (- (label-offset (.function info) label f) offset)))))))) (jump (- (label-offset (.function info) label f) offset))))))))
((return ,expr) ((return ,expr)
(let ((accu ((expr->accu info) expr))) (let ((info ((expr->accu info) expr)))
(clone accu #:text (append-text info (append (wrap-as (i386:ret))))))
(append (.text accu) (wrap-as (i386:ret))))))
;; DECL ;; DECL
@ -1518,9 +1449,7 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 0)) (let* ((locals (add-local locals name type 0))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info ((value->ident info) name value)))
(append text
((value->ident info) name value))))
(clone info #:globals (append globals (list (ident->global name type 0 value))))))) (clone info #:globals (append globals (list (ident->global name type 0 value)))))))
;; char c = 'A'; ;; char c = 'A';
@ -1529,9 +1458,7 @@
(let* ((locals (add-local locals name type 0)) (let* ((locals (add-local locals name type 0))
(info (clone info #:locals locals)) (info (clone info #:locals locals))
(value (char->integer (car (string->list value))))) (value (char->integer (car (string->list value)))))
(clone info #:text (append-text info ((value->ident info) name value))))
(append text
((value->ident info) name value)))))
;; int i = -1; ;; int i = -1;
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (neg (p-expr (fixed ,value))))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (neg (p-expr (fixed ,value)))))))
@ -1539,9 +1466,7 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 0)) (let* ((locals (add-local locals name type 0))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info ((value->ident info) name value)))
(append text
((value->ident info) name value))))
(clone info #:globals (append globals (list (ident->global name type 0 value))))))) (clone info #:globals (append globals (list (ident->global name type 0 value)))))))
;; int i = argc; ;; int i = argc;
@ -1549,13 +1474,10 @@
(if (not (.function info)) decl-barf2) (if (not (.function info)) decl-barf2)
(let* ((locals (add-local locals name type 0)) (let* ((locals (add-local locals name type 0))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info (append ((ident->accu info) local)
(append text
((ident->accu info) local)
((accu->ident info) name))))) ((accu->ident info) name)))))
;; char *p = "t.c"; ;; char *p = "t.c";
;;(decl (decl-spec-list (type-spec (fixed-type "char"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "p")) (initzer (p-expr (string "t.c\n"))))))
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,string)))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,string))))))
(when (not (.function info)) (when (not (.function info))
(stderr "o=~s\n" o) (stderr "o=~s\n" o)
@ -1563,8 +1485,7 @@
(let* ((locals (add-local locals name type 1)) (let* ((locals (add-local locals name type 1))
(globals (append globals (list (string->global string)))) (globals (append globals (list (string->global string))))
(info (clone info #:locals locals #:globals globals))) (info (clone info #:locals locals #:globals globals)))
(clone info #:text (append-text info (append
(append text
(list (lambda (f g ta t d) (list (lambda (f g ta t d)
(append (append
(i386:global->accu (+ (data-offset (add-s:-prefix string) g) d))))) (i386:global->accu (+ (data-offset (add-s:-prefix string) g) d)))))
@ -1576,9 +1497,7 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 1)) (let* ((locals (add-local locals name type 1))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info (append (wrap-as (i386:value->accu value))
(append text
(wrap-as (i386:value->accu value))
((accu->ident info) name)))) ((accu->ident info) name))))
(clone info #:globals (append globals (list (ident->global name type 0 value))))))) (clone info #:globals (append globals (list (ident->global name type 0 value)))))))
@ -1590,11 +1509,9 @@
(let* ((globals (.globals info)) (let* ((globals (.globals info))
(count (cstring->number count)) (count (cstring->number count))
(size (type->size info type)) (size (type->size info type))
;;;;(array (make-global name type -1 (string->list (make-string (* count size) #\nul))))
(array (make-global name type -1 (string->list (make-string (* count size) #\nul)))) (array (make-global name type -1 (string->list (make-string (* count size) #\nul))))
(globals (append globals (list array)))) (globals (append globals (list array))))
(clone info (clone info #:globals globals)))))
#:globals globals)))))
;;struct scm *g_cells = (struct scm*)arena; ;;struct scm *g_cells = (struct scm*)arena;
((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (struct-ref (ident ,=type)))) (abs-declr (pointer))) (p-expr (ident ,value))))))) ((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (struct-ref (ident ,=type)))) (abs-declr (pointer))) (p-expr (ident ,value)))))))
@ -1602,15 +1519,11 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 1)) (let* ((locals (add-local locals name type 1))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info (append ((ident->accu info) name)
(append text
((ident->accu info) name)
((accu->ident info) value)))) ;; FIXME: deref? ((accu->ident info) value)))) ;; FIXME: deref?
(let* ((globals (append globals (list (ident->global name type 1 0)))) (let* ((globals (append globals (list (ident->global name type 1 0))))
(info (clone info #:globals globals))) (info (clone info #:globals globals)))
(clone info #:text (append-text info (append ((ident->accu info) name)
(append text
((ident->accu info) name)
((accu->ident info) value)))))) ;; FIXME: deref? ((accu->ident info) value)))))) ;; FIXME: deref?
;; SCM tmp; ;; SCM tmp;
@ -1627,9 +1540,7 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 0)) (let* ((locals (add-local locals name type 0))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info ((value->ident info) name value)))
(append text
((value->ident info) name value))))
(let ((globals (append globals (list (ident->global name type 0 value))))) (let ((globals (append globals (list (ident->global name type 0 value)))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1643,15 +1554,11 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 0)) (let* ((locals (add-local locals name type 0))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info (append ((ident->accu info) local)
(append text
((ident->accu info) local)
((accu->ident info) name)))) ((accu->ident info) name))))
(let* ((globals (append globals (list (ident->global name type 0 0)))) (let* ((globals (append globals (list (ident->global name type 0 0))))
(info (clone info #:globals globals))) (info (clone info #:globals globals)))
(clone info #:text (append-text info (append ((ident->accu info) local)
(append text
((ident->accu info) local)
((accu->ident info) name)))))) ((accu->ident info) name))))))
;; int (*function) (void) = g_functions[g_cells[fn].cdr].function; ;; int (*function) (void) = g_functions[g_cells[fn].cdr].function;
@ -1676,9 +1583,7 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 1)) (let* ((locals (add-local locals name type 1))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info (append ((ident->accu info) value)
(append text
((ident->accu info) value)
((accu->ident info) name)))) ((accu->ident info) name))))
(let* ((globals (append globals (list (ident->global name type 1 0)))) (let* ((globals (append globals (list (ident->global name type 1 0))))
(here (data-offset name globals)) (here (data-offset name globals))
@ -1704,9 +1609,7 @@
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 1)) (let* ((locals (add-local locals name type 1))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(clone info #:text (append-text info (append ((ident->accu info) value)
(append text
((ident->accu info) value)
((accu->ident info) name)))) ((accu->ident info) name))))
(let* ((globals (append globals (list (ident->global name type 1 0)))) (let* ((globals (append globals (list (ident->global name type 1 0))))
(here (data-offset name globals))) (here (data-offset name globals)))
@ -1843,16 +1746,12 @@
;; EXPR ;; EXPR
((expr-stmt ,expression) ((expr-stmt ,expression)
(let ((info ((expr->accu info) expression))) (let ((info ((expr->accu info) expression)))
(clone info #:text (append-text info (wrap-as (i386:accu-zero?)))))
(append (.text info)
(wrap-as (i386:accu-zero?))))))
;; FIXME: why do we get (post-inc ...) here ;; FIXME: why do we get (post-inc ...) here
;; (array-ref ;; (array-ref
(_ (let ((info ((expr->accu info) o))) (_ (let ((info ((expr->accu info) o)))
(clone info #:text (append-text info (wrap-as (i386:accu-zero?)))))))))
(append (.text info)
(wrap-as (i386:accu-zero?))))))))))
(define (initzer->data info functions globals ta t d o) (define (initzer->data info functions globals ta t d o)
(pmatch o (pmatch o