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

mescc: Factor-out array-ref.

Browse source 
* module/language/c99/compiler.mes: Factor-out array-ref.
This commit is contained in:
Jan Nieuwenhuizen 2017-04-07 23:06:09 +02:00
parent 1eeec4a327
commit da931b4faa
1 changed files with 15 additions and 114 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -415,23 +415,13 @@
;; c+p expr->arg ;; c+p expr->arg
;; g_cells[<expr>] ;; g_cells[<expr>]
((array-ref ,index (p-expr (ident ,array))) ((array-ref ,index (p-expr (ident ,array)))
(let* ((info ((expr->accu info) index)) (let* ((type (ident->type info array))
(type (ident->type info array)) (size (type->size info type))
(size (type->size info type))) (info ((expr->accu* info) o)))
(append-text info (append (append-text info (wrap-as (append (case size
;; immediate: (i386:value->accu (* size index)) ((1) (i386:byte-mem->accu))
;; * size cells: * length * 4 = * 12 ((4) (i386:mem->accu))
(wrap-as (append (i386:accu->base) (else '())))))))
(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)))))))))
;; f.field ;; f.field
((d-sel (ident ,field) (p-expr (ident ,array))) ((d-sel (ident ,field) (p-expr (ident ,array)))
@ -443,69 +433,18 @@
(append-text info (append ((ident->accu info) array) (append-text info (append ((ident->accu info) array)
(wrap-as (i386:mem+n->accu offset)))))) (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)))) ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
(let* ((empty (clone info #:text '())) (let* ((type (ident->type info array))
(index ((expr->accu empty) index))
(type (ident->type info array))
(fields (or (type->description info type) '())) (fields (or (type->description info type) '()))
(size (type->size info type))
(count (length fields))
(field-size 4) ;; FIXME:4, not fixed (field-size 4) ;; FIXME:4, not fixed
(rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))) (rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
(begin (begin
(stderr "no field:~a\n" field) (stderr "no field:~a\n" field)
'()))) '())))
(offset (* field-size (1- (length rest)))) (offset (* field-size (1- (length rest))))
(text (.text info))) (info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
(append-text info (append (.text index) (append-text info (wrap-as (i386:mem+n->accu offset)))))
(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))))))
;;; FIXME: FROM INFO ...only zero?! ;;; FIXME: FROM INFO ...only zero?!
((p-expr (fixed ,value)) ((p-expr (fixed ,value))
(let ((value (cstring->number value))) (let ((value (cstring->number value)))
@ -624,7 +563,6 @@
((le ,a ,b) ((binop->accu info) b a (i386:base-sub))) ((le ,a ,b) ((binop->accu info) b a (i386:base-sub)))
((lt ,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) ((cast ,cast ,o)
((expr->accu info) o)) ((expr->accu info) o))
@ -766,52 +704,15 @@
((ident->base info) array) ((ident->base info) array)
(wrap-as (i386:accu+base)))))) (wrap-as (i386:accu+base))))))
;; g_cells[10].type ;; g_cells[<expr>].type
((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))) ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
(let* ((type (ident->type info array)) (let* ((type (ident->type info array))
(fields (or (type->description info type) '())) (fields (or (type->description info type) '()))
(size (type->size info type))
(count (length fields))
(field-size 4) ;; FIXME:4, not fixed (field-size 4) ;; FIXME:4, not fixed
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
(index (cstring->number index)) (info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
(text (.text info))) (append-text info (wrap-as (append (i386:accu+value offset))))))
(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)))))))
;; 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))) ((d-sel (ident ,field) (p-expr (ident ,name)))
(let* ((type (ident->type info name)) (let* ((type (ident->type info name))
(fields (or (type->description info type) '())) (fields (or (type->description info type) '()))