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:
Jan Nieuwenhuizen 2017-04-06 23:05:44 +02:00
parent 6b4e604441
commit 25a02752f5
4 changed files with 46 additions and 151 deletions

View file

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

View file

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

View file

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

View file

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