diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index a9209d24..9da74f3c 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -570,25 +570,20 @@ (let* ((info ((expr->accu* info) o)) (type0 (ident->type info struct0)) (type1 (field-type info type0 field0)) - (struct? (memq (type:type (ast-type->type info type0)) '(struct union))) (ptr (field-pointer info type0 field0)) (size (ast-type->size info type1))) - (if (= ptr -3) info - (append-text info (wrap-as (append (if (and (= ptr -2) struct?) (i386:mem->accu) '()) - (if (= size 1) (i386:byte-mem->accu) - (i386:mem->accu)))))))) + (append-text info (wrap-as (if (= size 1) (i386:byte-mem->accu) + (i386:mem->accu)))))) ;; foo->bar[baz]) ((array-ref ,index (i-sel (ident ,field0) (p-expr (ident ,struct0)))) (let* ((info ((expr->accu* info) o)) (type0 (ident->type info struct0)) (type1 (field-type info type0 field0)) - (struct? (memq (type:type (ast-type->type info type0)) '(struct union))) (ptr (field-pointer info type0 field0)) (size (ast-type->size info type1))) - (append-text info (wrap-as (append (if (and (= ptr -2) struct?) (i386:mem->accu) '()) - (if (= size 1) (i386:byte-mem->accu) - (i386:mem->accu))))))) + (append-text info (wrap-as (if (= size 1) (i386:byte-mem->accu) + (i386:mem->accu)))))) ;; [baz] ((array-ref ,index ,array) @@ -817,26 +812,23 @@ (size (cond ((= ptr 1) (expr->size info a)) ((> ptr 1) 4) ((and struct? (= ptr -2)) 4) + ((and struct? (= ptr 2)) 4) (else 1))) (info ((expr->accu info) a)) (value (cstring->number value)) (value (* size value))) - (stderr "ptr=~s\n" ptr) - (stderr " size=~s\n" size) - (stderr " struct?=~s\n" struct?) - (if (not (= size 1)) - (warn (format #f "TODO: pointer arithmetic: ~s\n" o))) (append-text info (wrap-as (i386:accu+value value))))) ((add ,a ,b) (let* ((ptr (expr->pointer info a)) + (type0 (p-expr->type info a)) + (struct? (memq (type:type (ast-type->type info type0)) '(struct union))) (size (cond ((= ptr 1) (expr->size info a)) ((> ptr 1) 4) ((and struct? (= ptr -2)) 4) + ((and struct? (= ptr 2)) 4) (else 1)))) - (if (not (= size 1)) - (warn (format #f "TODO: pointer arithmetic: ~s\n" o)))) - ((binop->accu info) a b (i386:accu+base))) + ((binop->accu info) a b (i386:accu+base)))) ((sub ,a (p-expr (fixed ,value))) (let* ((ptr (expr->pointer info a)) @@ -1148,35 +1140,7 @@ (type1 (field-type info type0 field0)) (offset (field-offset info type0 field0)) (info ((expr->accu info) index)) - (struct? (memq (type:type (ast-type->type info type0)) '(struct union))) - (ptr (field-pointer info type0 field0)) - (size (if (= ptr -1) (ast-type->size info type1) - 4))) - (stderr "ACCU* o=~s\n" o) - (stderr " ptr=~s\n" ptr) - (stderr " size=~s\n" size) - (append-text info (append (wrap-as (append (i386:accu->base) - (if (eq? size 1) '() - (append - (if (<= size 4) '() - (i386:accu+accu)) - (if (<= size 8) '() - (i386:accu+base)) - (i386:accu-shl 2))))) - (wrap-as (i386:push-accu)) - ((ident-address->accu info) struct0) - (if (and struct? (= ptr -2)) (wrap-as (i386:mem->accu)) '()) - (wrap-as (append (i386:accu+value offset) - (i386:pop-base) - (i386:accu+base))))))) - - ;; foo->bar[baz] - ((array-ref ,index (i-sel (ident ,field0) (p-expr (ident ,struct0)))) - (let* ((type0 (ident->type info struct0)) - (type1 (field-type info type0 field0)) - (offset (field-offset info type0 field0)) - (info ((expr->accu info) index)) - (struct? (memq (type:type (ast-type->type info type0)) '(struct union))) + (struct? (or #t (memq (type:type (ast-type->type info type0)) '(struct union)))) (ptr (field-pointer info type0 field0)) (size (if (= ptr -1) (ast-type->size info type1) 4))) @@ -1190,9 +1154,36 @@ (i386:accu-shl 2))))) (wrap-as (i386:push-accu)) ((ident->accu info) struct0) - (if (and struct? (= ptr -2)) (wrap-as (i386:mem->accu)) '()) (wrap-as (append (i386:accu+value offset) (i386:pop-base) + (if (and struct? (or (= ptr -2) + (= ptr 2))) (i386:mem->accu) '()) + (i386:accu+base))))))) + + ;; foo->bar[baz] + ((array-ref ,index (i-sel (ident ,field0) (p-expr (ident ,struct0)))) + (let* ((type0 (ident->type info struct0)) + (type1 (field-type info type0 field0)) + (offset (field-offset info type0 field0)) + (info ((expr->accu info) index)) + (struct? (or #t (memq (type:type (ast-type->type info type0)) '(struct union)))) + (ptr (field-pointer info type0 field0)) + (size (if (= ptr -1) (ast-type->size info type1) + 4))) + (append-text info (append (wrap-as (append (i386:accu->base) + (if (eq? size 1) '() + (append + (if (<= size 4) '() + (i386:accu+accu)) + (if (<= size 8) '() + (i386:accu+base)) + (i386:accu-shl 2))))) + (wrap-as (i386:push-accu)) + ((ident->accu info) struct0) + (wrap-as (append (i386:accu+value offset) + (i386:pop-base) + (if (and struct? (or (= ptr -2) + (= ptr 2))) (i386:mem->accu) '()) (i386:accu+base))))))) ((array-ref ,index ,array) @@ -1331,6 +1322,12 @@ ((type-spec ,type) (ast-type->type info type)) ((fixed-type ,type) (ast-type->type info type)) ((typename ,type) (ast-type->type info type)) + ((d-sel (idend ,field) ,struct) + (let ((type0 (ast-type->type info struct))) + (field-type info type0 field))) + ((i-sel (ident ,field) ,struct) + (let ((type0 (ast-type->type info struct))) + (field-type info type0 field))) (_ (let ((type (get-type (.types info) o))) (if type type (begin @@ -1338,15 +1335,20 @@ (error "ast-type->type: unsupported: " o))))))) (define (ast-type->description info o) - (let ((type (ast-type->type info o))) - (type:description type))) + (let* ((type (ast-type->type info o)) + (xtype (if (type? type) type + (ast-type->type info type)))) + (type:description xtype))) (define (ast-type->size info o) - (let ((type (ast-type->type info o))) - (type:size type))) + (let* ((type (ast-type->type info o)) + (xtype (if (type? type) type + (ast-type->type info type)))) + (type:size xtype))) (define (field-field info struct field) - (let* ((xtype (ast-type->type info struct)) + (let* ((xtype (if (type? struct) struct + (ast-type->type info struct))) (fields (type:description xtype))) (let loop ((fields fields)) (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct)) @@ -1357,7 +1359,8 @@ (else (loop (cdr fields))))))))) (define (field-offset info struct field) - (let ((xtype (ast-type->type info struct))) + (let ((xtype (if (type? struct) struct + (ast-type->type info struct)))) (if (eq? (type:type xtype) 'union) 0 (let ((fields (type:description xtype))) (let loop ((fields fields) (offset 0)) @@ -1370,20 +1373,19 @@ (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)))) + (let ((field (field-field info struct field))) + (field:pointer field))) (define (field-size info struct field) - (let ((xtype (ast-type->type info struct))) + (let ((xtype (if (type? struct) struct + (ast-type->type info struct)))) (if (eq? (type:type xtype) 'union) 0 (let ((field (field-field info struct field))) (field:size field))))) (define (field-type info struct field) - (let ((xtype (ast-type->type info struct))) - (let ((field (field-field info struct field))) - (field:type field)))) + (let ((field (field-field info struct field))) + (field:type field))) (define (ast->type o) (pmatch o @@ -1673,9 +1675,11 @@ (define (expr->pointer info o) (pmatch o + ((p-expr (fixed ,value)) 0) ((p-expr (ident ,name)) (ident->pointer info name)) ((de-ref ,expr) (1- (expr->pointer info expr))) ((add ,a ,b) (expr->pointer info a)) + ((neg ,a) (expr->pointer info a)) ((sub ,a ,b) (expr->pointer info a)) ((pre-inc ,a) (expr->pointer info a)) ((pre-dec ,a) (expr->pointer info a)) @@ -1727,11 +1731,18 @@ (field-type info type0 field))) ((de-ref ,expr) (p-expr->type info expr)) ((ref-to ,expr) (p-expr->type info expr)) - ((add ,a ,b) - (p-expr->type info a)) - ((sub ,a ,b) - (p-expr->type info a)) - (_ (error "p-expr->type: unsupported: " o)))) + ((add ,a ,b) (p-expr->type info a)) + ((sub ,a ,b) (p-expr->type info a)) + ((p-expr (fixed ,value)) "int") + ((neg ,a) (p-expr->type info a)) + ((cast (type-name ,type (abs-declr ,pointer)) (p-expr (ident ,name))) + type) + ((fctn-call (p-expr (ident ,name))) + (stderr "TODO: p-expr->type: unsupported: ~s\n" o) + "int") + (_ ;;(error (format #f "p-expr->type: unsupported: ~s") o) + (stderr "TODO: p-expr->type: unsupported: ~s\n" o) + "int"))) (define (local-var? o) ;; formals < 0, locals > 0 (positive? (local:id o))) diff --git a/scaffold/tests/79-int-array.c b/scaffold/tests/79-int-array.c index 64b2758a..6834c14e 100644 --- a/scaffold/tests/79-int-array.c +++ b/scaffold/tests/79-int-array.c @@ -20,8 +20,9 @@ #include "30-test.i" +#include #include -#include +#include struct foo { int *bar; diff --git a/scaffold/tests/7c-dynarray.c b/scaffold/tests/7c-dynarray.c index b11196aa..01a6b6be 100644 --- a/scaffold/tests/7c-dynarray.c +++ b/scaffold/tests/7c-dynarray.c @@ -81,7 +81,9 @@ test () eputs ("&PATHS="); eputs (itoa (&s->paths)); eputs ("\n"); eputs ("&FILES="); eputs (itoa (&s->files)); eputs ("\n"); - struct file *fs = s->files[0]; + struct file *fs; + eputs ("foo\n"); + fs = s->files[0]; eputs ("add s= "); eputs (itoa (s)); eputs ("\n"); eputs ("add fs= "); eputs (itoa (fs)); eputs ("\n"); eputs ("&fs->[0]="); eputs (itoa (fs->name)); eputs ("\n"); @@ -90,13 +92,46 @@ test () eputs ("ps= "); eputs (itoa (s->paths)); eputs ("\n"); eputs ("*ps "); eputs (*s->paths); eputs ("\n"); - if (strcmp (fs->name, file_name)) return 1; - + if (strcmp (fs->name, file_name)) return 2; + eputs ("&fs->[0]="); eputs (itoa (fs->name)); eputs ("\n"); eputs ("fs->name="); eputs (fs->name); eputs ("\n"); eputs ("ps= "); eputs (itoa (s->paths)); eputs ("\n"); eputs ("*ps "); eputs (*s->paths); eputs ("\n"); + + file = malloc (sizeof (struct file) + strlen (file_name)); + file_name = "hallo"; + strcpy (file->name, file_name); + add (&s->files, &s->file_count, file); + + struct file **pf = s->files; + fs = pf[0]; + eputs ("\n"); + eputs ("&fs0*= "); eputs (itoa (&pf[0])); eputs ("\n"); + + eputs ("fs0*= "); eputs (itoa (fs)); eputs ("\n"); + fs = s->files[0]; + eputs ("fs0*= "); eputs (itoa (fs)); eputs ("\n"); + eputs ("\n"); + + pf = s->files; + fs = pf[1]; + eputs ("&fs1*= "); eputs (itoa (&pf[1])); eputs ("\n"); + eputs ("fs1*= "); eputs (itoa (fs)); eputs ("\n"); + fs = s->files[1]; + eputs ("fs1*= "); eputs (itoa (fs)); eputs ("\n"); + eputs ("\n"); + if (strcmp (fs->name, file_name)) return 3; + + fs = g_s.files[0]; + eputs ("gfs0*= "); eputs (itoa (fs)); eputs ("\n"); + fs = g_s.files[1]; + eputs ("gfs1*= "); eputs (itoa (fs)); eputs ("\n"); + eputs ("\n"); + if (strcmp (fs->name, file_name)) return 3; + + return 0; } diff --git a/scaffold/tests/7f-struct-pointer-arithmetic.c b/scaffold/tests/7f-struct-pointer-arithmetic.c index 1a1e763c..a231139f 100644 --- a/scaffold/tests/7f-struct-pointer-arithmetic.c +++ b/scaffold/tests/7f-struct-pointer-arithmetic.c @@ -24,9 +24,11 @@ #include struct foo; +typedef struct foo foo_struct; struct foo { - struct foo **foo; + //struct foo **foo; + foo_struct **foo; }; struct foo g_foo[2];