From a2b6830ecb7ea39f487194252126c32c9982ab70 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Fri, 7 Apr 2017 07:06:35 +0200 Subject: [PATCH] mescc: Refactor comparisons. * module/language/c99/compiler.mes (compare->accu, append-text, wrap): New functions. (expr->accu): Use them to implement construct like 1 == inc (0). * scaffold/t.c (math_test): Test them. --- module/language/c99/compiler.mes | 114 ++++++------------------------- scaffold/t.c | 13 +++- 2 files changed, 33 insertions(+), 94 deletions(-) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 8d017b20..650b143d 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -785,21 +785,6 @@ (i386:accu-not)))) #:globals (.globals test-info)))) - ((eq ,a ,b) - (let* ((base ((expr->base info) a)) - (empty (clone base #:text '())) - (accu ((expr->accu empty) b))) - (clone info #:text - (append text ;; FIXME - (.text base) - (list (lambda (f g ta t d) - (i386:push-base))) - (.text accu) - (list (lambda (f g ta t d) - (i386:pop-base))) - (list (lambda (f g ta t d) - (i386:sub-base))))))) - ((neg (p-expr (fixed ,value))) (clone info #:text (append text (value->accu (- (cstring->number value)))))) @@ -811,82 +796,13 @@ (list (lambda (f g ta t d) (i386:sub-base)))))) - ((ge ,a ,b) - (let* ((base ((expr->base info) a)) - (empty (clone base #:text '())) - (accu ((expr->accu empty) b))) - (clone info #:text - (append text ;; FIXME - (.text base) - (list (lambda (f g ta t d) - (i386:push-base))) - (.text accu) - (list (lambda (f g ta t d) - (i386:pop-base))) - (list (lambda (f g ta t d) - (i386:sub-base))))))) - - ((gt ,a ,b) - (let* ((base ((expr->base info) a)) - (empty (clone base #:text '())) - (accu ((expr->accu empty) b))) - (clone info #:text - (append text - (.text base) - (list (lambda (f g ta t d) - (i386:push-base))) - (.text accu) - (list (lambda (f g ta t d) - (i386:pop-base))) - (list (lambda (f g ta t d) - (i386:sub-base))))))) - - ((ne ,a ,b) - (let* ((base ((expr->base info) a)) - (empty (clone base #:text '())) - (accu ((expr->accu empty) b))) - (clone info #:text - (append text - (.text base) - (list (lambda (f g ta t d) - (i386:push-base))) - (.text accu) - (list (lambda (f g ta t d) - (i386:pop-base))) - (list (lambda (f g ta t d) - (append - (i386:sub-base) - (i386:xor-zf)))))))) - - ((le ,a ,b) - (let* ((base ((expr->base info) a)) - (empty (clone base #:text '())) - (accu ((expr->accu empty) b))) - (clone info #:text - (append text - (.text base) - (list (lambda (f g ta t d) - (i386:push-base))) - (.text accu) - (list (lambda (f g ta t d) - (i386:pop-base))) - (list (lambda (f g ta t d) - (i386:base-sub))))))) - - ((lt ,a ,b) - (let* ((base ((expr->base info) a)) - (empty (clone base #:text '())) - (accu ((expr->accu empty) b))) - (clone info #:text - (append text - (.text base) - (list (lambda (f g ta t d) - (i386:push-base))) - (.text accu) - (list (lambda (f g ta t d) - (i386:pop-base))) - (list (lambda (f g ta t d) - (i386:base-sub))))))) + ((eq ,a ,b) ((compare->accu info) a b (i386:sub-base))) + ((ge ,a ,b) ((compare->accu info) b a (i386:sub-base))) + ((gt ,a ,b) ((compare->accu info) b a (i386:sub-base))) + ((ne ,a ,b) ((compare->accu info) a b (append (i386:sub-base) + (i386:xor-zf)))) + ((le ,a ,b) ((compare->accu info) b a (i386:base-sub))) + ((lt ,a ,b) ((compare->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) @@ -1026,11 +942,23 @@ (define (expr->+base info) (lambda (o) - (let* ((info (clone info #:text (append (.text info) (list (lambda (f g ta t d) (i386:push-accu)))))) + (let* ((info (append-text info (wrap (i386:push-accu)))) (info ((expr->accu info) o)) - (info (clone info #:text (append (.text info) (list (lambda (f g ta t d) (append (i386:accu->base) (i386:pop-accu)))))))) + (info (append-text info (wrap (append (i386:accu->base) (i386:pop-accu)))))) info))) +(define (compare->accu info) + (lambda (a b c) + (let* ((info ((expr->accu info) a)) + (info ((expr->+base info) b))) + (append-text info (wrap c))))) + +(define (append-text info text) + (clone info #:text (append (.text info) text))) + +(define (wrap o) + (list (lambda (f g ta t d) o))) + (define (expr->base info) ;; JUNKME (lambda (o) (let ((info ((expr->accu info) o))) diff --git a/scaffold/t.c b/scaffold/t.c index ca2244b7..4b1befae 100644 --- a/scaffold/t.c +++ b/scaffold/t.c @@ -177,6 +177,8 @@ read_test () int math_test () { + int i; + puts ("t: 0 < 0\n"); if (0 < 0) return 1; @@ -201,7 +203,16 @@ math_test () puts ("t: -1 > 0\n"); if (-1 > 0) return 1; - int i; + puts ("t: 1 == inc (0)\n"); + if (1 == inc (0)) goto ok0; + return 1; + ok0: + + puts ("t: 0 < inc (0)\n"); + if (0 < inc (0)) goto ok1; + return 1; + ok1: + puts ("t: 4/2="); i = 4 / 2; if (i!=2) return 1;