mescc: Tinycc support: struct struct array.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 17 Nov 2017 14:24:45 +0000 (15:24 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 17 Nov 2017 14:24:45 +0000 (15:24 +0100)
Support

  struct foo
  {
    struct bar baz[N];
    struct bar bla*[M];
  };

* module/language/c99/compiler.mes (expr->accu):
* scaffold/tests/7n-struct-struct-array.c: Test it.
* make.scm (add-scaffold-test): Build it.

make.scm
module/language/c99/compiler.mes
scaffold/tests/7n-struct-struct-array.c [new file with mode: 0644]

index 915a74dd2a2c7192603447839c4d233d55be02b6..34ad32404c69d28a4275f2e2d94cdefb179a4958 100755 (executable)
--- a/make.scm
+++ b/make.scm
@@ -245,7 +245,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
    "7j-strtoull"
    "7k-for-each-elem"
    "7l-struct-any-size-array"
-   "7m-struct-char-array-assign"))
+   "7m-struct-char-array-assign"
+   "7n-struct-struct-array"))
 
 (add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
 
index 978dd3b97d4c7e0ddf8b7fca3f002930124c3e09..f5643c91440c7538529d3f5b32784a0e83093c7d 100644 (file)
                 (info (clone info #:globals globals)))
            (append-text info (list (i386:label->accu `(#:string ,string))))))
 
-        ;;; FIXME: FROM INFO ...only zero?!
+        ;; FIXME: FROM INFO ...only zero?!
         ((p-expr (fixed ,value))
          (let ((value (cstring->number value)))
            (append-text info (wrap-as (i386:value->accu value)))))
 
         ((d-sel ,field ,struct)
          (let* ((info ((expr->accu* info) o))
+                (info (append-text info (ast->comment o)))
                 (ptr (expr->pointer info o))
                 (size (if (= ptr 0) (expr->type-size info o)
                           4)))
-           (if (= ptr -1) info
-                  (append-text info (wrap-as (case size
+           (if (or (= -2 ptr) (= -1 ptr)) info
+               (append-text info (wrap-as (case size
                                             ((1) (i386:byte-mem->accu))
                                             ((2) (i386:word-mem->accu))
                                             ((4) (i386:mem->accu))
 
         ((i-sel ,field ,struct)
          (let* ((info ((expr->accu* info) o))
+                (info (append-text info (ast->comment o)))
                 (ptr (expr->pointer info o))
                 (size (if (= ptr 0) (expr->type-size info o)
                           4)))
-           (if (= ptr -1) info
-                  (append-text info (wrap-as (case size
+           (if (or (= -2 ptr) (= ptr -1)) info
+               (append-text info (wrap-as (case size
                                             ((1) (i386:byte-mem->accu))
                                             ((2) (i386:word-mem->accu))
                                             ((4) (i386:mem->accu))
                 (info (append ((expr->accu info) expr))))
            info))
 
+
+
         ((add ,a (p-expr (fixed ,value)))
-         (let* ((ptr (expr->pointer info a))
+         ;;(stderr "add ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o))))
+         (let* ((ptr (pke "ptr" (expr->pointer info a)))
                 (type0 (expr->type info a))
-                (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
+                (struct? (pke "struct" (memq (type:type (ast-type->type info type0)) '(struct union))))
                 (size (cond ((= ptr 1) (expr->type-size info a))
                             ((> ptr 1) 4)
                             ((and struct? (= ptr -2)) 4)
                             (else 1)))
                 (info ((expr->accu info) a))
                 (value (cstring->number value))
-                (value (* size value)))
+                (value (pke "VALUE" (* size value))))
+           (pke "size" size)
            (append-text info (wrap-as (i386:accu+value value)))))
 
         ((add ,a ,b)
            (append-text info (wrap-as (i386:accu+value (- value))))))
 
         ((sub ,a ,b)
-         (let* ((ptr (expr->pointer info a))
-                (ptr-b (expr->pointer info b))
+         ;;(stderr "sub ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o))))
+         (let* ((ptr (pke "ptr" (expr->pointer info a)))
+                (ptr-b (pke "ptr-b" (expr->pointer info b)))
                 (type0 (expr->type info a))
-                (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
-                (size (cond ((= ptr 1) (expr->type-size info a))
-                            ((> ptr 1) 4)
-                            ((and struct? (= ptr -2)) 4)
-                            ((and struct? (= ptr 2)) 4)
-                            (else 1))))
-           (if (or (= size 1) (= ptr-b 1)) (let ((info ((binop->accu info) a b (i386:accu-base))))
-                                             (if (not (= ptr-b 1)) info
-                                                 (append-text info (wrap-as (append (i386:value->base size)
-                                                                                    (i386:accu/base))))))
+                (struct? (pke "struct?" (memq (type:type (ast-type->type info type0)) '(struct union))))
+                (size  (cond ((= ptr 1) (expr->type-size info a))
+                             ((> ptr 1) 4)
+                             ((and struct? (= ptr -2)) 4)
+                             ((and struct? (= ptr 2)) 4)
+                             (else 1))))
+           (pke "size" size)
+           (if (or (= size 1) (or (= ptr-b -2) (= ptr-b 1)))
+               (let ((info ((binop->accu info) a b (i386:accu-base))))
+                 (if (and (not (= ptr-b -2)) (not (= ptr-b 1))) info
+                     (append-text info (wrap-as (append (i386:value->base size)
+                                                        (i386:accu/base))))))
                (let* ((info ((expr->accu info) b))
                       (info (append-text info (wrap-as (append (i386:value->base size)
                                                                (i386:accu*base)
 
         ((neg ,expr)
          (let ((info ((expr->base info) expr)))
-          (append-text info (append (wrap-as (i386:value->accu 0))
-                                    (wrap-as (i386:sub-base))))))
+           (append-text info (append (wrap-as (i386:value->accu 0))
+                                     (wrap-as (i386:sub-base))))))
 
         ((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
         ((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
                 (ptr-b (expr->pointer info b))
                 (size-a (expr->size info a))
                 (size-b (expr->size info b))
-                ;;(foo (stderr "assign ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))))
-                ;;(foo (stderr "  size-a: ~a, ptr=~a\n" size-a ptr-a))
-                ;;(foo (stderr "  size-b: ~a, ptr=~a\n" size-b ptr-b))
+                ;; (foo (stderr "assign ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))))
+                ;; (foo (stderr "  size-a: ~a, ptr=~a\n" size-a ptr-a))
+                ;; (foo (stderr "  size-b: ~a, ptr=~a\n" size-b ptr-b))
                 (info ((expr->accu info) b))
                 (info (if (equal? op "=") info
                           (let* ((ptr (expr->pointer info a))
                                  (info ((expr->accu info) a))
                                  (info (append-text info (wrap-as (i386:pop-base))))
                                  (info (append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
-                                                     ((equal? op "-=") (wrap-as (i386:accu-base)))
-                                                     ((equal? op "*=") (wrap-as (i386:accu*base)))
-                                                     ((equal? op "/=") (wrap-as (i386:accu/base)))
-                                                     ((equal? op "%=") (wrap-as (i386:accu%base)))
-                                                     ((equal? op "&=") (wrap-as (i386:accu-and-base)))
-                                                     ((equal? op "|=") (wrap-as (i386:accu-or-base)))
-                                                     ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
-                                                     ((equal? op ">>=") (wrap-as (i386:accu>>base)))
-                                                     ((equal? op "<<=") (wrap-as (i386:accu<<base)))
-                                                     (else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
+                                                               ((equal? op "-=") (wrap-as (i386:accu-base)))
+                                                               ((equal? op "*=") (wrap-as (i386:accu*base)))
+                                                               ((equal? op "/=") (wrap-as (i386:accu/base)))
+                                                               ((equal? op "%=") (wrap-as (i386:accu%base)))
+                                                               ((equal? op "&=") (wrap-as (i386:accu-and-base)))
+                                                               ((equal? op "|=") (wrap-as (i386:accu-or-base)))
+                                                               ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
+                                                               ((equal? op ">>=") (wrap-as (i386:accu>>base)))
+                                                               ((equal? op "<<=") (wrap-as (i386:accu<<base)))
+                                                               (else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
                             (cond ((not (and (= ptr 1) (= ptr-b 1))) info)
                                   ((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
                                                                                        (i386:accu/base)))))
      (- (expr->number info a) (expr->number info b)))
     ((sizeof-type (type-name (decl-spec-list (type-spec ,type))))
      (ast-type->size info type))
+    ((sizeof-expr (d-sel (ident ,field) (p-expr (ident ,struct))))
+     (let ((type (ident->type info struct)))
+       (field-size info type field)))
     ((sizeof-expr (i-sel (ident ,field) (p-expr (ident ,struct))))
      (let ((type (ident->type info struct)))
        (field-size info type field)))
       ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) ,count)))))
        (let ((size 4)
              (count (expr->number info count)))
-         (list name type (* count size) -1)))
+         (list name type (* count size) -2)))
+
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
        (let ((size (ast-type->size info type))
              (count (expr->number info count)))
diff --git a/scaffold/tests/7n-struct-struct-array.c b/scaffold/tests/7n-struct-struct-array.c
new file mode 100644 (file)
index 0000000..24517d5
--- /dev/null
@@ -0,0 +1,104 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include "30-test.i"
+
+#include <mlibc.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+typedef struct file {
+  char name[10];
+} file_struct;
+
+#define STACK_SIZE 2
+struct state {
+  int bla;
+  file_struct *stack[STACK_SIZE];
+  char buf[100];
+  file_struct **stack_ptr;
+  char buf1[100];
+};
+
+int
+test ()
+{
+  struct state s;
+  struct state *ps;
+  ps = &s;
+  eputs ("0\n");
+
+  s.stack_ptr = s.stack;
+  ps->stack_ptr = ps->stack;
+  eputs ("ps->stack="); eputs (itoa (ps->stack)); eputs ("\n");
+
+  eputs ("1\n");
+  if (ps->stack_ptr >= ps->stack + STACK_SIZE) return 1;
+  eputs ("2\n");
+
+  struct file f = {"first.h"};
+#if 0 //__MESC__
+  strcpy (f.name, "first.h");
+#endif
+  eputs (f.name); eputs ("\n");
+
+  *ps->stack_ptr = &f;
+
+  eputs ("3\n");
+  ++ps->stack_ptr;
+  eputs ("s.stack_ptr -stack ="); eputs (itoa (ps->stack_ptr - ps->stack)); eputs ("\n");
+  eputs ("4\n");
+
+  for (file_struct **p = ps->stack; p < ps->stack_ptr; p++)
+    {
+      eputs ((*p)->name); eputs ("\n");
+    }
+
+  eputs ("5\n");
+
+  int i;
+  i = ps->stack_ptr - ps->stack + STACK_SIZE;
+  eputs ("i="); eputs (itoa (i)); eputs ("\n");
+
+  if (ps->stack_ptr >= ps->stack + STACK_SIZE) return 2;
+
+  eputs ("6\n");
+  struct file f2 = {"second.h"};
+#if 0//__MESC__
+  strcpy (f2.name, "second.h");
+#endif
+
+  *ps->stack_ptr = &f2;
+  eputs ("7\n");
+  ++ps->stack_ptr;
+  eputs ("s.stack_ptr -stack ="); eputs (itoa (ps->stack_ptr - ps->stack)); eputs ("\n");
+
+  for (file_struct **p = ps->stack; p < ps->stack_ptr; p++)
+    {
+      eputs ((*p)->name); eputs ("\n");
+    }
+
+  if (ps->stack_ptr >= ps->stack + STACK_SIZE) return 0;
+  struct file f3 = {"third.h"};
+  *ps->stack_ptr = &f3;
+  ++ps->stack_ptr;
+  return 3;
+}