From dae4a30417c3edae2f7fa8de5a678d595d5a983b Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 12 May 2018 12:03:01 +0200 Subject: [PATCH] mescc: Tinycc support: Anonymous string array. * 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 | 2 +- module/language/c99/compiler.mes | 97 +++++++++++++++++++++----------- scaffold/tests/4a-char-array.c | 94 +++++++++++++++++++++++++++++++ 3 files changed, 160 insertions(+), 33 deletions(-) create mode 100644 scaffold/tests/4a-char-array.c diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh index 094edae0..c2063d31 100755 --- a/build-aux/check-mescc.sh +++ b/build-aux/check-mescc.sh @@ -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 diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 247fba12..d5b94737 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -190,7 +190,7 @@ ((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)) @@ -946,12 +946,17 @@ ((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)) @@ -1552,7 +1557,7 @@ (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 @@ -1910,8 +1915,11 @@ (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 @@ -1941,6 +1949,9 @@ (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) @@ -1953,18 +1964,22 @@ (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)) @@ -1974,25 +1989,22 @@ (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))) @@ -2034,6 +2046,24 @@ (() (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)) @@ -2134,6 +2164,7 @@ ((,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)) @@ -2155,6 +2186,8 @@ (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 index 00000000..0cdb07bc --- /dev/null +++ b/scaffold/tests/4a-char-array.c @@ -0,0 +1,94 @@ +/* -*-comment-start: "//";comment-end:""-*- + * Mes --- Maxwell Equations of Software + * Copyright © 2018 Jan (janneke) Nieuwenhuizen + * + * 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 . + */ + +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; +}