mescc: Refactor assignment.

* module/language/c99/compiler.mes (expr->accu): Refactor assignment.
  Support multiple operators.
* scaffold/t.c (math_test): Test it.
* scaffold/mini-mes.c (minus, divide, modulo, multiply,
  logior)[!__GNUC__]: Remove branch.

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 994ec52fb0b8f3bc3ca8170a0f06cee45ceaa418..baa9698604bae2c8975cc0f754aa41ba6955340c 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -566,98 +566,60 @@
         ((cast ,cast ,o)
          ((expr->accu info) o))
 
         ((cast ,cast ,o)
          ((expr->accu info) o))
 

-        ;; *p++ = b;
-        ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
-         (when (not (equal? op "="))
-           (stderr "OOOPS0.0: op=~s\n" op)
-           barf)
-         (let ((info ((expr->base info) b)))
-           (append-text info (append ((base->ident-address info) name)
-                                     ((ident->accu info) name)
-                                     ((ident-add info) name 1)))))
-
-        ;; *p-- = b;
-        ((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
-         (when (not (equal? op "="))
-           (stderr "OOOPS0.0: op=~s\n" op)
-           barf)
-         (let ((info ((expr->base info) b)))
-           (append-text info (append ((base->ident-address info) name)
-                                     ((ident->accu info) name)
-                                     ((ident-add info) name -1)))))
-
-        ;; CAR (x) = 0
-        ;; TYPE (x) = PAIR;
-        ((assn-expr (d-sel (ident ,field) . ,d-sel) (op ,op) ,b)
-         (when (not (equal? op "="))
-           (stderr "OOOPS0: op=~s\n" op)
-           barf)
-         (let* (;;(empty (clone info #:text '()))
-                ;;(expr ((expr->accu* empty) `(d-sel (ident ,field) ,@d-sel))) ;; <-OFFSET
-                (info ((expr->accu info) b))
-                (info (append-text info (wrap-as (i386:push-accu))))
-                (info ((expr->accu* info) `(d-sel (ident ,field) ,@d-sel))) ;; <-OFFSET
-                (info (append-text info (wrap-as (i386:pop-base))))
-                (type (list "struct" "scm")) ;; FIXME
-                (fields (type->description info type))
-                (size (type->size info type))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))                )
-           (append-text info (wrap-as (i386:base->accu-address))))) ; FIXME: size
-
-
-        ;; i = 0;
-        ;; c = f ();
-        ;; i = i + 48;
-        ;; p = g_cell;
-        ((assn-expr (p-expr (ident ,name)) (op ,op) ,b)
-         (when (and (not (equal? op "="))
-                    (not (equal? op "+="))
-                    (not (equal? op "-=")))
-           (stderr "OOOPS1: op=~s\n" op)
-           barf)
-         (let ((info ((expr->base info) b)))
-           (append-text info (append (if (equal? op "=") '()
-                                         (append ((ident->accu info) name)
-                                                 (wrap-as (append (if (equal? op "+=") (i386:accu+base)
-                                                                      (i386:accu-base))
-                                                                  (i386:accu->base)))))
-                                     ;;assign:
-                                     ((base->ident info) name)
-                                     (wrap-as (i386:base->accu))))))
-
-        ;; *p = 0;
-        ((assn-expr (de-ref (p-expr (ident ,array))) (op ,op) ,b)
-         (when (not (equal? op "="))
-           (stderr "OOOPS2: op=~s\n" op)
-           barf)
-         (let ((info ((expr->base info) b)))
-           (append-text info (append ;;assign:
-                                     ((base->ident-address info) array)
-                                     (wrap-as (i386:base->accu))))))
-
-        ;; 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* ((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)))
-           (append-text info (append
-                              (if (eq? size 1) (wrap-as (i386:byte-base->accu-address))
-                                  (append
-                                   (wrap-as (i386:base-address->accu-address))
-                                   (if (<= size 4) '()
-                                       (wrap-as (append (i386:accu+n 4)
-                                                        (i386:base+n 4)
-                                                        (i386:base-address->accu-address))))
-                                   (if (<= size 8) '()
-                                       (wrap-as (append (i386:accu+n 4)
-                                                        (i386:base+n 4)
-                                                        (i386:base-address->accu-address))))))))))
+        ((assn-expr ,a (op ,op) ,b)
+         (let* ((info ((expr->accu info) b))
+                (info (if (equal? op "=") info
+                          (let* ((info (append-text info (wrap-as (i386:push-accu))))
+                                 (info ((expr->accu info) a))
+                                 (info (append-text info (wrap-as (i386:pop-base)))))
+                            (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-or-base)))
+                                                    (else (error "mescc: op ~a not supported: ~a\n" op o))))))))
+           (pmatch a
+             ((p-expr (ident ,name)) (append-text info ((accu->ident info) name)))
+             ((d-sel (ident ,field) . ,d-sel)
+              (let* ((type (list "struct" "scm")) ;; FIXME
+                     (fields (type->description info type))
+                     (size (type->size info type))
+                     (field-size 4) ;; FIXME:4, not fixed
+                     (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))                
+                     (info (append-text info (wrap-as (i386:push-accu))))
+                     (info ((expr->accu* info) a))
+                     (info (append-text info (wrap-as (i386:pop-base)))))
+                (append-text info (wrap-as (i386:base->accu-address))))) ; FIXME: size
+             ((de-ref (p-expr (ident ,array)))
+              (append-text info (append (wrap-as (i386:accu->base))
+                                        ((base->ident-address info) array)
+                                        (wrap-as (i386:base->accu)))))
+             ((de-ref (post-inc (p-expr (ident ,name))))
+              (let ((info ((expr->accu info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b))))
+                (append-text info ((ident-add info) name 1))))
+             ((de-ref (post-dec (p-expr (ident ,name))))
+              (let ((info ((expr->accu info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b))))
+                (append-text info ((ident-add info) name -1))))
+             ((array-ref ,index (p-expr (ident ,array)))
+              (let* ((type (ident->type info array))
+                     (size (type->size info type))
+                     (info (append-text info (wrap-as (append (i386:push-accu)))))
+                     (info ((expr->accu* info) a))
+                     (info (append-text info (wrap-as (append (i386:pop-base))))))
+                (append-text info
+                             (append (if (eq? size 1) (wrap-as (i386:byte-base->accu-address))
+                                         (append
+                                          (wrap-as (i386:base-address->accu-address))
+                                          (if (<= size 4) '()
+                                              (wrap-as (append (i386:accu+n 4)
+                                                               (i386:base+n 4)
+                                                               (i386:base-address->accu-address))))
+                                          (if (<= size 8) '()
+                                              (wrap-as (append (i386:accu+n 4)
+                                                               (i386:base+n 4)
+                                                               (i386:base-address->accu-address))))))))))
+             (_ barf-assign))))

 
         (_
          (format (current-error-port) "SKIP: expr->accu=~s\n" o)
 
         (_
          (format (current-error-port) "SKIP: expr->accu=~s\n" o)

diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
index 646aa40e52c892bc12b6f1bd33eff1b03410442c..b0a87a7d55ec785f3ed9b89ed854a9a8d8f37c28 100644 (file)
--- a/scaffold/mini-mes.c
+++ b/scaffold/mini-mes.c
@@ -1194,11 +1194,7 @@ minus (SCM x) ///((name . "-") (arity . n))
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);

-#if __GNUC__

       n -= VALUE (car (x));
       n -= VALUE (car (x));

-#else
-      n = n - VALUE (car (x));
-#endif

       x = cdr (x);
     }
   return MAKE_NUMBER (n);
       x = cdr (x);
     }
   return MAKE_NUMBER (n);


@@ -1211,11 +1207,7 @@ plus (SCM x) ///((name . "+") (arity . n))
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);

-#if __GNUC__

       n += VALUE (car (x));
       n += VALUE (car (x));

-#else
-      n = n + VALUE (car (x));
-#endif

       x = cdr (x);
     }
   return MAKE_NUMBER (n);
       x = cdr (x);
     }
   return MAKE_NUMBER (n);


@@ -1233,11 +1225,7 @@ divide (SCM x) ///((name . "/") (arity . n))
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);

-#if __GNUC__

       n /= VALUE (car (x));
       n /= VALUE (car (x));

-#else
-      n = n / VALUE (car (x));
-#endif

       x = cdr (x);
     }
   return MAKE_NUMBER (n);
       x = cdr (x);
     }
   return MAKE_NUMBER (n);


@@ -1260,11 +1248,7 @@ multiply (SCM x) ///((name . "*") (arity . n))
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);

-#if __GNUC__

       n *= VALUE (car (x));
       n *= VALUE (car (x));

-#else
-      n = n * VALUE (car (x));
-#endif

       x = cdr (x);
     }
   return MAKE_NUMBER (n);
       x = cdr (x);
     }
   return MAKE_NUMBER (n);


@@ -1277,11 +1261,7 @@ logior (SCM x) ///((arity . n))
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);
   while (x != cell_nil)
     {
       assert (TYPE (car (x)) == TNUMBER);

-#if __GNUC__

       n |= VALUE (car (x));
       n |= VALUE (car (x));

-#else
-      n = n | VALUE (car (x));
-#endif

       x = cdr (x);
     }
   return MAKE_NUMBER (n);
       x = cdr (x);
     }
   return MAKE_NUMBER (n);

diff --git a/scaffold/t.c b/scaffold/t.c
index ac369acf2e285210c475bd1661dc4e7d88f8f8cf..872fd7608e3753483aeeb8ea5d5870aafd02bb08 100644 (file)
--- a/scaffold/t.c
+++ b/scaffold/t.c
@@ -223,10 +223,18 @@ math_test ()
   putchar (i);
   puts ("\n");
 
   putchar (i);
   puts ("\n");
 

-  puts ("t: 3*4=");
+  puts ("t: 3*4=\n");

   i = 3 * 4;
   if (i!=12) return 1;
 
   i = 3 * 4;
   if (i!=12) return 1;
 

+  puts ("t: i /= 4\n");
+  i /= 4;
+  if (i!=3) return 1;
+
+  puts ("t: i *= 4\n");
+  i *= 4;
+  if (i!=12) return 1;
+

   puts ("t: 1 << 3\n");
   if (1 << 3 != 8) return 1 << 3;
 
   puts ("t: 1 << 3\n");
   if (1 << 3 != 8) return 1 << 3;