From 7ccbc0004734606889bc3db5aba61a81c7282b65 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Fri, 7 Apr 2017 09:36:30 +0200 Subject: [PATCH] mescc: Factor-out wrap-as. * module/language/c99/compiler.mes (wrap-as): Rename from wrap. Use throughout. --- module/language/c99/compiler.mes | 411 +++++++++++-------------------- 1 file changed, 150 insertions(+), 261 deletions(-) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 650b143d..a7a92853 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -192,9 +192,7 @@ (define (push-local locals) (lambda (o) - (list - (lambda (f g ta t d) - (i386:push-local (local:id o)))))) + (wrap-as (i386:push-local (local:id o))))) (define (push-global-address globals) (lambda (o) @@ -204,17 +202,13 @@ (define (push-local-address locals) (lambda (o) - (list - (lambda (f g ta t d) - (i386:push-local-address (local:id o)))))) + (wrap-as (i386:push-local-address (local:id o))))) (define push-global-de-ref push-global) (define (push-local-de-ref locals) (lambda (o) - (list - (lambda (f g ta t d) - (i386:push-local-de-ref (local:id o)))))) + (wrap-as (i386:push-local-de-ref (local:id o))))) (define (string->global string) (make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul)))) @@ -237,10 +231,8 @@ ((push-global (.globals info)) o) ;; FIXME: char*/int (let ((constant (assoc-ref (.constants info) o))) (if constant - (list (lambda (f g ta t d) - (append - (i386:value->accu constant) - (i386:push-accu)))) + (wrap-as (append (i386:value->accu constant) + (i386:push-accu))) TODO:push-function)))))))) (define (push-ident-address info) @@ -258,9 +250,7 @@ (define (expr->arg info) (lambda (o) (let ((info ((expr->accu info) o))) - (clone info #:text (append (.text info) - (list (lambda (f g ta t d) - (i386:push-accu)))))))) + (clone info #:text (append (.text info) (wrap-as (i386:push-accu))))))) (define (expr->arg info) ;; FIXME: get Mes curried-definitions (lambda (o) @@ -287,9 +277,7 @@ (_ (let* ((info ((expr->accu info) o)) (text (.text info))) - (clone info #:text (append text - (list (lambda (f g ta t d) - (i386:push-accu))))))))))) + (clone info #:text (append text (wrap-as (i386:push-accu)))))))))) ;; FIXME: see ident->base (define (ident->accu info) @@ -311,15 +299,11 @@ ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr) ;;(stderr "locals: ~s\n" locals) (case ptr - ((-1) (list (lambda (f g ta t d) - (i386:local-ptr->accu (local:id local))))) - ((1) (list (lambda (f g ta t d) - (i386:local->accu (local:id local))))) + ((-1) (wrap-as (i386:local-ptr->accu (local:id local)))) + ((1) (wrap-as (i386:local->accu (local:id local)))) (else - (list (lambda (f g ta t d) - (if (= size 1) - (i386:byte-local->accu (local:id local)) - (i386:local->accu (local:id local)))))))) + (wrap-as (if (= size 1) (i386:byte-local->accu (local:id local)) + (i386:local->accu (local:id local))))))) (if global (let ((ptr (ident->pointer info o))) ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr) @@ -328,59 +312,45 @@ (i386:global->accu (+ (data-offset o g) d))))) (else (list (lambda (f g ta t d) (i386:global-address->accu (+ (data-offset o g) d))))))) - (if constant - (list (lambda (f g ta t d) - (i386:value->accu constant))) + (if constant (wrap-as (i386:value->accu constant)) (list (lambda (f g ta t d) (i386:global->accu (+ ta (function-offset o f))))))))))) (define (value->accu v) - (list (lambda (f g ta t d) - (i386:value->accu v)))) + (wrap-as (i386:value->accu v))) (define (accu->ident info) (lambda (o) (let ((local (assoc-ref (.locals info) o))) - (if local - (list (lambda (f g ta t d) - (i386:accu->local (local:id local)))) + (if local (wrap-as (i386:accu->local (local:id local))) (list (lambda (f g ta t d) (i386:accu->global (+ (data-offset o g) d)))))))) (define (base->ident info) (lambda (o) (let ((local (assoc-ref (.locals info) o))) - (if local - (list (lambda (f g ta t d) - (i386:base->local (local:id local)))) + (if local (wrap-as (i386:base->local (local:id local))) (list (lambda (f g ta t d) (i386:base->global (+ (data-offset o g) d)))))))) (define (base->ident-address info) (lambda (o) (let ((local (assoc-ref (.locals info) o))) - (if local - (list (lambda (f g ta t d) - (append - (i386:local->accu (local:id local)) - (i386:byte-base->accu-address)))) + (if local (wrap-as (append (i386:local->accu (local:id local)) + (i386:byte-base->accu-address))) TODO:base->ident-address-global)))) (define (value->ident info) (lambda (o value) (let ((local (assoc-ref (.locals info) o))) - (if local - (list (lambda (f g ta t d) - (i386:value->local (local:id local) value))) + (if local (wrap-as (i386:value->local (local:id local) value)) (list (lambda (f g ta t d) (i386:value->global (+ (data-offset o g) d) value))))))) (define (ident-add info) (lambda (o n) (let ((local (assoc-ref (.locals info) o))) - (if local - (list (lambda (f g ta t d) - (i386:local-add (local:id local) n))) + (if local (wrap-as (i386:local-add (local:id local) n)) (list (lambda (f g ta t d) (i386:global-add (+ (data-offset o g) d) n))))))) @@ -394,15 +364,11 @@ (type (ident->type info o)) (size (and type (type->size info type)))) (case ptr - ((-1) (list (lambda (f g ta t d) - (i386:local-ptr->base (local:id local))))) - ((1) (list (lambda (f g ta t d) - (i386:local->base (local:id local))))) + ((-1) (wrap-as (i386:local-ptr->base (local:id local)))) + ((1) (wrap-as (i386:local->base (local:id local)))) (else - (list (lambda (f g ta t d) - (if (= size 1) - (i386:byte-local->base (local:id local)) - (i386:local->base (local:id local)))))))) + (wrap-as (if (= size 1) (i386:byte-local->base (local:id local)) + (i386:local->base (local:id local))))))) (let ((global (assoc-ref (.globals info) o) )) (if global (let ((ptr (ident->pointer info o))) @@ -413,9 +379,7 @@ (else (list (lambda (f g ta t d) (i386:global-address->base (+ (data-offset o g) d))))))) (let ((constant (assoc-ref (.constants info) o))) - (if constant - (list (lambda (f g ta t d) - (i386:value->base constant))) + (if constant (wrap-as (i386:value->base constant)) (list (lambda (f g ta t d) (i386:global->base (+ ta (function-offset o f))))))))))))) @@ -433,8 +397,6 @@ (pmatch o ((p-expr (string ,string)) (clone info #:text (append text (list (lambda (f g ta t d) - ;;(stderr "OFF[~a]: ~a\n" string (data-offset string globals)) - ;;(stderr "globals: ~s\n" (map car globals)) (i386:global->accu (+ (data-offset (add-s:-prefix string) globals) d))))))) ((p-expr (fixed ,value)) (clone info #:text (append text (value->accu (cstring->number value))))) @@ -452,10 +414,7 @@ (fields (or (type->description info type) '())) (size (type->size info type))) (clone info #:text - (append text - (list (lambda (f g ta t d) - (append - (i386:value->accu size)))))))) + (append text (wrap-as (i386:value->accu size)))))) ;; c+p expr->arg ;; g_cells[] @@ -467,21 +426,17 @@ (append (.text info) ;; immediate: (i386:value->accu (* size index)) ;; * size cells: * length * 4 = * 12 - (list (lambda (f g ta t d) - (append - (i386:accu->base) - (if (eq? size 1) '() - (append - (if (> size 4) (i386:accu+accu) '()) - (if (> size 8) (i386:accu+base) '()) - (i386:accu-shl 2)))))) + (wrap-as (append (i386:accu->base) + (if (eq? size 1) '() + (append + (if (> size 4) (i386:accu+accu) '()) + (if (> size 8) (i386:accu+base) '()) + (i386:accu-shl 2))))) ((ident->base info) array) - (list (lambda (f g ta t d) - (append - (case size - ((1) (i386:byte-base-mem->accu)) - ((4) (i386:base-mem->accu)) - (else (i386:accu+base)))))))))) + (wrap-as (append (case size + ((1) (i386:byte-base-mem->accu)) + ((4) (i386:base-mem->accu)) + (else (i386:accu+base))))))))) ;; f.field ((d-sel (ident ,field) (p-expr (ident ,array))) @@ -493,8 +448,7 @@ (clone info #:text (append text ((ident->accu info) array) - (list (lambda (f g ta t d) - (i386:mem+n->accu offset))))))) + (wrap-as (i386:mem+n->accu offset)))))) ;; g_cells[10].type ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))) @@ -508,16 +462,13 @@ (text (.text info))) (clone info #:text (append text - (list (lambda (f g ta t d) - (append - (i386:value->base index) - (i386:base->accu) - (if (> count 1) (i386:accu+accu) '()) - (if (= count 3) (i386:accu+base) '()) - (i386:accu-shl 2)))) + (wrap-as (append (i386:value->base index) + (i386:base->accu) + (if (> count 1) (i386:accu+accu) '()) + (if (= count 3) (i386:accu+base) '()) + (i386:accu-shl 2))) ((ident->base info) array) - (list (lambda (f g ta t d) - (i386:base-mem+n->accu offset))))))) + (wrap-as (i386:base-mem+n->accu offset)))))) ;; g_cells[x].type ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))) @@ -531,15 +482,12 @@ (clone info #:text (append text ((ident->base info) index) - (list (lambda (f g ta t d) - (append - (i386:base->accu) - (if (> count 1) (i386:accu+accu) '()) - (if (= count 3) (i386:accu+base) '()) - (i386:accu-shl 2)))) + (wrap-as (append (i386:base->accu) + (if (> count 1) (i386:accu+accu) '()) + (if (= count 3) (i386:accu+base) '()) + (i386:accu-shl 2))) ((ident->base info) array) - (list (lambda (f g ta t d) - (i386:base-mem+n->accu offset))))))) + (wrap-as (i386:base-mem+n->accu offset)))))) ;; g_functions[g_cells[fn].cdr].arity ;; INDEX0: g_cells[fn].cdr @@ -563,30 +511,23 @@ (clone info #:text (append text (.text index) - (list (lambda (f g ta t d) - (append - (i386:accu->base) - (if (> count 1) (i386:accu+accu) '()) - (if (= count 3) (i386:accu+base) '()) - (i386:accu-shl 2)))) + (wrap-as (append (i386:accu->base) + (if (> count 1) (i386:accu+accu) '()) + (if (= count 3) (i386:accu+base) '()) + (i386:accu-shl 2))) ((ident->base info) array) - (list (lambda (f g ta t d) - (i386:base-mem+n->accu offset))))))) + (wrap-as (i386:base-mem+n->accu offset)))))) ;;; FIXME: FROM INFO ...only zero?! ((p-expr (fixed ,value)) (let ((value (cstring->number value))) (clone info #:text - (append text - (list (lambda (f g ta t d) - (i386:value->accu value))))))) + (append text (wrap-as (i386:value->accu value)))))) ((p-expr (char ,char)) (let ((char (char->integer (car (string->list char))))) (clone info #:text - (append text - (list (lambda (f g ta t d) - (i386:value->accu char))))))) + (append text (wrap-as (i386:value->accu char)))))) ((p-expr (ident ,name)) (clone info #:text @@ -599,14 +540,12 @@ (clone info #:text (append text ((ident->accu info) name) - (list (lambda (f g ta t d) - (if (= size 1) - (i386:byte-mem->accu) - (i386:mem->accu)))))))) + (wrap-as (if (= size 1) (i386:byte-mem->accu) + (i386:mem->accu))))))) ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME - (clone info #:text (append text (list (lambda (f g ta t d) (asm->hex arg0)))))) + (clone info #:text (append text (wrap-as (asm->hex arg0))))) (let* ((globals (append globals (filter-map expr->global expr-list))) (info (clone info #:globals globals)) (text-length (length text)) @@ -686,8 +625,7 @@ (append text (.text base) ((ident->accu info) name) - (list (lambda (f g ta t d) - (i386:accu+base))))))) + (wrap-as (i386:accu+base)))))) ((add ,a ,b) (let* ((empty (clone info #:text '())) @@ -697,8 +635,7 @@ (append text (.text accu) (.text base) - (list (lambda (f g ta t d) - (i386:accu+base))))))) + (wrap-as (i386:accu+base)))))) ((sub ,a ,b) (let* ((empty (clone info #:text '())) @@ -708,8 +645,7 @@ (append text (.text accu) (.text base) - (list (lambda (f g ta t d) - (i386:accu-base))))))) + (wrap-as (i386:accu-base)))))) ((bitwise-or ,a ,b) (let* ((empty (clone info #:text '())) @@ -719,8 +655,7 @@ (append text (.text accu) (.text base) - (list (lambda (f g ta t d) - (i386:accu-or-base))))))) + (wrap-as (i386:accu-or-base)))))) ((lshift ,a ,b) (let* ((empty (clone info #:text '())) @@ -730,8 +665,7 @@ (append text (.text accu) (.text base) - (list (lambda (f g ta t d) - (i386:accu<>base))))))) + (wrap-as (i386:accu>>base)))))) ((div ,a ,b) (let* ((empty (clone info #:text '())) @@ -752,8 +685,7 @@ (append text (.text accu) (.text base) - (list (lambda (f g ta t d) - (i386:accu/base))))))) + (wrap-as (i386:accu/base)))))) ((mod ,a ,b) (let* ((empty (clone info #:text '())) @@ -763,8 +695,7 @@ (append text ;;FIXME:empty (.text accu) (.text base) - (list (lambda (f g ta t d) - (i386:accu%base))))))) + (wrap-as (i386:accu%base)))))) ((mul ,a ,b) (let* ((empty (clone info #:text '())) @@ -774,15 +705,13 @@ (append text (.text accu) (.text base) - (list (lambda (f g ta t d) - (i386:accu*base))))))) + (wrap-as (i386:accu*base)))))) ((not ,expr) (let* ((test-info ((ast->info info) expr))) (clone info #:text (append (.text test-info) - (list (lambda (f g ta t d) - (i386:accu-not)))) + (wrap-as (i386:accu-not))) #:globals (.globals test-info)))) ((neg (p-expr (fixed ,value))) @@ -791,10 +720,8 @@ ((neg (p-expr (ident ,name))) (clone info #:text (append text ((ident->base info) name) - (list (lambda (f g ta t d) - (i386:value->accu 0))) - (list (lambda (f g ta t d) - (i386:sub-base)))))) + (wrap-as (i386:value->accu 0)) + (wrap-as (i386:sub-base))))) ((eq ,a ,b) ((compare->accu info) a b (i386:sub-base))) ((ge ,a ,b) ((compare->accu info) b a (i386:sub-base))) @@ -855,10 +782,7 @@ (clone info #:text (append text (.text expr) (.text base) - (list (lambda (f g ta t d) - ;;(i386:byte-base->accu-ref) ;; FIXME: size - (i386:base->accu-address) - )))))) + (wrap-as (i386:base->accu-address)))))) ; FIXME: size ;; i = 0; @@ -877,16 +801,12 @@ (.text base) (if (equal? op "=") '() (append ((ident->accu info) name) - (list (lambda (f g ta t d) - (append - (if (equal? op "+=") - (i386:accu+base) - (i386:accu-base)) - (i386:accu->base)))))) + (wrap-as (append (if (equal? op "+=") (i386:accu+base) + (i386:accu-base)) + (i386:accu->base))))) ;;assign: ((base->ident info) name) - (list (lambda (f g ta t d) - (i386:base->accu))))))) + (wrap-as (i386:base->accu)))))) ;; *p = 0; ((assn-expr (de-ref (p-expr (ident ,array))) (op ,op) ,b) @@ -899,8 +819,7 @@ (.text base) ;;assign: ((base->ident-address info) array) - (list (lambda (f g ta t d) - (i386:base->accu))))))) + (wrap-as (i386:base->accu)))))) ;; g_cells[] = ; ((assn-expr (array-ref ,index (p-expr (ident ,array))) (op ,op) ,b) @@ -915,25 +834,17 @@ (clone info #:text (append (.text info) - (if (eq? size 1) (list (lambda (f g ta t d) - (i386:byte-base->accu-address))) + (if (eq? size 1) (wrap-as (i386:byte-base->accu-address)) (append - (list (lambda (f g ta t d) - (i386:base-address->accu-address))) - (if (> size 4) - (list (lambda (f g ta t d) - (append - (i386:accu+n 4) - (i386:base+n 4) - (i386:base-address->accu-address)))) - '()) - (if (> size 8) - (list (lambda (f g ta t d) - (append - (i386:accu+n 4) - (i386:base+n 4) - (i386:base-address->accu-address)))) - '()))))))) + (wrap-as (i386:base-address->accu-address)) + (if (<= size 4) '() + (wrap-as (append (i386:accu+n 4) + (i386:base+n 4) + (i386:base-address->accu-address)))) + (if (<= size 8) '() + (wrap-as (append (i386:accu+n 4) + (i386:base+n 4) + (i386:base-address->accu-address)))))))))) (_ (format (current-error-port) "SKIP: expr->accu=~s\n" o) @@ -942,35 +853,31 @@ (define (expr->+base info) (lambda (o) - (let* ((info (append-text info (wrap (i386:push-accu)))) + (let* ((info (append-text info (wrap-as (i386:push-accu)))) (info ((expr->accu info) o)) - (info (append-text info (wrap (append (i386:accu->base) (i386:pop-accu)))))) + (info (append-text info (wrap-as (append (i386:accu->base) (i386:pop-accu)))))) info))) (define (compare->accu info) (lambda (a b c) (let* ((info ((expr->accu info) a)) (info ((expr->+base info) b))) - (append-text info (wrap c))))) + (append-text info (wrap-as c))))) (define (append-text info text) (clone info #:text (append (.text info) text))) -(define (wrap o) +(define (wrap-as o) (list (lambda (f g ta t d) o))) (define (expr->base info) ;; JUNKME (lambda (o) (let ((info ((expr->accu info) o))) (clone info - #:text (append - (list (lambda (f g ta t d) - (i386:push-accu))) + #:text (append (wrap-as (i386:push-accu)) (.text info) - (list (lambda (f g ta t d) - (append - (i386:accu->base) - (i386:pop-accu))))))))) + (wrap-as (append (i386:accu->base) + (i386:pop-accu)))))))) (define (expr->accu* info) (lambda (o) @@ -984,16 +891,16 @@ (size (type->size info type))) (clone info #:text (append (.text info) - (list (lambda (f g ta t d) - (append - (i386:accu->base) - (if (eq? size 1) '() - (append - (if (> size 4) (i386:accu+accu) '()) - (if (> size 8) (i386:accu+base) '()) - (i386:accu-shl 2)))))) + (wrap-as (append (i386:accu->base) + (if (eq? size 1) '() + (append + (if (<= size 4) '() + (i386:accu+accu)) + (if (<= size 8) '() + (i386:accu+base)) + (i386:accu-shl 2))))) ((ident->base info) array) - (list (lambda (f g ta t d) (i386:accu+base))))))) + (wrap-as (i386:accu+base)))))) ;; g_cells[10].type ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))) @@ -1007,20 +914,18 @@ (text (.text info))) (clone info #:text (append text - (list (lambda (f g ta t d) - (append - (i386:value->base index) - (i386:base->accu) - (if (> count 1) (i386:accu+accu) '()) - (if (= count 3) (i386:accu+base) '()) - (i386:accu-shl 2)))) + (wrap-as (append (i386:value->base index) + (i386:base->accu) + (if (<= count 1) '() + (i386:accu+accu)) + (if (<= count 2) '() + (i386:accu+base)) + (i386:accu-shl 2))) ;; de-ref: g_cells, non: arena ;;((ident->base info) array) ((ident->base info) array) - (list (lambda (f g ta t d) - (append - (i386:accu+base) - (i386:accu+value offset)))))))) + (wrap-as (append (i386:accu+base) + (i386:accu+value offset))))))) ;; g_cells[x].type ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))) @@ -1034,19 +939,17 @@ (clone info #:text (append text ((ident->base info) index) - (list (lambda (f g ta t d) - (append - (i386:base->accu) - (if (> count 1) (i386:accu+accu) '()) - (if (= count 3) (i386:accu+base) '()) - (i386:accu-shl 2)))) + (wrap-as (append (i386:base->accu) + (if (<= count 1) '() + (i386:accu+accu)) + (if (<= count 2) '() + (i386:accu+base)) + (i386:accu-shl 2))) ;; de-ref: g_cells, non: arena ;;((ident->base info) array) ((ident->base info) array) - (list (lambda (f g ta t d) - (append - (i386:accu+base) - (i386:accu+value offset)))))))) + (wrap-as (append (i386:accu+base) + (i386:accu+value offset))))))) ;;((d-sel (ident "cdr") (p-expr (ident "scm_make_cell")))) ((d-sel (ident ,field) (p-expr (ident ,name))) @@ -1058,8 +961,7 @@ (clone info #:text (append text ((ident->accu info) name) - (list (lambda (f g ta t d) - (i386:accu+value offset))))))) + (wrap-as (i386:accu+value offset)))))) (_ (format (current-error-port) "SKIP: expr->accu*=~s\n" o) @@ -1112,9 +1014,9 @@ (define (case->jump-info info) (define (jump n) - (list (lambda (f g ta t d) (i386:Xjump n)))) + (wrap-as (i386:Xjump n))) (define (jump-nz n) - (list (lambda (f g ta t d) (i386:Xjump-nz n)))) + (wrap-as (i386:Xjump-nz n))) (define (statement->info info body-length) (lambda (o) (pmatch o @@ -1128,7 +1030,7 @@ (lambda (body-length) (define (test->text value clause-length) - (append (list (lambda (f g ta t d) (i386:accu-cmp-value value))) + (append (wrap-as (i386:accu-cmp-value value)) (jump-nz clause-length))) (let* ((value (assoc-ref (.constants info) constant)) (test-info @@ -1149,7 +1051,7 @@ (lambda (body-length) (define (test->text value clause-length) - (append (list (lambda (f g ta t d) (i386:accu-cmp-value value))) + (append (wrap-as (i386:accu-cmp-value value)) (jump-nz clause-length))) (let* ((value (cstring->number value)) (test-info @@ -1195,7 +1097,7 @@ (info (clone info #:text '())) (info ((ast->info info) o)) (jump-text (lambda (body-length) - (list (lambda (f g ta t d) (type body-length)))))) + (wrap-as (type body-length))))) (lambda (body-length) (clone info #:text (append text @@ -1243,14 +1145,14 @@ (a-text (.text (a-jump 0))) (a-length (length (text->list a-text))) - (jump-text (list (lambda (f g ta t d) (i386:Xjump 0)))) + (jump-text (wrap-as (i386:Xjump 0))) (jump-length (length (text->list jump-text))) (b-jump ((test->jump->info info) b)) (b-text (.text (b-jump 0))) (b-length (length (text->list b-text))) - (jump-text (list (lambda (f g ta t d) (i386:Xjump b-length))))) + (jump-text (wrap-as (i386:Xjump b-length)))) (lambda (body-length) (clone info #:text @@ -1260,18 +1162,18 @@ (.text (b-jump body-length))))))) ((array-ref . _) ((jump i386:jump-byte-z - (list (lambda (f g ta t d) (i386:accu-zero?)))) o)) + (wrap-as (i386:accu-zero?))) o)) ((de-ref _) ((jump i386:jump-byte-z - (list (lambda (f g ta t d) (i386:accu-zero?)))) o)) + (wrap-as (i386:accu-zero?))) o)) ((assn-expr (p-expr (ident ,name)) ,op ,expr) ((jump i386:Xjump-z (append ((ident->accu info) name) - (list (lambda (f g ta t d) (i386:accu-zero?))))) o)) + (wrap-as (i386:accu-zero?)))) o)) - (_ ((jump i386:Xjump-z (list (lambda (f g ta t d) (i386:accu-zero?)))) o))))) + (_ ((jump i386:Xjump-z (wrap-as (i386:accu-zero?))) o))))) (define (cstring->number s) (cond ((string-prefix? "0x" s) (string->number (string-drop s 2) 16)) @@ -1421,7 +1323,7 @@ (then-info ((ast->info test+jump-info) then)) (text-then-info (.text then-info)) (then-text (list-tail text-then-info test-length)) - (then-jump-text (list (lambda (f g ta t d) (i386:Xjump 0)))) + (then-jump-text (wrap-as (i386:Xjump 0))) (then-jump-length (length (text->list then-jump-text))) (then-length (+ (length (text->list then-text)) then-jump-length)) @@ -1433,7 +1335,7 @@ (text+test-text (.text (test-jump->info then-length))) (test-text (list-tail text+test-text text-length)) - (then-jump-text (list (lambda (f g ta t d) (i386:Xjump else-length))))) + (then-jump-text (wrap-as (i386:Xjump else-length)))) (clone info #:text (append text @@ -1457,7 +1359,7 @@ (then-text (list-tail text-then-info test-length)) (then-length (length (text->list then-text))) - (jump-text (list (lambda (f g ta t d) (i386:Xjump 0)))) + (jump-text (wrap-as (i386:Xjump 0))) (jump-length (length (text->list jump-text))) (test+then+jump-info @@ -1471,7 +1373,7 @@ (text+test-text (.text (test-jump->info (+ then-length jump-length)))) (test-text (list-tail text+test-text text-length)) - (jump-text (list (lambda (f g ta t d) (i386:Xjump else-length))))) + (jump-text (wrap-as (i386:Xjump else-length)))) (clone info #:text (append text @@ -1513,11 +1415,9 @@ (test+jump-info (test-jump->info 0)) (test-length (length (text->list (.text test+jump-info)))) - (skip-body-text (list (lambda (f g ta t d) - (i386:Xjump (+ body-length step-length))))) + (skip-body-text (wrap-as (i386:Xjump (+ body-length step-length)))) - (jump-text (list (lambda (f g ta t d) - (i386:Xjump (- (+ body-length step-length test-length)))))) + (jump-text (wrap-as (i386:Xjump (- (+ body-length step-length test-length))))) (jump-length (length (text->list jump-text))) (test-text (.text (test-jump->info jump-length)))) @@ -1537,7 +1437,7 @@ ((while ,test ,body) (let* ((skip-info (lambda (body-length) (clone info #:text (append text - (list (lambda (f g ta t d) (i386:Xjump body-length))))))) + (wrap-as (i386:Xjump body-length)))))) (text (.text (skip-info 0))) (text-length (length text)) @@ -1553,8 +1453,7 @@ (test+jump-info (test-jump->info 0)) (test-length (length (text->list (.text test+jump-info)))) - (jump-text (list (lambda (f g ta t d) - (i386:Xjump (- (+ body-length test-length)))))) + (jump-text (wrap-as (i386:Xjump (- (+ body-length test-length))))) (jump-length (length (text->list jump-text))) (test-text (.text (test-jump->info jump-length)))) @@ -1577,8 +1476,7 @@ (test+jump-info (test-jump->info 0)) (test-length (length (text->list (.text test+jump-info)))) - (jump-text (list (lambda (f g ta t d) - (i386:Xjump (- (+ body-length test-length)))))) + (jump-text (wrap-as (i386:Xjump (- (+ body-length test-length))))) (jump-length (length (text->list jump-text))) (test-text (.text (test-jump->info jump-length)))) @@ -1604,7 +1502,7 @@ ((return ,expr) (let ((accu ((expr->accu info) expr))) (clone accu #:text - (append (.text accu) (list (lambda (f g ta t d) (i386:ret))))))) + (append (.text accu) (wrap-as (i386:ret)))))) ;; DECL @@ -1680,8 +1578,7 @@ (info (clone info #:locals locals))) (clone info #:text (append text - (list (lambda (f g ta t d) - (i386:value->accu value))) + (wrap-as (i386:value->accu value)) ((accu->ident info) name)))) (clone info #:globals (append globals (list (ident->global name type 0 value))))))) @@ -1769,11 +1666,8 @@ (.text accu) ((accu->ident info) name) (list (lambda (f g ta t d) - (append - ;;(i386:value->base t) - ;;(i386:accu+base) - (i386:value->base ta) - (i386:accu+base))))) + (append (i386:value->base ta) + (i386:accu+base))))) #:locals locals))) ;; char *p = (char*)g_cells; @@ -1868,12 +1762,9 @@ (append (.text info) ((ident->accu info) name) - (list (lambda (f g ta t d) - (append - (i386:accu->base)))) + (wrap-as (append (i386:accu->base))) (.text ((expr->accu empty) initzer)) - (list (lambda (f g ta t d) - (i386:accu->base-address+n offset)))))))))) + (wrap-as (i386:accu->base-address+n offset))))))))) (let* ((globals (append globals (filter-map initzer->global initzers))) (global (make-global name type -1 (string->list (make-string size #\nul)))) (globals (append globals (list global))) @@ -1954,14 +1845,14 @@ (let ((info ((expr->accu info) expression))) (clone info #:text (append (.text info) - (list (lambda (f g ta t d) (i386:accu-zero?))))))) + (wrap-as (i386:accu-zero?)))))) ;; FIXME: why do we get (post-inc ...) here ;; (array-ref (_ (let ((info ((expr->accu info) o))) (clone info #:text (append (.text info) - (list (lambda (f g ta t d) (i386:accu-zero?))))))))))) + (wrap-as (i386:accu-zero?)))))))))) (define (initzer->data info functions globals ta t d o) (pmatch o @@ -2000,11 +1891,9 @@ (pmatch o ((param-list . ,formals) (let ((n (length formals))) - (list (lambda (f g ta t d) - (append - (i386:function-preamble) - (append-map (formal->text n) formals (iota n)) - (i386:function-locals)))))) + (wrap-as (append (i386:function-preamble) + (append-map (formal->text n) formals (iota n)) + (i386:function-locals))))) (_ (format (current-error-port) "formals->text: no match: ~a\n" o) barf)))