mescc: Tinycc support: anonymous union.

* module/language/c99/compiler.mes (field:name): New function.
  (decl->info): Use it.
  (struct-field): Support anonymous union.
  (field:size): Update.
  (field-field): Update.
  (field-offset): Update.

diff --git a/make.scm b/make.scm
index 0428fbc9fa3a47461fbd176bb97d9f9e5b7c5c55..190cae536a00dfedf2cd9acb35db238b109442dd 100755 (executable)
--- a/make.scm
+++ b/make.scm
@@ -153,7 +153,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
    "71-struct-array"
    "72-typedef-struct-def"
    "73-union"
-   "74-multi-line-string"))
+   "74-multi-line-string"
+   "75-struct-union"))
 
 (add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
 

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 68dfa585929ec757c8dabab5eb2689421b06f91a..998548fb7e86ecbafdbc5ae971a77563057da266 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -1105,8 +1105,17 @@
     ("unsigned long" . ,(make-type 'builtin 4 0 #f))
     ("unsigned long long" . ,(make-type 'builtin 8 0 #f))))
 
+(define (field:name o)
+  (pmatch o
+    ((union (,name ,type ,size ,pointer) . ,rest) name)
+    ((union (,name ,type ,size) . ,rest) name)
+    ((,name ,type ,size ,pointer) name)
+    ((,name ,type ,size) name)
+    (_ (error "field:name not supported:" o))))
+
 (define (field:size o)
   (pmatch o
+    ((union . ,fields) 4) ;; FIXME
     ((,name ,type ,size ,pointer) size)
     ((,name ,type ,size) size)
     (_ 4)))
@@ -1154,14 +1163,26 @@
 (define (field-field info struct field)
   (let* ((xtype (ast-type->type info struct))
          (fields (type:description xtype)))
-    (and=> (member field fields (lambda (a b) (equal? a (car b)))) car)))
+    (let loop ((fields fields))
+      (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
+          (let ((f (car fields)))
+            (cond ((equal? (car f) field) f)
+                  ((and (eq? (car f) 'union)
+                        (find (lambda (x) (equal? (car x) field)) (cdr f))))
+                  (else (loop (cdr fields)))))))))
 
 (define (field-offset info struct field)
   (let ((xtype (ast-type->type info struct)))
     (if (eq? (type:type xtype) 'union) 0
-        (let* ((fields (type:description xtype))
-               (prefix (and=> (member field (reverse fields) (lambda (a b) (equal? a (car b)))) cdr)))
-          (apply + (map field:size prefix))))))
+        (let ((fields (type:description xtype)))
+          (let loop ((fields fields) (offset 0))
+            (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
+                (let ((f (car fields)))
+                  (cond ((equal? (car f) field) offset)
+                        ((and (eq? (car f) 'union)
+                              (find (lambda (x) (equal? (car x) field)) (cdr f))
+                              offset))
+                        (else (loop (cdr fields) (+ offset (field:size f))))))))))))
 
 (define (field-size info struct field)
   (let ((xtype (ast-type->type info struct)))
@@ -1384,6 +1405,9 @@
        (let ((size (ast-type->size info `("struct" ,type))))
          (list name type size 0)))
 
+      ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
+       `(union ,@(map (struct-field info) fields)))
+
       (_ (error "struct-field: unsupported: " o)))
     )
   )
@@ -1772,7 +1796,7 @@
                       (empty (clone info #:text '())))
                  (let loop ((fields fields) (initzers initzers) (info info))
                    (if (null? fields) info
-                       (let ((offset (field-offset info type (caar fields)))
+                       (let ((offset (field-offset info type (field:name (car fields))))
                              (initzer (car initzers)))
                          (loop (cdr fields) (cdr initzers)
                                (clone info #:text

diff --git a/scaffold/tests/75-struct-union.c b/scaffold/tests/75-struct-union.c
new file mode 100644 (file)
index 0000000..0ba8630
--- /dev/null
+++ b/scaffold/tests/75-struct-union.c
@@ -0,0 +1,42 @@
+/* -*-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>
+
+struct foo
+{
+  union {
+    int bar;
+    int baz;
+  };
+};
+
+int
+test ()
+{
+  struct foo f = {2};
+  printf ("f.bar=%d\n", f.bar);
+  if (f.bar != 2) return 1;
+  printf ("f.baz=%d\n", f.baz);
+  if (f.baz != 2) return 1;
+  
+  return 0;
+}