mescc: function call.
authorJan Nieuwenhuizen <janneke@gnu.org>
Wed, 5 Apr 2017 18:11:13 +0000 (20:11 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 5 Apr 2017 18:11:13 +0000 (20:11 +0200)
* module/language/c99/compiler.mes (expr->accu): Move function call
  from ast->info.

module/language/c99/compiler.mes

index 6b81f7c7fe6c66a8e77aa07793787d42b048dedd..eb7715d05aa428a165e9066ff935a644892cd5a8 100644 (file)
 
 (define (expr->accu info)
   (lambda (o)
-    (let ((text (.text info))
-          (locals (.locals info))
+    (let ((locals (.locals info))
+          (constants (.constants info))
+          (text (.text info))
           (globals (.globals info)))
-      ;;(stderr "expr->accu o=~a\n" o)
+      (define (add-local locals name type pointer)
+        (let* ((id (1+ (length (filter local? (map cdr locals)))))
+               (locals (cons (make-local name type pointer id) locals)))
+          locals))
+      ;; (stderr "expr->accu o=~a\n" o)
       (pmatch o
         ((p-expr (string ,string))
          (clone info #:text (append text (list (lambda (f g ta t d)
          (clone info #:text (append text (value->accu (cstring->number value)))))
         ((p-expr (ident ,name))
          (clone info #:text (append text ((ident->accu info) name))))
-        ((fctn-call . _) ((ast->info info) `(expr-stmt ,o)))
         ((not (fctn-call . _)) ((ast->info info) o))
         ((neg (p-expr (fixed ,value)))
          (clone info #:text (append text (value->accu (- (cstring->number value))))))
                                      (i386:byte-mem->accu)
                                      (i386:mem->accu))))))))
 
-        ;; GRR --> info again??!?
-        ((fctn-call . ,call)
-         ((ast->info info) `(expr-stmt ,o)))
+        ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
+         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
+                                   (clone info #:text (append text (list (lambda (f g ta t d) (asm->hex arg0))))))
+             (let* ((globals (append globals (filter-map expr->global expr-list)))
+                    (info (clone info #:globals globals))
+                    (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))))))
+                    (text (.text args-info))
+                    (n (length expr-list)))
+               (if (and (not (assoc-ref locals name))
+                        (assoc-ref (.functions info) name))
+                   (clone args-info #:text
+                          (append text
+                                  (list (lambda (f g ta t d)
+                                          (i386:call f g ta t d (+ t (function-offset name f)) n))))
+                          #:globals globals)
+                   (let* ((empty (clone info #:text '()))
+                          (accu ((expr->accu empty) `(p-expr (ident ,name)))))
+                     (clone args-info #:text
+                            (append text
+                                    (.text accu)
+                                    (list (lambda (f g ta t d)
+                                            (i386:call-accu f g ta t d n))))
+                            #:globals globals))))))
+
+        ((fctn-call ,function (expr-list . ,expr-list))
+         (let* ((globals (append globals (filter-map expr->global expr-list)))
+                (info (clone info #:globals globals))
+                (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))))))
+                (text (.text args-info))
+                (n (length expr-list))
+                (empty (clone info #:text '()))
+                (accu ((expr->accu empty) function)))
+           (clone info #:text
+                  (append text
+                          (.text accu)
+                          (list (lambda (f g ta t d)
+                                  (i386:call-accu f g ta t d n))))
+                  #:globals globals)))
 
         ((cond-expr . ,cond-expr)
          ((ast->info info) `(expr-stmt ,o)))
 
         ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
         
-        ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
-         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
-                                   (clone info #:text (append text (list (lambda (f g ta t d) (asm->hex arg0))))))
-             (let* ((globals (append globals (filter-map expr->global expr-list)))
-                    (info (clone info #:globals globals))
-                    (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))))))
-                    (text (.text args-info))
-                    (n (length expr-list)))
-               (if (and (not (assoc-ref locals name))
-                        (assoc-ref (.functions info) name))
-                (clone args-info #:text
-                       (append text
-                               (list (lambda (f g ta t d)
-                                       (i386:call f g ta t d (+ t (function-offset name f)) n))))
-                       #:globals globals)
-                (let* ((empty (clone info #:text '()))
-                       (accu ((expr->accu empty) `(p-expr (ident ,name)))))
-                  (clone args-info #:text
-                         (append text
-                                 (.text accu)
-                                 (list (lambda (f g ta t d)
-                                         (i386:call-accu f g ta t d n))))
-                         #:globals globals))))))
-
-        ;;((expr-stmt (fctn-call (d-sel (ident "function") (array-ref (d-sel (ident "cdr") (array-ref (p-expr (ident "fn")) (p-expr (ident "g_cells")))) (p-expr (ident "g_functions")))) (expr-list))))
-        ((expr-stmt (fctn-call ,function (expr-list . ,expr-list)))
-         (let* ((globals (append globals (filter-map expr->global expr-list)))
-                (info (clone info #:globals globals))
-                (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))))))
-                (text (.text args-info))
-                (n (length expr-list))
-                (empty (clone info #:text '()))
-                (accu ((expr->accu empty) function)))
-           (clone info #:text
-                  (append text
-                          (.text accu)
-                          (list (lambda (f g ta t d)
-                                  (i386:call-accu f g ta t d n))))
-                  #:globals globals)))
-
         ((if ,test ,body)
          (let* ((text-length (length text))
 
                                  (i386:byte-mem->accu)))))))
 
         ((fctn-call . ,call)
-         (let ((info ((ast->info info) `(expr-stmt ,o))))
+         (let ((info ((expr->accu info) o)))
            (clone info #:text
                   (append (.text info)
                           (list (lambda (f g ta t d)
                                   '())))
                          ((ident-add info) index 1)))))
 
+        ((expr-stmt ,expression)
+         ((expr->accu info) expression))
+
         ;; DECL
         ;;
         ;; struct f = {...};