mescc: Refactor array ref.
* module/language/c99/compiler.mes (expr->accu, expr->accu*): Remove duplication, use expression as array index. * scaffold/t.c (struct_test): Test it. * vector.c (vector_length, list_to_vector)[!__GNUC__]: Remove branch.
This commit is contained in:
parent
6b4e604441
commit
25a02752f5
|
@ -790,7 +790,7 @@
|
||||||
(empty (clone base #:text '()))
|
(empty (clone base #:text '()))
|
||||||
(accu ((expr->accu empty) b)))
|
(accu ((expr->accu empty) b)))
|
||||||
(clone info #:text
|
(clone info #:text
|
||||||
(append ;;text
|
(append text ;; FIXME
|
||||||
(.text base)
|
(.text base)
|
||||||
(list (lambda (f g ta t d)
|
(list (lambda (f g ta t d)
|
||||||
(i386:push-base)))
|
(i386:push-base)))
|
||||||
|
@ -816,7 +816,7 @@
|
||||||
(empty (clone base #:text '()))
|
(empty (clone base #:text '()))
|
||||||
(accu ((expr->accu empty) b)))
|
(accu ((expr->accu empty) b)))
|
||||||
(clone info #:text
|
(clone info #:text
|
||||||
(append text
|
(append text ;; FIXME
|
||||||
(.text base)
|
(.text base)
|
||||||
(list (lambda (f g ta t d)
|
(list (lambda (f g ta t d)
|
||||||
(i386:push-base)))
|
(i386:push-base)))
|
||||||
|
@ -986,37 +986,19 @@
|
||||||
(list (lambda (f g ta t d)
|
(list (lambda (f g ta t d)
|
||||||
(i386:base->accu)))))))
|
(i386:base->accu)))))))
|
||||||
|
|
||||||
|
;; g_cells[<expr>] = <expr>;
|
||||||
;; g_cells[0] = 65;
|
((assn-expr (array-ref ,index (p-expr (ident ,array))) (op ,op) ,b)
|
||||||
((assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))) (op ,op) ,b)
|
|
||||||
(when (not (equal? op "="))
|
(when (not (equal? op "="))
|
||||||
(stderr "OOOPS3: op=~s\n" op)
|
(stderr "OOOPS3: op=~s\n" op)
|
||||||
barf)
|
barf)
|
||||||
(let* ((index (cstring->number index))
|
(let* ((info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array)))))
|
||||||
(empty (clone info #:text '()))
|
(info ((expr->+base info) b))
|
||||||
(base ((expr->base empty) b))
|
|
||||||
(type (ident->type info array))
|
(type (ident->type info array))
|
||||||
(size (type->size info type))
|
(size (type->size info type))
|
||||||
(ptr (ident->pointer info array)))
|
(ptr (ident->pointer info array)))
|
||||||
(clone info #:text
|
(clone info #:text
|
||||||
(append text
|
(append (.text info)
|
||||||
(.text base)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:push-base)))
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(append
|
|
||||||
(i386:value->base index)
|
|
||||||
(i386:base->accu)
|
|
||||||
(if (eq? size 1) '()
|
|
||||||
(append
|
|
||||||
(if (> size 4) (i386:accu+accu) '())
|
|
||||||
(if (> size 8) (i386:accu+base) '())
|
|
||||||
(i386:accu-shl 2))))))
|
|
||||||
((ident->base info) array)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:accu+base)))
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:pop-base)))
|
|
||||||
(if (eq? size 1) (list (lambda (f g ta t d)
|
(if (eq? size 1) (list (lambda (f g ta t d)
|
||||||
(i386:byte-base->accu-address)))
|
(i386:byte-base->accu-address)))
|
||||||
(append
|
(append
|
||||||
|
@ -1037,112 +1019,19 @@
|
||||||
(i386:base-address->accu-address))))
|
(i386:base-address->accu-address))))
|
||||||
'())))))))
|
'())))))))
|
||||||
|
|
||||||
;; g_cells[i] = c;
|
|
||||||
((assn-expr (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))) (op ,op) ,b)
|
|
||||||
;;(stderr "pointer_cells4[]: ~s\n" array)
|
|
||||||
(when (not (equal? op "="))
|
|
||||||
(stderr "OOOPS4: op=~s\n" op)
|
|
||||||
barf)
|
|
||||||
(let* ((empty (clone info #:text '()))
|
|
||||||
(base ((expr->base empty) b))
|
|
||||||
(type (ident->type info array))
|
|
||||||
(size (type->size info type))
|
|
||||||
(ptr (ident->pointer info array)))
|
|
||||||
(clone info #:text
|
|
||||||
(append text
|
|
||||||
(.text base)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:push-base)))
|
|
||||||
((ident->base info) index)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(append
|
|
||||||
(i386:base->accu)
|
|
||||||
(if (eq? size 1) '()
|
|
||||||
(append
|
|
||||||
(if (> size 4) (i386:accu+accu) '())
|
|
||||||
(if (> size 8) (i386:accu+base) '())
|
|
||||||
(i386:accu-shl 2))))))
|
|
||||||
((ident->base info) array)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:accu+base)))
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:pop-base)))
|
|
||||||
(if (eq? size 1) (list (lambda (f g ta t d)
|
|
||||||
(i386:byte-base->accu-address)))
|
|
||||||
(append
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:base-address->accu-address)))
|
|
||||||
(if (> size 4)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(append
|
|
||||||
(i386:accu+n 4)
|
|
||||||
(i386:base+n 4)
|
|
||||||
(i386:base-address->accu-address))))
|
|
||||||
'())
|
|
||||||
(if (> size 8)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(append
|
|
||||||
(i386:accu+n 4)
|
|
||||||
(i386:base+n 4)
|
|
||||||
(i386:base-address->accu-address))))
|
|
||||||
'())))))))
|
|
||||||
|
|
||||||
;; g_functions[g_function++] = g_foo;
|
|
||||||
((assn-expr (array-ref (post-inc (p-expr (ident ,index))) (p-expr (ident ,array))) (op ,op) ,b)
|
|
||||||
(when (not (equal? op "="))
|
|
||||||
(stderr "OOOPS5: op=~s\n" op)
|
|
||||||
barf)
|
|
||||||
(let* ((empty (clone info #:text '()))
|
|
||||||
(base ((expr->base empty) b))
|
|
||||||
(type (ident->type info array))
|
|
||||||
(size (type->size info type))
|
|
||||||
(ptr (ident->pointer info array)))
|
|
||||||
(clone info #:text
|
|
||||||
(append text
|
|
||||||
(.text base)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:push-base)))
|
|
||||||
((ident->base info) index)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(append
|
|
||||||
(i386:base->accu)
|
|
||||||
(if (eq? size 1) '()
|
|
||||||
(append
|
|
||||||
(if (> size 4) (i386:accu+accu) '())
|
|
||||||
(if (> size 8) (i386:accu+base) '())
|
|
||||||
(i386:accu-shl 2))))))
|
|
||||||
((ident->base info) array)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:accu+base)))
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:pop-base)))
|
|
||||||
(if (eq? size 1) (list (lambda (f g ta t d)
|
|
||||||
(i386:byte-base->accu-address)))
|
|
||||||
(append
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(i386:base-address->accu-address)))
|
|
||||||
(if (> size 4)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(append
|
|
||||||
(i386:accu+n 4)
|
|
||||||
(i386:base+n 4)
|
|
||||||
(i386:base-address->accu-address))))
|
|
||||||
'())
|
|
||||||
(if (> size 8)
|
|
||||||
(list (lambda (f g ta t d)
|
|
||||||
(append
|
|
||||||
(i386:accu+n 4)
|
|
||||||
(i386:base+n 4)
|
|
||||||
(i386:base-address->accu-address))))
|
|
||||||
'())))
|
|
||||||
((ident-add info) index 1)))))
|
|
||||||
|
|
||||||
(_
|
(_
|
||||||
(format (current-error-port) "SKIP: expr->accu=~s\n" o)
|
(format (current-error-port) "SKIP: expr->accu=~s\n" o)
|
||||||
barf
|
barf
|
||||||
info)))))
|
info)))))
|
||||||
|
|
||||||
(define (expr->base info)
|
(define (expr->+base info)
|
||||||
|
(lambda (o)
|
||||||
|
(let* ((info (clone info #:text (append (.text info) (list (lambda (f g ta t d) (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)))
|
||||||
|
|
||||||
|
(define (expr->base info) ;; JUNKME
|
||||||
(lambda (o)
|
(lambda (o)
|
||||||
(let ((info ((expr->accu info) o)))
|
(let ((info ((expr->accu info) o)))
|
||||||
(clone info
|
(clone info
|
||||||
|
@ -1157,8 +1046,27 @@
|
||||||
|
|
||||||
(define (expr->accu* info)
|
(define (expr->accu* info)
|
||||||
(lambda (o)
|
(lambda (o)
|
||||||
|
;; (stderr "expr->accu* o=~s\n" o)
|
||||||
|
|
||||||
(pmatch o
|
(pmatch o
|
||||||
;;(stderr "expr->accu* o=~s\n" o)
|
;; g_cells[<expr>]
|
||||||
|
((array-ref ,index (p-expr (ident ,array)))
|
||||||
|
(let* ((info ((expr->accu info) index))
|
||||||
|
(type (ident->type info array))
|
||||||
|
(size (type->size info type)))
|
||||||
|
(clone info #:text
|
||||||
|
(append (.text info)
|
||||||
|
(list (lambda (f g ta t d)
|
||||||
|
(append
|
||||||
|
(i386:accu->base)
|
||||||
|
(if (eq? size 1) '()
|
||||||
|
(append
|
||||||
|
(if (> size 4) (i386:accu+accu) '())
|
||||||
|
(if (> size 8) (i386:accu+base) '())
|
||||||
|
(i386:accu-shl 2))))))
|
||||||
|
((ident->base info) array)
|
||||||
|
(list (lambda (f g ta t d) (i386:accu+base)))))))
|
||||||
|
|
||||||
;; g_cells[10].type
|
;; g_cells[10].type
|
||||||
((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
|
((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
|
||||||
(let* ((type (ident->type info array))
|
(let* ((type (ident->type info array))
|
||||||
|
|
|
@ -956,13 +956,7 @@ eval_apply ()
|
||||||
|
|
||||||
call_with_current_continuation:
|
call_with_current_continuation:
|
||||||
gc_push_frame ();
|
gc_push_frame ();
|
||||||
#if __GNUC__
|
|
||||||
// FIXME GCC
|
|
||||||
x = MAKE_CONTINUATION (g_continuations++);
|
x = MAKE_CONTINUATION (g_continuations++);
|
||||||
#else
|
|
||||||
x = MAKE_CONTINUATION (g_continuations);
|
|
||||||
g_continuations++;
|
|
||||||
#endif
|
|
||||||
gc_pop_frame ();
|
gc_pop_frame ();
|
||||||
push_cc (cons (car (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2);
|
push_cc (cons (car (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2);
|
||||||
goto apply;
|
goto apply;
|
||||||
|
|
11
scaffold/t.c
11
scaffold/t.c
|
@ -294,7 +294,7 @@ struct_test ()
|
||||||
TYPE (1) = 1;
|
TYPE (1) = 1;
|
||||||
CAR (1) = 2;
|
CAR (1) = 2;
|
||||||
CDR (1) = 3;
|
CDR (1) = 3;
|
||||||
g_cells[0] = g_cells[0+1];
|
g_cells[0] = g_cells[1];
|
||||||
if (TYPE (0) != 1) return 1;
|
if (TYPE (0) != 1) return 1;
|
||||||
if (CAR (0) != 2) return 2;
|
if (CAR (0) != 2) return 2;
|
||||||
if (CDR (0) != 3) return 3;
|
if (CDR (0) != 3) return 3;
|
||||||
|
@ -310,6 +310,15 @@ struct_test ()
|
||||||
if (CAR (0) != 5) return 2;
|
if (CAR (0) != 5) return 2;
|
||||||
if (CDR (0) != 6) return 3;
|
if (CDR (0) != 6) return 3;
|
||||||
|
|
||||||
|
puts ("t: g_cells[0+add(0,0] = g_cells[0+inc(0)]\n");
|
||||||
|
TYPE (1) = 1;
|
||||||
|
CAR (1) = 2;
|
||||||
|
CDR (1) = 3;
|
||||||
|
g_cells[0+add(0, 0)] = g_cells[0+inc(0)];
|
||||||
|
if (TYPE (0) != 1) return 1;
|
||||||
|
if (CAR (0) != 2) return 2;
|
||||||
|
if (CDR (0) != 3) return 3;
|
||||||
|
|
||||||
g_cells[0].type = TNUMBER;
|
g_cells[0].type = TNUMBER;
|
||||||
g_cells[0].car = 0;
|
g_cells[0].car = 0;
|
||||||
g_cells[0].cdr = 0;
|
g_cells[0].cdr = 0;
|
||||||
|
|
16
vector.c
16
vector.c
|
@ -25,17 +25,7 @@ make_vector (SCM n)
|
||||||
VALUE (tmp_num) = TVECTOR;
|
VALUE (tmp_num) = TVECTOR;
|
||||||
SCM v = alloc (k);
|
SCM v = alloc (k);
|
||||||
SCM x = make_cell_ (tmp_num, k, v);
|
SCM x = make_cell_ (tmp_num, k, v);
|
||||||
#if __GNUC__
|
|
||||||
for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
|
for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
|
||||||
#else
|
|
||||||
for (int i=v; i<k+v; i++)
|
|
||||||
{
|
|
||||||
SCM t = vector_entry (cell_unspecified);
|
|
||||||
struct scm s = g_cells[t];
|
|
||||||
s = g_cells[t];
|
|
||||||
g_cells[i] = s;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
return x;
|
return x;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -69,13 +59,7 @@ vector_set_x (SCM x, SCM i, SCM e)
|
||||||
{
|
{
|
||||||
assert (TYPE (x) == TVECTOR);
|
assert (TYPE (x) == TVECTOR);
|
||||||
assert (VALUE (i) < LENGTH (x));
|
assert (VALUE (i) < LENGTH (x));
|
||||||
#if __GNUC__
|
|
||||||
g_cells[VECTOR (x)+VALUE (i)] = g_cells[vector_entry (e)];
|
g_cells[VECTOR (x)+VALUE (i)] = g_cells[vector_entry (e)];
|
||||||
#else
|
|
||||||
SCM a = VECTOR (x)+VALUE (i);
|
|
||||||
SCM b = vector_entry (e);
|
|
||||||
g_cells[a] = g_cells[b];
|
|
||||||
#endif
|
|
||||||
return cell_unspecified;
|
return cell_unspecified;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue