From def730d74a41bfd86ad0ba1f3ba889028f0da964 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 19 May 2018 14:53:05 +0200 Subject: [PATCH] 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 | 3 +- module/language/c99/compiler.mes | 110 +++++++++++++++++++------------ module/mes/as.mes | 5 ++ module/mes/as.scm | 1 + module/mes/bytevectors.mes | 8 ++- module/mes/bytevectors.scm | 1 + scaffold/tests/4a-char-array.c | 6 +- scaffold/tests/7s-struct-short.c | 73 ++++++++++++++++++++ 8 files changed, 158 insertions(+), 49 deletions(-) create mode 100644 scaffold/tests/7s-struct-short.c diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh index 2d05a0e1..34242e2c 100755 --- a/build-aux/check-mescc.sh +++ b/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 diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index cbe444e9..235eb254 100644 --- a/module/language/c99/compiler.mes +++ b/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)) - (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))))))) + ((c-array? type) + (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 type size init info)))) + (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))) - (_ (init->data o info)) - ;;(_ (error "array-init-element->data: not supported: " o)) - )) + (int->bv type (expr->number info fixed))) + ((initzer (initzer-list . ,inits)) + (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))) - (if (not size) data - (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))) + (array-init->data type size (car o) info)) - (((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)) - ((fixed ,fixed) (int->bv32 (expr->number info o))) - ((char ,char) (int->bv32 (char->integer (string-ref char 0)))) + ((p-expr ,expr) (init->data type expr info)) + ((fixed ,fixed) (int->bv type (expr->number info o))) + ((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))) - ((initzer ,init) (init->data init info)) - (((initzer ,init)) (init->data init info)) - ((cast _ ,expr) (init->data expr info)) + (append (map int->bv type o))) + ((initzer ,init) (init->data type init info)) + (((initzer ,init)) (init->data type init 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 diff --git a/module/mes/as.mes b/module/mes/as.mes index ee551882..d6508a69 100644 --- a/module/mes/as.mes +++ b/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)) diff --git a/module/mes/as.scm b/module/mes/as.scm index e815b84f..c7cb83b7 100644 --- a/module/mes/as.scm +++ b/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)) diff --git a/module/mes/bytevectors.mes b/module/mes/bytevectors.mes index 3260685a..2a19676b 100644 --- a/module/mes/bytevectors.mes +++ b/module/mes/bytevectors.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen ;;; ;;; 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)) diff --git a/module/mes/bytevectors.scm b/module/mes/bytevectors.scm index 15607a81..c2415539 100644 --- a/module/mes/bytevectors.scm +++ b/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 diff --git a/scaffold/tests/4a-char-array.c b/scaffold/tests/4a-char-array.c index 0cdb07bc..d0da7532 100644 --- a/scaffold/tests/4a-char-array.c +++ b/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 (g_hello2); - puts (g_hello3); + puts ("0:"); puts (g_hello); puts ("\n"); + puts ("2:"); puts (g_hello2); puts ("\n"); + puts ("3:"); puts (g_hello3); puts ("\n"); if (strcmp (g_hello, g_hello2)) return 1; diff --git a/scaffold/tests/7s-struct-short.c b/scaffold/tests/7s-struct-short.c new file mode 100644 index 00000000..5ab48b4d --- /dev/null +++ b/scaffold/tests/7s-struct-short.c @@ -0,0 +1,73 @@ +/* -*-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 . + */ + + +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; +}