expr
; Local variables of the sequence `expr' is in.
+ ; This is recorded in the same form as the sequence,
+ ; i.e. (MODE name).
locals
; Ordinal of the statement.
; Users of this statement.
; Each element is (owner-number . owner-object),
; where owner-number is an index into the initial insn table
- ; (e.g. insn-list arg of sfrag-create-cse-mapping), and
+ ; (e.g. insn-list arg of /sfrag-create-cse-mapping), and
; owner-object is the corresponding object.
users
)
(loop (cdr chars) (modulo (+ (* result 7) (car chars)) #xfffffff))))
)
-(define (/frag-hash-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff)
+;; MODE is the name of the mode.
+
+(define (/frag-hash-compute! rtx-obj expr parent-expr op-pos tstate appstuff)
(let ((h 0))
(case (rtx-name expr)
((operand)
(define (/frag-hash-stmt stmt locals size)
(set! /frag-hash-value-tmp 0)
- (rtx-traverse-with-locals #f #f stmt /frag-hash-compute! locals #f) ; FIXME: (/fastcall-make /frag-hash-compute!))
+ (rtx-traverse-with-locals #f #f stmt /frag-hash-compute! locals #f)
(modulo /frag-hash-value-tmp size)
)
(define /frag-speed-cost-tmp 0)
(define /frag-size-cost-tmp 0)
-(define (/frag-cost-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff)
+;; MODE is the name of the mode.
+
+(define (/frag-cost-compute! rtx-obj expr parent-expr op-pos tstate appstuff)
; FIXME: wip
(let ((speed 0)
(size 0))
; FIXME: speed/size = 0?
(set! speed 1)
(set! size 1))
- ((UNARY BINARY TRINARY)
+ ((UNARY BINARY TRINARY COMPARE)
(set! speed 1)
(set! size 1))
((IF)
(define (/frag-stmt-cost stmt locals)
(set! /frag-speed-cost-tmp 0)
(set! /frag-size-cost-tmp 0)
- (rtx-traverse-with-locals #f #f stmt /frag-cost-compute! locals #f) ; FIXME: (/fastcall-make /frag-cost-compute!))
+ (rtx-traverse-with-locals #f #f stmt /frag-cost-compute! locals #f)
(cons /frag-speed-cost-tmp /frag-size-cost-tmp)
)
(define (/frag-expr-locals expr)
(if (rtx-kind? 'sequence expr)
+ (rtx-sequence-locals expr)
+ nil)
+)
+
+; Return the locals in EXPR in assq-able form, i.e. (name MODE).
+; If a sequence, return locals.
+; Otherwise, return nil.
+; The result is in assq'able form.
+
+(define (/frag-expr-assq-locals expr)
+ (if (rtx-kind? 'sequence expr)
(rtx-sequence-assq-locals expr)
nil)
)
; statements.
stmt-numbers
- ; Raw rtl source of fragment.
+ ; rtl source of fragment.
semantics
- ; Compiled source.
- compiled-semantics
-
; Boolean indicating if this frag is for parallel exec support.
parallel?
)
(define-getters <sfrag> sfrag
- (users user-nums sfmt stmt-numbers semantics compiled-semantics
+ (users user-nums sfmt stmt-numbers semantics
parallel? header? trailer?)
)
(for-each
(lambda (users)
(let* ((first-owner (cdar users))
+ (context (make-obj-context first-owner "While building sfrags"))
+ (rtl (apply
+ rtx-make
+ (cons 'sequence
+ (cons 'VOID
+ (cons nil
+ (map (lambda (stmt-num)
+ (-stmt-expr
+ (vector-ref stmt-table
+ stmt-num)))
+ stmt-list))))))
(sfrag
(make <sfrag>
(symbol-append (obj:name first-owner)
(map car users)
(insn-sfmt first-owner)
stmt-list
- (apply
- rtx-make
- (cons 'sequence
- (cons 'VOID
- (cons nil
- (map (lambda (stmt-num)
- (-stmt-expr
- (vector-ref stmt-table
- stmt-num)))
- stmt-list)))))
- #f ; compiled-semantics
+ rtl
#f ; parallel?
(eq? kind 'header)
(eq? kind 'trailer)
(+ expr-num 1)
(cdr expr-middle-stmts))
; Yep.
- (let ((owner (vector-ref owner-table expr-num)))
+ (let* ((owner (vector-ref owner-table expr-num))
+ (context (make-obj-context owner "While building sfrags"))
+ (rtl (apply
+ rtx-make
+ (cons 'sequence
+ (cons 'VOID
+ (cons nil
+ (map (lambda (stmt-num)
+ (-stmt-expr
+ (vector-ref stmt-table stmt-num)))
+ (car expr-middle-stmts))))))))
(vector-set! (vector-ref expr-sfrags expr-num)
1 next-middle-frag-num)
(loop (cons (make <sfrag>
(list expr-num)
(insn-sfmt owner)
(car expr-middle-stmts)
- (apply
- rtx-make
- (cons 'sequence
- (cons 'VOID
- (cons nil
- (map (lambda (stmt-num)
- (-stmt-expr
- (vector-ref stmt-table stmt-num)))
- (car expr-middle-stmts))))))
- #f ; compiled-semantics
+ rtl
#f ; parallel?
#f ; header?
#f ; trailer?
(mode:eq? (cadr l1) (cadr l2)))))
)
(for-each (lambda (expr)
- (let ((locals (/frag-expr-locals expr)))
+ (let ((locals (/frag-expr-assq-locals expr)))
(for-each (lambda (local)
(let ((entry (lookup-local local result)))
(if (and entry
(define (sem-find-common-frags insn-list)
(/sem-find-common-frags-1
(begin
- (logit 2 "Simplifying/canonicalizing rtl ...\n")
+ (logit 2 "Simplifying rtl ...\n")
(map (lambda (insn)
(rtx-simplify-insn #f insn))
insn-list))
insn-list)
)
-; Subroutine of sfrag-create-cse-mapping to compute INSN's fragment list.
+; Subroutine of /sfrag-create-cse-mapping to compute INSN's fragment list.
; FRAG-USAGE is a vector of 3 elements: #(header middle trailer).
; Each element is a fragment number or #f if not present.
; Numbers in FRAG-USAGE are indices relative to their respective subtables
(cdr result))
)
-; Subroutine of sfrag-create-cse-mapping to find the fragment number of the
+; Subroutine of /sfrag-create-cse-mapping to find the fragment number of the
; x-header/x-trailer virtual frags.
(define (/frag-lookup-virtual frag-list name)
; - table mapping used fragments for each insn (a list)
; - locals list
-(define (sfrag-create-cse-mapping insn-list)
+(define (/sfrag-create-cse-mapping insn-list)
(logit 1 "Creating semantic fragments for pbb engine ...\n")
(let ((cse-data (sem-find-common-frags insn-list)))
'(VIRTUAL) "")
nil ; users
nil ; user ordinals
- (insn-sfmt (current-insn-lookup 'x-before))
+ (insn-sfmt (current-insn-lookup 'x-before #f))
#f ; stmt-numbers
(rtx-make 'nop)
- #f ; compiled-semantics
#f ; parallel?
#t ; header?
#f ; trailer?
'(VIRTUAL) "")
nil ; users
nil ; user ordinals
- (insn-sfmt (current-insn-lookup 'x-before))
+ (insn-sfmt (current-insn-lookup 'x-before #f))
#f ; stmt-numbers
(rtx-make 'nop)
- #f ; compiled-semantics
#f ; parallel?
#f ; header?
#t ; trailer?
(if (not /sim-sfrag-init?)
(begin
(set! /sim-sfrag-insn-list (non-multi-insns (non-alias-insns (current-insn-list))))
- (let ((frag-data (sfrag-create-cse-mapping /sim-sfrag-insn-list)))
+ (let ((frag-data (/sfrag-create-cse-mapping /sim-sfrag-insn-list)))
(set! /sim-sfrag-frag-table (vector-ref frag-data 0))
(set! /sim-sfrag-usage-table (vector-ref frag-data 1))
(set! /sim-sfrag-locals-list (vector-ref frag-data 2)))
OSDN Git Service
