mescc: Factor-out array-ref.

* module/language/c99/compiler.mes: Factor-out array-ref.

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 2d1b555e6dcc57dc28c4d73f4841ca6842c308d3..994ec52fb0b8f3bc3ca8170a0f06cee45ceaa418 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -415,23 +415,13 @@
         ;; c+p expr->arg
         ;; g_cells[<expr>]
         ((array-ref ,index (p-expr (ident ,array)))
         ;; c+p expr->arg
         ;; 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)))
-           (append-text info (append
-                              ;; immediate: (i386:value->accu (* size index))
-                              ;; * size cells: * length * 4 = * 12
-                              (wrap-as (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)
-                              (wrap-as (append (case size
-                                                 ((1) (i386:byte-base-mem->accu))
-                                                 ((4) (i386:base-mem->accu))
-                                                 (else (i386:accu+base)))))))))
+         (let* ((type (ident->type info array))
+                (size (type->size info type))
+                (info ((expr->accu* info) o)))
+           (append-text info (wrap-as (append (case size
+                                                ((1) (i386:byte-mem->accu))
+                                                ((4) (i386:mem->accu))
+                                                (else '())))))))

 
         ;; f.field
         ((d-sel (ident ,field) (p-expr (ident ,array)))
 
         ;; f.field
         ((d-sel (ident ,field) (p-expr (ident ,array)))


@@ -443,69 +433,18 @@
            (append-text info (append ((ident->accu info) array)
                                      (wrap-as (i386:mem+n->accu offset))))))
 
            (append-text info (append ((ident->accu info) array)
                                      (wrap-as (i386:mem+n->accu offset))))))
 

-        ;; g_cells[10].type
-        ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
-         (let* ((type (ident->type info array))
-                (fields (or (type->description info type) '()))
-                (size (type->size info type))
-                (count (length fields))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
-                (index (cstring->number index))
-                (text (.text info)))
-           (append-text info (append
-                              (wrap-as (append (i386:value->base index)
-                                               (i386:base->accu)
-                                               (if (<= count 1) '() (i386:accu+accu))
-                                               (if (<= count 2) '() (i386:accu+base))
-                                               (i386:accu-shl 2)))
-                              ((ident->base info) array)
-                              (wrap-as (i386:base-mem+n->accu offset))))))
-        
-        ;; g_cells[x].type
-        ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
-         (let* ((type (ident->type info array))
-                (fields (or (type->description info type) '()))
-                (size (type->size info type))
-                (count (length fields))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
-                (text (.text info)))
-           (append-text info (append ((ident->base info) index)
-                                     (wrap-as (append (i386:base->accu)
-                                                      (if (<= count 1) '() (i386:accu+accu))
-                                                      (if (<= count 2) '() (i386:accu+base))
-                                                      (i386:accu-shl 2)))
-                                     ((ident->base info) array)
-                                     (wrap-as (i386:base-mem+n->accu offset))))))
-
-        ;; g_functions[g_cells[fn].cdr].arity
-        ;; INDEX0: g_cells[fn].cdr
-
-        ;;; index: (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells))))
-        ;;((d-sel (ident ,arity) (array-ref (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells)))) (p-expr (ident ,g_functions)))))

         ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
         ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))

-         (let* ((empty (clone info #:text '()))
-                (index ((expr->accu empty) index))
-                (type (ident->type info array))
+         (let* ((type (ident->type info array))

                 (fields (or (type->description info type) '()))
                 (fields (or (type->description info type) '()))

-                (size (type->size info type))
-                (count (length fields))

                 (field-size 4) ;; FIXME:4, not fixed
                 (rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
                           (begin
                             (stderr "no field:~a\n" field)
                             '())))
                 (offset (* field-size (1- (length rest))))
                 (field-size 4) ;; FIXME:4, not fixed
                 (rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
                           (begin
                             (stderr "no field:~a\n" field)
                             '())))
                 (offset (* field-size (1- (length rest))))

-                (text (.text info)))
-           (append-text info (append (.text index)
-                                     (wrap-as (append (i386:accu->base)
-                                                      (if (<= count 1) '() (i386:accu+accu))
-                                                      (if (<= count 2) '() (i386:accu+base))
-                                                      (i386:accu-shl 2)))
-                                     ((ident->base info) array)
-                                     (wrap-as (i386:base-mem+n->accu offset))))))
-        
+                (info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
+           (append-text info (wrap-as (i386:mem+n->accu offset)))))
+

         ;;; FIXME: FROM INFO ...only zero?!
         ((p-expr (fixed ,value))
          (let ((value (cstring->number value)))
         ;;; FIXME: FROM INFO ...only zero?!
         ((p-expr (fixed ,value))
          (let ((value (cstring->number value)))


@@ -624,7 +563,6 @@
         ((le ,a ,b) ((binop->accu info) b a (i386:base-sub)))
         ((lt ,a ,b) ((binop->accu info) b a (i386:base-sub)))
 
         ((le ,a ,b) ((binop->accu info) b a (i386:base-sub)))
         ((lt ,a ,b) ((binop->accu info) b a (i386:base-sub)))
 

-        ;;((cast (type-name (decl-spec-list (type-spec (typename "SCM"))) (abs-declr (declr-fctn (declr-scope (abs-declr (pointer))) (param-list (param-decl (decl-spec-list (type-spec (typename "SCM")))))))) (d-sel (ident "function") (array-ref (d-sel (ident "cdr") (array-ref (p-expr (ident "fn")) (p-expr (ident "g_cells")))) (p-expr (ident "functions"))))))

         ((cast ,cast ,o)
          ((expr->accu info) o))
 
         ((cast ,cast ,o)
          ((expr->accu info) o))
 


@@ -766,52 +704,15 @@
                                    ((ident->base info) array)
                                    (wrap-as (i386:accu+base))))))
 
                                    ((ident->base info) array)
                                    (wrap-as (i386:accu+base))))))
 

-      ;; g_cells[10].type
-      ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
+      ;; g_cells[<expr>].type
+      ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))

        (let* ((type (ident->type info array))
               (fields (or (type->description info type) '()))
        (let* ((type (ident->type info array))
               (fields (or (type->description info type) '()))

-              (size (type->size info type))
-              (count (length fields))

               (field-size 4) ;; FIXME:4, not fixed
               (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
               (field-size 4) ;; FIXME:4, not fixed
               (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))

-              (index (cstring->number index))
-              (text (.text info)))
-         (append-text info (append (wrap-as (append (i386:value->base index)
-                                                    (i386:base->accu)
-                                                    (if (<= count 1) '()
-                                                        (i386:accu+accu))
-                                                    (if (<= count 2) '()
-                                                        (i386:accu+base))
-                                                    (i386:accu-shl 2)))
-                                   ;; de-ref: g_cells, non: arena
-                                   ;;((ident->base info) array)
-                                   ((ident->base info) array)
-                                   (wrap-as (append (i386:accu+base)
-                                                    (i386:accu+value offset)))))))
-
-      ;; g_cells[x].type
-      ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
-       (let* ((type (ident->type info array))
-              (fields (or (type->description info type) '()))
-              (size (type->size info type))
-              (count (length fields))
-              (field-size 4) ;; FIXME:4, not fixed
-              (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
-              (text (.text info)))
-         (append-text info (append ((ident->base info) index)
-                                   (wrap-as (append (i386:base->accu)
-                                                    (if (<= count 1) '()
-                                                        (i386:accu+accu))
-                                                    (if (<= count 2) '()
-                                                        (i386:accu+base))
-                                                    (i386:accu-shl 2)))
-                                   ;; de-ref: g_cells, non: arena
-                                   ;;((ident->base info) array)
-                                   ((ident->base info) array)
-                                   (wrap-as (append (i386:accu+base)
-                                                    (i386:accu+value offset)))))))
+              (info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
+         (append-text info (wrap-as (append (i386:accu+value offset))))))

 
 

-      ;;((d-sel (ident "cdr") (p-expr (ident "scm_make_cell"))))

       ((d-sel (ident ,field) (p-expr (ident ,name)))
        (let* ((type (ident->type info name))
               (fields (or (type->description info type) '()))
       ((d-sel (ident ,field) (p-expr (ident ,name)))
        (let* ((type (ident->type info name))
               (fields (or (type->description info type) '()))