diff --git a/make.scm b/make.scm index a515782b..2b9e7bf7 100755 --- a/make.scm +++ b/make.scm @@ -135,6 +135,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$ (add-target (compile.gcc "mlibc/libc-gcc+tcc.c" #:libc #f)) ;;(add-scaffold-test "t" #:libc mini-libc-mes.hex2) +(add-scaffold-test "t") ;;(add-scaffold-test "t" #:libc libc-mes+tcc.hex2) ;; tests/00: exit, functions without libc diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index f8566850..28e82726 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -685,13 +685,11 @@ (ptr (ident->pointer info name)) (size (if (= ptr 1) (ast-type->size info type) 4))) - (append-text info (append (if (or #t (assoc-ref locals name)) ((ident->accu info) name) - ((ident-address->accu info) name)) + (append-text info (append ((ident->accu info) name) (wrap-as (case size ((1) (i386:byte-mem->accu)) ((2) (i386:word-mem->accu)) (else (i386:mem->accu)))))))) - ((de-ref ,expr) (let* ((info ((expr->accu info) expr)) (ptr (expr->pointer info expr)) @@ -701,7 +699,6 @@ ((1) (i386:byte-mem->accu)) ((2) (i386:word-mem->accu)) (else (i386:mem->accu))))))) - ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME (append-text info (wrap-as (asm->m1 arg0)))) @@ -925,6 +922,112 @@ (size (if (> ptr 1) 4 1))) (append-text info ((ident-add info) name (- size))))) + ;; type = *type; + ((assn-expr (p-expr (ident ,a)) (op ,op) (de-ref (p-expr (ident ,b)))) + (guard (and (equal? op "=") + (= 1 (expr->pointer info `(p-expr (ident ,b)))) + (let* ((type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union)))) + struct?))) + (let* ((info (append-text info (ast->comment o))) + (info ((expr->accu info) `(p-expr (ident ,b)))) + (info ((expr->base* info) `(p-expr (ident ,a)))) + (type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union))) + (ptr (expr->pointer info `(p-expr (ident ,a)))) + (size (if (and struct? (or (= ptr 0) (= ptr -1))) (type:size type) + 4))) + (accu-mem->base-mem*n info size))) + + ;; *type = *type; + ((assn-expr (de-ref (p-expr (ident ,a))) (op ,op) (de-ref (p-expr (ident ,b)))) + (guard (and (equal? op "=") + (= 1 (expr->pointer info `(p-expr (ident ,a)))) + (= 1 (expr->pointer info `(p-expr (ident ,b)))) + (let* ((type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union)))) + struct?))) + (let* ((info (append-text info (ast->comment o))) + (info ((expr->accu info) `(p-expr (ident ,b)))) + (info ((expr->base info) `(p-expr (ident ,a)))) + (type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union))) + (ptr (expr->pointer info `(p-expr (ident ,a)))) + (size (if (and struct? (or (= ptr 1) (= ptr -1))) (type:size type) + 4))) + (accu-mem->base-mem*n info size))) + + ;; s->tokc = tokc; + ((assn-expr (i-sel (ident ,field) (p-expr (ident ,a))) (op ,op) (p-expr (ident ,b))) + (guard (and (equal? op "=") + (or (= 0 (expr->pointer info `(p-expr (ident ,b)))) + (= -1 (expr->pointer info `(p-expr (ident ,b))))) + (let* ((type (ast-type->type info `(p-expr (ident ,b)))) + (struct? (memq (type:type type) '(struct union)))) + struct?))) + (let* ((info ((expr->accu* info) `(p-expr (ident ,b)))) + (info ((expr->base* info) `(i-sel (ident ,field) (p-expr (ident ,a))))) + (type (p-expr->type info `(p-expr (ident ,a)))) + (ptr (field-pointer info type field)) + (type (ast-type->type info `(p-expr (ident ,b)))) + (struct? (memq (type:type type) '(struct union))) + (type1 (p-expr->type info `(i-sel (ident ,field) (p-expr (ident ,a))))) + (size (if (and struct? (or (= ptr 0) (= ptr -1))) (ast-type->size info type1) + 4))) + (accu-mem->base-mem*n info size))) + + ;; vtop->type = *type; + ((assn-expr (i-sel (ident ,field) (p-expr (ident ,a))) (op ,op) (de-ref (p-expr (ident ,b)))) + (guard (and (equal? op "=") + (= 1 (expr->pointer info `(p-expr (ident ,b)))) + (let* ((type (ast-type->type info `(p-expr (ident ,b)))) + (struct? (memq (type:type type) '(struct union)))) + struct?))) + (let* ((info ((expr->accu info) `(p-expr (ident ,b)))) + (info ((expr->base* info) `(i-sel (ident ,field) (p-expr (ident ,a))))) + (type (p-expr->type info `(p-expr (ident ,a)))) + (ptr (field-pointer info type field)) + (type (ast-type->type info `(p-expr (ident ,b)))) + (struct? (memq (type:type type) '(struct union))) + (type1 (p-expr->type info `(i-sel (ident ,field) (p-expr (ident ,a))))) + (size (if (and struct? (= ptr 0)) (ast-type->size info type1) + 4))) + (accu-mem->base-mem*n info size))) + + ;; type[0] = type[1] + ((assn-expr (array-ref ,index-a (p-expr (ident ,a))) (op ,op) (array-ref ,index-b (p-expr (ident ,b)))) + (guard (and (equal? op "=") + (= 1 (abs (expr->pointer info `(p-expr (ident ,a))))) + (let* ((type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union)))) + struct?))) + (let* ((info (append-text info (ast->comment o))) + (info ((expr->accu* info) `(array-ref ,index-b (p-expr (ident ,b))))) + (info ((expr->base* info) `(array-ref ,index-a (p-expr (ident ,a))))) + (type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union))) + (ptr (expr->pointer info `(p-expr (ident ,a)))) + (size (if (and struct? (or (= ptr 1) (= ptr -1))) (type:size type) + 4))) + (accu-mem->base-mem*n info size))) + + ;; type[0] = type + ((assn-expr (array-ref ,index-a (p-expr (ident ,a))) (op ,op) (p-expr (ident ,b))) + (guard (and (equal? op "=") + (= 1 (abs (expr->pointer info `(p-expr (ident ,a))))) + (let* ((type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union)))) + struct?))) + (let* ((info (append-text info (ast->comment o))) + (info ((expr->accu* info) `(p-expr (ident ,b)))) + (info ((expr->base* info) `(array-ref ,index-a (p-expr (ident ,a))))) + (type (ast-type->type info `(p-expr (ident ,a)))) + (struct? (memq (type:type type) '(struct union))) + (ptr (expr->pointer info `(p-expr (ident ,a)))) + (size (if (and struct? (or (= ptr 1) (= ptr -1))) (type:size type) + 4))) + (accu-mem->base-mem*n info size))) + ((assn-expr ,a (op ,op) ,b) (let* ((info (append-text info (ast->comment o))) (info ((expr->accu info) b)) @@ -984,7 +1087,7 @@ ((1) (wrap-as (i386:byte-accu->base-mem))) ((2) (wrap-as (i386:word-accu->base-mem))) (else (wrap-as (i386:accu->base-mem))))))) - ((de-ref ,expr) + ((Xde-ref ,expr) (let* ((info ((expr->base info) expr)) (ptr (expr->pointer info expr)) (size (if (= ptr 1) (expr->size info expr) @@ -993,6 +1096,12 @@ ((1) (wrap-as (i386:byte-accu->base-mem))) ((2) (wrap-as (i386:word-accu->base-mem))) (else (wrap-as (i386:accu->base-mem))))))) + ((de-ref ,expr) + (let* ((info ((expr->base info) expr)) + (ptr (expr->pointer info expr)) + (size (if (= ptr 1) (expr->size info expr) + 4))) + (accu->base-mem*n info size))) ((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct)))) (let* ((info ((expr->base* info) a)) (type (ident->type info struct)) @@ -1023,6 +1132,7 @@ (size (if (or (= ptr -1) (= ptr 1)) (ast-type->size info type) 4)) (info ((expr->base* info) a))) + ;;(accu->base-mem*n info size) (append-text info (append (case size ((1) (wrap-as (i386:byte-accu->base-mem))) @@ -1072,8 +1182,8 @@ (let ((source (with-output-to-string (lambda () (pretty-print-c99 o))))) (make-comment (string-join (string-split source #\newline) " ")))) -(define (accu*value info value) - (append-text info (wrap-as (case value +(define (accu*n info n) + (append-text info (wrap-as (case n ((1) (i386:accu->base)) ((2) (i386:accu+accu)) ((3) (append (i386:accu->base) @@ -1087,9 +1197,48 @@ (i386:accu+base) (i386:accu-shl 2))) ((16) (i386:accu-shl 4)) - (else (append (i386:value->base value) + (else (append (i386:value->base n) (i386:accu*base))))))) +(define (accu->base-mem*n- info n) + (wrap-as + (case n + ((1) (i386:byte-accu->base-mem)) + ((2) (i386:word-accu->base-mem)) + ;; ((3) (append (i386:word-accu->base-mem) + ;; (i386:accu+value 2) + ;; (i386:base+value 2) + ;; (i386:byte-accu->base-mem))) + ((4) (i386:accu->base-mem)) + (else (append (let loop ((i 0)) + (if (>= i n) '() + (append (if (= i 0) '() + (append (i386:accu+value 4) + (i386:base+value 4))) + (case (- n i) + ((1) (append (i386:accu+value -3) + (i386:base+value -3) + (i386:accu-mem->base-mem))) + ((2) (append (i386:accu+value -2) + (i386:base+value -2) + (i386:accu-mem->base-mem))) + ((3) (append (i386:accu+value -1) + (i386:base+value -1) + (i386:accu-mem->base-mem))) + (else (i386:accu-mem->base-mem))) + (loop (+ i 4)))))))))) + +(define (accu->base-mem*n info n) + (append-text info (accu->base-mem*n- info n))) + +(define (accu-mem->base-mem*n info n) + (append-text info (append (cond ((= n 1) (wrap-as (i386:byte-mem->accu))) + ((= n 2) (wrap-as (i386:word-mem->accu))) + ((= n 3) (wrap-as (i386:mem->accu))) + ((= n 4) (wrap-as (i386:mem->accu))) + (else '())) + (accu->base-mem*n- info n)))) + (define (expr->accu* info) (lambda (o) (pmatch o @@ -1107,7 +1256,7 @@ (size (if (or (= ptr 1) (= ptr -1)) (ast-type->size info type) 4)) (info ((expr->accu info) index)) - (info (accu*value info size))) + (info (accu*n info size))) (append-text info (append ((ident->base info) array) (wrap-as (i386:accu+base)))))) @@ -1201,7 +1350,7 @@ (size (if (or (= ptr -1) (= ptr 1)) (ast-type->size info type1) 4)) - (info (accu*value info size))) + (info (accu*n info size))) (append-text info (append (wrap-as (i386:push-accu)) ((ident->accu info) struct0) (wrap-as (append (i386:accu+value offset) @@ -1222,7 +1371,7 @@ (size (if (or (= ptr -1) (= ptr 1)) (ast-type->size info type1) 4)) - (info (accu*value info size))) + (info (accu*n info size))) (append-text info (append (wrap-as (i386:push-accu)) ((ident->accu info) struct0) (wrap-as (append (i386:accu+value offset) @@ -1237,7 +1386,7 @@ (ptr (expr->pointer info array)) (size (if (= ptr 1) (expr->size info array) 4)) - (info (accu*value info size)) + (info (accu*n info size)) (info ((expr->base info) array))) (append-text info (wrap-as (i386:accu+base))))) diff --git a/scaffold/tests/7h-struct-assign.c b/scaffold/tests/7h-struct-assign.c index 4de679f0..798b0151 100644 --- a/scaffold/tests/7h-struct-assign.c +++ b/scaffold/tests/7h-struct-assign.c @@ -26,22 +26,113 @@ struct string { int len; }; +typedef struct biggie { + int a; + int b; + int c; + char *str; + int len; +} biggie; + +struct other { + struct biggie big; +}; + struct string g_t; +struct biggie tab[2]; + int test () { struct string s = {"hallo"}; s.len = strlen (s.str); + eputs (s.str); eputs ("\n"); + struct string t; t = s; + eputs (t.str); eputs ("\n"); if (t.len != s.len) return 1; if (strcmp (t.str, s.str)) return 2; g_t = s; + eputs (g_t.str); eputs ("\n"); if (g_t.len != s.len) return 3; if (strcmp (g_t.str, s.str)) return 4; + struct biggie b; + b.str = "hello"; + b.len = strlen (b.str); + eputs (b.str); eputs ("\n"); + + struct biggie tb; + tb = b; + eputs (tb.str); eputs ("\n"); + if (tb.len != b.len) return 5; + if (strcmp (tb.str, b.str)) return 6; + + b.str = "bye"; + b.len = strlen (b.str); + eputs (b.str); eputs ("\n"); + //struct biggie *pb = &tb; + biggie *pb = &tb; + *pb = b; + eputs (tb.str); eputs ("\n"); + if (tb.len != b.len) return 7; + if (strcmp (tb.str, b.str)) return 8; + + tb.str = "there"; + tb.len = strlen (tb.str); + + b = *pb; + eputs (b.str); eputs ("\n"); + if (b.len != tb.len) return 9; + if (strcmp (b.str, tb.str)) return 10; + + char **x = &b.str; + char *p; + p = *x; + + struct other o; + struct other* po = &o; + po->big = b; + eputs (o.big.str); eputs ("\n"); + if (o.big.len != b.len) return 13; + if (strcmp (o.big.str, b.str)) return 14; + + po->big = *pb; + eputs (o.big.str); eputs ("\n"); + if (o.big.len != b.len) return 15; + if (strcmp (o.big.str, b.str)) return 16; + + b.str = "* = *"; + b.len = strlen (b.str); + eputs (b.str); eputs ("\n"); + struct biggie *q = tab; + pb = &b; + *q++ = *pb; + eputs (tab[0].str); eputs ("\n"); + if (tab[0].len != b.len) return 17; + if (strcmp (tab[0].str, b.str)) return 18; + + tab[1] = tab[0]; + eputs (tab[1].str); eputs ("\n"); + if (tab[1].len != b.len) return 19; + if (strcmp (tab[1].str, b.str)) return 20; + + tab[0].str = "burp"; + tab[0].len = strlen (tab[1].str); + eputs (tab[0].str); eputs ("\n"); + b = tab[0]; + eputs (b.str); eputs ("\n"); + if (b.len != tab[0].len) return 21; + if (strcmp (b.str, tab[0].str)) return 22; + + tab[1] = b; + eputs (tab[1].str); eputs ("\n"); + if (tab[1].len != b.len) return 23; + if (strcmp (tab[1].str, b.str)) return 24; + return 0; }