mescc: Remove jump calculation, use labels: prepare.
[mes.git] / module / language / c99 / compiler.mes
index 91e91877774492a6d33e97a181f86471d87e9cd8..ffda180c8a370c131283bb9defcc42a10c17f800 100644 (file)
 
       (_ ((jump i386:Xjump-z (wrap-as (i386:accu-zero?))) o)))))
 
+(define (test-jump-label->info info label)
+  (define (jump type . test)
+    (lambda (o)
+      (let* ((info ((ast->info info) o))
+             (info (append-text info (wrap-as `(#:comment "jmp test LABEL"))))
+             (jump-text (wrap-as (type `(#:local ,label)))))
+        (append-text info (append (if (null? test) '() (car test))
+                                  jump-text)))))
+  (lambda (o)
+    (pmatch o
+      ;; unsigned
+      ;; ((le ,a ,b) ((jump i386:jump-label-ncz) o)) ; ja
+      ;; ((lt ,a ,b) ((jump i386:jump-label-nc) o))  ; jae
+      ;; ((ge ,a ,b) ((jump i386:jump-label-ncz) o))
+      ;; ((gt ,a ,b) ((jump i386:jump-label-nc) o))
+
+      ((le ,a ,b) ((jump i386:jump-label-g) o))
+      ((lt ,a ,b) ((jump i386:jump-label-ge) o))
+      ((ge ,a ,b) ((jump i386:jump-label-g) o))
+      ((gt ,a ,b) ((jump i386:jump-label-ge) o))
+
+      ((ne ,a ,b) ((jump i386:jump-label-nz) o))
+      ((eq ,a ,b) ((jump i386:jump-label-nz) o))
+      ((not _) ((jump i386:jump-label-z) o))
+
+      ((and ,a ,b)
+       (let* ((info ((test-jump-label->info info label) a))
+              (info ((test-jump-label->info info label) b)))
+         info))
+
+      ((or ,a ,b)
+       (let* ((here (number->string (length (.text info))))
+              (skip-b-label (string-append label "_skip_b_" here))
+              (b-label (string-append label "_b_" here))
+              (info ((test-jump-label->info info b-label) a))
+              (info (append-text info (wrap-as (i386:jump-label `(#:local ,skip-b-label)))))
+              (info (append-text info (wrap-as `(#:label ,b-label))))
+              (info ((test-jump-label->info info label) b))
+              (info (append-text info (wrap-as `(#:label ,skip-b-label)))))
+         info))
+
+      ((array-ref . _) ((jump i386:jump-label-byte-z
+                              (wrap-as (i386:accu-zero?))) o))
+
+      ((de-ref _) ((jump i386:jump-label-byte-z
+                         (wrap-as (i386:accu-zero?))) o))
+
+      ((assn-expr (p-expr (ident ,name)) ,op ,expr)
+       ((jump i386:jump-label-z
+              (append ((ident->accu info) name)
+                      (wrap-as (i386:accu-zero?)))) o))
+
+      (_ ((jump i386:jump-label-z (wrap-as (i386:accu-zero?))) o)))))
+
 (define (cstring->number s)
   (cond ((string-prefix? "0x" s) (string->number (string-drop s 2) 16))
         ((string-prefix? "0b" s) (string->number (string-drop s 2) 2))