mescc: Support array in struct.
authorJan Nieuwenhuizen <janneke@gnu.org>
Wed, 31 May 2017 18:52:48 +0000 (20:52 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 31 May 2017 18:52:48 +0000 (20:52 +0200)
* module/language/c99/compiler.mes: (field:size, field-offset): New
  functions.  Update callers, use them throughout.
  (ast->info): Support declaration of struct and typedef'ed struct
  variable with array fields.
  (expr->accu, expr->accu*): Support foo.bar[baz], foo->bar[baz].
* scaffold/t-tcc.c: Test it.

module/language/c99/compiler.mes
scaffold/scaffold.make
scaffold/t-tcc.c [new file with mode: 0644]

index 49899b5d44e219ae10957322c545f7cf258424a5..d40c7621f7de12243bd8856935943810ec0f6cd6 100644 (file)
         ;; &f.field
         ((ref-to (d-sel (ident ,field) (p-expr (ident ,array))))
          (let* ((type (ident->type info array))
-                (fields (type->description info type))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+                (offset (field-offset info type field))
                 (text (.text info)))
            (append-text info (append ((ident->accu info) array)
                                      (wrap-as (i386:accu+n offset))))))
 
         ((sizeof-expr (p-expr (ident ,name)))
          (let* ((type (ident->type info name))
-                (fields (or (type->description info type) '()))
                 (size (type->size info type)))
            (append-text info (wrap-as (i386:value->accu size)))))
 
         ((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,name)))))
          (let* ((type name)
-                (fields (or (type->description info type) '()))
                 (size (type->size info type)))
            (append-text info (wrap-as (i386:value->accu size)))))
 
         ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
          (let* ((type (list "struct" name))
-                (fields (or (type->description info type) '()))
                 (size (type->size info type)))
            (append-text info (wrap-as (i386:value->accu size)))))
 
         ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
          (let* ((type (list "struct" name))
-                (fields (or (type->description info type) '()))
                 (size (type->size info type)))
            (append-text info (wrap-as (i386:value->accu size)))))
 
                                                 ((4) (i386:mem->accu))
                                                 (else '())))))))
 
+        ;; foo.bar[baz])
+        ((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct))))
+         (let ((info ((expr->accu* info) o)))
+           (append-text info (wrap-as (i386:mem->accu)))))
+
+        ;; foo->bar[baz])
+        ((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,struct))))
+         (let ((info ((expr->accu* info) o)))
+           (append-text info (wrap-as (i386:mem->accu)))))
+
         ;; f.field
         ((d-sel (ident ,field) (p-expr (ident ,array)))
          (let* ((type (ident->type info array))
-                (fields (type->description info type))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+                (offset (field-offset info type field))
                 (text (.text info)))
            (append-text info (append ((ident->accu info) array)
                                      (wrap-as (i386:mem+n->accu offset))))))
 
         ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
          (let* ((type (ident->type info array))
-                (fields (or (type->description info type) '()))
-                (field-size 4) ;; FIXME:4, not fixed
-                (rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
-                          (begin
-                            (stderr "no field:~a\n" field)
-                            '())))
-                (offset (* field-size (1- (length rest))))
+                (offset (field-offset info type field))
                 (info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
            (append-text info (wrap-as (i386:mem+n->accu offset)))))
 
         ((i-sel (ident ,field) (p-expr (ident ,array)))
          (let* ((type (ident->type info array))
-                (fields (type->description info type))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+                (offset (field-offset info type field))
                 (text (.text info)))
            (append-text info (append ((ident-address->accu info) array)
                                      (wrap-as (i386:mem->accu))
              ((p-expr (ident ,name)) (append-text info ((accu->ident info) name)))
              ((d-sel (ident ,field) ,p-expr)
               (let* ((type (p-expr->type info p-expr))
-                     (fields (type->description info type))
-                     (size (type->size info type))
-                     (field-size 4) ;; FIXME:4, not fixed
-                     (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))                
+                     (offset (field-offset info type field))
                      (info (append-text info (wrap-as (i386:push-accu))))
                      (info ((expr->accu* info) a))
                      (info (append-text info (wrap-as (i386:pop-base)))))
                 (append-text info (append (wrap-as (i386:accu->base))
                                           ((base->ident-address info) array)
                                           (i386:base->accu)))))
+             ((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct))))
+              (let* ((info (append-text info (wrap-as (i386:push-accu))))
+                     (info ((expr->accu* info) a))
+                     (info (append-text info (wrap-as (i386:pop-base)))))
+                (append-text info (wrap-as (i386:base->accu-address)))))
+             ((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,struct))))
+              (let* ((info (append-text info (wrap-as (i386:push-accu))))
+                     (info ((expr->accu* info) a))
+                     (info (append-text info (wrap-as (i386:pop-base)))))
+                (append-text info (wrap-as (i386:base->accu-address)))))
              ((array-ref ,index (p-expr (ident ,array)))
               (let* ((type (ident->type info array))
                      (size (type->size info type))
       ;; g_cells[<expr>].type
       ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
        (let* ((type (ident->type info array))
-              (fields (or (type->description info type) '()))
-              (field-size 4) ;; FIXME:4, not fixed
-              (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+              (offset (field-offset info type field))
               (info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
          (append-text info (wrap-as (append (i386:accu+value offset))))))
 
       ((d-sel (ident ,field) (p-expr (ident ,name)))
        (let* ((type (ident->type info name))
-              (fields (or (type->description info type) '()))
-              (field-size 4) ;; FIXME
-              (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+              (offset (field-offset info type field))
               (text (.text info)))
          (append-text info (append ((ident->accu info) name)
                                    (wrap-as (i386:accu+value offset))))))
 
+      ;; foo.bar[baz]
+      ((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,name))))
+       (let* ((type (ident->type info name))
+              (offset (field-offset info type field))
+              (info ((expr->accu info) index)))
+         (append-text info (append (wrap-as (append (i386:accu-shl 2) ;; FIXME: assume size=4
+                                                    (i386:push-accu)))
+                                   ((ident-address->accu info) name)
+                                   (wrap-as (append (i386:accu+value offset)
+                                                    (i386:pop-base)
+                                                    (i386:accu+base)))))))
+
+      ;; foo->bar[baz]
+      ((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,name))))
+       (let* ((type (ident->type info name))
+              (offset (field-offset info type field))
+              (info ((expr->accu info) index)))
+         (append-text info (append (wrap-as (append (i386:accu-shl 2) ;; FIXME: assume size=4
+                                                    (i386:push-accu)))
+                                   ((ident->accu info) name)
+                                   (wrap-as (append (i386:accu+value offset)
+                                                    (i386:pop-base)
+                                                    (i386:accu+base)))))))
+      
       (_ (error "expr->accu*: unsupported: " o)))))
 
 (define (ident->constant name value)
   (make-type name 'enum 4 fields))
 
 (define (struct->type name fields)
-  (make-type name 'struct (* 4 (length fields)) fields)) ;; FIXME
+  (make-type name 'struct (apply + (map field:size fields)) fields))
+
+(define i386:type-alist
+  '(("char" . (builtin 1 #f))
+    ("short" . (builtin 2 #f))
+    ("int" . (builtin 4 #f))
+    ("long" . (builtin 4 #f))
+    ("long long" . (builtin 8 #f))
+    ;; FIXME sign
+    ("unsigned char" . (builtin 1 #f))
+    ("unsigned short" . (builtin 2 #f))
+    ("unsigned" . (builtin 4 #f))
+    ("unsigned int" . (builtin 4 #f))
+    ("unsigned long" . (builtin 4 #f))
+    ("unsigned long long" . (builtin 8 #f))))
+
+(define (field:size o)
+  (pmatch o
+    ((,name ,type ,size ,pointer) size)
+    (_ 4)))
+
+(define (type->size info o)
+  (pmatch o
+    ((decl-spec-list (type-spec (fixed-type ,type)))
+     (type->size info type))
+    ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
+     (type->size info type))
+    ((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
+     (type->size info type))
+    ((struct-ref (ident ,type))
+     (type->size info `("struct" ,type)))
+    (_ (let ((type (get-type (.types info) o)))
+         (if type (cadr type)
+             (error "type->size: unsupported: " o))))))
+
+(define (field-offset info struct field)
+  (let* ((fields (type->description info struct))
+         (prefix (and=> (member field (reverse fields) (lambda (a b) (equal? a (car b)))) cdr
+)))
+    (apply + (map field:size prefix))))
+
+(define (ast->type o)
+  (pmatch o
+    ((fixed-type ,type)
+     type)
+    ((struct-ref (ident ,type))
+     (list "struct" type))
+    (_ (stderr "SKIP: type=~s\n" o)
+       "int")))
 
 (define (decl->type o)
   (pmatch o
   (pmatch o
     ((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
                 (comp-declr-list (comp-declr (ident ,name))))
-     (cons type name))
+     (list name type 4))
     ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
-     (cons type name))
+     (list name type 4))
     ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
-     (cons type name))
+     (list name type 4))
     ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-     (cons type name)) ;; FIXME: **
+     (list name type 4)) ;; FIXME: **
     ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
-     (cons type name)) ;; FIXME function / int
+     (list name type 4)) ;; FIXME function / int
     ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-     (cons type name)) ;; FIXME: ptr/char
+     (list name type 4)) ;; FIXME: ptr/char
     ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-     (cons type name)) ;; FIXME: **
+     (list name type 4)) ;; FIXME: **
     ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-     (cons '(void) name)) ;; FIXME: *
+     (list name '(void) 4)) ;; FIXME: *
     ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
-     (cons '(void) name))
+     (list name '(void) 4))
     ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-     (cons '(void) name))
-    ;; FIXME: BufferedFile *include_stack[INCLUDE_STACK_SIZE];
-    ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) (p-expr (fixed ,size)))))))
-     (cons type name)) ;; FIXME: decl, array size
-    ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) (p-expr (fixed ,size))))))
-     (cons type name))
+     (list name '(void) 4))
+    ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) (p-expr (fixed ,count)))))))
+     (let ((size 4)
+           (count (cstring->number count)))
+       (list name type (* count size) 0)))
+    ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
+     (let ((size 4)
+           (count (cstring->number count)))
+       (list name type (* count size) 0)))
+    ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
+     (let ((size 4)
+           (count (cstring->number count)))
+       (list name type (* count size) 0)))
     ;; struct InlineFunc **inline_fns;
     ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-     (cons type name))
+     (list name type 4))
     ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-     (cons type name))
+     (list name type 4))
     (_ (error "struct-field: unsupported: " o))))
 
-(define (ast->type o)
-  (pmatch o
-    ((fixed-type ,type)
-     type)
-    ((struct-ref (ident ,type))
-     (list "struct" type))
-    (_ (stderr "SKIP: type=~s\n" o)
-       "int")))
-
-(define i386:type-alist
-  '(("char" . (builtin 1 #f))
-    ("short" . (builtin 2 #f))
-    ("int" . (builtin 4 #f))
-    ("long" . (builtin 4 #f))
-    ("long long" . (builtin 8 #f))
-    ;; FIXME sign
-    ("unsigned char" . (builtin 1 #f))
-    ("unsigned short" . (builtin 2 #f))
-    ("unsigned" . (builtin 4 #f))
-    ("unsigned int" . (builtin 4 #f))
-    ("unsigned long" . (builtin 4 #f))
-    ("unsigned long long" . (builtin 8 #f))))
-
-(define (type->size info o)
-  (pmatch o
-    ((decl-spec-list (type-spec (fixed-type ,type)))
-     (type->size info type))
-    ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
-     (type->size info type))
-    ((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
-     (type->size info type))
-    ((struct-ref (ident ,type))
-     (type->size info `("struct" ,type)))
-    (_ (let ((type (get-type (.types info) o)))
-         (if type (cadr type)
-             (error "type->size: unsupported: " o))))))
-
 (define (ident->decl info o)
   (or (assoc-ref (.locals info) o)
       (assoc-ref (.globals info) o)
                (let* ((local (car (add-local locals name type -1)))
                       (count (string->number count))
                       (size (type->size info type))
-                      (local (make-local name type -1 (+ (local:id local) (* count size))))
+                      (local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))                      
                       (locals (cons local locals))
                       (info (clone info #:locals locals)))
                  info)
                (let* ((local (car (add-local locals name type -1)))
                       (count (string->number count))
                       (size (type->size info type))
-                      (local (make-local name type 1 (+ (local:id local) (* count size))))
+                      (local (make-local name type 1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
                       (locals (cons local locals))
                       (info (clone info #:locals locals)))
                  info)
         ;; struct foo bar;
         ((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
          (if (.function info)
-             (let* ((locals (add-local locals name `("struct" ,type) 1))
-                    (info (clone info #:locals locals)))
-               info)
+             (let* ((size (type->size info (list "struct" type)))
+                    (local (car (add-local locals name type 1)))
+                    (local (make-local name `("struct" ,type) -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
+                    (locals (cons local locals)))
+               (clone info #:locals locals))
              (let* ((size (type->size info (list "struct" type)))
                     (global (make-global name (list "struct" type) -1 (string->list (make-string size #\nul))))
                     (globals (append globals (list global)))
                (append-text info (append ((ident->accu info) name)
                                          ((accu->ident info) value)))))) ;; FIXME: deref?
 
-
         ;; SCM tmp;
         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name))))
          (if (.function info)
-             (clone info #:locals (add-local locals name type 0))
+             (let ((size (type->size info type)))
+               (if (<= size 4) (clone info #:locals (add-local locals name type 0))
+                   (let* ((local (car (add-local locals name type 1)))
+                          (local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
+                          (locals (cons local locals)))
+                     (clone info #:locals locals))))
              (clone info #:globals (append globals (list (ident->global name type 0 0))))))
 
         ;; SCM g_stack = 0;
          (let* ((type (decl->type type))
                 (fields (type->description info type))
                 (size (type->size info type))
-                (field-size 4)  ;; FIXME:4, not fixed
                 (initzers (map (initzer->non-const info) initzers)))
            (if (.function info)
                (let* ((globals (append globals (filter-map initzer->global initzers)))
                       (locals (add-local locals name type -1))
                       (info (clone info #:locals locals #:globals globals))
                       (empty (clone info #:text '())))
-                 (let loop ((fields (iota (length fields))) (initzers initzers) (info info))
+                 (let loop ((fields fields) (initzers initzers) (info info))
                    (if (null? fields) info
-                       (let ((offset (* field-size (car fields)))
+                       (let ((offset (field-offset info type (caar fields)))
                              (initzer (car initzers)))
                          (loop (cdr fields) (cdr initzers)
                                (clone info #:text
                (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)))
-                      (info (clone info #:globals globals))
-                      (field-size 4))
-                 (let loop ((fields (iota (length fields))) (initzers initzers) (info info))
+                      (info (clone info #:globals globals)))
+                 (let loop ((fields fields) (initzers initzers) (info info))
                    (if (null? fields) info
-                       (let ((offset (* field-size (car fields)))
+                       (let ((offset (field-offset info type (caar fields)))
                              (initzer (car initzers)))
                          (loop (cdr fields) (cdr initzers)
                                (clone info #:init
                                              (append
                                               (list-head data (+ here ,offset))
                                               (initzer->data f g ta t d ',(car initzers))
-                                              (list-tail data (+ here ,offset ,field-size))))))))))))))))
+                                              (list-tail data (+ here ,offset ,(field:size (car fields))))))))))))))))))
 
 
         ;;char cc = g_cells[c].cdr;  ==> generic?
index 6939d4c3a0d952ef8b8670f968cd001c545bab8e..fbf28f9a3edf737580297708c53aa9d0a2d17390 100644 (file)
@@ -27,6 +27,15 @@ include make/bin.make
 TARGET:=t
 include make/check.make
 
+TARGET:=t-tcc
+C_FILES:=$(DIR)/t-tcc.c
+DEFINES:=POSIX=1
+INCLUDES:=libc
+include make/bin.make
+
+TARGET:=t-tcc
+include make/check.make
+
 TARGET:=m.mlibc
 C_FILES:=$(DIR)/m.c
 include make/bin-mlibc.make
@@ -59,6 +68,18 @@ include make/bin-mlibc.make
 TARGET:=t.mlibc
 include make/check.make
 
+TARGET:=t-tcc.mlibc
+C_FILES:=$(DIR)/t-tcc.c
+include make/bin-mlibc.make
+
+TARGET:=t-tcc.mlibc
+include make/check.make
+
+CROSS:=$(CC32:%gcc=%)
+#$(OUT)/$(DIR)/mini-mes.$(CROSS)o: $(SNARF.MES)
+$(OUT)/mini-mes: $(SNARF.MES)
+
+TARGET:=mini-mes.mlibc
 # guile/mescc.scm
 
 TARGET:=m.guile
@@ -93,6 +114,13 @@ include make/mescc-guile.make
 TARGET:=t.guile
 include make/check.make
 
+TARGET:=t-tcc.guile
+C_FILES:=$(DIR)/t-tcc.c
+include make/mescc-guile.make
+
+TARGET:=t-tcc.guile
+include make/check.make
+
 # scripts/mescc.mes
 ifneq ($(MES),)
 TARGET:=m.mes
diff --git a/scaffold/t-tcc.c b/scaffold/t-tcc.c
new file mode 100644 (file)
index 0000000..e3af7fc
--- /dev/null
@@ -0,0 +1,47 @@
+/* -*-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 <stdio.h>
+
+struct foo;
+
+typedef struct foo foo_struct;
+
+struct foo
+{
+  int bar[2];
+};
+  
+int
+main (int argc, char *argv[])
+{
+  //struct foo f;
+  foo_struct f;
+  f.bar[0] = 0x22;
+  f.bar[1] = 0x34;
+  printf ("eentje: %d\n", f.bar[0]);
+  printf ("tweetje: %d\n", f.bar[1]);
+
+  struct foo *g = &f;
+  printf ("punter eentje: %d\n", g->bar[0]);
+  printf ("punter tweetje: %d\n", g->bar[1]);
+
+  return 0;
+}