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.
This commit is contained in:
Jan Nieuwenhuizen
parent
7548ad9efc
commit
a2b6830ecb
|
|
@ -785,21 +785,6 @@
|
||||||
(i386:accu-not))))
|
(i386:accu-not))))
|
||||||
#:globals (.globals test-info))))
|
#: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)))
|
((neg (p-expr (fixed ,value)))
|
||||||
(clone info #:text (append text (value->accu (- (cstring->number value))))))
|
(clone info #:text (append text (value->accu (- (cstring->number value))))))
|
||||||
|
|
||||||
|
|
@ -811,82 +796,13 @@
|
||||||
(list (lambda (f g ta t d)
|
(list (lambda (f g ta t d)
|
||||||
(i386:sub-base))))))
|
(i386:sub-base))))))
|
||||||
|
|
||||||
((ge ,a ,b)
|
((eq ,a ,b) ((compare->accu info) a b (i386:sub-base)))
|
||||||
(let* ((base ((expr->base info) a))
|
((ge ,a ,b) ((compare->accu info) b a (i386:sub-base)))
|
||||||
(empty (clone base #:text '()))
|
((gt ,a ,b) ((compare->accu info) b a (i386:sub-base)))
|
||||||
(accu ((expr->accu empty) b)))
|
((ne ,a ,b) ((compare->accu info) a b (append (i386:sub-base)
|
||||||
(clone info #:text
|
(i386:xor-zf))))
|
||||||
(append text ;; FIXME
|
((le ,a ,b) ((compare->accu info) b a (i386:base-sub)))
|
||||||
(.text base)
|
((lt ,a ,b) ((compare->accu info) b a (i386:base-sub)))
|
||||||
(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)))))))
|
|
||||||
|
|
||||||
;;((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 (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)
|
((cast ,cast ,o)
|
||||||
|
|
@ -1026,11 +942,23 @@
|
||||||
|
|
||||||
(define (expr->+base info)
|
(define (expr->+base info)
|
||||||
(lambda (o)
|
(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 ((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)))
|
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
|
(define (expr->base info) ;; JUNKME
|
||||||
(lambda (o)
|
(lambda (o)
|
||||||
(let ((info ((expr->accu info) o)))
|
(let ((info ((expr->accu info) o)))
|
||||||
|
|
|
||||||
13
scaffold/t.c
13
scaffold/t.c
|
|
@ -177,6 +177,8 @@ read_test ()
|
||||||
int
|
int
|
||||||
math_test ()
|
math_test ()
|
||||||
{
|
{
|
||||||
|
int i;
|
||||||
|
|
||||||
puts ("t: 0 < 0\n");
|
puts ("t: 0 < 0\n");
|
||||||
if (0 < 0) return 1;
|
if (0 < 0) return 1;
|
||||||
|
|
||||||
|
|
@ -201,7 +203,16 @@ math_test ()
|
||||||
puts ("t: -1 > 0\n");
|
puts ("t: -1 > 0\n");
|
||||||
if (-1 > 0) return 1;
|
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=");
|
puts ("t: 4/2=");
|
||||||
i = 4 / 2;
|
i = 4 / 2;
|
||||||
if (i!=2) return 1;
|
if (i!=2) return 1;
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue