1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs compiler.cfg compiler.cfg.debugger
4 compiler.cfg.def-use compiler.cfg.linearization compiler.cfg.registers
5 compiler.cfg.representations.preferred compiler.cfg.rpo
6 compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.utilities
7 compiler.tree.builder compiler.tree.checker compiler.tree.def-use
8 compiler.tree.normalization compiler.tree.propagation
9 compiler.tree.propagation.info compiler.tree.recursive compiler.units
10 hashtables kernel math namespaces sequences stack-checker
11 tools.test vectors vocabs words ;
14 : decompile ( word -- )
15 dup def>> 2array 1array t t modify-code-heap ;
17 : recompile-all ( -- )
20 : compile-call ( quot -- )
21 [ dup infer define-temp ] with-compilation-unit execute ;
23 << \ compile-call t "no-compile" set-word-prop >>
25 : init-cfg-test ( -- )
26 reset-vreg-counter begin-stack-analysis
27 <basic-block> dup basic-block set begin-local-analysis
28 H{ } clone representations set
29 H{ } clone replaces set ;
31 : cfg-unit-test ( result quot -- )
32 '[ init-cfg-test @ ] unit-test ; inline
35 [ get ] bi@ 1vector >>successors drop ;
37 : edges ( from tos -- )
38 [ get ] [ [ get ] V{ } map-as ] bi* >>successors drop ;
46 : resolve-phis ( bb -- )
48 [ [ [ get ] dip ] assoc-map ] change-inputs drop
51 : test-bb ( insns n -- )
52 [ insns>block dup ] keep set resolve-phis ;
54 : fake-representations ( cfg -- )
57 [ [ temp-vregs ] [ temp-vreg-reps ] bi zip ]
58 [ [ defs-vregs ] [ defs-vreg-reps ] bi zip ]
61 ] map concat >hashtable representations set ;
63 : count-insns ( quot insn-check -- ? )
64 [ test-regs [ cfg>insns ] map concat ] dip count ; inline
66 : contains-insn? ( quot insn-check -- ? )
67 count-insns 0 > ; inline
69 : make-edges ( block-map edgelist -- )
70 [ [ of ] with map first2 connect-bbs ] with each ;
72 : final-info ( quot -- seq )
79 last node-input-infos ;
81 : final-classes ( quot -- seq )
82 final-info [ class>> ] map ;
84 : final-literals ( quot -- seq )
85 final-info [ literal>> ] map ;