1 ! Copyright (C) 2009, 2011 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators
4 combinators.short-circuit compiler.cfg compiler.cfg.instructions
5 compiler.cfg.linear-scan.allocation.state
6 compiler.cfg.linear-scan.assignment compiler.cfg.parallel-copy
7 compiler.cfg.predecessors compiler.cfg.registers
8 compiler.cfg.rpo compiler.cfg.utilities cpu.architecture kernel
9 make namespaces sequences ;
10 IN: compiler.cfg.linear-scan.resolve
15 { reg-class read-only } ;
17 : <location> ( reg rep -- location )
18 dup reg-class-of location boa ;
22 { [ [ reg>> ] same? ] [ [ reg-class>> ] same? ] } 2&&
30 : temp-spill ( rep -- spill-slot )
31 rep-size temp-spills get
32 [ cfg get stack-frame>> next-spill-slot ] cache ;
34 SYMBOL: temp-locations
36 : temp-location ( loc -- temp )
37 rep>> temp-locations get
38 [ [ temp-spill ] keep <location> ] cache ;
41 H{ } clone temp-spills set
42 H{ } clone temp-locations set ;
44 : add-mapping ( from to rep -- )
45 '[ _ <location> ] bi@ 2array , ;
47 :: resolve-value-data-flow ( vreg live-out live-in edge-live-in -- )
48 vreg live-out ?at [ bad-vreg ] unless
49 vreg live-in ?at [ edge-live-in ?at [ bad-vreg ] unless ] unless
50 2dup = [ 2drop ] [ vreg rep-of add-mapping ] if ;
52 :: compute-mappings ( bb to -- mappings )
53 bb machine-live-out :> live-out
54 to machine-live-in :> live-in
55 bb to machine-edge-live-in :> edge-live-in
56 live-out assoc-empty? [ f ] [
58 live-in keys edge-live-in keys append [
59 live-out live-in edge-live-in
60 resolve-value-data-flow
65 : memory->register ( from to -- )
66 swap [ reg>> ] [ [ rep>> ] [ reg>> ] bi ] bi* ##reload, ;
68 : register->memory ( from to -- )
69 [ [ reg>> ] [ rep>> ] bi ] [ reg>> ] bi* ##spill, ;
71 : register->register ( from to -- )
72 swap [ reg>> ] [ [ reg>> ] [ rep>> ] bi ] bi* ##copy, ;
74 : >insn ( from to -- )
76 { [ over reg>> spill-slot? ] [ memory->register ] }
77 { [ dup reg>> spill-slot? ] [ register->memory ] }
78 [ register->register ]
81 : mapping-instructions ( alist -- insns )
82 [ swap ] H{ } assoc-map-as [
83 [ temp-location ] [ swap >insn ] parallel-mapping
87 : perform-mappings ( bb to mappings -- )
89 mapping-instructions insert-basic-block
93 : resolve-edge-data-flow ( bb to -- )
94 2dup compute-mappings perform-mappings ;
96 : resolve-block-data-flow ( bb -- )
97 dup kill-block?>> [ drop ] [
98 dup successors>> [ resolve-edge-data-flow ] with each
101 : resolve-data-flow ( cfg -- )
103 [ needs-predecessors ]
104 [ [ resolve-block-data-flow ] each-basic-block ] bi ;