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< + * + * 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; +}