mescc: Tinycc support: Structured type with char or short on heap.

* module/language/c99/compiler.mes (int->bv): New function.
  (init->data): Use it.  Add parameter.  Update callers.
  (array-init->data): Add type parmeter.
  (array-init-element->data): Likewise.
* module/mes/bytevectors.mes (bytevector-u8-set!): New function.
* module/mes/bytevectors.scm (mes): Export it.
* module/mes/as.mes (int->bv8): New function.

build-aux/check-mescc.sh

@@ -116,6 +116,7 @@ t
 7p-struct-cast
 7q-bit-field
 7r-sign-extend
+7s-struct-short
 80-setjmp
 81-qsort
 82-define
@@ -228,7 +229,6 @@ broken="$broken
 
 31_args
 37_sprintf
-38_multiple_array_index
 39_typedef
 
 40_stdio
@@ -245,7 +245,6 @@ broken="$broken
 #30_hanoi                ; fails with GCC
 #34_array_assignment     ; fails with GCC
 #37_sprintf              ; integer formatting unsupported
-#38_multiple_array_index ; unspported: (decl (decl-spec-list (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (array-of (ident "a") (p-expr (fixed "4"))) (p-expr (fixed "4"))))))
 #39_typedef              ;unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename "MyFunStruct"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "MoreFunThanEver")))))
 
 #40_stdio                ; f* functions

module/language/c99/compiler.mes

@@ -648,7 +648,8 @@
   (let ((type (global:type o)))
     (cond ((or (c-array? type)
                (structured-type? type)) (wrap-as (i386:label->accu `(#:address ,o))))
-          (else (wrap-as (i386:label-mem->accu `(#:address ,o)))))))
+          (else (append (wrap-as (i386:label-mem->accu `(#:address ,o)))
+                        (convert-accu type))))))
 
 (define (number->accu o)
   (wrap-as (i386:value->accu o)))
@@ -2076,40 +2077,47 @@
 (define (global->info type name o init info)
   (let* ((rank (->rank type))
          (size (->size type))
-         (array? (or (and (c-array? type) type)
-                     (and (pointer? type)
-                          (c-array? (pointer:type type))
-                          (pointer:type type))
-                     (and (pointer? type)
-                          (pointer? (pointer:type type))
-                          (c-array? (pointer:type (pointer:type type)))
-                          (pointer:type (pointer:type type)))))
          (data (cond ((not init) (string->list (make-string size #\nul)))
-                     (array? (let* ((string (array-init->string init))
+                     ((c-array? type)
-                                    (size (or (and string (max size (1+ (string-length string))))
+                      (let* ((string (array-init->string init))
-                                              size))
+                             (size (or (and string (max size (1+ (string-length string))))
-                                    (data (or (and=> string string->list)
+                                       size))
-                                              (array-init->data size init info))))
+                             (data  (or (and=> string string->list)
-                               (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))
+                                        (array-init->data type size init info))))
-                     (else (let ((data (init->data init info)))
+                        (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))
-                             (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))))
+                     ((structured-type? type)
+                      (let ((data (init->data type init info)))
+                        (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))
+                     (else
+                      (let ((data (init->data type init info)))
+                        (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))))
          (global (make-global-entry name type data)))
     (clone info #:globals (append (.globals info) (list global)))))
 
-(define (array-init-element->data size o info)
+(define (array-init-element->data type o info)
   (pmatch o
     ((initzer (p-expr (string ,string)))
      `((#:string ,string)))
     ((initzer (p-expr (fixed ,fixed)))
-     (int->bv32 (expr->number info fixed)))
+     (int->bv type (expr->number info fixed)))
-    (_ (init->data o info))
+    ((initzer (initzer-list . ,inits))
-    ;;(_ (error "array-init-element->data: not supported: " o))
+     (if (structured-type? type)
-    ))
+         (map (cut init->data <> <> info) (map cdr (struct->init-fields type)) inits)
+         (begin
+           (stderr "array-init-element->data: oops:~s\n" o)
+           (stderr "type:~s\n" type)
+           (error "array-init-element->data: not supported: " o))))
+    (_ (init->data type o info))
+    (_ (error "array-init-element->data: not supported: " o))))
 
-(define (array-init->data size o info)
+(define (array-init->data type size o info)
   (pmatch o
+    ((initzer (initzer-list . ,inits))
+     (let ((type (c-array:type type)))
+       (map (cut array-init-element->data type <> info) inits)))
+
     (((initzer (initzer-list . ,inits)))
-     (map (cut array-init-element->data size <> info) inits))
+     (array-init->data type size (car o) info))
 
     ((initzer (p-expr (string ,string)))
      (let ((data (string->list string)))
@@ -2117,17 +2125,18 @@
            (append data (string->list (make-string (max 0 (- size (length data))) #\nul))))))
 
     (((initzer (p-expr (string ,string))))
-     (let ((data (string->list string)))
+     (array-init->data type size (car o) info))
-       (if (not size) data
-           (append data (string->list (make-string (max 0 (- size (length data))) #\nul))))))
 
-    (((initzer (p-expr (string . ,strings))))
+    ((initzer (p-expr (string . ,strings)))
      (let ((data (string->list (apply string-append strings))))
        (if (not size) data
            (append data (string->list (make-string (max 0 (- size (length data))) #\nul))))))
 
+    (((initzer (p-expr (string . ,strings))))
+     (array-init->data type size (car o) info))
+
     ((initzer (p-expr (fixed ,fixed)))
-     (int->bv32 (expr->number info fixed)))
+     (int->bv type (expr->number info fixed)))
 
     (() (string->list (make-string size #\nul)))
     (_ (error "array-init->data: not supported: " o))))
@@ -2198,13 +2207,13 @@
        (if (.function info) (local->info type name o init info)
            (global->info type name o init info))))
     ;; FIXME: recursion
-    (((array-of (array-of (ident ,name) ,count) ,count1) . ,init)
+    (((array-of (array-of (ident ,name) ,count1) ,count) . ,init)
      (let* ((strings (init->strings init info))
             (info (if (null? strings) info
                       (clone info #:globals (append (.globals info) strings))))
             (count (expr->number info count))
             (count1 (expr->number info count1))
-            (type (rank++ (make-c-array type (* %pointer-size count count1)))))
+            (type (make-c-array (make-c-array type count1) count)))
        (if (.function info) (local->info type name o init info)
            (global->info type name o init info))))
     (_ (error "init-declr->info: not supported: " o))))
@@ -2226,18 +2235,25 @@
                 (1+ i)
                 (append constants (list (ident->constant name i))))))))
 
-(define (init->data o info)
+(define (init->data type o info)
   (pmatch o
-    ((p-expr ,expr) (init->data expr info))
+    ((p-expr ,expr) (init->data type expr info))
-    ((fixed ,fixed) (int->bv32 (expr->number info o)))
+    ((fixed ,fixed) (int->bv type (expr->number info o)))
-    ((char ,char) (int->bv32 (char->integer (string-ref char 0))))
+    ((char ,char) (int->bv type (char->integer (string-ref char 0))))
     ((string ,string) `((#:string ,string)))
     ((string . ,strings) `((#:string ,(string-join strings ""))))
     ((ident ,name) (let ((var (ident->variable info name)))
                      `((#:address ,var))))
-    ((initzer-list . ,initzers) (append-map (cut init->data <> info) initzers))
+    ((initzer-list . ,inits)
+     (cond ((structured-type? type)
+            (map (cut init->data <> <> info) (map cdr (struct->init-fields type)) inits))
+           ((c-array? type)
+            (let ((size (->size type)))
+             (array-init->data type size `(initzer ,o) info)))
+           (else
+            (append-map (cut init->data type <> info) inits))))
     (((initzer (initzer-list . ,inits)))
-     (init->data `(initzer-list . ,inits) info))
+     (init->data type `(initzer-list . ,inits) info))
     ((ref-to (p-expr (ident ,name)))
      (let ((var (ident->variable info name)))
        `((#:address ,var))))
@@ -2245,17 +2261,25 @@
      (let* ((type (ast->type struct info))
             (offset (field-offset info type field))
             (base (cstring->int base)))
-       (int->bv32 (+ base offset))))
+       (int->bv type (+ base offset))))
     ((,char . _) (guard (char? char)) o)
     ((,number . _) (guard (number? number))
-     (append (map int->bv32 o)))
+     (append (map int->bv type o)))
-    ((initzer ,init) (init->data init info))
+    ((initzer ,init) (init->data type init info))
-    (((initzer ,init)) (init->data init info))
+    (((initzer ,init)) (init->data type init info))
-    ((cast _ ,expr) (init->data expr info))
+    ((cast _ ,expr) (init->data type expr info))
+    (() '())
     (_ (let ((number (try-expr->number info o)))
-         (cond (number (int->bv32 number))
+         (cond (number (int->bv type number))
                (else (error "init->data: not supported: " o)))))))
 
+(define (int->bv type o)
+  (let ((size (->size type)))
+    (case size
+      ((1) (int->bv8 o))
+      ((2) (int->bv16 o))
+      (else (int->bv32 o)))))
+
 (define (init->strings o info)
   (let ((globals (.globals info)))
     (pmatch o

module/mes/as.mes

@@ -42,6 +42,11 @@
     (bytevector-u16-native-set! bv 0 value)
     bv))
 
+(define (int->bv8 value)
+  (let ((bv (make-bytevector 1)))
+    (bytevector-u8-set! bv 0 value)
+    bv))
+
 (define (dec->hex o)
   (cond ((number? o) (number->string o 16))
         ((char? o) (number->string (char->integer o) 16))

module/mes/as.scm

@@ -27,6 +27,7 @@
   #:use-module (mes guile)
   #:use-module (mes bytevectors)
   #:export (dec->hex
+            int->bv8
             int->bv16
             int->bv32))
 

module/mes/bytevectors.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -45,5 +45,11 @@
     (set-cdr! bv (cdr x))
     x))
 
+(define (bytevector-u8-set! bv index value)
+  (when (not (= 0 index)) (error "bytevector-u8-set! index not zero: " index " value: " value))
+  (let ((x (modulo value #x100)))
+    (set-car! bv x)
+    x))
+
 (define (make-bytevector length)
   (make-list length 0))

module/mes/bytevectors.scm

@@ -26,6 +26,7 @@
   #:use-module (mes guile)
   #:export (bytevector-u32-native-set!
             bytevector-u16-native-set!
+            bytevector-u8-set!
             make-bytevector))
 
 (cond-expand

scaffold/tests/4a-char-array.c

@@ -41,9 +41,9 @@ int g_hello_int[] = {0, 1, 2, 3, 4, 5};
 int
 main (int argc)
 {
-  puts (g_hello);
+  puts ("0:"); puts (g_hello); puts ("\n");
-  puts (g_hello2);
+  puts ("2:"); puts (g_hello2); puts ("\n");
-  puts (g_hello3);
+  puts ("3:"); puts (g_hello3); puts ("\n");
   if (strcmp (g_hello, g_hello2))
     return 1;
 

scaffold/tests/7s-struct-short.c

@@ -0,0 +1,73 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) 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/>.
+ */
+
+
+struct foo
+{
+  char c;
+  short bar;
+  short baz;
+};
+
+struct bar
+{
+  char bar;
+};
+
+struct foo global_f = {0, 11, 22};
+struct bar global_b = {11};
+int i = 0x11223344;
+
+struct foo foes[2] = {{0, 1, 2}, {0, 3, 4}};
+
+int
+main ()
+{
+  if (global_f.bar != 11)
+    return 1;
+  
+  if (global_f.baz != 22)
+    return 2;
+
+  struct foo f = {0, 44, 55};
+
+  if (f.bar != 44)
+    return 3;
+  
+  if (f.baz != 55)
+    return 4;
+
+  if (global_b.bar != 11)
+    return 5;
+
+  if (foes[0].bar != 1)
+    return 6;
+
+  if (foes[0].baz != 2)
+    return foes[0].baz;
+
+  if (foes[1].bar != 3)
+    return 8;
+
+  if (foes[1].baz != 4)
+    return 9;
+
+  return 0;
+}