mescc: Refactor array ref.

* module/language/c99/compiler.mes (expr->accu, expr->accu*): Remove
  duplication, use expression as array index.
* scaffold/t.c (struct_test): Test it.
* vector.c (vector_length, list_to_vector)[!__GNUC__]: Remove branch.

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 3cf0a1a30c6465fcb7c40ec0aad7b64ce9c695f4..8d017b20f77adeb8674a3710cca6378d392b92f3 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -790,7 +790,7 @@
                 (empty (clone base #:text '()))
                 (accu ((expr->accu empty) b)))
            (clone info #:text
-                  (append ;;text 
+                  (append text ;; FIXME
                    (.text base)
                    (list (lambda (f g ta t d)
                            (i386:push-base)))
@@ -816,7 +816,7 @@
                 (empty (clone base #:text '()))
                 (accu ((expr->accu empty) b)))
            (clone info #:text
-                  (append text
+                  (append text ;; FIXME
                           (.text base)
                           (list (lambda (f g ta t d)
                                   (i386:push-base)))
@@ -986,87 +986,19 @@
                                       (list (lambda (f g ta t d)
                                               (i386:base->accu)))))))
 
-
-        ;; g_cells[0] = 65;
-        ((assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))) (op ,op) ,b)
+        ;; g_cells[<expr>] = <expr>;
+        ((assn-expr (array-ref ,index (p-expr (ident ,array))) (op ,op) ,b)
          (when (not (equal? op "="))
            (stderr "OOOPS3: op=~s\n" op)
            barf)
-         (let* ((index (cstring->number index))
-                (empty (clone info #:text '()))
-                (base ((expr->base empty) b))
+         (let* ((info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array)))))
+                (info ((expr->+base info) b))
                 (type (ident->type info array))
                 (size (type->size info type))
                 (ptr (ident->pointer info array)))
            (clone info #:text
-                  (append text
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          (list (lambda (f g ta t d)
-                                  (append
-                                   (i386:value->base index)
-                                   (i386:base->accu)
-                                   (if (eq? size 1) '()
-                                       (append
-                                        (if (> size 4) (i386:accu+accu) '())
-                                        (if (> size 8) (i386:accu+base) '())
-                                        (i386:accu-shl 2))))))
-                          ((ident->base info) array)
-                          (list (lambda (f g ta t d)
-                                  (i386:accu+base)))
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
-                          (if (eq? size 1) (list (lambda (f g ta t d)
-                                                   (i386:byte-base->accu-address)))
-                              (append
-                               (list (lambda (f g ta t d)
-                                       (i386:base-address->accu-address)))
-                               (if (> size 4)
-                                   (list (lambda (f g ta t d)
-                                           (append
-                                            (i386:accu+n 4)
-                                            (i386:base+n 4)
-                                            (i386:base-address->accu-address))))
-                                   '())
-                               (if (> size 8)
-                                   (list (lambda (f g ta t d)
-                                           (append
-                                            (i386:accu+n 4)
-                                            (i386:base+n 4)
-                                            (i386:base-address->accu-address))))
-                                   '())))))))
+                  (append (.text info)
 
-        ;; g_cells[i] = c;
-        ((assn-expr (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))) (op ,op) ,b)
-         ;;(stderr "pointer_cells4[]: ~s\n" array)
-         (when (not (equal? op "="))
-           (stderr "OOOPS4: op=~s\n" op)
-           barf)
-         (let* ((empty (clone info #:text '()))
-                (base ((expr->base empty) b))
-                (type (ident->type info array))
-                (size (type->size info type))
-                (ptr (ident->pointer info array)))
-           (clone info #:text
-                  (append text
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          ((ident->base info) index)
-                          (list (lambda (f g ta t d)
-                                  (append
-                                   (i386:base->accu)
-                                   (if (eq? size 1) '()
-                                       (append
-                                        (if (> size 4) (i386:accu+accu) '())
-                                        (if (> size 8) (i386:accu+base) '())
-                                        (i386:accu-shl 2))))))
-                          ((ident->base info) array)
-                          (list (lambda (f g ta t d)
-                                  (i386:accu+base)))
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
                           (if (eq? size 1) (list (lambda (f g ta t d)
                                                    (i386:byte-base->accu-address)))
                               (append
@@ -1087,62 +1019,19 @@
                                             (i386:base-address->accu-address))))
                                    '())))))))
 
-        ;; g_functions[g_function++] = g_foo;
-        ((assn-expr (array-ref (post-inc (p-expr (ident ,index))) (p-expr (ident ,array))) (op ,op) ,b)
-         (when (not (equal? op "="))
-           (stderr "OOOPS5: op=~s\n" op)
-           barf)
-         (let* ((empty (clone info #:text '()))
-                (base ((expr->base empty) b))
-                (type (ident->type info array))
-                (size (type->size info type))
-                (ptr (ident->pointer info array)))
-           (clone info #:text
-                  (append text
-                          (.text base)
-                          (list (lambda (f g ta t d)
-                                  (i386:push-base)))
-                          ((ident->base info) index)
-                          (list (lambda (f g ta t d)
-                                  (append
-                                   (i386:base->accu)
-                                   (if (eq? size 1) '()
-                                       (append
-                                        (if (> size 4) (i386:accu+accu) '())
-                                        (if (> size 8) (i386:accu+base) '())
-                                        (i386:accu-shl 2))))))
-                          ((ident->base info) array)
-                          (list (lambda (f g ta t d)
-                                  (i386:accu+base)))
-                          (list (lambda (f g ta t d)
-                                  (i386:pop-base)))
-                          (if (eq? size 1) (list (lambda (f g ta t d)
-                                                   (i386:byte-base->accu-address)))
-                              (append
-                               (list (lambda (f g ta t d)
-                                       (i386:base-address->accu-address)))
-                               (if (> size 4)
-                                   (list (lambda (f g ta t d)
-                                           (append
-                                            (i386:accu+n 4)
-                                            (i386:base+n 4)
-                                            (i386:base-address->accu-address))))
-                                   '())
-                               (if (> size 8)
-                                   (list (lambda (f g ta t d)
-                                           (append
-                                            (i386:accu+n 4)
-                                            (i386:base+n 4)
-                                            (i386:base-address->accu-address))))
-                                   '())))
-                          ((ident-add info) index 1)))))
-
         (_
          (format (current-error-port) "SKIP: expr->accu=~s\n" o)
          barf
          info)))))
 
-(define (expr->base info)
+(define (expr->+base info)
+  (lambda (o)
+    (let* ((info (clone info #:text (append (.text info) (list (lambda (f g ta t d) (i386:push-accu))))))
+           (info ((expr->accu info) o))
+           (info (clone info #:text (append (.text info) (list (lambda (f g ta t d) (append (i386:accu->base) (i386:pop-accu))))))))
+      info)))
+
+(define (expr->base info) ;; JUNKME
   (lambda (o)
     (let ((info ((expr->accu info) o)))
       (clone info
@@ -1157,8 +1046,27 @@
 
 (define (expr->accu* info)
   (lambda (o)
+    ;; (stderr "expr->accu* o=~s\n" o)
+
     (pmatch o
-      ;;(stderr "expr->accu* o=~s\n" o)
+      ;; g_cells[<expr>]
+      ((array-ref ,index (p-expr (ident ,array)))
+       (let* ((info ((expr->accu info) index))
+              (type (ident->type info array))
+              (size (type->size info type)))
+         (clone info #:text
+                (append (.text info)
+                        (list (lambda (f g ta t d)
+                                (append
+                                 (i386:accu->base)
+                                 (if (eq? size 1) '()
+                                     (append
+                                      (if (> size 4) (i386:accu+accu) '())
+                                      (if (> size 8) (i386:accu+base) '())
+                                      (i386:accu-shl 2))))))
+                        ((ident->base info) array)
+                        (list (lambda (f g ta t d) (i386:accu+base)))))))
+
       ;; g_cells[10].type
       ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
        (let* ((type (ident->type info array))

diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
index e0d92c1375c25da264565b4be0c1d0cd39bc12d1..646aa40e52c892bc12b6f1bd33eff1b03410442c 100644 (file)
--- a/scaffold/mini-mes.c
+++ b/scaffold/mini-mes.c
@@ -956,13 +956,7 @@ eval_apply ()
 
  call_with_current_continuation:
   gc_push_frame ();
-#if __GNUC__
-  // FIXME GCC
   x = MAKE_CONTINUATION (g_continuations++);
-#else
-  x = MAKE_CONTINUATION (g_continuations);
-  g_continuations++;
-#endif
   gc_pop_frame ();
   push_cc (cons (car (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2);
   goto apply;

diff --git a/scaffold/t.c b/scaffold/t.c
index 522ba7ca7f63d0b0df8efaaccafbf7f35e720668..ca2244b7a328f9f91ff42119377c3075b4337ad2 100644 (file)
--- a/scaffold/t.c
+++ b/scaffold/t.c
@@ -294,7 +294,7 @@ struct_test ()
   TYPE (1) = 1;
   CAR (1) = 2;
   CDR (1) = 3;
-  g_cells[0] = g_cells[0+1];
+  g_cells[0] = g_cells[1];
   if (TYPE (0) != 1) return 1;
   if (CAR (0) != 2) return 2;
   if (CDR (0) != 3) return 3;
@@ -310,6 +310,15 @@ struct_test ()
   if (CAR (0) != 5) return 2;
   if (CDR (0) != 6) return 3;
 
+  puts ("t: g_cells[0+add(0,0] = g_cells[0+inc(0)]\n");
+  TYPE (1) = 1;
+  CAR (1) = 2;
+  CDR (1) = 3;
+  g_cells[0+add(0, 0)] = g_cells[0+inc(0)];
+  if (TYPE (0) != 1) return 1;
+  if (CAR (0) != 2) return 2;
+  if (CDR (0) != 3) return 3;
+
   g_cells[0].type = TNUMBER;
   g_cells[0].car = 0;
   g_cells[0].cdr = 0;

diff --git a/vector.c b/vector.c
index 1b5db5234ade64d535443edd8c27024e03db9652..5f433230a7722c33d0e0dc5b3fe6a00b5f50719e 100644 (file)
--- a/vector.c
+++ b/vector.c
@@ -25,17 +25,7 @@ make_vector (SCM n)
   VALUE (tmp_num) = TVECTOR;
   SCM v = alloc (k);
   SCM x = make_cell_ (tmp_num, k, v);
-#if __GNUC__
   for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
-#else
-  for (int i=v; i<k+v; i++)
-    {
-      SCM t = vector_entry (cell_unspecified);
-      struct scm s = g_cells[t];
-      s = g_cells[t];
-      g_cells[i] = s;
-    }
-#endif
   return x;
 }
 
@@ -69,13 +59,7 @@ vector_set_x (SCM x, SCM i, SCM e)
 {
   assert (TYPE (x) == TVECTOR);
   assert (VALUE (i) < LENGTH (x));
-#if __GNUC__
   g_cells[VECTOR (x)+VALUE (i)] = g_cells[vector_entry (e)];
-#else
-  SCM a = VECTOR (x)+VALUE (i);
-  SCM b = vector_entry (e);
-  g_cells[a] = g_cells[b];
-#endif
   return cell_unspecified;
 }