artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Refactor comparisons.

Browse source 
* 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 2017-04-07 07:06:35 +02:00
parent 7548ad9efc
commit a2b6830ecb
2 changed files with 33 additions and 94 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

114
module/language/c99/compiler.mes
View file

@ -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)))

13
scaffold/t.c
View file

@ -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;