mescc: Factor-out array-ref.
* module/language/c99/compiler.mes: Factor-out array-ref.
This commit is contained in:
Jan Nieuwenhuizen
parent
1eeec4a327
commit
da931b4faa
|
|
@ -415,23 +415,13 @@
|
|||
;; c+p expr->arg
|
||||
;; 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)))
|
||||
(append-text info (append
|
||||
;; immediate: (i386:value->accu (* size index))
|
||||
;; * size cells: * length * 4 = * 12
|
||||
(wrap-as (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)
|
||||
(wrap-as (append (case size
|
||||
((1) (i386:byte-base-mem->accu))
|
||||
((4) (i386:base-mem->accu))
|
||||
(else (i386:accu+base)))))))))
|
||||
(let* ((type (ident->type info array))
|
||||
(size (type->size info type))
|
||||
(info ((expr->accu* info) o)))
|
||||
(append-text info (wrap-as (append (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '())))))))
|
||||
|
||||
;; f.field
|
||||
((d-sel (ident ,field) (p-expr (ident ,array)))
|
||||
|
|
@ -443,69 +433,18 @@
|
|||
(append-text info (append ((ident->accu info) array)
|
||||
(wrap-as (i386:mem+n->accu offset))))))
|
||||
|
||||
;; g_cells[10].type
|
||||
((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
|
||||
(let* ((type (ident->type info array))
|
||||
(fields (or (type->description info type) '()))
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
|
||||
(index (cstring->number index))
|
||||
(text (.text info)))
|
||||
(append-text info (append
|
||||
(wrap-as (append (i386:value->base index)
|
||||
(i386:base->accu)
|
||||
(if (<= count 1) '() (i386:accu+accu))
|
||||
(if (<= count 2) '() (i386:accu+base))
|
||||
(i386:accu-shl 2)))
|
||||
((ident->base info) array)
|
||||
(wrap-as (i386:base-mem+n->accu offset))))))
|
||||
|
||||
;; g_cells[x].type
|
||||
((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
|
||||
(let* ((type (ident->type info array))
|
||||
(fields (or (type->description info type) '()))
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
|
||||
(text (.text info)))
|
||||
(append-text info (append ((ident->base info) index)
|
||||
(wrap-as (append (i386:base->accu)
|
||||
(if (<= count 1) '() (i386:accu+accu))
|
||||
(if (<= count 2) '() (i386:accu+base))
|
||||
(i386:accu-shl 2)))
|
||||
((ident->base info) array)
|
||||
(wrap-as (i386:base-mem+n->accu offset))))))
|
||||
|
||||
;; g_functions[g_cells[fn].cdr].arity
|
||||
;; INDEX0: g_cells[fn].cdr
|
||||
|
||||
;;; index: (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells))))
|
||||
;;((d-sel (ident ,arity) (array-ref (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells)))) (p-expr (ident ,g_functions)))))
|
||||
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(index ((expr->accu empty) index))
|
||||
(type (ident->type info array))
|
||||
(let* ((type (ident->type info array))
|
||||
(fields (or (type->description info type) '()))
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
|
||||
(begin
|
||||
(stderr "no field:~a\n" field)
|
||||
'())))
|
||||
(offset (* field-size (1- (length rest))))
|
||||
(text (.text info)))
|
||||
(append-text info (append (.text index)
|
||||
(wrap-as (append (i386:accu->base)
|
||||
(if (<= count 1) '() (i386:accu+accu))
|
||||
(if (<= count 2) '() (i386:accu+base))
|
||||
(i386:accu-shl 2)))
|
||||
((ident->base info) array)
|
||||
(wrap-as (i386:base-mem+n->accu offset))))))
|
||||
|
||||
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
|
||||
(append-text info (wrap-as (i386:mem+n->accu offset)))))
|
||||
|
||||
;;; FIXME: FROM INFO ...only zero?!
|
||||
((p-expr (fixed ,value))
|
||||
(let ((value (cstring->number value)))
|
||||
|
|
@ -624,7 +563,6 @@
|
|||
((le ,a ,b) ((binop->accu info) b a (i386:base-sub)))
|
||||
((lt ,a ,b) ((binop->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)
|
||||
((expr->accu info) o))
|
||||
|
||||
|
|
@ -766,52 +704,15 @@
|
|||
((ident->base info) array)
|
||||
(wrap-as (i386:accu+base))))))
|
||||
|
||||
;; g_cells[10].type
|
||||
((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
|
||||
;; g_cells[<expr>].type
|
||||
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
|
||||
(let* ((type (ident->type info array))
|
||||
(fields (or (type->description info type) '()))
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
|
||||
(index (cstring->number index))
|
||||
(text (.text info)))
|
||||
(append-text info (append (wrap-as (append (i386:value->base index)
|
||||
(i386:base->accu)
|
||||
(if (<= count 1) '()
|
||||
(i386:accu+accu))
|
||||
(if (<= count 2) '()
|
||||
(i386:accu+base))
|
||||
(i386:accu-shl 2)))
|
||||
;; de-ref: g_cells, non: arena
|
||||
;;((ident->base info) array)
|
||||
((ident->base info) array)
|
||||
(wrap-as (append (i386:accu+base)
|
||||
(i386:accu+value offset)))))))
|
||||
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
|
||||
(append-text info (wrap-as (append (i386:accu+value offset))))))
|
||||
|
||||
;; g_cells[x].type
|
||||
((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
|
||||
(let* ((type (ident->type info array))
|
||||
(fields (or (type->description info type) '()))
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
|
||||
(text (.text info)))
|
||||
(append-text info (append ((ident->base info) index)
|
||||
(wrap-as (append (i386:base->accu)
|
||||
(if (<= count 1) '()
|
||||
(i386:accu+accu))
|
||||
(if (<= count 2) '()
|
||||
(i386:accu+base))
|
||||
(i386:accu-shl 2)))
|
||||
;; de-ref: g_cells, non: arena
|
||||
;;((ident->base info) array)
|
||||
((ident->base info) array)
|
||||
(wrap-as (append (i386:accu+base)
|
||||
(i386:accu+value offset)))))))
|
||||
|
||||
;;((d-sel (ident "cdr") (p-expr (ident "scm_make_cell"))))
|
||||
((d-sel (ident ,field) (p-expr (ident ,name)))
|
||||
(let* ((type (ident->type info name))
|
||||
(fields (or (type->description info type) '()))
|
||||
|
|
|
|||
Loading…
Reference in New Issue