mescc: Tinycc support: struct.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 16 Jul 2017 17:00:01 +0000 (19:00 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 26 Jul 2017 09:36:08 +0000 (11:36 +0200)
* scaffold/tests/72-typedef-struct-def.c: New file.
* module/language/c99/compiler.mes (decl->info): Struct support for tinycc.

make.scm
module/language/c99/compiler.mes
scaffold/tests/72-typedef-struct-def.c [new file with mode: 0644]

index faca76c78d3a70db933a20e4770536224a3a699a..7c4218913c3db268b681c28af500f69f6a5da7e5 100755 (executable)
--- a/make.scm
+++ b/make.scm
@@ -150,7 +150,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
 (for-each
  add-scaffold-test
  '("70-printf"
-   "71-struct-array"))
+   "71-struct-array"
+   "72-typedef-struct-def"))
 
 (add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
 
index 9d9df0949ad43aba6ffee1e7681b4dbaece3b132..e488cc4a854fe810ebad3830b03b6081f1d436e2 100644 (file)
                 (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))
+                (size (ast-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))
                 (size (type->size info type)))
     ((decl-spec-list (type-spec (fixed-type ,type)))
      (type->size info type))
     ((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
-     (type->size info type))
+     (type->type info type))
+    ((struct-ref (ident (,type)))
+     (type->type info `("struct" ,type)))
     ((struct-ref (ident ,type))
      (type->size info `("struct" ,type)))
     (void 4)
   (pmatch o
     ((fixed-type ,type)
      type)
+    ((typename ,type)
+     type)
+    ((struct-ref (ident (,type)))
+     (list "struct" type))
     ((struct-ref (ident ,type))
      (list "struct" type))
     (_ (stderr "SKIP: type=~s\n" o)
 (define (decl->type o)
   (pmatch o
     ((fixed-type ,type) type)
+    ((struct-ref (ident (,name))) (list "struct" name))
     ((struct-ref (ident ,name)) (list "struct" name))
     ((struct-def (ident ,name) . ,fields) (list "struct" name))
     ((decl (decl-spec-list (type-spec (struct-ref (ident ,name))))) ;; "scm"
         ((string-prefix? "0" s) (string->number s 8))
         (else (string->number s))))
 
-(define (struct-field o)
-  (pmatch o
-    ((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
-                (comp-declr-list (comp-declr (ident ,name))))
-     (list name type 4))
-    ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
-     (list name type 4))
-    ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,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)))))
-     (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)))))
-     (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)))))
-     (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)))))
-     (list name type 4)) ;; FIXME: **
-    ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-     (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)))))
-     (list name '(void) 4))
-    ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,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)))))
-     (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)))))
-     (list name type 4))
-    (_ (error "struct-field: unsupported: " o))))
+(define (struct-field info)
+  (lambda (o)
+    (pmatch o
+      ((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
+                  (comp-declr-list (comp-declr (ident ,name))))
+       (list name type 4))
+      ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
+       (list name type 4))
+      ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,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)))))
+       (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)))))
+       (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)))))
+       (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)))))
+       (list name type 4)) ;; FIXME: **
+      ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
+       (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)))))
+       (list name '(void) 4))
+      ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
+       (list name type 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)))))
+       (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)))))
+       (list name type 4))
+
+      ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
+       (let ((size (type->size info `("struct" ,type))))
+         (list name type size 0)))
+
+      (_ (error "struct-field: unsupported: " o)))
+    )
+  )
 
 (define (ident->decl info o)
   (or (assoc-ref (.locals info) o)
             (clone info #:functions (cons (cons name #f) functions))))
       (pmatch o
 
+        ;; FIXME: Nyacc sometimes produces extra parens: (ident (<struct-name>))
+        ((decl (decl-spec-list (stor-spec ,spec) (type-spec (struct-ref (ident (,type))))) ,init)
+         ((decl->info info) `(decl (decl-spec-list (stor-spec ,spec) (type-spec (struct-ref (ident ,type)))) ,init)))
+        ((decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
+         ((decl->info info) `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))))
+
+        ((decl (decl-spec-list (type-spec (struct-def (ident (,type)) ,field-list))))
+         ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
+
+
+
         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
          (declare name))
 
         ((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
          info)
 
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident (,type))))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (or (get-type types type) `(typedef ("struct" ,type)))) types)))
-
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
          (clone info #:types (cons (cons name (or (get-type types type) `(typedef ("struct" ,type)))) types)))
 
          (clone info #:types (cons (cons name (or (get-type types type) `(typedef ,type))) types)))
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
-         (let ((info ((ast->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name)))))))
-           (clone info #:types (cons (cons name (or (get-type types `("struct" ,name)) `(typedef ,name))) types))))
+         ((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
+
+        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
+         (let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
+                (types (.types info)))
+           (clone info #:types (cons (cons name (or (get-type types `("struct" ,type)) `(typedef ,type))) types))))
+
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
          (let* ((type (get-type types type))
 
         ;; struct
         ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
-         (let ((type-entry (struct->type-entry name (map struct-field fields))))
+         (let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
            (clone info #:types (cons type-entry types))))
 
         ;; enum e i;
            (clone info
                   #:constants (append constants (.constants info)))))
 
-        ;; FIXME TCC/Nyacc madness here: extra parentheses around struct name?!?
-        ;; struct (FOO) WTF?
-        ((decl (decl-spec-list (type-spec (struct-def (ident (,name)) (field-list . ,fields)))))
-         (let ((type-entry (struct->type-entry name (map struct-field fields))))
+        ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
+         (let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
            (clone info #:types (cons type-entry types))))
 
-        ((decl (decl-spec-list (type-spec (struct-def (ident (,type)) (field-list . ,fields))))
+        ((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))
                (init-declr-list (init-declr (ident ,name))))
-         (let ((info ((ast->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))))))
-           ((ast->info info)
-            `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
+         (let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))))))
+           ((decl->info info) `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
 
         ;; struct f = {...};
         ;; LOCALS!
          (let loop ((inits `((init-declr (ident ,name) ,@initzer) ,@rest)) (info info))
            (if (null? inits) info
                (loop (cdr inits)
-                     ((ast->info info)
+                     ((decl->info info)
                       `(decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list ,(car inits))))))))
 
-
         ((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name)
          (format (current-error-port) "SKIP: typedef=~s\n" o)
          info)        
          (format (current-error-port) "SKIP: at=~s\n" o)
          info)
 
-        ((decl . _) (error "ast->info: unsupported: " o))))))
+        ((decl . _) (error "decl->info: unsupported: " o))))))
 
 (define (ast->info info)
   (lambda (o)
 (define (type->info info o)
   (pmatch o
     ((struct-def (ident ,name) (field-list . ,fields))
-     (let ((type-entry (struct->type-entry name (map struct-field fields))))
+     (let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
     (_  info)))
 
diff --git a/scaffold/tests/72-typedef-struct-def.c b/scaffold/tests/72-typedef-struct-def.c
new file mode 100644 (file)
index 0000000..4d4fa7e
--- /dev/null
@@ -0,0 +1,44 @@
+/* -*-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 <stdio.h>
+
+typedef struct foo
+{
+  int i;
+} foo;
+
+typedef struct
+{
+  int i;
+} bar;
+
+int
+test ()
+{
+  foo b = {1};
+  printf ("b.i=%d\n", b.i);
+
+  bar b = {2};
+  printf ("b.i=%d\n", b.i);
+
+  return 0;
+}