diff --git a/make.scm b/make.scm
index 915a74dd..34ad3240 100755
--- a/make.scm
+++ b/make.scm
@@ -245,7 +245,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
"7j-strtoull"
"7k-for-each-elem"
"7l-struct-any-size-array"
- "7m-struct-char-array-assign"))
+ "7m-struct-char-array-assign"
+ "7n-struct-struct-array"))
(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 978dd3b9..f5643c91 100644
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -873,7 +873,7 @@
(info (clone info #:globals globals)))
(append-text info (list (i386:label->accu `(#:string ,string))))))
- ;;; FIXME: FROM INFO ...only zero?!
+ ;; FIXME: FROM INFO ...only zero?!
((p-expr (fixed ,value))
(let ((value (cstring->number value)))
(append-text info (wrap-as (i386:value->accu value)))))
@@ -964,11 +964,12 @@
((d-sel ,field ,struct)
(let* ((info ((expr->accu* info) o))
+ (info (append-text info (ast->comment o)))
(ptr (expr->pointer info o))
(size (if (= ptr 0) (expr->type-size info o)
4)))
- (if (= ptr -1) info
- (append-text info (wrap-as (case size
+ (if (or (= -2 ptr) (= -1 ptr)) info
+ (append-text info (wrap-as (case size
((1) (i386:byte-mem->accu))
((2) (i386:word-mem->accu))
((4) (i386:mem->accu))
@@ -976,11 +977,12 @@
((i-sel ,field ,struct)
(let* ((info ((expr->accu* info) o))
+ (info (append-text info (ast->comment o)))
(ptr (expr->pointer info o))
(size (if (= ptr 0) (expr->type-size info o)
4)))
- (if (= ptr -1) info
- (append-text info (wrap-as (case size
+ (if (or (= -2 ptr) (= ptr -1)) info
+ (append-text info (wrap-as (case size
((1) (i386:byte-mem->accu))
((2) (i386:word-mem->accu))
((4) (i386:mem->accu))
@@ -1070,10 +1072,13 @@
(info (append ((expr->accu info) expr))))
info))
+
+
((add ,a (p-expr (fixed ,value)))
- (let* ((ptr (expr->pointer info a))
+ ;;(stderr "add ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o))))
+ (let* ((ptr (pke "ptr" (expr->pointer info a)))
(type0 (expr->type info a))
- (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
+ (struct? (pke "struct" (memq (type:type (ast-type->type info type0)) '(struct union))))
(size (cond ((= ptr 1) (expr->type-size info a))
((> ptr 1) 4)
((and struct? (= ptr -2)) 4)
@@ -1081,7 +1086,8 @@
(else 1)))
(info ((expr->accu info) a))
(value (cstring->number value))
- (value (* size value)))
+ (value (pke "VALUE" (* size value))))
+ (pke "size" size)
(append-text info (wrap-as (i386:accu+value value)))))
((add ,a ,b)
@@ -1117,19 +1123,22 @@
(append-text info (wrap-as (i386:accu+value (- value))))))
((sub ,a ,b)
- (let* ((ptr (expr->pointer info a))
- (ptr-b (expr->pointer info b))
+ ;;(stderr "sub ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o))))
+ (let* ((ptr (pke "ptr" (expr->pointer info a)))
+ (ptr-b (pke "ptr-b" (expr->pointer info b)))
(type0 (expr->type info a))
- (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
- (size (cond ((= ptr 1) (expr->type-size info a))
- ((> ptr 1) 4)
- ((and struct? (= ptr -2)) 4)
- ((and struct? (= ptr 2)) 4)
- (else 1))))
- (if (or (= size 1) (= ptr-b 1)) (let ((info ((binop->accu info) a b (i386:accu-base))))
- (if (not (= ptr-b 1)) info
- (append-text info (wrap-as (append (i386:value->base size)
- (i386:accu/base))))))
+ (struct? (pke "struct?" (memq (type:type (ast-type->type info type0)) '(struct union))))
+ (size (cond ((= ptr 1) (expr->type-size info a))
+ ((> ptr 1) 4)
+ ((and struct? (= ptr -2)) 4)
+ ((and struct? (= ptr 2)) 4)
+ (else 1))))
+ (pke "size" size)
+ (if (or (= size 1) (or (= ptr-b -2) (= ptr-b 1)))
+ (let ((info ((binop->accu info) a b (i386:accu-base))))
+ (if (and (not (= ptr-b -2)) (not (= ptr-b 1))) info
+ (append-text info (wrap-as (append (i386:value->base size)
+ (i386:accu/base))))))
(let* ((info ((expr->accu info) b))
(info (append-text info (wrap-as (append (i386:value->base size)
(i386:accu*base)
@@ -1158,8 +1167,8 @@
((neg ,expr)
(let ((info ((expr->base info) expr)))
- (append-text info (append (wrap-as (i386:value->accu 0))
- (wrap-as (i386:sub-base))))))
+ (append-text info (append (wrap-as (i386:value->accu 0))
+ (wrap-as (i386:sub-base))))))
((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
@@ -1225,9 +1234,9 @@
(ptr-b (expr->pointer info b))
(size-a (expr->size info a))
(size-b (expr->size info b))
- ;;(foo (stderr "assign ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))))
- ;;(foo (stderr " size-a: ~a, ptr=~a\n" size-a ptr-a))
- ;;(foo (stderr " size-b: ~a, ptr=~a\n" size-b ptr-b))
+ ;; (foo (stderr "assign ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))))
+ ;; (foo (stderr " size-a: ~a, ptr=~a\n" size-a ptr-a))
+ ;; (foo (stderr " size-b: ~a, ptr=~a\n" size-b ptr-b))
(info ((expr->accu info) b))
(info (if (equal? op "=") info
(let* ((ptr (expr->pointer info a))
@@ -1246,16 +1255,16 @@
(info ((expr->accu info) a))
(info (append-text info (wrap-as (i386:pop-base))))
(info (append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
- ((equal? op "-=") (wrap-as (i386:accu-base)))
- ((equal? op "*=") (wrap-as (i386:accu*base)))
- ((equal? op "/=") (wrap-as (i386:accu/base)))
- ((equal? op "%=") (wrap-as (i386:accu%base)))
- ((equal? op "&=") (wrap-as (i386:accu-and-base)))
- ((equal? op "|=") (wrap-as (i386:accu-or-base)))
- ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
- ((equal? op ">>=") (wrap-as (i386:accu>>base)))
- ((equal? op "<<=") (wrap-as (i386:accu<>=") (wrap-as (i386:accu>>base)))
+ ((equal? op "<<=") (wrap-as (i386:accu<base size)
(i386:accu/base)))))
@@ -1449,6 +1458,9 @@
(- (expr->number info a) (expr->number info b)))
((sizeof-type (type-name (decl-spec-list (type-spec ,type))))
(ast-type->size info type))
+ ((sizeof-expr (d-sel (ident ,field) (p-expr (ident ,struct))))
+ (let ((type (ident->type info struct)))
+ (field-size info type field)))
((sizeof-expr (i-sel (ident ,field) (p-expr (ident ,struct))))
(let ((type (ident->type info struct)))
(field-size info type field)))
@@ -1500,7 +1512,8 @@
((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)
(count (expr->number info count)))
- (list name type (* count size) -1)))
+ (list name type (* count size) -2)))
+
((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
(let ((size (ast-type->size info type))
(count (expr->number info count)))
diff --git a/scaffold/tests/7n-struct-struct-array.c b/scaffold/tests/7n-struct-struct-array.c
new file mode 100644
index 00000000..24517d5e
--- /dev/null
+++ b/scaffold/tests/7n-struct-struct-array.c
@@ -0,0 +1,104 @@
+/* -*-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"
+
+#include
+#include
+#include
+#include
+
+typedef struct file {
+ char name[10];
+} file_struct;
+
+#define STACK_SIZE 2
+struct state {
+ int bla;
+ file_struct *stack[STACK_SIZE];
+ char buf[100];
+ file_struct **stack_ptr;
+ char buf1[100];
+};
+
+int
+test ()
+{
+ struct state s;
+ struct state *ps;
+ ps = &s;
+ eputs ("0\n");
+
+ s.stack_ptr = s.stack;
+ ps->stack_ptr = ps->stack;
+ eputs ("ps->stack="); eputs (itoa (ps->stack)); eputs ("\n");
+
+ eputs ("1\n");
+ if (ps->stack_ptr >= ps->stack + STACK_SIZE) return 1;
+ eputs ("2\n");
+
+ struct file f = {"first.h"};
+#if 0 //__MESC__
+ strcpy (f.name, "first.h");
+#endif
+ eputs (f.name); eputs ("\n");
+
+ *ps->stack_ptr = &f;
+
+ eputs ("3\n");
+ ++ps->stack_ptr;
+ eputs ("s.stack_ptr -stack ="); eputs (itoa (ps->stack_ptr - ps->stack)); eputs ("\n");
+ eputs ("4\n");
+
+ for (file_struct **p = ps->stack; p < ps->stack_ptr; p++)
+ {
+ eputs ((*p)->name); eputs ("\n");
+ }
+
+ eputs ("5\n");
+
+ int i;
+ i = ps->stack_ptr - ps->stack + STACK_SIZE;
+ eputs ("i="); eputs (itoa (i)); eputs ("\n");
+
+ if (ps->stack_ptr >= ps->stack + STACK_SIZE) return 2;
+
+ eputs ("6\n");
+ struct file f2 = {"second.h"};
+#if 0//__MESC__
+ strcpy (f2.name, "second.h");
+#endif
+
+ *ps->stack_ptr = &f2;
+ eputs ("7\n");
+ ++ps->stack_ptr;
+ eputs ("s.stack_ptr -stack ="); eputs (itoa (ps->stack_ptr - ps->stack)); eputs ("\n");
+
+ for (file_struct **p = ps->stack; p < ps->stack_ptr; p++)
+ {
+ eputs ((*p)->name); eputs ("\n");
+ }
+
+ if (ps->stack_ptr >= ps->stack + STACK_SIZE) return 0;
+ struct file f3 = {"third.h"};
+ *ps->stack_ptr = &f3;
+ ++ps->stack_ptr;
+ return 3;
+}