mescc: Tinycc support: Anonymous string array.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 12 May 2018 10:03:01 +0000 (12:03 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 12 May 2018 10:03:01 +0000 (12:03 +0200)
* module/language/c99/compiler.mes (global->info): Anonymous string
  array.
  (local->info): Likewise.
  (array-init->string): Support array of char.
  (init-local): Likewise.
  (->size): Fix for array.
* scaffold/tests/4a-char-array.c: Test it.
* build-aux/check-mescc.sh (tests): Run it.

build-aux/check-mescc.sh
module/language/c99/compiler.mes
scaffold/tests/4a-char-array.c [new file with mode: 0644]

index 094edae0c6693edd4e0b4cb1bc31d9d206018d41..c2063d319f9a7967ef120cb7a2d8041793ffa79e 100755 (executable)
@@ -76,6 +76,7 @@ t
 47-function-expression
 48-function-destruct
 49-global-static
+4a-char-array
 50-assert
 51-strcmp
 52-itoa
@@ -224,7 +225,6 @@ broken="$broken
 28_strings
 
 31_args
-34_array_assignment
 37_sprintf
 38_multiple_array_index
 39_typedef
index 247fba1261686efd816aa3b5207eac63faed3426..d5b94737271f7985511175c75573b57114f1c06c 100644 (file)
       ((fixed ,value) (get-type "int" info))
       ((sizeof-expr . _) (get-type "int" info))
       ((sizeof-type . _) (get-type "int" info))
-      ((string _) (make-c-array (get-type "char" info) #f))
+      ((string ,string) (make-c-array (get-type "char" info) (1+ (string-length string))))
       ((void) (get-type "void" info))
 
       ((type-name ,type) (ast->type type info))
         ((p-expr (string . ,strings))
          (append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
 
+        (,char (guard (char? char)) (append-text info (wrap-as (i386:value->accu char))))
+
         ((p-expr (ident ,name))
          (append-text info ((ident->accu info) name)))
 
         ((initzer ,initzer)
          (expr->accu initzer info))
 
+        (((initzer ,initzer))
+         (expr->accu initzer info))
+
         ;; offsetoff
         ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
          (let* ((type (ast->basic-type struct info))
          (apply max (map (compose ->size cdr) (struct->fields o))))
         ((type? o) (type:size o))
         ((pointer? o) %pointer-size)
-        ((c-array? o) (* (c-array:count o) ((compose type:size c-array:type) o)))
+        ((c-array? o) (* (c-array:count o) ((compose ->size c-array:type) o)))
         ((local? o) ((compose ->size local:type) o))
         ((global? o) ((compose ->size global:type) o))
         ;; FIXME
                        (else (i386:accu->base-mem+n offset))))))))
 
 (define (init-array-entry local index init info)
-  (let* ((size (or (and (zero? (local:pointer local)) ((compose type:size local:type) local))
-                   4))
+  (let* ((type (local:type local))
+         (size (cond ((pointer? type) %pointer-size)
+                     ((and (c-array? type) ((compose pointer? c-array:type) type)) %pointer-size)
+                     ((c-array? type) ((compose type:size c-array:type) type))
+                     (else (type:size type))))
          (offset (* index size))
          (empty (clone info #:text '())))
     (clone info #:text
               (let ((fields ((compose struct->init-fields local:type) local)))
                 (fold (cut init-struct-field local <> <> <>) info fields (append inits (map (const '(p-expr (fixed "22"))) (iota (max 0 (- (length fields) (length inits)))))))))
              (else (fold (cut init-local local <> <> <>) info inits (iota (length inits)))))))
+    (,string (guard (string? string))
+             (let ((inits (string->list string)))
+               (fold (cut init-array-entry local <> <> <>) info (iota (length inits)) inits)))
     (((initzer (initzer-list . ,inits)))
      (fold (cut init-array-entry local <> <> <>) info (iota (length inits)) inits))
     (() info)
                  (1+ (local:id (cdar locals)))))
          (local (make-local-entry name type id))
          (pointer (->rank (cdr local)))
-         (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)))))
+         (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)))))
          (struct? (structured-type? type))
          (size (->size type))
-         (count (and (c-array? array) (c-array:count array)))
-         (local (if (not array) local
-                    (make-local-entry name type (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4)))))
+         (string (and array? (array-init->string init)))
+         (init (or string init))
+         (local (if (not array?) local
+                    (let ((size (or (and string (max size (1+ (string-length string))))
+                                    size)))
+                      (make-local-entry name type (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))))
          (local (if struct? (make-local-entry name type (+ (local:id (cdr local)) (quotient (+ size 3) 4)))
                     local))
          (locals (cons local locals))
 
 (define (global->info type name o init info)
   (let* ((rank (->rank type))
-         (size (cond ;;((not (zero? rank)) 4)
-                ((pointer? type) 4)
-                ((c-array? type) (cond ((pointer? (c-array:type type)) 4)
-                                       ((type? (c-array:type type)) ((compose type:size c-array:type) type))
-                                       (else (error "urg:" type))))
-                ((type? type) (type:size type))
-                (else (error "global->info: no such type:" 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)))
-                     ((let ((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))))))
-                        array)
-                      =>
-                      (lambda (array) (array-init->data (* (c-array:count array) size) init info)))
+                     (array? (let* ((string (array-init->string init))
+                                    (size (or (and string (max size (1+ (string-length string))))
+                                              size))
+                                    (data (or (and=> string string->list)
+                                              (array-init->data size init info))))
+                               (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))
                      (else (let ((data (init->data init info)))
                              (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))))
          (global (make-global-entry name type data)))
     (() (string->list (make-string size #\nul)))
     (_ (error "array-init->data: not supported: " o))))
 
+(define (array-init->string o)
+  (pmatch o
+    ((p-expr (string ,string)) string)
+    ((p-expr (string . ,strings)) (apply string-append strings))
+    ((initzer ,init) (array-init->string init))
+    (((initzer ,init)) (array-init->string init))
+    ((initzer-list (initzer (p-expr (char ,c))) . ,inits)
+     (list->string (map (lambda (i) (pmatch i
+                                      ((initzer (p-expr (char ,c))) ((compose car string->list) c))
+                                      ((initzer (p-expr (fixed ,fixed)))
+                                       (let ((value (cstring->number fixed)))
+                                         (if (and (>= value 0) (<= value 255))
+                                             (integer->char value)
+                                             (error "array-init->string: not supported:" i o))))
+                                      (_ (error "array-init->string: not supported:" i o))))
+                        (cdr o))))
+    (_ #f)))
+
 (define (init-declr->info type o info)
   (pmatch o
     (((ident ,name))
     ((,number . _) (guard (number? number))
      (append (map int->bv32 o)))
     ((initzer ,init) (init->data init info))
+    (((initzer ,init)) (init->data init info))
     ((cast _ ,expr) (init->data expr info))
     (_ (let ((number (try-expr->number info o)))
          (cond (number (int->bv32 number))
        (append-map (cut init->strings <> info) init))
       ((initzer ,init)
        (init->strings init info))
+      (((initzer ,init))
+       (init->strings init info))
       ((initzer-list . ,init)
        (append-map (cut init->strings <> info) init))
       (_ '()))))
diff --git a/scaffold/tests/4a-char-array.c b/scaffold/tests/4a-char-array.c
new file mode 100644 (file)
index 0000000..0cdb07b
--- /dev/null
@@ -0,0 +1,94 @@
+/* -*-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/>.
+ */
+
+char g_hello[] =
+    "hello\n"
+    "world\n"
+  ;
+
+char *g_hello2 =
+    "hello\n"
+    "world\n"
+  ;
+
+char g_hello3[] =
+  {
+    'h', 'e', 'l', 'l', 'o', '\n',
+    'w', 'o', 'r', 'l', 'd', '\n',
+    '\0',
+  }
+  ;
+
+int g_hello_int[] = {0, 1, 2, 3, 4, 5};
+
+int
+main (int argc)
+{
+  puts (g_hello);
+  puts (g_hello2);
+  puts (g_hello3);
+  if (strcmp (g_hello, g_hello2))
+    return 1;
+
+  if (strcmp (g_hello, g_hello3))
+    return 2;
+
+  char hello[] =
+    "hello\n"
+    "world\n"
+    ;
+
+  char *hello2 =
+    "hello\n"
+    "world\n"
+    ;
+
+  puts (hello);
+  puts (hello2);
+  if (strcmp (hello, hello2))
+    return 3;
+
+  char hello3[] =
+    {
+      'h', 'e', 'l', 'l', 'o', '\n',
+      'w', 'o', 'r', 'l', 'd', '\n',
+      '\0',
+    }
+    ;
+
+  puts (hello3);
+  if (strcmp (hello, hello3))
+    return 4;
+
+  if (g_hello_int[0])
+    return 5;
+
+  if (g_hello_int[1] != 1)
+    return 6;
+
+  int hello_int[] = {0, 1, 2, 3, 4, 5};
+  if (hello_int[0])
+    return 7;
+
+  if (hello_int[1] != 1)
+    return 8;
+
+  return 0;
+}