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.

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 35abc763b5eb997c195866a0c22d897d07780ab8..9cb82012eb86b5559c465e41165e1036fc268c17 100644 (file)
--- 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 9de5677d83d6030cb0513f062712eee4bd0dec3f..67c3b19b04c26a76c360f17e91d8f84d3225324e 100644 (file)
--- 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 23def0f28d584ac0267e56c25164324acc5521bc..456a9927a56a2767bd1218b646071a6bf3e93cb4 100644 (file)
--- 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;