mescc: Support array in struct.

* module/language/c99/compiler.mes: (field:size, field-offset): New
  functions.  Update callers, use them throughout.
  (ast->info): Support declaration of struct and typedef'ed struct
  variable with array fields.
  (expr->accu, expr->accu*): Support foo.bar[baz], foo->bar[baz].
* scaffold/t-tcc.c: Test it.
This commit is contained in:
Jan Nieuwenhuizen 2017-05-31 20:52:48 +02:00
parent 3a240221f0
commit 6f842c6051
3 changed files with 218 additions and 100 deletions

View File

@ -559,9 +559,7 @@
;; &f.field
((ref-to (d-sel (ident ,field) (p-expr (ident ,array))))
(let* ((type (ident->type info array))
(fields (type->description info type))
(field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(offset (field-offset info type field))
(text (.text info)))
(append-text info (append ((ident->accu info) array)
(wrap-as (i386:accu+n offset))))))
@ -572,25 +570,21 @@
((sizeof-expr (p-expr (ident ,name)))
(let* ((type (ident->type info name))
(fields (or (type->description info type) '()))
(size (type->size info type)))
(append-text info (wrap-as (i386:value->accu size)))))
((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,name)))))
(let* ((type name)
(fields (or (type->description info type) '()))
(size (type->size info type)))
(append-text info (wrap-as (i386:value->accu size)))))
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
(let* ((type (list "struct" name))
(fields (or (type->description info type) '()))
(size (type->size info type)))
(append-text info (wrap-as (i386:value->accu size)))))
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
(let* ((type (list "struct" name))
(fields (or (type->description info type) '()))
(size (type->size info type)))
(append-text info (wrap-as (i386:value->accu size)))))
@ -607,33 +601,33 @@
((4) (i386:mem->accu))
(else '())))))))
;; foo.bar[baz])
((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct))))
(let ((info ((expr->accu* info) o)))
(append-text info (wrap-as (i386:mem->accu)))))
;; foo->bar[baz])
((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,struct))))
(let ((info ((expr->accu* info) o)))
(append-text info (wrap-as (i386:mem->accu)))))
;; f.field
((d-sel (ident ,field) (p-expr (ident ,array)))
(let* ((type (ident->type info array))
(fields (type->description info type))
(field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(offset (field-offset info type field))
(text (.text info)))
(append-text info (append ((ident->accu info) array)
(wrap-as (i386:mem+n->accu offset))))))
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
(let* ((type (ident->type info array))
(fields (or (type->description info type) '()))
(field-size 4) ;; FIXME:4, not fixed
(rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
(begin
(stderr "no field:~a\n" field)
'())))
(offset (* field-size (1- (length rest))))
(offset (field-offset info type field))
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
(append-text info (wrap-as (i386:mem+n->accu offset)))))
((i-sel (ident ,field) (p-expr (ident ,array)))
(let* ((type (ident->type info array))
(fields (type->description info type))
(field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(offset (field-offset info type field))
(text (.text info)))
(append-text info (append ((ident-address->accu info) array)
(wrap-as (i386:mem->accu))
@ -822,10 +816,7 @@
((p-expr (ident ,name)) (append-text info ((accu->ident info) name)))
((d-sel (ident ,field) ,p-expr)
(let* ((type (p-expr->type info p-expr))
(fields (type->description info type))
(size (type->size info type))
(field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(offset (field-offset info type field))
(info (append-text info (wrap-as (i386:push-accu))))
(info ((expr->accu* info) a))
(info (append-text info (wrap-as (i386:pop-base)))))
@ -838,6 +829,16 @@
(append-text info (append (wrap-as (i386:accu->base))
((base->ident-address info) array)
(i386:base->accu)))))
((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct))))
(let* ((info (append-text info (wrap-as (i386:push-accu))))
(info ((expr->accu* info) a))
(info (append-text info (wrap-as (i386:pop-base)))))
(append-text info (wrap-as (i386:base->accu-address)))))
((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,struct))))
(let* ((info (append-text info (wrap-as (i386:push-accu))))
(info ((expr->accu* info) a))
(info (append-text info (wrap-as (i386:pop-base)))))
(append-text info (wrap-as (i386:base->accu-address)))))
((array-ref ,index (p-expr (ident ,array)))
(let* ((type (ident->type info array))
(size (type->size info type))
@ -903,21 +904,41 @@
;; g_cells[<expr>].type
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
(let* ((type (ident->type info array))
(fields (or (type->description info type) '()))
(field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(offset (field-offset info type field))
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
(append-text info (wrap-as (append (i386:accu+value offset))))))
((d-sel (ident ,field) (p-expr (ident ,name)))
(let* ((type (ident->type info name))
(fields (or (type->description info type) '()))
(field-size 4) ;; FIXME
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(offset (field-offset info type field))
(text (.text info)))
(append-text info (append ((ident->accu info) name)
(wrap-as (i386:accu+value offset))))))
;; foo.bar[baz]
((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,name))))
(let* ((type (ident->type info name))
(offset (field-offset info type field))
(info ((expr->accu info) index)))
(append-text info (append (wrap-as (append (i386:accu-shl 2) ;; FIXME: assume size=4
(i386:push-accu)))
((ident-address->accu info) name)
(wrap-as (append (i386:accu+value offset)
(i386:pop-base)
(i386:accu+base)))))))
;; foo->bar[baz]
((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,name))))
(let* ((type (ident->type info name))
(offset (field-offset info type field))
(info ((expr->accu info) index)))
(append-text info (append (wrap-as (append (i386:accu-shl 2) ;; FIXME: assume size=4
(i386:push-accu)))
((ident->accu info) name)
(wrap-as (append (i386:accu+value offset)
(i386:pop-base)
(i386:accu+base)))))))
(_ (error "expr->accu*: unsupported: " o)))))
(define (ident->constant name value)
@ -930,7 +951,55 @@
(make-type name 'enum 4 fields))
(define (struct->type name fields)
(make-type name 'struct (* 4 (length fields)) fields)) ;; FIXME
(make-type name 'struct (apply + (map field:size fields)) fields))
(define i386:type-alist
'(("char" . (builtin 1 #f))
("short" . (builtin 2 #f))
("int" . (builtin 4 #f))
("long" . (builtin 4 #f))
("long long" . (builtin 8 #f))
;; FIXME sign
("unsigned char" . (builtin 1 #f))
("unsigned short" . (builtin 2 #f))
("unsigned" . (builtin 4 #f))
("unsigned int" . (builtin 4 #f))
("unsigned long" . (builtin 4 #f))
("unsigned long long" . (builtin 8 #f))))
(define (field:size o)
(pmatch o
((,name ,type ,size ,pointer) size)
(_ 4)))
(define (type->size info o)
(pmatch o
((decl-spec-list (type-spec (fixed-type ,type)))
(type->size info type))
((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
(type->size info type))
((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
(type->size info type))
((struct-ref (ident ,type))
(type->size info `("struct" ,type)))
(_ (let ((type (get-type (.types info) o)))
(if type (cadr type)
(error "type->size: unsupported: " o))))))
(define (field-offset info struct field)
(let* ((fields (type->description info struct))
(prefix (and=> (member field (reverse fields) (lambda (a b) (equal? a (car b)))) cdr
)))
(apply + (map field:size prefix))))
(define (ast->type o)
(pmatch o
((fixed-type ,type)
type)
((struct-ref (ident ,type))
(list "struct" type))
(_ (stderr "SKIP: type=~s\n" o)
"int")))
(define (decl->type o)
(pmatch o
@ -1127,74 +1196,44 @@
(pmatch o
((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
(comp-declr-list (comp-declr (ident ,name))))
(cons type name))
(list name type 4))
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
(cons type name))
(list name type 4))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
(cons type name))
(list name type 4))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(cons type name)) ;; FIXME: **
(list name type 4)) ;; FIXME: **
((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)))))
(cons type name)) ;; FIXME function / int
(list name type 4)) ;; FIXME function / int
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(cons type name)) ;; FIXME: ptr/char
(list name type 4)) ;; FIXME: ptr/char
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(cons type name)) ;; FIXME: **
(list name type 4)) ;; FIXME: **
((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(cons '(void) name)) ;; FIXME: *
(list name '(void) 4)) ;; FIXME: *
((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)))))
(cons '(void) name))
(list name '(void) 4))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(cons '(void) name))
;; FIXME: BufferedFile *include_stack[INCLUDE_STACK_SIZE];
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) (p-expr (fixed ,size)))))))
(cons type name)) ;; FIXME: decl, array size
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) (p-expr (fixed ,size))))))
(cons type name))
(list name '(void) 4))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) (p-expr (fixed ,count)))))))
(let ((size 4)
(count (cstring->number count)))
(list name type (* count size) 0)))
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
(let ((size 4)
(count (cstring->number count)))
(list name type (* count size) 0)))
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
(let ((size 4)
(count (cstring->number count)))
(list name type (* count size) 0)))
;; struct InlineFunc **inline_fns;
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(cons type name))
(list name type 4))
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
(cons type name))
(list name type 4))
(_ (error "struct-field: unsupported: " o))))
(define (ast->type o)
(pmatch o
((fixed-type ,type)
type)
((struct-ref (ident ,type))
(list "struct" type))
(_ (stderr "SKIP: type=~s\n" o)
"int")))
(define i386:type-alist
'(("char" . (builtin 1 #f))
("short" . (builtin 2 #f))
("int" . (builtin 4 #f))
("long" . (builtin 4 #f))
("long long" . (builtin 8 #f))
;; FIXME sign
("unsigned char" . (builtin 1 #f))
("unsigned short" . (builtin 2 #f))
("unsigned" . (builtin 4 #f))
("unsigned int" . (builtin 4 #f))
("unsigned long" . (builtin 4 #f))
("unsigned long long" . (builtin 8 #f))))
(define (type->size info o)
(pmatch o
((decl-spec-list (type-spec (fixed-type ,type)))
(type->size info type))
((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
(type->size info type))
((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
(type->size info type))
((struct-ref (ident ,type))
(type->size info `("struct" ,type)))
(_ (let ((type (get-type (.types info) o)))
(if type (cadr type)
(error "type->size: unsupported: " o))))))
(define (ident->decl info o)
(or (assoc-ref (.locals info) o)
(assoc-ref (.globals info) o)
@ -1708,7 +1747,7 @@
(let* ((local (car (add-local locals name type -1)))
(count (string->number count))
(size (type->size info type))
(local (make-local name type -1 (+ (local:id local) (* count size))))
(local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
(locals (cons local locals))
(info (clone info #:locals locals)))
info)
@ -1726,7 +1765,7 @@
(let* ((local (car (add-local locals name type -1)))
(count (string->number count))
(size (type->size info type))
(local (make-local name type 1 (+ (local:id local) (* count size))))
(local (make-local name type 1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
(locals (cons local locals))
(info (clone info #:locals locals)))
info)
@ -1740,9 +1779,11 @@
;; struct foo bar;
((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
(if (.function info)
(let* ((locals (add-local locals name `("struct" ,type) 1))
(info (clone info #:locals locals)))
info)
(let* ((size (type->size info (list "struct" type)))
(local (car (add-local locals name type 1)))
(local (make-local name `("struct" ,type) -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
(locals (cons local locals)))
(clone info #:locals locals))
(let* ((size (type->size info (list "struct" type)))
(global (make-global name (list "struct" type) -1 (string->list (make-string size #\nul))))
(globals (append globals (list global)))
@ -1761,11 +1802,15 @@
(append-text info (append ((ident->accu info) name)
((accu->ident info) value)))))) ;; FIXME: deref?
;; SCM tmp;
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name))))
(if (.function info)
(clone info #:locals (add-local locals name type 0))
(let ((size (type->size info type)))
(if (<= size 4) (clone info #:locals (add-local locals name type 0))
(let* ((local (car (add-local locals name type 1)))
(local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
(locals (cons local locals)))
(clone info #:locals locals))))
(clone info #:globals (append globals (list (ident->global name type 0 0))))))
;; SCM g_stack = 0;
@ -1989,7 +2034,6 @@
(let* ((type (decl->type type))
(fields (type->description info type))
(size (type->size info type))
(field-size 4) ;; FIXME:4, not fixed
(initzers (map (initzer->non-const info) initzers)))
(if (.function info)
(let* ((globals (append globals (filter-map initzer->global initzers)))
@ -1999,9 +2043,9 @@
(locals (add-local locals name type -1))
(info (clone info #:locals locals #:globals globals))
(empty (clone info #:text '())))
(let loop ((fields (iota (length fields))) (initzers initzers) (info info))
(let loop ((fields fields) (initzers initzers) (info info))
(if (null? fields) info
(let ((offset (* field-size (car fields)))
(let ((offset (field-offset info type (caar fields)))
(initzer (car initzers)))
(loop (cdr fields) (cdr initzers)
(clone info #:text
@ -2014,11 +2058,10 @@
(let* ((globals (append globals (filter-map initzer->global initzers)))
(global (make-global name type -1 (string->list (make-string size #\nul))))
(globals (append globals (list global)))
(info (clone info #:globals globals))
(field-size 4))
(let loop ((fields (iota (length fields))) (initzers initzers) (info info))
(info (clone info #:globals globals)))
(let loop ((fields fields) (initzers initzers) (info info))
(if (null? fields) info
(let ((offset (* field-size (car fields)))
(let ((offset (field-offset info type (caar fields)))
(initzer (car initzers)))
(loop (cdr fields) (cdr initzers)
(clone info #:init
@ -2030,7 +2073,7 @@
(append
(list-head data (+ here ,offset))
(initzer->data f g ta t d ',(car initzers))
(list-tail data (+ here ,offset ,field-size))))))))))))))))
(list-tail data (+ here ,offset ,(field:size (car fields))))))))))))))))))
;;char cc = g_cells[c].cdr; ==> generic?

View File

@ -27,6 +27,15 @@ include make/bin.make
TARGET:=t
include make/check.make
TARGET:=t-tcc
C_FILES:=$(DIR)/t-tcc.c
DEFINES:=POSIX=1
INCLUDES:=libc
include make/bin.make
TARGET:=t-tcc
include make/check.make
TARGET:=m.mlibc
C_FILES:=$(DIR)/m.c
include make/bin-mlibc.make
@ -59,6 +68,18 @@ include make/bin-mlibc.make
TARGET:=t.mlibc
include make/check.make
TARGET:=t-tcc.mlibc
C_FILES:=$(DIR)/t-tcc.c
include make/bin-mlibc.make
TARGET:=t-tcc.mlibc
include make/check.make
CROSS:=$(CC32:%gcc=%)
#$(OUT)/$(DIR)/mini-mes.$(CROSS)o: $(SNARF.MES)
$(OUT)/mini-mes: $(SNARF.MES)
TARGET:=mini-mes.mlibc
# guile/mescc.scm
TARGET:=m.guile
@ -93,6 +114,13 @@ include make/mescc-guile.make
TARGET:=t.guile
include make/check.make
TARGET:=t-tcc.guile
C_FILES:=$(DIR)/t-tcc.c
include make/mescc-guile.make
TARGET:=t-tcc.guile
include make/check.make
# scripts/mescc.mes
ifneq ($(MES),)
TARGET:=m.mes

47
scaffold/t-tcc.c Normal file
View File

@ -0,0 +1,47 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2017 Jan 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/>.
*/
#include <stdio.h>
struct foo;
typedef struct foo foo_struct;
struct foo
{
int bar[2];
};
int
main (int argc, char *argv[])
{
//struct foo f;
foo_struct f;
f.bar[0] = 0x22;
f.bar[1] = 0x34;
printf ("eentje: %d\n", f.bar[0]);
printf ("tweetje: %d\n", f.bar[1]);
struct foo *g = &f;
printf ("punter eentje: %d\n", g->bar[0]);
printf ("punter tweetje: %d\n", g->bar[1]);
return 0;
}