2 ; Copyright (C) 2000 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ; See file COPYING.CGEN for details.
7 ; Some improvement in pbb simulator efficiency is obtained in cases like
8 ; the ARM where for example operand2 computation is expensive in terms of
9 ; cpu cost, code size, and subroutine call overhead if the code is put in
10 ; a subroutine. It could be inlined, but there are numerous occurences
11 ; resulting in poor icache usage.
12 ; If the computation is put in its own fragment then code size is reduced
13 ; [improving icache usage] and subroutine call overhead is removed in a
14 ; computed-goto simulator [arguments are passed in machine generated local
17 ; The basic procedure here is to:
18 ; - break all insns up into a set of statements
19 ; This is either one statement in the case of insns that don't begin with a
20 ; sequence, or a list of statements, one for each element in the sequence.
21 ; - find a profitable set of common leading statements (called the "header")
22 ; and a profitable set of common trailing statements (called the "trailer")
23 ; What is "profitable" depends on
24 ; - how expensive the statement is
25 ; - how long the statement is
26 ; - the number of insns using the statement
27 ; - what fraction of the total insn the statement is
28 ; - rewrite insn semantics in terms of the new header and trailer fragments
29 ; plus a "middle" part that is whatever is left over
30 ; - there is always a header, the middle and trailer parts are optional
31 ; - cti insns require a header and trailer, though they can be the same
35 ; - check ARM orr insns which come out as header, tiny middle, trailer
36 ; - the tiny middle seems like a waste (combine with trailer?)
37 ; - there are 8 trailers consisting of just `nop' for ARM
38 ; - rearranging statements to increase number and length of common sets
39 ; - combine common middle fragments
40 ; - parallel's not handled yet (only have to handle parallel's at the
42 ; - insns can also be split on timing-sensitive boundaries (pipeline, memory,
43 ; whatever) though that is not implemented yet. This may involve rtl
47 ; - call sim-sfrag-init! first, to initialize
48 ; - call sim-sfrag-analyze-insns! to create the semantic fragments
50 ; - sim-sfrag-insn-list
51 ; - sim-sfrag-frag-table
52 ; - sim-sfrag-usage-table
53 ; - sim-sfrag-locals-list
55 ; Statement computation.
57 ; Set to #t to collect various statistics.
59 (define -stmt-stats? #f)
61 ; Collection of computed stats. Only set if -stmt-stats? = #t.
63 (define -stmt-stats #f)
65 ; Collection of computed statement data. Only set if -stmt-stats? = #t.
67 (define -stmt-stats-data #f)
69 ; Create a structure recording data of all statements.
70 ; A pair of (next-ordinal . table).
72 (define (-stmt-data-make hash-size)
73 (cons 0 (make-vector hash-size nil))
78 (define (-stmt-data-table data) (cdr data))
79 (define (-stmt-data-next-num data) (car data))
80 (define (-stmt-data-set-next-num! data newval) (set-car! data newval))
81 (define (-stmt-data-hash-size data) (vector-length (cdr data)))
84 ; INSN semantics either consist of a single statement or a sequence of them.
87 (class-make '<statement> nil
92 ; Local variables of the sequence `expr' is in.
95 ; Ordinal of the statement.
99 ; SPEED-COST is the cost of executing fragment, relative to a
101 ; SIZE-COST is the size of the fragment, relative to a simple
103 ; ??? The cost numbers are somewhat arbitrary and subject to
108 ; Users of this statement.
109 ; Each element is (owner-number . owner-object),
110 ; where owner-number is an index into the initial insn table
111 ; (e.g. insn-list arg of sfrag-create-cse-mapping), and
112 ; owner-object is the corresponding object.
118 (define-getters <statement> -stmt (expr locals num speed-cost size-cost users))
120 (define-setters <statement> -stmt (users))
122 ; Make a <statement> object of EXPR.
123 ; LOCALS is a list of local variables of the sequence EXPR is in.
124 ; NUM is the ordinal of EXPR.
125 ; SPEED-COST is the cost of executing the statement, relative to a simple add.
126 ; SIZE-COST is the size of the fragment, relative to a simple add.
127 ; ??? The cost numbers are somewhat arbitrary and subject to review.
129 ; The user list is set to nil.
131 (define (-stmt-make expr locals num speed-cost size-cost)
132 (make <statement> expr locals num speed-cost size-cost nil)
135 ; Add a user of STMT.
137 (define (-stmt-add-user! stmt user-num user-obj)
138 (-stmt-set-users! stmt (cons (cons user-num user-obj) (-stmt-users stmt)))
142 ; Lookup STMT in DATA.
143 ; CHAIN-NUM is an argument so it need only be computed once.
144 ; The result is the found <statement> object or #f.
146 (define (-frag-lookup-stmt data chain-num stmt)
147 (let ((table (-stmt-data-table data)))
148 (let loop ((stmts (vector-ref table chain-num)))
151 ; ??? equal? should be appropriate rtx-equal?, blah blah blah.
152 ((equal? (-stmt-expr (car stmts)) stmt)
155 (loop (cdr stmts))))))
160 ; Computed hash value.
161 ; Global 'cus -frag-hash-compute! is defined globally so we can use
162 ; /fastcall (FIXME: Need /fastcall to work on non-global procs).
164 (define -frag-hash-value-tmp 0)
166 (define (-frag-hash-string str)
167 (let loop ((chars (map char->integer (string->list str))) (result 0))
170 (loop (cdr chars) (modulo (+ (* result 7) (car chars)) #xfffffff))))
173 (define (-frag-hash-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff)
175 (case (rtx-name expr)
177 (set! h (-frag-hash-string (symbol->string (rtx-operand-name expr)))))
179 (set! h (-frag-hash-string (symbol->string (rtx-local-name expr)))))
181 (set! h (rtx-const-value expr)))
183 (set! h (rtx-num rtx-obj))))
184 (set! -frag-hash-value-tmp
186 (modulo (+ (* -frag-hash-value-tmp 3) h op-pos)
189 ; #f -> "continue with normal traversing"
193 (define (-frag-hash-stmt stmt locals size)
194 (set! -frag-hash-value-tmp 0)
195 (rtx-traverse-with-locals #f #f stmt -frag-hash-compute! locals #f) ; FIXME: (/fastcall-make -frag-hash-compute!))
196 (modulo -frag-hash-value-tmp size)
199 ; Compute the speed/size costs of a statement.
201 ; Compute speed/size costs.
202 ; Global 'cus -frag-cost-compute! is defined globally so we can use
203 ; /fastcall (FIXME: Need /fastcall to work on non-global procs).
205 (define -frag-speed-cost-tmp 0)
206 (define -frag-size-cost-tmp 0)
208 (define (-frag-cost-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff)
212 (case (rtx-class rtx-obj)
214 #f) ; these don't contribute to costs (at least for now)
216 ; FIXME: speed/size = 0?
219 ((UNARY BINARY TRINARY)
228 (set! -frag-speed-cost-tmp (+ -frag-speed-cost-tmp speed))
229 (set! -frag-size-cost-tmp (+ -frag-size-cost-tmp size)))
231 ; #f -> "continue with normal traversing"
235 (define (-frag-stmt-cost stmt locals)
236 (set! -frag-speed-cost-tmp 0)
237 (set! -frag-size-cost-tmp 0)
238 (rtx-traverse-with-locals #f #f stmt -frag-cost-compute! locals #f) ; FIXME: (/fastcall-make -frag-cost-compute!))
239 (cons -frag-speed-cost-tmp -frag-size-cost-tmp)
242 ; Add STMT to statement table DATA.
243 ; CHAIN-NUM is the chain in the hash table to add STMT to.
244 ; {SPEED,SIZE}-COST are passed through to -stmt-make.
245 ; The result is the newly created <statement> object.
247 (define (-frag-add-stmt! data chain-num stmt locals speed-cost size-cost)
248 (let ((stmt (-stmt-make stmt locals (-stmt-data-next-num data) speed-cost size-cost))
249 (table (-stmt-data-table data)))
250 (vector-set! table chain-num (cons stmt (vector-ref table chain-num)))
251 (-stmt-data-set-next-num! data (+ 1 (-stmt-data-next-num data)))
255 ; Return the locals in EXPR.
256 ; If a sequence, return locals.
257 ; Otherwise, return nil.
258 ; The result is in assq'able form.
260 (define (-frag-expr-locals expr)
261 (if (rtx-kind? 'sequence expr)
262 (rtx-sequence-assq-locals expr)
266 ; Return the statements in EXPR.
267 ; If a sequence, return the sequence's expressions.
268 ; Otherwise, return (list expr).
270 (define (-frag-expr-stmts expr)
271 (if (rtx-kind? 'sequence expr)
272 (rtx-sequence-exprs expr)
276 ; Analyze statement STMT.
277 ; If STMT is already in STMT-DATA increment its frequency count.
279 ; LOCALS are locals of the sequence STMT is in.
280 ; USAGE-TABLE is a vector of statement index lists for each expression.
281 ; USAGE-INDEX is the index of USAGE-TABLE to use.
282 ; OWNER is the object of the owner of the statement.
284 (define (-frag-analyze-expr-stmt! locals stmt stmt-data usage-table expr-num owner)
285 (logit 3 "Analyzing statement: " (rtx-strdump stmt) "\n")
287 (-frag-hash-stmt stmt locals (-stmt-data-hash-size stmt-data)))
288 (stmt-obj (-frag-lookup-stmt stmt-data chain-num stmt)))
290 (logit 3 " chain #" chain-num "\n")
293 (let* ((costs (-frag-stmt-cost stmt locals))
294 (speed-cost (car costs))
295 (size-cost (cdr costs)))
296 (set! stmt-obj (-frag-add-stmt! stmt-data chain-num stmt locals
297 speed-cost size-cost))
298 (logit 3 " new statement, #" (-stmt-num stmt-obj) "\n"))
299 (logit 3 " existing statement, #" (-stmt-num stmt-obj) "\n"))
301 (-stmt-add-user! stmt-obj expr-num owner)
303 ; If first entry, initialize list, otherwise append to existing list.
304 (if (null? (vector-ref usage-table expr-num))
305 (vector-set! usage-table expr-num (list (-stmt-num stmt-obj)))
306 (append! (vector-ref usage-table expr-num)
307 (list (-stmt-num stmt-obj)))))
312 ; Analyze each statement in EXPR and add it to STMT-DATA.
313 ; OWNER is the object of the owner of the expression.
314 ; USAGE-TABLE is a vector of statement index lists for each expression.
315 ; USAGE-INDEX is the index of the USAGE-TABLE entry to use.
316 ; As each statement's ordinal is computed it is added to the usage list.
318 (define (-frag-analyze-expr! expr owner stmt-data usage-table usage-index)
319 (logit 3 "Analyzing " (obj:name owner) ": " (rtx-strdump expr) "\n")
320 (let ((locals (-frag-expr-locals expr))
321 (stmt-list (-frag-expr-stmts expr)))
322 (for-each (lambda (stmt)
323 (-frag-analyze-expr-stmt! locals stmt stmt-data
324 usage-table usage-index owner))
329 ; Compute statement data from EXPRS, a list of expressions.
330 ; OWNERS is a vector of objects that "own" each corresponding element in EXPRS.
331 ; The owner is usually an <insn> object. Actually it'll probably always be
332 ; an <insn> object but for now I want the disassociation.
334 ; The result contains:
335 ; - vector of statement lists of each expression
336 ; - each element is (stmt1-index stmt2-index ...) where each stmtN-index is
337 ; an index into the statement table
338 ; - vector of statements (the statement table of the previous item)
339 ; - each element is a <statement> object
341 (define (-frag-compute-statements exprs owners)
342 (logit 2 "Computing statement table ...\n")
343 (let* ((num-exprs (length exprs))
345 ; FIXME: This is just a quick hack to put something down on paper.
346 ; blah blah blah. Revisit as necessary.
347 (cond ((> num-exprs 300) 1019)
348 ((> num-exprs 100) 511)
351 (let (; Hash table of expressions.
352 (stmt-data (-stmt-data-make hash-size))
353 ; Statement index lists for each expression.
354 (usage-table (make-vector num-exprs nil)))
356 ; Scan each expr, filling in stmt-data and usage-table.
357 (let loop ((exprs exprs) (exprnum 0))
358 (if (not (null? exprs))
359 (let ((expr (car exprs))
360 (owner (vector-ref owners exprnum)))
361 (-frag-analyze-expr! expr owner stmt-data usage-table exprnum)
362 (loop (cdr exprs) (+ exprnum 1)))))
364 ; Convert statement hash table to vector.
365 (let ((stmt-hash-table (-stmt-data-table stmt-data))
366 (end (vector-length (-stmt-data-table stmt-data)))
367 (stmt-table (make-vector (-stmt-data-next-num stmt-data) #f)))
372 (vector-set! stmt-table (-stmt-num stmt) stmt))
373 (vector-ref stmt-hash-table i))
376 ; All done. Compute stats if asked to.
379 ; See how well the hashing worked.
380 (set! -stmt-stats-data stmt-data)
382 (make-vector (vector-length stmt-hash-table) #f))
386 (vector-set! -stmt-stats i
387 (length (vector-ref stmt-hash-table i)))
391 (cons usage-table stmt-table))))
394 ; Semantic fragment selection.
396 ; "semantic fragment" is the name assigned to each header/middle/trailer
397 ; "fragment" as each may consist of more than one statement, though not
398 ; necessarily all statements of the original sequence.
401 (class-make '<sfrag> '(<ident>)
403 ; List of insn's using this frag.
406 ; Ordinal's of each element of `users'.
409 ; Semantic format of insns using this fragment.
412 ; List of statement numbers that make up `semantics'.
413 ; Each element is an index into the stmt-table arg of
415 ; This is #f if the sfrag wasn't derived from some set of
419 ; Raw rtl source of fragment.
425 ; Boolean indicating if this frag is for parallel exec support.
428 ; Boolean indicating if this is a header frag.
429 ; This includes all frags that begin a sequence.
432 ; Boolean indicating if this is a trailer frag.
433 ; This includes all frags that end a sequence.
439 (define-getters <sfrag> sfrag
440 (users user-nums sfmt stmt-numbers semantics compiled-semantics
441 parallel? header? trailer?)
444 (define-setters <sfrag> sfrag
448 ; Sorter to merge common fragments together.
449 ; A and B are lists of statement numbers.
451 (define (-frag-sort a b)
461 (-frag-sort (cdr a) (cdr b))))
464 ; Return a boolean indicating if L1,L2 match in the first LEN elements.
465 ; Each element is an integer.
467 (define (-frag-list-match? l1 l2 len)
470 ((or (null? l1) (null? l2))
472 ((= (car l1) (car l2))
473 (-frag-list-match? (cdr l1) (cdr l2) (- len 1)))
478 ; Return the number of expressions that match in the first LEN statements.
480 (define (-frag-find-matching expr-table indices stmt-list len)
481 (let loop ((num-exprs 0) (indices indices))
482 (cond ((null? indices)
484 ((-frag-list-match? stmt-list
485 (vector-ref expr-table (car indices)) len)
486 (loop (+ num-exprs 1) (cdr indices)))
491 ; Return a boolean indicating if making STMT-LIST a common fragment
492 ; among several owners is profitable.
493 ; STMT-LIST is a list of statement numbers, indices into STMT-TABLE.
494 ; NUM-EXPRS is the number of expressions with STMT-LIST in common.
496 (define (-frag-merge-profitable? stmt-table stmt-list num-exprs)
498 (and (>= num-exprs 2)
499 (or ; No need to include speed costs yet.
500 ;(>= (-frag-list-speed-cost stmt-table stmt-list) 10)
501 (>= (-frag-list-size-cost stmt-table stmt-list) 4)))
504 ; Return the cost of executing STMT-LIST.
505 ; STMT-LIST is a list of statment numbers, indices into STMT-TABLE.
507 ; FIXME: The yardstick to use is wip. Currently we measure things relative
508 ; to a simple add insn which is given the value 1.
510 (define (-frag-list-speed-cost stmt-table stmt-list)
512 (apply + (map (lambda (stmt-num)
513 (-stmt-speed-cost (vector-ref stmt-table stmt-num)))
517 (define (-frag-list-size-cost stmt-table stmt-list)
519 (apply + (map (lambda (stmt-num)
520 (-stmt-size-cost (vector-ref stmt-table stmt-num)))
524 ; Compute the longest set of fragments it is desirable/profitable to create.
525 ; The result is (number-of-matching-exprs . stmt-number-list)
526 ; or #f if there isn't one (the longest set is the empty set).
528 ; What is desirable depends on a few things:
529 ; - how often is it used?
530 ; - how expensive is it (size-wise and speed-wise)
531 ; - relationship to other frags
533 ; STMT-TABLE is a vector of all statements.
534 ; STMT-USAGE-TABLE is a vector of all expressions. Each element is a list of
535 ; statement numbers (indices into STMT-TABLE).
536 ; INDICES is a sorted list of indices into STMT-USAGE-TABLE.
537 ; STMT-USAGE-TABLE is processed in the order specified by INDICES.
539 ; FIXME: Choosing a statement list should depend on whether there are existing
540 ; chosen statement lists only slightly shorter.
542 (define (-frag-longest-desired stmt-table stmt-usage-table indices)
543 ; STMT-LIST is the list of statements in the first expression.
544 (let ((stmt-list (vector-ref stmt-usage-table (car indices))))
546 (let loop ((len 1) (prev-num-exprs 0))
548 ; See how many subsequent expressions match at length LEN.
549 (let ((num-exprs (-frag-find-matching stmt-usage-table (cdr indices)
551 ; If there aren't any, we're done.
552 ; If LEN-1 is usable, return that.
553 ; Otherwise there is no profitable list of fragments.
556 (let ((matching-stmt-list (list-take (- len 1) stmt-list)))
557 (if (-frag-merge-profitable? stmt-table matching-stmt-list
559 (cons prev-num-exprs matching-stmt-list)
562 ; Found at least 1 subsequent matching expression.
563 ; Extend LEN and see if we still find matching expressions.
564 (loop (+ len 1) num-exprs)))))
567 ; Return list of lists of objects for each unique <sformat-argbuf> in
569 ; Each element of USER-LIST is (insn-num . <insn> object).
570 ; The result is a list of lists. Each element in the top level list is
571 ; a list of elements of USER-LIST that have the same <sformat-argbuf>.
572 ; Insns are also distinguished by being a CTI insn vs a non-CTI insn.
573 ; CTI insns require special handling in the semantics.
575 (define (-frag-split-by-sbuf user-list)
577 (if (not (elm-bound? (cdar user-list) 'sfmt))
578 (error "sformats not computed"))
579 (if (not (elm-bound? (insn-sfmt (cdar user-list)) 'sbuf))
580 (error "sformat argbufs not computed"))
583 ; Find INSN in SFMT-LIST. The result is the list INSN belongs in
585 (find-obj (lambda (sbuf-list insn)
586 (let ((name (obj:name (sfmt-sbuf (insn-sfmt insn)))))
587 (let loop ((sbuf-list sbuf-list))
588 (cond ((null? sbuf-list)
591 (obj:name (sfmt-sbuf (insn-sfmt (cdaar sbuf-list)))))
592 (eq? (insn-cti? insn)
593 (insn-cti? (cdaar sbuf-list))))
596 (loop (cdr sbuf-list))))))))
598 (let loop ((users user-list))
599 (if (not (null? users))
600 (let ((try (find-obj result (cdar users))))
602 (append! try (list (car users)))
603 (set! result (cons (list (car users)) result)))
604 (loop (cdr users)))))
610 ; Return a list of desired fragments to create.
611 ; These consist of the longest set of profitable leading statements in EXPRS.
612 ; Each element of the result is an <sfrag> object.
614 ; STMT-TABLE is a vector of all statements.
615 ; STMT-USAGE-TABLE is a vector of statement number lists of each expression.
616 ; OWNER-TABLE is a vector of owner objects of each corresponding expression
617 ; in STMT-USAGE-TABLE.
618 ; KIND is one of 'header or 'trailer.
620 ; This works for trailing fragments too as we do the computation based on the
621 ; reversed statement lists.
623 (define (-frag-compute-desired-frags stmt-table stmt-usage-table owner-table kind)
624 (logit 2 "Computing desired " kind " frags ...\n")
628 (if (eq? kind 'header)
629 (vector->list stmt-usage-table)
630 (map reverse (vector->list stmt-usage-table))))
631 ; Sort STMT-USAGE-TABLE. That will bring exprs with common fragments
633 (sorted-indices (sort-grade stmt-usage-list -frag-sort))
634 ; List of statement lists that together yield the fragment to create,
635 ; plus associated users.
639 ; Update STMT-USAGE-TABLE in case we reversed the contents.
640 (set! stmt-usage-table (list->vector stmt-usage-list))
642 (let loop ((indices sorted-indices) (iteration 1))
643 (logit 3 "Iteration " iteration "\n")
644 (if (not (null? indices))
645 (let ((longest (-frag-longest-desired stmt-table stmt-usage-table indices)))
649 ; Found an acceptable frag to create.
650 (let* ((num-exprs (car longest))
651 ; Reverse statement numbers back if trailer.
652 (stmt-list (if (eq? kind 'header)
654 (reverse (cdr longest))))
655 (picked-indices (list-take num-exprs indices))
656 ; Need one copy of the frag for each sbuf, as structure
657 ; offsets will be different in generated C/C++ code.
658 (sfmt-users (-frag-split-by-sbuf
659 (map (lambda (expr-num)
661 (vector-ref owner-table
665 (logit 3 "Creating frag of length " (length stmt-list) ", " num-exprs " users\n")
666 (logit 3 "Indices: " picked-indices "\n")
668 ; Create an sfrag for each sbuf.
671 (let* ((first-owner (cdar users))
674 (symbol-append (obj:name first-owner)
675 (if (eq? kind 'header)
682 (insn-sfmt first-owner)
689 (map (lambda (stmt-num)
691 (vector-ref stmt-table
694 #f ; compiled-semantics
699 (set! desired-frags (cons sfrag desired-frags))))
702 ; Continue, dropping statements we've put into the frag.
703 (loop (list-drop num-exprs indices) (+ iteration 1)))
705 ; Couldn't find an acceptable statement list.
706 ; Try again with next one.
708 (logit 3 "No acceptable frag found.\n")
709 (loop (cdr indices) (+ iteration 1)))))))
715 ; Return the set of desired fragments to create.
716 ; STMT-TABLE is a vector of each statement.
717 ; STMT-USAGE-TABLE is a vector of (stmt1-index stmt2-index ...) elements for
718 ; each expression, where each stmtN-index is an index into STMT-TABLE.
719 ; OWNER-TABLE is a vector of owner objects of each corresponding expression
720 ; in STMT-USAGE-TABLE.
722 ; Each expression is split in up to three pieces: header, middle, trailer.
723 ; This computes pseudo-optimal headers and trailers (if they exist).
724 ; The "middle" part is whatever is leftover.
726 ; The result is a vector of 4 elements:
727 ; - vector of (header middle trailer) semantic fragments for each expression
728 ; - each element is an index into the respective table or #f if not present
729 ; - list of header fragments, each element is an <sfrag> object
730 ; - same but for trailer fragments
731 ; - same but for middle fragments
733 ; ??? While this is a big function, each piece is simple and straightforward.
734 ; It's kept as one big function so we can compute each expression's sfrag list
735 ; as we go. Though it's not much extra expense to not do this.
737 (define (-frag-pick-best stmt-table stmt-usage-table owner-table)
739 (num-stmts (vector-length stmt-table))
740 (num-exprs (vector-length stmt-usage-table))
741 ; FIXME: Shouldn't have to do vector->list.
742 (stmt-usage-list (vector->list stmt-usage-table))
743 ; Specify result holders here, simplifies code.
744 (desired-header-frags #f)
745 (desired-trailer-frags #f)
747 ; Also allocate space for expression sfrag usage table.
748 ; We compute it as we go to save scanning the header and trailer
750 ; copy-tree is needed to avoid shared storage.
751 (expr-sfrags (copy-tree (make-vector (vector-length stmt-usage-table)
755 ; Compute desired headers.
756 (set! desired-header-frags
757 (-frag-compute-desired-frags stmt-table stmt-usage-table owner-table
760 ; Compute the header used by each expression.
761 (let ((expr-hdrs-v (make-vector num-exprs #f))
762 (num-hdrs (length desired-header-frags)))
763 (let loop ((hdrs desired-header-frags) (hdrnum 0))
764 (if (< hdrnum num-hdrs)
765 (let ((hdr (car hdrs)))
766 (for-each (lambda (expr-num)
767 (vector-set! (vector-ref expr-sfrags expr-num) 0
769 (vector-set! expr-hdrs-v expr-num hdr))
770 (sfrag-user-nums hdr))
771 (loop (cdr hdrs) (+ hdrnum 1)))))
773 ; Truncate each expression by the header it will use and then find
774 ; the set of desired trailers.
775 (let ((expr-hdrs (vector->list expr-hdrs-v)))
777 (set! desired-trailer-frags
778 (-frag-compute-desired-frags
780 ; FIXME: Shouldn't have to use list->vector.
781 ; [still pass a vector, but use vector-map here instead of map]
783 (map (lambda (expr hdr)
785 (list-drop (length (sfrag-stmt-numbers hdr)) expr)
787 stmt-usage-list expr-hdrs))
791 ; Record the trailer used by each expression.
792 (let ((expr-trlrs-v (make-vector num-exprs #f))
793 (num-trlrs (length desired-trailer-frags)))
794 (let loop ((trlrs desired-trailer-frags) (trlrnum 0))
795 (if (< trlrnum num-trlrs)
796 (let ((trlr (car trlrs)))
797 (for-each (lambda (expr-num)
798 (vector-set! (vector-ref expr-sfrags expr-num) 2
800 (vector-set! expr-trlrs-v expr-num trlr))
801 (sfrag-user-nums trlr))
802 (loop (cdr trlrs) (+ trlrnum 1)))))
804 ; We have the desired headers and trailers, now compute the middle
805 ; part for each expression. This is just what's left over.
806 ; ??? We don't try to cse the middle part. Though we can in the
807 ; future should it prove useful enough.
808 (logit 2 "Computing middle frags ...\n")
809 (let* ((expr-trlrs (vector->list expr-trlrs-v))
811 (map (lambda (expr hdr trlr)
813 (if trlr (length (sfrag-stmt-numbers trlr)) 0)
815 (if hdr (length (sfrag-stmt-numbers hdr)) 0)
817 stmt-usage-list expr-hdrs expr-trlrs)))
819 ; Finally, record the middle sfrags used by each expression.
820 (let loop ((tmp-middle-frags nil)
821 (next-middle-frag-num 0)
823 (expr-middle-stmts expr-middle-stmts))
825 (if (null? expr-middle-stmts)
828 ; [The next statement executed after this is the one at the
829 ; end that builds the result. Maybe it should be built here
830 ; and this should be the last statement, but I'm trying this
831 ; style out for awhile.]
832 (set! middle-frags (reverse! tmp-middle-frags))
834 ; Does this expr have a middle sfrag?
835 (if (null? (car expr-middle-stmts))
837 (loop tmp-middle-frags
840 (cdr expr-middle-stmts))
842 (let ((owner (vector-ref owner-table expr-num)))
843 (vector-set! (vector-ref expr-sfrags expr-num)
844 1 next-middle-frag-num)
845 (loop (cons (make <sfrag>
846 (symbol-append (obj:name owner) '-mid)
847 (string-append (obj:comment owner)
853 (car expr-middle-stmts)
859 (map (lambda (stmt-num)
861 (vector-ref stmt-table stmt-num)))
862 (car expr-middle-stmts))))))
863 #f ; compiled-semantics
869 (+ next-middle-frag-num 1)
871 (cdr expr-middle-stmts))))))))))
876 desired-trailer-frags
880 ; Given a list of expressions, return list of locals in top level sequences.
881 ; ??? Collisions will be handled by rewriting rtl (renaming locals).
883 ; This has to be done now as the cse pass must (currently) take into account
885 ; ??? This can be done later, with an appropriate enhancement to rtx-equal?
886 ; ??? cse can be improved by ignoring local variable name (of course).
888 (define (-frag-compute-locals! expr-list)
889 (logit 2 "Computing common locals ...\n")
891 (lookup-local (lambda (local local-list)
892 (assq (car local) local-list)))
893 (local-equal? (lambda (l1 l2)
894 (and (eq? (car l1) (car l2))
895 (mode:eq? (cadr l1) (cadr l2)))))
897 (for-each (lambda (expr)
898 (let ((locals (-frag-expr-locals expr)))
899 (for-each (lambda (local)
900 (let ((entry (lookup-local local result)))
902 (local-equal? local entry))
904 (set! result (cons local result)))))
911 ; Common subexpression computation.
913 ; Given a list of rtl expressions and their owners, return a pseudo-optimal
914 ; set of fragments and a usage list for each owner.
915 ; Common fragments are combined and the original expressions become a sequence
916 ; of these fragments. The result is "pseudo-optimal" in the sense that the
917 ; desired result is somewhat optimal, though no attempt is made at precise
920 ; OWNERS is a list of objects that "own" each corresponding element in EXPRS.
921 ; The owner is usually an <insn> object. Actually it'll probably always be
922 ; an <insn> object but for now I want the disassociation.
924 ; The result is a vector of six elements:
925 ; - sfrag usage table for each owner #(header middle trailer)
926 ; - statement table (vector of all statements, made with -stmt-make)
927 ; - list of sequence locals used by header sfrags
928 ; - these locals are defined at the top level so that all fragments have
930 ; - ??? Need to handle collisions among incompatible types.
935 (define (-sem-find-common-frags-1 exprs owners)
937 (if (not (elm-bound? (car owners) 'sfmt))
938 (error "sformats not computed"))
940 ; A simple procedure that calls, in order:
941 ; -frag-compute-locals!
942 ; -frag-compute-statements
944 ; The rest is shuffling of results.
946 ; Internally it's easier if OWNERS is a vector.
947 (let ((owners (list->vector owners))
948 (locals (-frag-compute-locals! exprs)))
950 ; Collect statement usage data.
951 (let ((stmt-usage (-frag-compute-statements exprs owners)))
952 (let ((stmt-usage-table (car stmt-usage))
953 (stmt-table (cdr stmt-usage)))
955 ; Compute the frags we want to create.
956 ; These are in general sequences of statements.
958 (-frag-pick-best stmt-table stmt-usage-table owners)))
960 (expr-sfrags (vector-ref desired-frags 0))
961 (headers (vector-ref desired-frags 1))
962 (trailers (vector-ref desired-frags 2))
963 (middles (vector-ref desired-frags 3))
966 (vector expr-sfrags stmt-table locals
967 headers trailers middles))))))
970 ; Cover proc of -sem-find-common-frags-1.
971 ; See its documentation.
973 (define (sem-find-common-frags insn-list)
974 (-sem-find-common-frags-1
976 (logit 2 "Simplifying/canonicalizing rtl ...\n")
978 ; Must pass canonicalized and macro-expanded rtl.
979 (rtx-simplify #f insn (insn-semantics insn)
980 (-build-known-values insn)))
985 ; Subroutine of sfrag-create-cse-mapping to compute INSN's fragment list.
986 ; FRAG-USAGE is a vector of 3 elements: #(header middle trailer).
987 ; Each element is a fragment number or #f if not present.
988 ; Numbers in FRAG-USAGE are indices relative to their respective subtables
989 ; of FRAG-TABLE (which is a vector of all 3 tables concatenated together).
990 ; NUM-HEADERS,NUM-TRAILERS are used to compute absolute indices.
992 ; No header may have been created. This happens when
993 ; it's not profitable (or possible) to merge this insn's
994 ; leading statements with other insns. Ditto for
995 ; trailer. However, each cti insn must have a header
996 ; and a trailer (for pc handling setup and change).
997 ; Try to use the middle fragment if present. Otherwise,
998 ; use the x-header,x-trailer virtual insns.
1000 (define (-sfrag-compute-frag-list! insn frag-usage frag-table num-headers num-trailers x-header-relnum x-trailer-relnum)
1001 ; `(list #f)' is so append! works. The #f is deleted before returning.
1002 (let ((result (list #f))
1003 (header (vector-ref frag-usage 0))
1004 (middle (and (vector-ref frag-usage 1)
1005 (+ (vector-ref frag-usage 1)
1006 num-headers num-trailers)))
1007 (trailer (and (vector-ref frag-usage 2)
1008 (+ (vector-ref frag-usage 2)
1010 (x-header-num x-header-relnum)
1011 (x-trailer-num (+ x-trailer-relnum num-headers))
1014 ; cse'd header created?
1017 (append! result (list header))
1018 ; Nope. Use the middle frag if present, otherwise use x-header.
1019 ; Can't use the trailer fragment because by definition it is shared
1020 ; among several insns.
1022 ; Mark the middle frag as the header frag.
1023 (sfrag-set-header?! (vector-ref frag-table middle) #t)
1024 ; No middle, use x-header.
1025 (append! result (list x-header-num))))
1027 ; middle fragment present?
1029 (append! result (list middle)))
1031 ; cse'd trailer created?
1034 (append! result (list trailer))
1035 ; Nope. Use the middle frag if present, otherwise use x-trailer.
1036 ; Can't use the header fragment because by definition it is shared
1037 ; among several insns.
1039 ; Mark the middle frag as the trailer frag.
1040 (sfrag-set-trailer?! (vector-ref frag-table middle) #t)
1041 ; No middle, use x-trailer.
1042 (append! result (list x-trailer-num))))
1048 ; Subroutine of sfrag-create-cse-mapping to find the fragment number of the
1049 ; x-header/x-trailer virtual frags.
1051 (define (-frag-lookup-virtual frag-list name)
1052 (let loop ((i 0) (frag-list frag-list))
1053 (if (null? frag-list)
1054 (assert (not "expected virtual insn not present"))
1055 (if (eq? name (obj:name (car frag-list)))
1057 (loop (+ i 1) (cdr frag-list)))))
1060 ; Handle complex case, find set of common header and trailer fragments.
1061 ; The result is a vector of:
1062 ; - fragment table (a vector)
1063 ; - table mapping used fragments for each insn (a list)
1066 (define (sfrag-create-cse-mapping insn-list)
1067 (logit 1 "Creating semantic fragments for pbb engine ...\n")
1069 (let ((cse-data (sem-find-common-frags insn-list)))
1071 ; Extract the results of sem-find-common-frags.
1072 (let ((sfrag-usage-table (vector-ref cse-data 0))
1073 (stmt-table (vector-ref cse-data 1))
1074 (locals-list (vector-ref cse-data 2))
1075 (header-list1 (vector-ref cse-data 3))
1076 (trailer-list1 (vector-ref cse-data 4))
1077 (middle-list (vector-ref cse-data 5)))
1079 ; Create two special frags: x-header, x-trailer.
1080 ; These are used by insns that don't have one or the other.
1081 ; Header/trailer table indices are already computed for each insn
1082 ; so append x-header/x-trailer to the end.
1084 (append header-list1
1088 "header fragment for insns without one"
1089 (atlist-parse '(VIRTUAL) "" "semantic frag computation")
1092 (insn-sfmt (current-insn-lookup 'x-before))
1095 #f ; compiled-semantics
1101 (append trailer-list1
1105 "trailer fragment for insns without one"
1106 (atlist-parse '(VIRTUAL) "" "semantic frag computation")
1109 (insn-sfmt (current-insn-lookup 'x-before))
1112 #f ; compiled-semantics
1118 (let ((num-headers (length header-list))
1119 (num-trailers (length trailer-list))
1120 (num-middles (length middle-list)))
1122 ; Combine the three sfrag tables (headers, trailers, middles) into
1124 (let ((frag-table (list->vector (append header-list
1127 (x-header-relnum (-frag-lookup-virtual header-list 'x-header))
1128 (x-trailer-relnum (-frag-lookup-virtual trailer-list 'x-trailer))
1130 ; Convert sfrag-usage-table to one that refers to the one big
1132 (logit 2 "Computing insn frag usage ...\n")
1134 (map (lambda (insn frag-usage)
1135 (-sfrag-compute-frag-list! insn frag-usage
1137 num-headers num-trailers
1141 ; FIXME: vector->list
1142 (vector->list sfrag-usage-table)))
1144 (logit 1 "Done fragment creation.\n")
1145 (vector frag-table insn-frags locals-list)))))))
1148 ; Data analysis interface.
1150 (define -sim-sfrag-init? #f)
1151 (define (sim-sfrag-init?) -sim-sfrag-init?)
1153 ; Keep in globals for now, simplifies debugging.
1154 ; evil globals, blah blah blah.
1155 (define -sim-sfrag-insn-list #f)
1156 (define -sim-sfrag-frag-table #f)
1157 (define -sim-sfrag-usage-table #f)
1158 (define -sim-sfrag-locals-list #f)
1160 (define (sim-sfrag-insn-list)
1161 (assert -sim-sfrag-init?)
1162 -sim-sfrag-insn-list
1164 (define (sim-sfrag-frag-table)
1165 (assert -sim-sfrag-init?)
1166 -sim-sfrag-frag-table
1168 (define (sim-sfrag-usage-table)
1169 (assert -sim-sfrag-init?)
1170 -sim-sfrag-usage-table
1172 (define (sim-sfrag-locals-list)
1173 (assert -sim-sfrag-init?)
1174 -sim-sfrag-locals-list
1177 (define (sim-sfrag-init!)
1178 (set! -sim-sfrag-init? #f)
1179 (set! -sim-sfrag-insn-list #f)
1180 (set! -sim-sfrag-frag-table #f)
1181 (set! -sim-sfrag-usage-table #f)
1182 (set! -sim-sfrag-locals-list #f)
1185 (define (sim-sfrag-analyze-insns!)
1186 (if (not -sim-sfrag-init?)
1188 (set! -sim-sfrag-insn-list (non-multi-insns (non-alias-insns (current-insn-list))))
1189 (let ((frag-data (sfrag-create-cse-mapping -sim-sfrag-insn-list)))
1190 (set! -sim-sfrag-frag-table (vector-ref frag-data 0))
1191 (set! -sim-sfrag-usage-table (vector-ref frag-data 1))
1192 (set! -sim-sfrag-locals-list (vector-ref frag-data 2)))
1193 (set! -sim-sfrag-init? #t)))
1200 (define (-frag-small-test-data)
1202 (a . (sequence VOID ((SI tmp)) (set DFLT tmp rm) (set DFLT rd rm)))
1203 (b . (sequence VOID ((SI tmp)) (set DFLT tmp rm) (set DFLT rd rm)))
1204 (c . (set DFLT rd rm))
1208 (define (-frag-test-data)
1211 ; Must pass canonicalized and macro-expanded rtl.
1212 (rtx-simplify #f insn (insn-semantics insn)
1213 (-build-known-values insn)))
1214 (non-multi-insns (non-alias-insns (current-insn-list))))
1215 (non-multi-insns (non-alias-insns (current-insn-list))))
1218 (define test-sfrag-table #f)
1219 (define test-stmt-table #f)
1220 (define test-locals-list #f)
1221 (define test-header-list #f)
1222 (define test-trailer-list #f)
1223 (define test-middle-list #f)
1225 (define (frag-test-run)
1226 (let* ((test-data (-frag-test-data))
1227 (frag-data (sem-find-common-frags (car test-data) (cdr test-data))))
1228 (set! test-sfrag-table (vector-ref frag-data 0))
1229 (set! test-stmt-table (vector-ref frag-data 1))
1230 (set! test-locals-list (vector-ref frag-data 2))
1231 (set! test-header-list (vector-ref frag-data 3))
1232 (set! test-trailer-list (vector-ref frag-data 4))
1233 (set! test-middle-list (vector-ref frag-data 5))