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

mescc: Tinycc support: bugfix struct.array.

Browse source 
* module/language/c99/compiler.mes (struct-field): Update pointer
  info.
  (field:name,field:pointer,field:size,field:type): Rely on pointer
  info.
  (field:pointer): New function.
 (expr->accu): Use it.
* scaffold/tests/71-struct-array.c (test): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2017-07-26 01:13:33 +02:00
parent d2f701b825
commit b7cc9d375d
2 changed files with 96 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -612,12 +612,16 @@
(let ((info ((expr->accu* info) o))) (let ((info ((expr->accu* info) o)))
(append-text info (wrap-as (i386:mem->accu))))) (append-text info (wrap-as (i386:mem->accu)))))
;; f.field ;; foo.bar
((d-sel (ident ,field) (p-expr (ident ,struct))) ((d-sel (ident ,field) (p-expr (ident ,struct)))
(let* ((type (ident->type info struct)) (let* ((type (ident->type info struct))
(offset (field-offset info type field))) (offset (field-offset info type field))
(append-text info (append ((ident->accu info) struct) (ptr (field-pointer info type field)))
(wrap-as (i386:mem+n->accu offset)))))) (if (= ptr -1)
(append-text info (append ((ident->accu info) struct)
(wrap-as (i386:accu+value offset))))
(append-text info (append ((ident->accu info) struct)
(wrap-as (i386:mem+n->accu offset)))))))
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array)))) ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
(let* ((type (ident->type info array)) (let* ((type (ident->type info array))
@ -627,10 +631,15 @@
((i-sel (ident ,field) (p-expr (ident ,array))) ((i-sel (ident ,field) (p-expr (ident ,array)))
(let* ((type (ident->type info array)) (let* ((type (ident->type info array))
(offset (field-offset info type field))) (offset (field-offset info type field))
(append-text info (append ((ident-address->accu info) array) (ptr (field-pointer info type field)))
(wrap-as (i386:mem->accu)) (if (= ptr -1)
(wrap-as (i386:mem+n->accu offset)))))) (append-text info (append ((ident-address->accu info) array)
(wrap-as (i386:mem->accu))
(wrap-as (i386:accu+value offset))))
(append-text info (append ((ident-address->accu info) array)
(wrap-as (i386:mem->accu))
(wrap-as (i386:mem+n->accu offset)))))))
((i-sel (ident ,field) (de-ref (p-expr (ident ,array)))) ((i-sel (ident ,field) (de-ref (p-expr (ident ,array))))
(let* ((type (ident->type info array)) (let* ((type (ident->type info array))
@ -1027,12 +1036,17 @@
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array)))))) (info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
(append-text info (wrap-as (i386:accu+value offset))))) (append-text info (wrap-as (i386:accu+value offset)))))
;; foo.bar
((d-sel (ident ,field) (p-expr (ident ,struct))) ((d-sel (ident ,field) (p-expr (ident ,struct)))
(let* ((type (ident->type info struct)) (let* ((type (ident->type info struct))
(offset (field-offset info type field)) (offset (field-offset info type field))
(text (.text info))) (text (.text info))
(append-text info (append ((ident->accu info) struct) (ptr (field-pointer info type field)))
(wrap-as (i386:accu+value offset)))))) (if (= ptr -1)
(append-text info (append ((ident-address->accu info) struct)
(wrap-as (i386:accu+value offset))))
(append-text info (append ((ident->accu info) struct)
(wrap-as (i386:accu+value offset)))))))
;; foo.bar[baz] ;; foo.bar[baz]
((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct)))) ((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct))))
@ -1137,22 +1151,28 @@
(define (field:name o) (define (field:name o)
(pmatch o (pmatch o
((union (,name ,type ,size ,pointer) . ,rest) name) ((union (,name ,type ,size ,pointer) . ,rest) name)
((union (,name ,type ,size) . ,rest) name) ;;((union (,name ,type ,size) . ,rest) name)
((,name ,type ,size ,pointer) name) ((,name ,type ,size ,pointer) name)
((,name ,type ,size) name) ;;((,name ,type ,size) name)
(_ (error "field:name not supported:" o))))
(define (field:pointer o)
(pmatch o
((union (,name ,type ,size ,pointer) . ,rest) pointer)
((,name ,type ,size ,pointer) pointer)
(_ (error "field:name not supported:" o)))) (_ (error "field:name not supported:" o))))
(define (field:size o) (define (field:size o)
(pmatch o (pmatch o
((union . ,fields) 4) ;; FIXME ((union . ,fields) 4) ;; FIXME
((,name ,type ,size ,pointer) size) ((,name ,type ,size ,pointer) size)
((,name ,type ,size) size) ;;((,name ,type ,size) size)
(_ 4))) (_ 4)))
(define (field:type o) (define (field:type o)
(pmatch o (pmatch o
((,name ,type ,size ,pointer) type) ((,name ,type ,size ,pointer) type)
((,name ,type ,size) type) ;;((,name ,type ,size) type)
(_ (error "field:type:" o)))) (_ (error "field:type:" o))))
(define (get-type types o) (define (get-type types o)
@ -1178,7 +1198,9 @@
(let ((struct (if (pair? type) type `("tag" ,type)))) (let ((struct (if (pair? type) type `("tag" ,type))))
(ast-type->type info struct))) (ast-type->type info struct)))
((void) (ast-type->type info "void")) ((void) (ast-type->type info "void"))
((type-spec (typename ,type)) (ast-type->type info type)) ((type-spec ,type) (ast-type->type info type))
((fixed-type ,type) (ast-type->type info type))
((typename ,type) (ast-type->type info type))
(_ (let ((type (get-type (.types info) o))) (_ (let ((type (get-type (.types info) o)))
(if type type (if type type
(begin (begin
@ -1217,6 +1239,11 @@
offset)) offset))
(else (loop (cdr fields) (+ offset (field:size f)))))))))))) (else (loop (cdr fields) (+ offset (field:size f))))))))))))
(define (field-pointer info struct field)
(let ((xtype (ast-type->type info struct)))
(let ((field (field-field info struct field)))
(field:pointer field))))
(define (field-size info struct field) (define (field-size info struct field)
(let ((xtype (ast-type->type info struct))) (let ((xtype (ast-type->type info struct)))
(if (eq? (type:type xtype) 'union) 0 (if (eq? (type:type xtype) 'union) 0
@ -1408,6 +1435,8 @@
(* (p-expr->number info a) (p-expr->number info b))) (* (p-expr->number info a) (p-expr->number info b)))
((sub ,a ,b) ((sub ,a ,b)
(- (p-expr->number info a) (p-expr->number info b))) (- (p-expr->number info a) (p-expr->number info b)))
((sizeof-type (type-name (decl-spec-list (type-spec ,type))))
(ast-type->size info type))
((sizeof-expr (i-sel (ident ,field) (p-expr (ident ,struct)))) ((sizeof-expr (i-sel (ident ,field) (p-expr (ident ,struct))))
(let ((type (ident->type info struct))) (let ((type (ident->type info struct)))
(field-size info type field))) (field-size info type field)))
@ -1422,49 +1451,44 @@
(pmatch o (pmatch o
((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type)))) ((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
(comp-declr-list (comp-declr (ident ,name)))) (comp-declr-list (comp-declr (ident ,name))))
(list name `("tag" ,type) 4)) (list name `("tag" ,type) 4 0))
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name)))) ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
(list name type 4)) (list name type 4 0))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name)))) ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
(list name type 4)) (list name type 4 0))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(list name type 4)) ;; FIXME: ** (list name type 4 2))
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list))))) ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
(list name type 4)) ;; FIXME function / int (list name type 4 1))
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(list name type 4)) ;; FIXME: ptr/char (list name type 4 1))
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(list name type 4)) ;; FIXME: ** (list name type 4 2))
((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(list name '(void) 4)) ;; FIXME: * (list name '(void) 4 1))
((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list))))) ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
(list name '(void) 4)) (list name '(void) 4 1))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(list name type 4)) (list name type 4 1))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) ,count))))) ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) ,count)))))
(let ((size 4) (let ((size 4)
(count (p-expr->number info count))) (count (p-expr->number info count)))
(list name type (* count size) 0))) (list name type (* count size) -1)))
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) ,count)))) ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
(let ((size 4) (let ((size (ast-type->size info type))
(count (p-expr->number info count))) (count (p-expr->number info count)))
(list name type (* count size) 0))) (list name type (* count size) -1)))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
(let ((size 4)
(count (p-expr->number info count)))
(list name type (* count size) 0)))
((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(list name `("tag" ,type) 4)) (list name `("tag" ,type) 4 2))
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(list name `("tag" ,type) 4)) (list name `("tag" ,type) 4 2))
((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(list name `("tag" ,type) 4)) (list name `("tag" ,type) 4 1))
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name))))) ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(list name `("tag" ,type) 4)) (list name `("tag" ,type) 4 1))
((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ident ,name)))) ((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ident ,name))))
((struct-field info) `(comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name)))))) ((struct-field info) `(comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))))
@ -1480,9 +1504,7 @@
((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields))))) ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
`(union ,@(map (struct-field info) fields))) `(union ,@(map (struct-field info) fields)))
(_ (error "struct-field: unsupported: " o))) (_ (error "struct-field: unsupported: " o)))))
)
)
(define (ident->decl info o) (define (ident->decl info o)
(or (assoc-ref (.locals info) o) (or (assoc-ref (.locals info) o)
@ -1851,10 +1873,9 @@
(global-names (map car globals)) (global-names (map car globals))
(initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals)) (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
(globals (append globals initzer-globals)) (globals (append globals initzer-globals))
(locals (let loop ((fields (cdr fields)) (locals locals)) (local (car (add-local locals name type -1)))
(if (null? fields) locals (local (make-local-entry name type -1 (+ (local:id (cdr local)) (quotient (+ size 3) 4))))
(loop (cdr fields) (add-local locals "foobar" "int" 0))))) (locals (cons local locals))
(locals (add-local locals name type -1))
(info (clone info #:locals locals #:globals globals)) (info (clone info #:locals locals #:globals globals))
(empty (clone info #:text '()))) (empty (clone info #:text '())))
(let loop ((fields fields) (initzers initzers) (info info)) (let loop ((fields fields) (initzers initzers) (info info))
@ -1889,8 +1910,8 @@
(size (* (length entries) entry-size)) (size (* (length entries) entry-size))
(initzers (map (initzer->non-const info) initzers))) (initzers (map (initzer->non-const info) initzers)))
(if (.function info) (if (.function info)
(let* ((local (car (add-local locals name type -1))) (let* ((count (length initzers))
(count (length initzers)) (local (car (add-local locals name type -1)))
(local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (1+ count)))) (local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (1+ count))))
(locals (cons local locals)) (locals (cons local locals))
(info (clone info #:locals locals)) (info (clone info #:locals locals))
@ -1914,6 +1935,7 @@
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer))) ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
(let* ((info (type->info info type)) (let* ((info (type->info info type))
(xtype type)
(type (decl->ast-type type)) (type (decl->ast-type type))
(name (init-declr->name init)) (name (init-declr->name init))
(pointer (init-declr->pointer init)) (pointer (init-declr->pointer init))
@ -1925,11 +1947,14 @@
(info (append-text info (ast->comment o))) (info (append-text info (ast->comment o)))
(globals (append globals initzer-globals)) (globals (append globals initzer-globals))
(info (clone info #:globals globals)) (info (clone info #:globals globals))
(pointer (if (and (zero? pointer) (pair? type) (equal? (car type) "tag")) -1 pointer)) (struct? (and (zero? pointer)
(size (if (zero? pointer) (ast-type->size info type) (or (and (pair? type) (equal? (car type) "tag"))
(eq? (type:type (ast-type->type info xtype)) 'struct))))
(pointer (if struct? -1 pointer))
(size (if (<= pointer 0) (ast-type->size info type)
4))) 4)))
(if (.function info) (if (.function info)
(let* ((locals (if (or (not (= pointer 0)) (<= size 4)) (add-local locals name type pointer) (let* ((locals (if (or (> pointer 0) (<= size 4)) (add-local locals name type pointer)
(let* ((local (car (add-local locals name type 1))) (let* ((local (car (add-local locals name type 1)))
(local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))) (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4)))))
(cons local locals)))) (cons local locals))))

20
scaffold/tests/71-struct-array.c
View file

@ -20,6 +20,7 @@
#include "30-test.i" #include "30-test.i"
#include <stdio.h> #include <stdio.h>
#include <string.h>
struct foo; struct foo;
@ -30,8 +31,11 @@ typedef struct foo foo_struct;
struct foo struct foo
{ {
int bar[2]; int bar[2];
char name[10];
}; };
struct foo g_foo;
int a, b; int a, b;
int i, *j; int i, *j;
int *k = 0, l; int *k = 0, l;
@ -50,6 +54,7 @@ test ()
foo_struct f; foo_struct f;
f.bar[0] = 0x22; f.bar[0] = 0x22;
f.bar[1] = 0x34; f.bar[1] = 0x34;
printf ("eentje: %d\n", f.bar[0]); printf ("eentje: %d\n", f.bar[0]);
printf ("tweetje: %d\n", f.bar[1]); printf ("tweetje: %d\n", f.bar[1]);
@ -61,5 +66,20 @@ test ()
char **p = strings; char **p = strings;
while (*p) puts (*p++); while (*p) puts (*p++);
strcpy (f.name, "hallo\n");
puts (f.name);
struct foo fu;
strcpy (fu.name, "hello\n");
puts (fu.name);
strcpy (g_foo.name, "hey\n");
puts (g_foo.name);
char buf[10];
struct foo* s = &buf;
strcpy (s->name, "hi\n");
puts (s->name);
return 0; return 0;
} }