artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

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

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-19 14:53:05 +02:00
parent bbfe7de3da
commit def730d74a
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
8 changed files with 158 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
build-aux/check-mescc.sh
View file

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

100
module/language/c99/compiler.mes
View file

@ -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)
(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))))
(array-init->data type size init info))))
(append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))
(else (let ((data (init->data init info)))
((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

5
module/mes/as.mes
View file

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

1
module/mes/as.scm
View file

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

8
module/mes/bytevectors.mes
View file

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

1
module/mes/bytevectors.scm
View file

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

6
scaffold/tests/4a-char-array.c
View file

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

73
scaffold/tests/7s-struct-short.c Normal file
View file

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