From d039b003494e40f246e885bc73e9f302c2e340bd Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 13 Mar 2017 19:38:38 +0100 Subject: [PATCH] mescc: Fix for character array s[0]. * module/language/c99/compiler.mes (expr->arg, expr->accu, ast->info): Use type size to calculate index. * doc/examples/t.c: Test it. * doc/examples/mini-mes.c (cstring_to_list): Simplify. --- module/language/c99/compiler.mes | 122 ++++++++++++++++++++++--------- scaffold/mini-mes.c | 27 ------- scaffold/t.c | 18 ++++- 3 files changed, 105 insertions(+), 62 deletions(-) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 35abc763..9cb82012 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -263,28 +263,40 @@ ;; g_cells[0] ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))) - (let ((index (cstring->number index)) - (size 4)) ;; FIXME: type: int + (let* ((index (cstring->number index)) + (type (ident->type info array)) + (size (type->size info type))) (clone info #:text (append text ((ident->base info) array) (list (lambda (f g ta t d) (append - (i386:value->accu (* size index)) ;; FIXME: type: int - (i386:base-mem->accu) ;; FIXME: type: int + (i386:value->accu (* size index)) + (if (eq? size 1) + (i386:byte-base-mem->accu) + (i386:base-mem->accu)) (i386:push-accu)))))))) ;; g_cells[i] ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array))) - (let ((index (cstring->number index)) - (size 4)) ;; FIXME: type: int + (let* ((type (ident->type info array)) + (size (type->size info type))) (clone info #:text (append text + ((ident->base info) index) + (list (lambda (f g ta t d) + (append + (i386:base->accu) + (if (< size 4) '() + (begin + (i386:accu+accu) + (if (= size 12) (i386:accu+base) '()) +_))))) ((ident->base info) array) - ((ident->accu info) array) - (list - (lambda (f g ta t d) - (i386:base-mem->accu))) + (list (lambda (f g ta t d) + (if (eq? size 1) + (i386:byte-base-mem->accu) + (i386:base-mem->accu)))) (list (lambda (f g ta t d) (i386:push-accu))))))) @@ -487,24 +499,46 @@ (type (list "struct" name)) (fields (or (type->description info type) '())) (size (type->size info type))) - (stderr "SIZEOF: type=~s => ~s\n" type size) (clone info #:text (append text (list (lambda (f g ta t d) (append (i386:value->accu size)))))))) + ;; c+p expr->arg ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,array))) - (let ((value (cstring->number value))) + (let* ((value (cstring->number value)) + (type (ident->type info array)) + (size (type->size info type))) (clone info #:text (append text ((ident->base info) array) (list (lambda (f g ta t d) (append (i386:value->accu value) - ;;(i386:byte-base-mem->accu) ;; FIXME: int/char - (i386:base-mem->accu) - ))))))) + (if (eq? size 1) + (i386:byte-base-mem->accu) + (i386:base-mem->accu))))))))) + + ;; c+p expr->arg + ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array))) + (let* ((type (ident->type info array)) + (size (type->size info type))) + (clone info #:text (append text + ((ident->base info) index) + (list (lambda (f g ta t d) + (append + (i386:base->accu) + (if (< size 4) '() + (begin + (i386:accu+accu) + (if (= size 12) (i386:accu+base) '()) +_))))) + ((ident->base info) array) + (list (lambda (f g ta t d) + (if (eq? size 1) + (i386:byte-base-mem->accu) + (i386:base-mem->accu)))))))) ;; f.field ((d-sel (ident ,field) (p-expr (ident ,array))) @@ -1041,9 +1075,14 @@ ("int" . (builtin 4 #f)))) (define (type->size info o) - ;; (stderr "types=~s\n" (.types info)) - ;; (stderr "type->size o=~s => ~s\n" o (cadr (assoc-ref (.types info) o))) - (cadr (assoc-ref (.types info) o))) + ;;(stderr "types=~s\n" (.types info)) + ;;(stderr "type->size o=~s => ~s\n" o (cadr (assoc-ref (.types 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)) + (_ (cadr (assoc-ref (.types info) o))))) (define (ident->decl info o) ;; (stderr "ident->decl o=~s\n" o) @@ -1069,7 +1108,12 @@ ;; (stderr "types=~s\n" (.types info)) ;; (stderr "type->description o=~s ==> ~s\n" o (caddr (assoc-ref (.types info) o))) ;; (stderr " assoc ~a\n" (assoc-ref (.types info) o)) - (caddr (assoc-ref (.types info) o))) + (pmatch o + ((decl-spec-list (type-spec (fixed-type ,type))) + (type->description info type)) + ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual)) + (type->description info type)) + (_ (caddr (assoc-ref (.types info) o))))) (define (local? o) ;; formals < 0, locals > 0 (positive? (local:id o))) @@ -1541,28 +1585,40 @@ (i386:byte-sub-base))))))) ;; g_cells[0] - ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,array))) - (let ((value (cstring->number value))) + ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))) + (let* ((value (cstring->number value)) + (type (ident->type info array)) + (size (type->size info type))) (clone info #:text (append text ((ident->base info) array) (list (lambda (f g ta t d) (append - (i386:value->accu value) - ;;(i386:byte-base-mem->accu) - (i386:base-mem->accu) - ))))))) ; FIXME: type: char + (i386:value->accu (* size index)) + (if (eq? size 1) + (i386:byte-base-mem->accu) + (i386:base-mem->accu))))))))) ;; g_cells[a] ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array))) - (clone info #:text - (append text - ((ident->base info) index) ;; FIXME: chars! index*size - ((ident->accu info) array) - (list (lambda (f g ta t d) - ;;(i386:byte-base-mem->accu) - (i386:base-mem->accu) - ))))) ; FIXME: type: char + (let* ((type (ident->type info array)) + (size (type->size info type))) + (clone info #:text + (append text + ((ident->base info) index) + (list (lambda (f g ta t d) + (append + (i386:base->accu) + (if (< size 4) '() + (begin + (i386:accu+accu) + (if (= size 12) (i386:accu+base) '()) + (i386:accu-shl 2)))))) + ((ident->base info) array) + (list (lambda (f g ta t d) + (if (eq? size 1) + (i386:byte-base-mem->accu) + (i386:base-mem->accu)))))))) ((return ,expr) (let ((accu ((expr->accu info) expr))) diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c index 9de5677d..67c3b19b 100644 --- a/scaffold/mini-mes.c +++ b/scaffold/mini-mes.c @@ -1208,38 +1208,11 @@ cstring_to_list (char const* s) char *x = s; SCM p = cell_nil; int i = strlen (s); - puts ("cstring_to_list["); - puts (s); - puts ("]: "); while (i--) { -#if 0 - //FIXME p = cons (MAKE_CHAR (s[i]), p); -#else - char c; - c = *x; - puts ("[c:"); - putchar (c); -#if __GNUC__ - p = cons (MAKE_CHAR (c), p); -#else - SCM xx; - xx = MAKE_CHAR (c); - //FIXME - TYPE (xx) = 0; - VALUE (xx) = c; - puts (",t="); - puts (itoa (TYPE (xx))); - puts (",v="); - putchar (VALUE (xx)); - puts ("]"); - p = cons (xx, p); -#endif x++; -#endif } - puts ("\n"); return p; } diff --git a/scaffold/t.c b/scaffold/t.c index 23def0f2..456a9927 100644 --- a/scaffold/t.c +++ b/scaffold/t.c @@ -95,10 +95,9 @@ struct scm { int cdr; }; -char arena[200]; +char arena[84]; struct scm *g_cells = arena; char *g_chars = arena; -char buf[200]; int foo () {puts ("t: foo\n"); return 0;}; int bar (int i) {puts ("t: bar\n"); return 0;}; @@ -176,6 +175,12 @@ inc (int i) return i + 1; } +int +identity (int i) +{ + return i; +} + int label (int c) { @@ -517,6 +522,15 @@ test (char *p) puts ("t: (f) ?\n"); (f) ? exit (1) : 1; + puts ("t: p[0] != 't'\n"); + if (p[0] != 't') return p[0]; + + puts ("t: p[i] != 't'\n"); + if (p[i] != 't') return p[i]; + + puts ("t: identity (p[i]) != 't'\n"); + if (identity (p[i]) != 't') return identity (p[i]); + puts ("t: *g_chars != 'A'\n"); arena[0] = 'A'; if (*g_chars != 'A') return 1;