andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mescc: Tinycc support: struct by value assign. 

* module/language/c99/compiler.mes (expr->accu): warn for unsupported
  sizes.
* scaffold/tests/7h-struct-assign.c (test): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2017-09-10 16:59:53 +02:00
parent 2896ce46c4
commit 9555d90174
3 changed files with 253 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
make.scm
View File

@ -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

173
module/language/c99/compiler.mes
View File

@ -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)))))

91
scaffold/tests/7h-struct-assign.c
View File

@ -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;
}