mescc: Tinycc support: Implement (foo--)->bar and permutations.

* module/language/c99/info.scm (clone): Add post field.
  (make): Handle post parameter.
* module/language/c99/compiler.mes (clone): Handle post parameter.
  (expr->accu*): Set it to support foo--/foo--.
  (expr->accu): Read it to support foo--/foo--.
* scaffold/tests/7o-struct-pre-post.c: Test it.
* build-aux/check-mescc.sh: Run it.

diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh
index 404c8bbebb9d979088eeff973714fb64022b120c..59d2328dc97210709d1063266f30059af4bee464 100755 (executable)
--- a/build-aux/check-mescc.sh
+++ b/build-aux/check-mescc.sh
@@ -111,6 +111,7 @@ t
 7l-struct-any-size-array
 7m-struct-char-array-assign
 7n-struct-struct-array
+7o-struct-pre-post
 80-setjmp
 81-qsort
 82-define

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index ea41b3620b0b57a7c544220bfd1be50410f26da8..947ab1df50e932388d704ee5353738b4c22f86fa 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -115,6 +115,7 @@
                (statics (.statics o))
                (function (.function o))
                (text (.text o))
+               (post (.post o))
                (break (.break o))
                (continue (.continue o)))
            (let-keywords rest
@@ -127,9 +128,10 @@
                           (statics statics)
                           (function function)
                           (text text)
+                          (post post)
                           (break break)
                           (continue continue))
-                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:statics statics #:function function #:text text #:break break #:continue continue))))))
+                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:statics statics #:function function #:text text #:post post #:break break #:continue continue))))))
 
 (define (ident->constant name value)
   (cons name value))
@@ -810,402 +812,466 @@
             (info (expr->base array info)))
        (append-text info (wrap-as (i386:accu+base)))))
 
-    (_ (error "expr->accu*: not supported: " o))))
-
-(define (expr-add info)
-  (lambda (o n)
-    (let* ((info (expr->accu* o info))
-           (info (append-text info (wrap-as (i386:accu-mem-add n)))))
-      info)))
-
-(define (expr->accu o info)
-  (let ((locals (.locals info))
-        (constants (.constants info))
-        (text (.text info))
-        (globals (.globals info)))
-    (pmatch o
-      ((expr) info)
-
-      ((comma-expr) info)
-
-      ((comma-expr ,a . ,rest)
-       (let ((info (expr->accu a info)))
-         (expr->accu `(comma-expr ,@rest) info)))
+    ;;((cast (type-name (decl-spec-list (type-spec (typename "Elf32_Rel"))) (abs-declr (pointer))) (add (i-sel (ident "data") (p-expr (ident "sr"))) (p-expr (ident "a")))))
 
-      ((p-expr (string ,string))
-       (let* ((globals ((globals:add-string globals) string))
-              (info (clone info #:globals globals)))
-         (append-text info (list (i386:label->accu `(#:string ,string))))))
-
-      ((p-expr (fixed ,value))
-       (let ((value (cstring->number value)))
-         (append-text info (wrap-as (i386:value->accu value)))))
+    ((cast ,type ,expr)
+     (expr->accu expr info))
 
-      ((neg (p-expr (fixed ,value)))
-       (let ((value (- (cstring->number value))))
-         (append-text info (wrap-as (i386:value->accu value)))))
+    ;; ((post-dec (p-expr (ident "vtop"))))
 
-      ((p-expr (char ,char))
-       (let ((char (char->integer (car (string->list char)))))
-         (append-text info (wrap-as (i386:value->accu char)))))
+    ;; ((cast ,type ,expr)
+    ;;  (expr->accu `(ref-to ,expr) info))
 
-      ((p-expr (string . ,strings))
-       (append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
-
-      ((p-expr (ident ,name))
-       (append-text info ((ident->accu info) name)))
-
-      ((initzer ,initzer)
-       (expr->accu initzer info))
-
-      ;; offsetoff
-      ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
-       (let* ((type (ast->basic-type struct info))
-              (offset (field-offset info type field))
-              (base (cstring->number base)))
-         (append-text info (wrap-as (i386:value->accu (+ base offset))))))
-
-      ;; &foo
-      ((ref-to (p-expr (ident ,name)))
-       (append-text info ((ident-address->accu info) name)))
-
-      ;; &*foo
-      ((ref-to (de-ref ,expr))
-       (expr->accu expr info))
-
-      ((ref-to ,expr)
-       (expr->accu* expr info))
-
-      ((sizeof-expr ,expr)
-       (append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
-
-      ((sizeof-type ,type)
-       (append-text info (wrap-as (i386:value->accu (ast->size type info)))))
-
-      ((array-ref ,index ,array)
-       (let* ((info (expr->accu* o info))
-              (size (ast->size o info)))
-         (append-text info (wrap-as (case size
-                                      ((1) (i386:byte-mem->accu))
-                                      ((2) (i386:word-mem->accu))
-                                      ((4) (i386:mem->accu))
-                                      (else '()))))))
-
-      ((d-sel ,field ,struct)
-       (let* ((info (expr->accu* o info))
-              (info (append-text info (ast->comment o)))
-              (type (ast->type o info))
-              (size (->size type))
-              (array? (c-array? type)))
-         (if array? info
-             (append-text info (wrap-as (case size
-                                          ((1) (i386:byte-mem->accu))
-                                          ((2) (i386:word-mem->accu))
-                                          ((4) (i386:mem->accu))
-                                          (else '())))))))
-
-      ((i-sel ,field ,struct)
-       (let* ((info (expr->accu* o info))
-              (info (append-text info (ast->comment o)))
-              (type (ast->type o info))
-              (size (->size type))
-              (array? (c-array? type)))
-         (if array? info
-             (append-text info (wrap-as (case size
-                                          ((1) (i386:byte-mem->accu))
-                                          ((2) (i386:word-mem->accu))
-                                          ((4) (i386:mem->accu))
-                                          (else '())))))))
-
-      ((de-ref ,expr)
-       (let* ((info (expr->accu expr info))
-              (size (ast->size o info)))
-         (append-text info (wrap-as (case size
-                                      ((1) (i386:byte-mem->accu))
-                                      ((2) (i386:word-mem->accu))
-                                      ((4) (i386:mem->accu))
-                                      (else '()))))))
-
-      ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
-       (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
-                                 (append-text info (wrap-as (asm->m1 arg0))))
-           (let* ((text-length (length text))
-                  (args-info (let loop ((expressions (reverse expr-list)) (info info))
-                               (if (null? expressions) info
-                                   (loop (cdr expressions) ((expr->arg info) (car expressions))))))
-                  (n (length expr-list)))
-             (if (not (assoc-ref locals name))
-                 (begin
-                   (if (and (not (assoc name (.functions info)))
-                            (not (assoc name globals))
-                            (not (equal? name (.function info))))
-                       (stderr "warning: undeclared function: ~a\n" name))
-                   (append-text args-info (list (i386:call-label name n))))
-                 (let* ((empty (clone info #:text '()))
-                        (accu (expr->accu `(p-expr (ident ,name)) empty)))
-                   (append-text args-info (append (.text accu)
-                                                  (list (i386:call-accu n)))))))))
-
-      ((fctn-call ,function (expr-list . ,expr-list))
-       (let* ((text-length (length text))
-              (args-info (let loop ((expressions (reverse expr-list)) (info info))
-                           (if (null? expressions) info
-                               (loop (cdr expressions) ((expr->arg info) (car expressions))))))
-              (n (length expr-list))
-              (empty (clone info #:text '()))
-              (accu (expr->accu function empty)))
-         (append-text args-info (append (.text accu)
-                                        (list (i386:call-accu n))))))
-
-      ((cond-expr . ,cond-expr)
-       (ast->info `(expr-stmt ,o) info))
+      ((pre-dec ,expr)
+         (let* ((rank (expr->rank info expr))
+                (size (cond ((= rank 1) (ast-type->size info expr))
+                            ((> rank 1) 4)
+                            (else 1)))
+                (info ((expr-add info) expr (- size)))
+                (info (append (expr->accu* expr info))))
+           info))
 
-      ((post-inc ,expr)
-       (let* ((info (append (expr->accu expr info)))
-              (info (append-text info (wrap-as (i386:push-accu))))
-              (rank (expr->rank info expr))
-              (size (cond ((= rank 1) (ast-type->size info expr))
-                          ((> rank 1) 4)
-                          (else 1)))
-              (info ((expr-add info) expr size))
-              (info (append-text info (wrap-as (i386:pop-accu)))))
-         info))
+      ((pre-inc ,expr)
+         (let* ((rank (expr->rank info expr))
+                (size (cond ((= rank 1) (ast-type->size info expr))
+                            ((> rank 1) 4)
+                            (else 1)))
+                (info ((expr-add info) expr size))
+                (info (append (expr->accu* expr info))))
+           info))
 
       ((post-dec ,expr)
-       (let* ((info (append (expr->accu expr info)))
+       (let* ((info (expr->accu* expr info))
               (info (append-text info (wrap-as (i386:push-accu))))
-              (rank (expr->rank info expr))
-              (size (cond ((= rank 1) (ast-type->size info expr))
+              (post (clone info #:text '()))
+              (post (append-text post (ast->comment o)))
+              (post (append-text post (wrap-as (i386:pop-base))))
+              (post (append-text post (wrap-as (i386:push-accu))))
+              (post (append-text post (wrap-as (i386:base->accu))))
+              (rank (expr->rank post expr))
+              (size (cond ((= rank 1) (ast-type->size post expr))
                           ((> rank 1) 4)
                           (else 1)))
-              (info ((expr-add info) expr (- size)))
-              (info (append-text info (wrap-as (i386:pop-accu)))))
-         info))
+              (post ((expr-add post) expr (- size)))
+              (post (append-text post (wrap-as (i386:pop-accu)))))
+         (clone info #:post (.text post))))
 
-      ((pre-inc ,expr)
-       (let* ((rank (expr->rank info expr))
-              (size (cond ((= rank 1) (ast-type->size info expr))
-                          ((> rank 1) 4)
-                          (else 1)))
-              (info ((expr-add info) expr size))
-              (info (append (expr->accu expr info))))
-         info))
-
-      ((pre-dec ,expr)
-       (let* ((rank (expr->rank info expr))
-              (size (cond ((= rank 1) (ast-type->size info expr))
-                          ((> rank 1) 4)
-                          (else 1)))
-              (info ((expr-add info) expr (- size)))
-              (info (append (expr->accu expr info))))
-         info))
-
-
-
-      ((add ,a (p-expr (fixed ,value)))
-       (let* ((rank (expr->rank info a))
-              (type (ast->basic-type a info))
-              (struct? (structured-type? type))
-              (size (cond ((= rank 1) (ast-type->size info a))
-                          ((> rank 1) 4)
-                          ((and struct? (= rank 2)) 4)
-                          (else 1)))
-              (info (expr->accu a info))
-              (value (cstring->number value))
-              (value (* size value)))
-         (append-text info (wrap-as (i386:accu+value value)))))
-
-      ((add ,a ,b)
-       (let* ((rank (expr->rank info a))
-              (rank-b (expr->rank info b))
-              (type (ast->basic-type a info))
-              (struct? (structured-type? type))
-              (size (cond ((= rank 1) (ast-type->size info a))
-                          ((> rank 1) 4)
-                          ((and struct? (= rank 2)) 4)
-                          (else 1))))
-         (if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
-             (let* ((info (expr->accu b info))
-                    (info (append-text info (wrap-as (append (i386:value->base size)
-                                                             (i386:accu*base)
-                                                             (i386:accu->base)))))
-                    (info (expr->accu a info)))
-               (append-text info (wrap-as (i386:accu+base)))))))
-
-      ((sub ,a (p-expr (fixed ,value)))
-       (let* ((rank (expr->rank info a))
-              (type (ast->basic-type a info))
-              (struct? (structured-type? type))
-              (size (->size type))
-              (size (cond ((= rank 1) size)
+      ((post-inc ,expr)
+       (let* ((info (expr->accu* expr info))
+              (info (append-text info (wrap-as (i386:push-accu))))
+              (post (clone info #:text '()))
+              (post (append-text post (ast->comment o)))
+              (post (append-text post (wrap-as (i386:pop-base))))
+              (post (append-text post (wrap-as (i386:push-accu))))
+              (post (append-text post (wrap-as (i386:base->accu))))
+              (rank (expr->rank post expr))
+              (size (cond ((= rank 1) (ast-type->size post expr))
                           ((> rank 1) 4)
-                          ((and struct? (= rank 2)) 4)
                           (else 1)))
-              (info (expr->accu a info))
-              (value (cstring->number value))
-              (value (* size value)))
-         (append-text info (wrap-as (i386:accu+value (- value))))))
-
-      ((sub ,a ,b)
-       (let* ((rank (expr->rank info a))
-              (rank-b (expr->rank info b))
-              (type (ast->basic-type a info))
-              (struct? (structured-type? type))
-              (size (->size type))
-              (size  (cond ((= rank 1) size)
-                           ((> rank 1) 4)
-                           ((and struct? (= rank 2)) 4)
-                           (else 1))))
-         (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
-             (let ((info ((binop->accu info) a b (i386:accu-base))))
-               (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
-                   (append-text info (wrap-as (append (i386:value->base size)
-                                                      (i386:accu/base))))))
-             (let* ((info (expr->accu b info))
-                    (info (append-text info (wrap-as (append (i386:value->base size)
-                                                             (i386:accu*base)
-                                                             (i386:accu->base)))))
-                    (info (expr->accu a info)))
-               (append-text info (wrap-as (i386:accu-base)))))))
-
-      ((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
-      ((bitwise-not ,expr)
-       (let ((info (ast->info expr info)))
-         (append-text info (wrap-as (i386:accu-not)))))
-      ((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
-      ((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
-      ((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
-      ((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
-      ((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
-      ((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
-      ((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
-
-      ((not ,expr)
-       (let* ((test-info (ast->info expr info)))
-         (clone info #:text
-                (append (.text test-info)
-                        (wrap-as (i386:accu-negate)))
-                #:globals (.globals test-info))))
-
-      ((neg ,expr)
-       (let ((info (expr->base expr info)))
-         (append-text info (append (wrap-as (i386:value->accu 0))
-                                   (wrap-as (i386:sub-base))))))
-
-      ((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
-      ((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
-      ((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
-
-      ;; FIXME: set accu *and* flags
-      ((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
-                                                  (i386:sub-base)
-                                                  (i386:nz->accu)
-                                                  (i386:accu<->stack)
-                                                  (i386:sub-base)
-                                                  (i386:xor-zf)
-                                                  (i386:pop-accu))))
-
-      ((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
-      ((le ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:le?->accu))))
-      ((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
+              (post ((expr-add post) expr size))
+              (post (append-text post (wrap-as (i386:pop-accu)))))
+         (clone info #:post (.text post))))
 
-      ((or ,a ,b)
-       (let* ((info (expr->accu a info))
-              (here (number->string (length (.text info))))
-              (skip-b-label (string-append "_" (.function info) "_" here "_or_skip_b"))
-              (info (append-text info (wrap-as (i386:accu-test))))
-              (info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
-              (info (append-text info (wrap-as (i386:accu-test))))
-              (info (expr->accu b info))
-              (info (append-text info (wrap-as (i386:accu-test))))
-              (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
-         info))
+    (_ (error "expr->accu*: not supported: " o))))
 
-      ((and ,a ,b)
-       (let* ((info (expr->accu a info))
-              (here (number->string (length (.text info))))
-              (skip-b-label (string-append "_" (.function info) "_" here "_and_skip_b"))
-              (info (append-text info (wrap-as (i386:accu-test))))
-              (info (append-text info (wrap-as (i386:jump-z skip-b-label))))
-              (info (append-text info (wrap-as (i386:accu-test))))
-              (info (expr->accu b info))
-              (info (append-text info (wrap-as (i386:accu-test))))
-              (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
-         info))
+(define (expr-add info)
+  (lambda (o n)
+    (let* ((info (expr->accu* o info))
+           (info (append-text info (wrap-as (i386:accu-mem-add n)))))
+      info)))
 
-      ((cast ,type ,expr)
-       (expr->accu expr info))
-
-      ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
-       (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
-              (type (ident->type info name))
-              (rank (ident->rank info name))
-              (size (if (> rank 1) 4 1)))
-         (append-text info ((ident-add info) name size))))
-
-      ((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
-       (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
-              (type (ident->type info name))
-              (rank (ident->rank info name))
-              (size (if (> rank 1) 4 1)))
-         (append-text info ((ident-add info) name (- size)))))
-
-      ((assn-expr ,a (op ,op) ,b)
-       (let* ((info (append-text info (ast->comment o)))
-              (type (ast->type a info))
-              (rank (->rank type))
-              (type-b (ast->type b info))
-              (rank-b (->rank type-b))
-              (size (->size type))
-              (size-b (->size type-b))
-              (info (expr->accu b info))
-              (info (if (equal? op "=") info
-                        (let* ((struct? (structured-type? type))
-                               (size (cond ((= rank 1) (ast-type->size info a))
-                                           ((> rank 1) 4)
-                                           ((and struct? (= rank 2)) 4)
-                                           (else 1)))
-                               (info (if (or (= size 1) (= rank-b 1)) info
-                                         (let ((info (append-text info (wrap-as (i386:value->base size)))))
-                                           (append-text info (wrap-as (i386:accu*base))))))
-                               (info (append-text info (wrap-as (i386:push-accu))))
-                               (info (expr->accu a info))
-                               (info (append-text info (wrap-as (i386:pop-base))))
-                               (info (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-and-base)))
-                                                             ((equal? op "|=") (wrap-as (i386:accu-or-base)))
-                                                             ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
-                                                             ((equal? op ">>=") (wrap-as (i386:accu>>base)))
-                                                             ((equal? op "<<=") (wrap-as (i386:accu<<base)))
-                                                             (else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
-                          (cond ((not (and (= rank 1) (= rank-b 1))) info)
-                                ((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
-                                                                                     (i386:accu/base)))))
-                                (else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
-         (when (and (equal? op "=")
-                    (not (= size size-b))
-                    (not (and (or (= size 1) (= size 2))
-                              (= size-b 4)))
-                    (not (and (= size 2)
-                              (= size-b 4)))
-                    (not (and (= size 4)
-                              (or (= size-b 1) (= size-b 2)))))
-           (stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
-           (stderr "   size[~a]:~a != size[~a]:~a\n"  rank size rank-b size-b))
-         (pmatch a
-           ((p-expr (ident ,name))
-            (if (or (<= size 4) ;; FIXME: long long = int
-                    (<= size-b 4)) (append-text info ((accu->ident info) name))
-                    (let ((info (expr->base* a info)))
-                      (accu->base-mem*n info size))))
-           (_ (let ((info (expr->base* a info)))
-                (accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int
-
-      (_ (error "expr->accu: not supported: " o)))))
+(define (expr->accu o info)
+  (let ((locals (.locals info))
+        (text (.text info))
+        (globals (.globals info)))
+    (define (helper)
+      (pmatch o
+        ((expr) info)
+
+        ((comma-expr) info)
+
+        ((comma-expr ,a . ,rest)
+         (let ((info (expr->accu a info)))
+           (expr->accu `(comma-expr ,@rest) info)))
+
+        ((p-expr (string ,string))
+         (let* ((globals ((globals:add-string globals) string))
+                (info (clone info #:globals globals)))
+           (append-text info (list (i386:label->accu `(#:string ,string))))))
+
+        ((p-expr (fixed ,value))
+         (let ((value (cstring->number value)))
+           (append-text info (wrap-as (i386:value->accu value)))))
+
+        ((neg (p-expr (fixed ,value)))
+         (let ((value (- (cstring->number value))))
+           (append-text info (wrap-as (i386:value->accu value)))))
+
+        ((p-expr (char ,char))
+         (let ((char (char->integer (car (string->list char)))))
+           (append-text info (wrap-as (i386:value->accu char)))))
+
+        ((p-expr (string . ,strings))
+         (append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
+
+        ((p-expr (ident ,name))
+         (append-text info ((ident->accu info) name)))
+
+        ((initzer ,initzer)
+         (expr->accu initzer info))
+
+        ;; offsetoff
+        ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
+         (let* ((type (ast->basic-type struct info))
+                (offset (field-offset info type field))
+                (base (cstring->number base)))
+           (append-text info (wrap-as (i386:value->accu (+ base offset))))))
+
+        ;; &foo
+        ((ref-to (p-expr (ident ,name)))
+         (append-text info ((ident-address->accu info) name)))
+
+        ;; &*foo
+        ((ref-to (de-ref ,expr))
+         (expr->accu expr info))
+
+        ((ref-to ,expr)
+         (expr->accu* expr info))
+
+        ((sizeof-expr ,expr)
+         (append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
+
+        ((sizeof-type ,type)
+         (append-text info (wrap-as (i386:value->accu (ast->size type info)))))
+
+        ((array-ref ,index ,array)
+         (let* ((info (expr->accu* o info))
+                (size (ast->size o info)))
+           (append-text info (wrap-as (case size
+                                        ((1) (i386:byte-mem->accu))
+                                        ((2) (i386:word-mem->accu))
+                                        ((4) (i386:mem->accu))
+                                        (else '()))))))
+
+        ((d-sel ,field ,struct)
+         (let* ((info (expr->accu* o info))
+                (info (append-text info (ast->comment o)))
+                (type (ast->type o info))
+                (size (->size type))
+                (array? (c-array? type)))
+           (if array? info
+               (append-text info (wrap-as (case size
+                                            ((1) (i386:byte-mem->accu))
+                                            ((2) (i386:word-mem->accu))
+                                            ((4) (i386:mem->accu))
+                                            (else '())))))))
+
+        ((i-sel ,field ,struct)
+         (let* ((info (expr->accu* o info))
+                (info (append-text info (ast->comment o)))
+                (type (ast->type o info))
+                (size (->size type))
+                (array? (c-array? type)))
+           (if array? info
+               (append-text info (wrap-as (case size
+                                            ((1) (i386:byte-mem->accu))
+                                            ((2) (i386:word-mem->accu))
+                                            ((4) (i386:mem->accu))
+                                            (else '())))))))
+
+        ((de-ref ,expr)
+         (let* ((info (expr->accu expr info))
+                (size (ast->size o info)))
+           (append-text info (wrap-as (case size
+                                        ((1) (i386:byte-mem->accu))
+                                        ((2) (i386:word-mem->accu))
+                                        ((4) (i386:mem->accu))
+                                        (else '()))))))
+
+        ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
+         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
+                                   (append-text info (wrap-as (asm->m1 arg0))))
+             (let* ((text-length (length text))
+                    (args-info (let loop ((expressions (reverse expr-list)) (info info))
+                                 (if (null? expressions) info
+                                     (loop (cdr expressions) ((expr->arg info) (car expressions))))))
+                    (n (length expr-list)))
+               (if (not (assoc-ref locals name))
+                   (begin
+                     (if (and (not (assoc name (.functions info)))
+                              (not (assoc name globals))
+                              (not (equal? name (.function info))))
+                         (stderr "warning: undeclared function: ~a\n" name))
+                     (append-text args-info (list (i386:call-label name n))))
+                   (let* ((empty (clone info #:text '()))
+                          (accu (expr->accu `(p-expr (ident ,name)) empty)))
+                     (append-text args-info (append (.text accu)
+                                                    (list (i386:call-accu n)))))))))
+
+        ((fctn-call ,function (expr-list . ,expr-list))
+         (let* ((text-length (length text))
+                (args-info (let loop ((expressions (reverse expr-list)) (info info))
+                             (if (null? expressions) info
+                                 (loop (cdr expressions) ((expr->arg info) (car expressions))))))
+                (n (length expr-list))
+                (empty (clone info #:text '()))
+                (accu (expr->accu function empty)))
+           (append-text args-info (append (.text accu)
+                                          (list (i386:call-accu n))))))
+
+        ((cond-expr . ,cond-expr)
+         (ast->info `(expr-stmt ,o) info))
+
+        ((post-inc ,expr)
+         (let* ((info (append (expr->accu expr info)))
+                (info (append-text info (wrap-as (i386:push-accu))))
+                (rank (expr->rank info expr))
+                (size (cond ((= rank 1) (ast-type->size info expr))
+                            ((> rank 1) 4)
+                            (else 1)))
+                (info ((expr-add info) expr size))
+                (info (append-text info (wrap-as (i386:pop-accu)))))
+           info))
+
+        ((post-dec ,expr)
+         (let* ((info (append (expr->accu expr info)))
+                (info (append-text info (wrap-as (i386:push-accu))))
+                (rank (expr->rank info expr))
+                (size (cond ((= rank 1) (ast-type->size info expr))
+                            ((> rank 1) 4)
+                            (else 1)))
+                (info ((expr-add info) expr (- size)))
+                (info (append-text info (wrap-as (i386:pop-accu)))))
+           info))
+
+        ((pre-inc ,expr)
+         (let* ((rank (expr->rank info expr))
+                (size (cond ((= rank 1) (ast-type->size info expr))
+                            ((> rank 1) 4)
+                            (else 1)))
+                (info ((expr-add info) expr size))
+                (info (append (expr->accu expr info))))
+           info))
+
+        ((pre-dec ,expr)
+         (let* ((rank (expr->rank info expr))
+                (size (cond ((= rank 1) (ast-type->size info expr))
+                            ((> rank 1) 4)
+                            (else 1)))
+                (info ((expr-add info) expr (- size)))
+                (info (append (expr->accu expr info))))
+           info))
+
+
+
+        ((add ,a (p-expr (fixed ,value)))
+         (let* ((rank (expr->rank info a))
+                (type (ast->basic-type a info))
+                (struct? (structured-type? type))
+                (size (cond ((= rank 1) (ast-type->size info a))
+                            ((> rank 1) 4)
+                            ((and struct? (= rank 2)) 4)
+                            (else 1)))
+                (info (expr->accu a info))
+                (value (cstring->number value))
+                (value (* size value)))
+           (append-text info (wrap-as (i386:accu+value value)))))
+
+        ((add ,a ,b)
+         (let* ((rank (expr->rank info a))
+                (rank-b (expr->rank info b))
+                (type (ast->basic-type a info))
+                (struct? (structured-type? type))
+                (size (cond ((= rank 1) (ast-type->size info a))
+                            ((> rank 1) 4)
+                            ((and struct? (= rank 2)) 4)
+                            (else 1))))
+           (if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
+               (let* ((info (expr->accu b info))
+                      (info (append-text info (wrap-as (append (i386:value->base size)
+                                                               (i386:accu*base)
+                                                               (i386:accu->base)))))
+                      (info (expr->accu a info)))
+                 (append-text info (wrap-as (i386:accu+base)))))))
+
+        ((sub ,a (p-expr (fixed ,value)))
+         (let* ((rank (expr->rank info a))
+                (type (ast->basic-type a info))
+                (struct? (structured-type? type))
+                (size (->size type))
+                (size (cond ((= rank 1) size)
+                            ((> rank 1) 4)
+                            ((and struct? (= rank 2)) 4)
+                            (else 1)))
+                (info (expr->accu a info))
+                (value (cstring->number value))
+                (value (* size value)))
+           (append-text info (wrap-as (i386:accu+value (- value))))))
+
+        ((sub ,a ,b)
+         (let* ((rank (expr->rank info a))
+                (rank-b (expr->rank info b))
+                (type (ast->basic-type a info))
+                (struct? (structured-type? type))
+                (size (->size type))
+                (size  (cond ((= rank 1) size)
+                             ((> rank 1) 4)
+                             ((and struct? (= rank 2)) 4)
+                             (else 1))))
+           (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
+               (let ((info ((binop->accu info) a b (i386:accu-base))))
+                 (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
+                     (append-text info (wrap-as (append (i386:value->base size)
+                                                        (i386:accu/base))))))
+               (let* ((info (expr->accu b info))
+                      (info (append-text info (wrap-as (append (i386:value->base size)
+                                                               (i386:accu*base)
+                                                               (i386:accu->base)))))
+                      (info (expr->accu a info)))
+                 (append-text info (wrap-as (i386:accu-base)))))))
+
+        ((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
+        ((bitwise-not ,expr)
+         (let ((info (ast->info expr info)))
+           (append-text info (wrap-as (i386:accu-not)))))
+        ((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
+        ((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
+        ((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
+        ((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
+        ((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
+        ((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
+        ((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
+
+        ((not ,expr)
+         (let* ((test-info (ast->info expr info)))
+           (clone info #:text
+                  (append (.text test-info)
+                          (wrap-as (i386:accu-negate)))
+                  #:globals (.globals test-info))))
+
+        ((neg ,expr)
+         (let ((info (expr->base expr info)))
+           (append-text info (append (wrap-as (i386:value->accu 0))
+                                     (wrap-as (i386:sub-base))))))
+
+        ((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
+        ((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
+        ((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
+
+        ;; FIXME: set accu *and* flags
+        ((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
+                                                    (i386:sub-base)
+                                                    (i386:nz->accu)
+                                                    (i386:accu<->stack)
+                                                    (i386:sub-base)
+                                                    (i386:xor-zf)
+                                                    (i386:pop-accu))))
+
+        ((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
+        ((le ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:le?->accu))))
+        ((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
+
+        ((or ,a ,b)
+         (let* ((info (expr->accu a info))
+                (here (number->string (length (.text info))))
+                (skip-b-label (string-append "_" (.function info) "_" here "_or_skip_b"))
+                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
+                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (expr->accu b info))
+                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
+           info))
+
+        ((and ,a ,b)
+         (let* ((info (expr->accu a info))
+                (here (number->string (length (.text info))))
+                (skip-b-label (string-append "_" (.function info) "_" here "_and_skip_b"))
+                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as (i386:jump-z skip-b-label))))
+                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (expr->accu b info))
+                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
+           info))
+
+        ((cast ,type ,expr)
+         (expr->accu expr info))
+
+        ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
+         (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
+                (type (ident->type info name))
+                (rank (ident->rank info name))
+                (size (if (> rank 1) 4 1)))
+           (append-text info ((ident-add info) name size))))
+
+        ((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
+         (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
+                (type (ident->type info name))
+                (rank (ident->rank info name))
+                (size (if (> rank 1) 4 1)))
+           (append-text info ((ident-add info) name (- size)))))
+
+        ((assn-expr ,a (op ,op) ,b)
+         (let* ((info (append-text info (ast->comment o)))
+                (type (ast->type a info))
+                (rank (->rank type))
+                (type-b (ast->type b info))
+                (rank-b (->rank type-b))
+                (size (->size type))
+                (size-b (->size type-b))
+                (info (expr->accu b info))
+                (info (if (equal? op "=") info
+                          (let* ((struct? (structured-type? type))
+                                 (size (cond ((= rank 1) (ast-type->size info a))
+                                             ((> rank 1) 4)
+                                             ((and struct? (= rank 2)) 4)
+                                             (else 1)))
+                                 (info (if (or (= size 1) (= rank-b 1)) info
+                                           (let ((info (append-text info (wrap-as (i386:value->base size)))))
+                                             (append-text info (wrap-as (i386:accu*base))))))
+                                 (info (append-text info (wrap-as (i386:push-accu))))
+                                 (info (expr->accu a info))
+                                 (info (append-text info (wrap-as (i386:pop-base))))
+                                 (info (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-and-base)))
+                                                               ((equal? op "|=") (wrap-as (i386:accu-or-base)))
+                                                               ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
+                                                               ((equal? op ">>=") (wrap-as (i386:accu>>base)))
+                                                               ((equal? op "<<=") (wrap-as (i386:accu<<base)))
+                                                               (else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
+                            (cond ((not (and (= rank 1) (= rank-b 1))) info)
+                                  ((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
+                                                                                       (i386:accu/base)))))
+                                  (else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
+           (when (and (equal? op "=")
+                      (not (= size size-b))
+                      (not (and (or (= size 1) (= size 2))
+                                (= size-b 4)))
+                      (not (and (= size 2)
+                                (= size-b 4)))
+                      (not (and (= size 4)
+                                (or (= size-b 1) (= size-b 2)))))
+             (stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
+             (stderr "   size[~a]:~a != size[~a]:~a\n"  rank size rank-b size-b))
+           (pmatch a
+             ((p-expr (ident ,name))
+              (if (or (<= size 4) ;; FIXME: long long = int
+                      (<= size-b 4)) (append-text info ((accu->ident info) name))
+                      (let ((info (expr->base* a info)))
+                        (accu->base-mem*n info size))))
+             (_ (let ((info (expr->base* a info)))
+                  (accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int
+
+        (_ (error "expr->accu: not supported: " o))))
+
+    (let ((info (helper)))
+      (if (null? (.post info)) info
+          (append-text (clone info #:post '()) (.post info))))))
 
 (define (expr->base o info)
   (let* ((info (append-text info (wrap-as (i386:push-accu))))

diff --git a/module/language/c99/info.scm b/module/language/c99/info.scm
index a04276100dd49fda3cbc463377b4c92c79fe82ba..000b364e72c8f57b96e00a439c873dfbd4b9ff13 100644 (file)
--- a/module/language/c99/info.scm
+++ b/module/language/c99/info.scm
@@ -40,6 +40,7 @@
             .function
             .statics
             .text
+            .post
             .break
             .continue
 
@@ -114,7 +115,7 @@
   (mes-use-module (mes optargs))))
 
 (define-immutable-record-type <info>
-  (make-<info> types constants functions globals locals statics function text break continue)
+  (make-<info> types constants functions globals locals statics function text post break continue)
   info?
   (types .types)
   (constants .constants)
@@ -124,11 +125,12 @@
   (statics .statics)
   (function .function)
   (text .text)
+  (post .post)
   (break .break)
   (continue .continue))
 
-(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (break '()) (continue '()))
-  (make-<info> types constants functions globals locals statics function text break continue))
+(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()))
+  (make-<info> types constants functions globals locals statics function text post break continue))
 
 ;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
 ;;           (make-type 'enum 4 0 fields)

diff --git a/scaffold/tests/7o-struct-pre-post.c b/scaffold/tests/7o-struct-pre-post.c
new file mode 100644 (file)
index 0000000..46f22e7
--- /dev/null
+++ b/scaffold/tests/7o-struct-pre-post.c
@@ -0,0 +1,39 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+// struct foo {int length; char* string; struct foo *next;};
+// struct foo stack[] = {{20, "foo", 0}, {4, "baaz", 0}, {0, 0, 0}};
+
+struct info {int flag;};
+struct foo {int length; char* string; struct info info;};
+struct foo stack[] = {{3, "foo", {11}},{4, "baar", {12}}};
+
+int
+main ()
+{
+  puts (stack[0].string); puts ("\n");
+  puts (stack[1].string); puts ("\n");
+  struct foo* top = &stack[1];
+  int i;
+  i = (top--)->info.flag;
+  top++;
+  int j = (--top)->info.flag;
+  return i - j - 1;
+}