diff --git a/make.scm b/make.scm index fc4080ae..3a9bcac4 100755 --- a/make.scm +++ b/make.scm @@ -169,7 +169,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$ "7g-struct-byte-word-field" "7h-struct-assign" "7i-struct-struct" - "7j-strtoull")) + "7j-strtoull" + "7k-for-each-elem")) (add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets))) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index a1c9d1c1..12544de5 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -431,11 +431,6 @@ (info (append-text info (wrap-as (i386:accu-mem-add n))))) info))) -(define (expr->pointer info o) - (pmatch o - ((p-expr (ident ,name)) (ident->pointer info name)) ;; FIXME - (_ 0))) - (define (ident-address-add info) (lambda (o n) (let ((local (assoc-ref (.locals info) o))) @@ -1708,6 +1703,7 @@ ((p-expr (fixed ,value)) 0) ((p-expr (ident ,name)) (ident->pointer info name)) ((de-ref ,expr) (1- (expr->pointer info expr))) + ((assn-expr ,lhs ,op ,rhs) (expr->pointer info lhs)) ((add ,a ,b) (expr->pointer info a)) ((neg ,a) (expr->pointer info a)) ((sub ,a ,b) (expr->pointer info a)) @@ -1715,30 +1711,111 @@ ((pre-dec ,a) (expr->pointer info a)) ((post-inc ,a) (expr->pointer info a)) ((post-dec ,a) (expr->pointer info a)) + ((array-ref ,index ,array) + (1- (expr->pointer info array))) + + ((d-sel (ident ,field) (array-ref ,index ,array)) + (let ((type (p-expr->type info array))) + (field-pointer info type field))) + + ((i-sel (ident ,field) (array-ref ,index ,array)) + (let ((type (p-expr->type info array))) + (field-pointer info type field))) + ((d-sel (ident ,field) (p-expr (ident ,struct))) (let ((type (ident->type info struct))) (field-pointer info type field))) + ((i-sel (ident ,field) (p-expr (ident ,struct))) (let ((type (ident->type info struct))) (field-pointer info type field))) - ((cast (type-name ,type (abs-declr ,pointer)) (p-expr (ident ,name))) + + ((i-sel (ident ,field1) (i-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-pointer info type1 field1))) + + ((i-sel (ident ,field1) (d-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-pointer info type1 field1))) + + ((d-sel (ident ,field1) (i-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + ;;(type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-pointer info type1 field1))) + + ((d-sel (ident ,field1) (d-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-pointer info type1 field1))) + + ((cast (type-name ,type) ,expr) ; FIXME: add expr? + (let* ((type (ast-type->type info type)) + (pointer (type:pointer type))) + pointer)) + ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: add expr? (let* ((type (ast-type->type info type)) (pointer0 (type:pointer type)) - (pointer1 (ptr-declr->pointer pointer))) + (pointer1 (ptr-declr->pointer pointer)) + (pointer2 (expr->pointer info expr))) (+ pointer0 pointer1))) (_ (stderr "expr->pointer: unsupported: ~s\n" o) 0))) (define (expr->size info o) (pmatch o ((p-expr (ident ,name)) (ident->size info name)) + + ((array-ref ,index ,array) + (let ((type (p-expr->type info array))) + (ast-type->size info type))) + + ((d-sel (ident ,field) (array-ref ,index ,array)) + (let ((type (p-expr->type info array))) + (field-size info type field))) + + ((i-sel (ident ,field) (array-ref ,index ,array)) + (let ((type (p-expr->type info array))) + (field-size info type field))) + ((d-sel (ident ,field) (p-expr (ident ,struct))) (let* ((type (ident->type info struct)) (type1 (field-type info type field))) (ast-type->size info type1))) + ((i-sel (ident ,field) (p-expr (ident ,struct))) (let* ((type (ident->type info struct)) (type1 (field-type info type field))) (ast-type->size info type1))) + + ((i-sel (ident ,field1) (i-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (ast-type->size info type1))) + + ((i-sel (ident ,field1) (d-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (ast-type->size info type1))) + + ((d-sel (ident ,field1) (i-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (ast-type->size info type1))) + + ((d-sel (ident ,field1) (d-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (ast-type->size info type1))) + ((de-ref ,expr) (expr->size info expr)) ((add ,a ,b) (expr->size info a)) ((sub ,a ,b) (expr->size info a)) @@ -1746,7 +1823,10 @@ ((pre-dec ,a) (expr->size info a)) ((post-inc ,a) (expr->size info a)) ((post-dec ,a) (expr->size info a)) - ((cast (type-name ,type (abs-declr ,pointer)) (p-expr (ident ,name))) + ((cast (type-name ,type) ,expr) ; FIXME: ignore expr? + (let ((type (ast-type->type info type))) + (type:size type))) + ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr? (let ((type (ast-type->type info type))) (type:size type))) (_ (stderr "expr->size: unsupported: ~s\n" o) 4))) @@ -1754,7 +1834,33 @@ (define (p-expr->type info o) (pmatch o ((p-expr (ident ,name)) (ident->type info name)) + ((array-ref ,index ,array) + (p-expr->type info array)) ((array-ref ,index (p-expr (ident ,array))) (ident->type info array)) + ((i-sel (ident ,field1) (i-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-type info type1 field1))) + + ((i-sel (ident ,field1) (d-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-type info type1 field1))) + + ((d-sel (ident ,field1) (i-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-type info type1 field1))) + + ((d-sel (ident ,field1) (d-sel (ident ,field0) ,struct0)) + (let* ((type0 (p-expr->type info struct0)) + (type0 (if (pair? type0) type0 `("tag" ,type0))) + (type1 (field-type info type0 field0))) + (field-type info type1 field1))) + ((i-sel (ident ,field) (p-expr (ident ,struct))) (let* ((type0 (ident->type info struct)) (type0 (if (pair? type0) type0 `("tag" ,type0)))) @@ -1773,7 +1879,9 @@ ((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))) + ((cast (type-name ,type) ,expr) ; FIXME: ignore expr? + type) + ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr? type) ((fctn-call (p-expr (ident ,name))) (stderr "TODO: p-expr->type: unsupported: ~s\n" o) diff --git a/scaffold/tests/7k-for-each-elem.c b/scaffold/tests/7k-for-each-elem.c new file mode 100644 index 00000000..bb93f3d5 --- /dev/null +++ b/scaffold/tests/7k-for-each-elem.c @@ -0,0 +1,74 @@ +/* -*-comment-start: "//";comment-end:""-*- + * Mes --- Maxwell Equations of Software + * Copyright © 2017 Jan 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 . + */ + +#include "30-test.i" + +struct section { + unsigned char *data; + int offset; +}; + +struct sym { + char* name; + int index; +}; + + +struct sym tab[3] = {"foo", 0, "bar", 1, "baz", 2}; + +struct section section; + +#define for_each_elem(sec, startoff, elem, type) \ + for (elem = (type *) sec->data + startoff; \ + elem < (type *) (sec->data + sec->offset); elem++) +#define for_each_elem2(sec, startoff, elem, type) \ + elem = sec->data + sizeof (type) * startoff; \ + for (;elem < ((type *) (sec->data + sec->offset)); elem++) + +int +test () +{ + section.data = tab; + section.offset = 24; + + struct sym* p; + int size = sizeof (struct sym); + eputs ("size="); eputs (itoa (size)); eputs ("\n"); + if (size != 8) return 1; + struct section* psection = §ion; + p = (struct sym*)psection->data + 1; + struct sym* q = tab; + int i = (int)p; + i -= (int)q; + eputs ("diff="); eputs (itoa (i)); eputs ("\n"); + if (i != 8) return 2; + + for_each_elem(psection, 1, p, struct section) { + eputs ("i="); eputs (itoa (p->index)); + eputs (" name="); eputs (p->name); eputs ("\n"); + } + + for_each_elem2(psection, 1, p, struct section) { + eputs ("i="); eputs (itoa (p->index)); + eputs (" name="); eputs (p->name); eputs ("\n"); + } + + return 0; +}