andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-12 12:03:01 +02:00
parent e8969af4ca
commit dae4a30417
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
3 changed files with 160 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
build-aux/check-mescc.sh
View File

@ -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

97
module/language/c99/compiler.mes
View File

@ -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))
(_ '()))))

94
scaffold/tests/4a-char-array.c Normal file
View File

@ -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;
}