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.

diff --git a/make.scm b/make.scm
index a515782bc19298677267d364259b22aeb5c3b227..2b9e7bf7d9c73f94c7da9a6655b273735240191c 100755 (executable)
--- 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 f8566850df8ab1a695effe46f4fc0726e0a6d88e..28e82726f142a37904a2ef13586958838c1b403e 100644 (file)
--- 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 4de679f0e93b305a7fa27c039824729032a74e24..798b015117e7060d63eeefbc6fa352d63822c8af 100644 (file)
--- 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;
 }