mescc: Refactor assignment.
* module/language/c99/compiler.mes (expr->accu): Refactor assignment. Support multiple operators. * scaffold/t.c (math_test): Test it. * scaffold/mini-mes.c (minus, divide, modulo, multiply, logior)[!__GNUC__]: Remove branch.
This commit is contained in:
Jan Nieuwenhuizen
parent
da931b4faa
commit
2deca502ed
|
|
@ -566,98 +566,60 @@
|
||||||
((cast ,cast ,o)
|
((cast ,cast ,o)
|
||||||
((expr->accu info) o))
|
((expr->accu info) o))
|
||||||
|
|
||||||
;; *p++ = b;
|
((assn-expr ,a (op ,op) ,b)
|
||||||
((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
|
(let* ((info ((expr->accu info) b))
|
||||||
(when (not (equal? op "="))
|
(info (if (equal? op "=") info
|
||||||
(stderr "OOOPS0.0: op=~s\n" op)
|
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
||||||
barf)
|
(info ((expr->accu info) a))
|
||||||
(let ((info ((expr->base info) b)))
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
||||||
(append-text info (append ((base->ident-address info) name)
|
(append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
|
||||||
((ident->accu info) name)
|
((equal? op "-=") (wrap-as (i386:accu-base)))
|
||||||
((ident-add info) name 1)))))
|
((equal? op "*=") (wrap-as (i386:accu*base)))
|
||||||
|
((equal? op "/=") (wrap-as (i386:accu/base)))
|
||||||
;; *p-- = b;
|
((equal? op "%=") (wrap-as (i386:accu%base)))
|
||||||
((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
|
((equal? op "|=") (wrap-as (i386:accu-or-base)))
|
||||||
(when (not (equal? op "="))
|
(else (error "mescc: op ~a not supported: ~a\n" op o))))))))
|
||||||
(stderr "OOOPS0.0: op=~s\n" op)
|
(pmatch a
|
||||||
barf)
|
((p-expr (ident ,name)) (append-text info ((accu->ident info) name)))
|
||||||
(let ((info ((expr->base info) b)))
|
((d-sel (ident ,field) . ,d-sel)
|
||||||
(append-text info (append ((base->ident-address info) name)
|
(let* ((type (list "struct" "scm")) ;; FIXME
|
||||||
((ident->accu info) name)
|
(fields (type->description info type))
|
||||||
((ident-add info) name -1)))))
|
(size (type->size info type))
|
||||||
|
(field-size 4) ;; FIXME:4, not fixed
|
||||||
;; CAR (x) = 0
|
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
|
||||||
;; TYPE (x) = PAIR;
|
(info (append-text info (wrap-as (i386:push-accu))))
|
||||||
((assn-expr (d-sel (ident ,field) . ,d-sel) (op ,op) ,b)
|
(info ((expr->accu* info) a))
|
||||||
(when (not (equal? op "="))
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
||||||
(stderr "OOOPS0: op=~s\n" op)
|
(append-text info (wrap-as (i386:base->accu-address))))) ; FIXME: size
|
||||||
barf)
|
((de-ref (p-expr (ident ,array)))
|
||||||
(let* (;;(empty (clone info #:text '()))
|
(append-text info (append (wrap-as (i386:accu->base))
|
||||||
;;(expr ((expr->accu* empty) `(d-sel (ident ,field) ,@d-sel))) ;; <-OFFSET
|
((base->ident-address info) array)
|
||||||
(info ((expr->accu info) b))
|
(wrap-as (i386:base->accu)))))
|
||||||
(info (append-text info (wrap-as (i386:push-accu))))
|
((de-ref (post-inc (p-expr (ident ,name))))
|
||||||
(info ((expr->accu* info) `(d-sel (ident ,field) ,@d-sel))) ;; <-OFFSET
|
(let ((info ((expr->accu info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b))))
|
||||||
(info (append-text info (wrap-as (i386:pop-base))))
|
(append-text info ((ident-add info) name 1))))
|
||||||
(type (list "struct" "scm")) ;; FIXME
|
((de-ref (post-dec (p-expr (ident ,name))))
|
||||||
(fields (type->description info type))
|
(let ((info ((expr->accu info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b))))
|
||||||
(size (type->size info type))
|
(append-text info ((ident-add info) name -1))))
|
||||||
(field-size 4) ;; FIXME:4, not fixed
|
((array-ref ,index (p-expr (ident ,array)))
|
||||||
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) )
|
(let* ((type (ident->type info array))
|
||||||
(append-text info (wrap-as (i386:base->accu-address))))) ; FIXME: size
|
(size (type->size info type))
|
||||||
|
(info (append-text info (wrap-as (append (i386:push-accu)))))
|
||||||
|
(info ((expr->accu* info) a))
|
||||||
;; i = 0;
|
(info (append-text info (wrap-as (append (i386:pop-base))))))
|
||||||
;; c = f ();
|
(append-text info
|
||||||
;; i = i + 48;
|
(append (if (eq? size 1) (wrap-as (i386:byte-base->accu-address))
|
||||||
;; p = g_cell;
|
(append
|
||||||
((assn-expr (p-expr (ident ,name)) (op ,op) ,b)
|
(wrap-as (i386:base-address->accu-address))
|
||||||
(when (and (not (equal? op "="))
|
(if (<= size 4) '()
|
||||||
(not (equal? op "+="))
|
(wrap-as (append (i386:accu+n 4)
|
||||||
(not (equal? op "-=")))
|
(i386:base+n 4)
|
||||||
(stderr "OOOPS1: op=~s\n" op)
|
(i386:base-address->accu-address))))
|
||||||
barf)
|
(if (<= size 8) '()
|
||||||
(let ((info ((expr->base info) b)))
|
(wrap-as (append (i386:accu+n 4)
|
||||||
(append-text info (append (if (equal? op "=") '()
|
(i386:base+n 4)
|
||||||
(append ((ident->accu info) name)
|
(i386:base-address->accu-address))))))))))
|
||||||
(wrap-as (append (if (equal? op "+=") (i386:accu+base)
|
(_ barf-assign))))
|
||||||
(i386:accu-base))
|
|
||||||
(i386:accu->base)))))
|
|
||||||
;;assign:
|
|
||||||
((base->ident info) name)
|
|
||||||
(wrap-as (i386:base->accu))))))
|
|
||||||
|
|
||||||
;; *p = 0;
|
|
||||||
((assn-expr (de-ref (p-expr (ident ,array))) (op ,op) ,b)
|
|
||||||
(when (not (equal? op "="))
|
|
||||||
(stderr "OOOPS2: op=~s\n" op)
|
|
||||||
barf)
|
|
||||||
(let ((info ((expr->base info) b)))
|
|
||||||
(append-text info (append ;;assign:
|
|
||||||
((base->ident-address info) array)
|
|
||||||
(wrap-as (i386:base->accu))))))
|
|
||||||
|
|
||||||
;; g_cells[<expr>] = <expr>;
|
|
||||||
((assn-expr (array-ref ,index (p-expr (ident ,array))) (op ,op) ,b)
|
|
||||||
(when (not (equal? op "="))
|
|
||||||
(stderr "OOOPS3: op=~s\n" op)
|
|
||||||
barf)
|
|
||||||
(let* ((info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array)))))
|
|
||||||
(info ((expr->base info) b))
|
|
||||||
(type (ident->type info array))
|
|
||||||
(size (type->size info type))
|
|
||||||
(ptr (ident->pointer info array)))
|
|
||||||
(append-text info (append
|
|
||||||
(if (eq? size 1) (wrap-as (i386:byte-base->accu-address))
|
|
||||||
(append
|
|
||||||
(wrap-as (i386:base-address->accu-address))
|
|
||||||
(if (<= size 4) '()
|
|
||||||
(wrap-as (append (i386:accu+n 4)
|
|
||||||
(i386:base+n 4)
|
|
||||||
(i386:base-address->accu-address))))
|
|
||||||
(if (<= size 8) '()
|
|
||||||
(wrap-as (append (i386:accu+n 4)
|
|
||||||
(i386:base+n 4)
|
|
||||||
(i386:base-address->accu-address))))))))))
|
|
||||||
|
|
||||||
(_
|
(_
|
||||||
(format (current-error-port) "SKIP: expr->accu=~s\n" o)
|
(format (current-error-port) "SKIP: expr->accu=~s\n" o)
|
||||||
|
|
|
||||||
|
|
@ -1194,11 +1194,7 @@ minus (SCM x) ///((name . "-") (arity . n))
|
||||||
while (x != cell_nil)
|
while (x != cell_nil)
|
||||||
{
|
{
|
||||||
assert (TYPE (car (x)) == TNUMBER);
|
assert (TYPE (car (x)) == TNUMBER);
|
||||||
#if __GNUC__
|
|
||||||
n -= VALUE (car (x));
|
n -= VALUE (car (x));
|
||||||
#else
|
|
||||||
n = n - VALUE (car (x));
|
|
||||||
#endif
|
|
||||||
x = cdr (x);
|
x = cdr (x);
|
||||||
}
|
}
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
|
|
@ -1211,11 +1207,7 @@ plus (SCM x) ///((name . "+") (arity . n))
|
||||||
while (x != cell_nil)
|
while (x != cell_nil)
|
||||||
{
|
{
|
||||||
assert (TYPE (car (x)) == TNUMBER);
|
assert (TYPE (car (x)) == TNUMBER);
|
||||||
#if __GNUC__
|
|
||||||
n += VALUE (car (x));
|
n += VALUE (car (x));
|
||||||
#else
|
|
||||||
n = n + VALUE (car (x));
|
|
||||||
#endif
|
|
||||||
x = cdr (x);
|
x = cdr (x);
|
||||||
}
|
}
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
|
|
@ -1233,11 +1225,7 @@ divide (SCM x) ///((name . "/") (arity . n))
|
||||||
while (x != cell_nil)
|
while (x != cell_nil)
|
||||||
{
|
{
|
||||||
assert (TYPE (car (x)) == TNUMBER);
|
assert (TYPE (car (x)) == TNUMBER);
|
||||||
#if __GNUC__
|
|
||||||
n /= VALUE (car (x));
|
n /= VALUE (car (x));
|
||||||
#else
|
|
||||||
n = n / VALUE (car (x));
|
|
||||||
#endif
|
|
||||||
x = cdr (x);
|
x = cdr (x);
|
||||||
}
|
}
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
|
|
@ -1260,11 +1248,7 @@ multiply (SCM x) ///((name . "*") (arity . n))
|
||||||
while (x != cell_nil)
|
while (x != cell_nil)
|
||||||
{
|
{
|
||||||
assert (TYPE (car (x)) == TNUMBER);
|
assert (TYPE (car (x)) == TNUMBER);
|
||||||
#if __GNUC__
|
|
||||||
n *= VALUE (car (x));
|
n *= VALUE (car (x));
|
||||||
#else
|
|
||||||
n = n * VALUE (car (x));
|
|
||||||
#endif
|
|
||||||
x = cdr (x);
|
x = cdr (x);
|
||||||
}
|
}
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
|
|
@ -1277,11 +1261,7 @@ logior (SCM x) ///((arity . n))
|
||||||
while (x != cell_nil)
|
while (x != cell_nil)
|
||||||
{
|
{
|
||||||
assert (TYPE (car (x)) == TNUMBER);
|
assert (TYPE (car (x)) == TNUMBER);
|
||||||
#if __GNUC__
|
|
||||||
n |= VALUE (car (x));
|
n |= VALUE (car (x));
|
||||||
#else
|
|
||||||
n = n | VALUE (car (x));
|
|
||||||
#endif
|
|
||||||
x = cdr (x);
|
x = cdr (x);
|
||||||
}
|
}
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
|
|
|
||||||
10
scaffold/t.c
10
scaffold/t.c
|
|
@ -223,10 +223,18 @@ math_test ()
|
||||||
putchar (i);
|
putchar (i);
|
||||||
puts ("\n");
|
puts ("\n");
|
||||||
|
|
||||||
puts ("t: 3*4=");
|
puts ("t: 3*4=\n");
|
||||||
i = 3 * 4;
|
i = 3 * 4;
|
||||||
if (i!=12) return 1;
|
if (i!=12) return 1;
|
||||||
|
|
||||||
|
puts ("t: i /= 4\n");
|
||||||
|
i /= 4;
|
||||||
|
if (i!=3) return 1;
|
||||||
|
|
||||||
|
puts ("t: i *= 4\n");
|
||||||
|
i *= 4;
|
||||||
|
if (i!=12) return 1;
|
||||||
|
|
||||||
puts ("t: 1 << 3\n");
|
puts ("t: 1 << 3\n");
|
||||||
if (1 << 3 != 8) return 1 << 3;
|
if (1 << 3 != 8) return 1 << 3;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue