Forgot your password?
Document Actions
SETL Optimizer
Stefan M. Freudenberger, Art Grand, Jacob T. Schwartz, Micha Sharir, Leonard Vanek. SETL optimizer. Given to Annie Liu by Jack Schwartz on 4 February 2009.
1 .=member intro
2 .title 'setl optimizer'
3$
4$
5$ ssssssss eeeeeeeeee tttttttttt ll
6$ ssssssssss eeeeeeeeee tttttttttt ll
7$ ss ss ee tt ll
8$ ss ee tt ll
9$ sssssssss eeeeee tt ll
10$ sssssssss eeeeee tt ll
11$ ss ee tt ll
12$ ss ss ee tt ll
13$ ssssssssss eeeeeeeeee tt llllllllll
14$ ssssssss eeeeeeeeee tt llllllllll
15$
16$
17$ oooooooo ppppppppp tttttttttt
18$ oooooooooo pppppppppp tttttttttt
19$ oo oo pp pp tt
20$ oo oo pp pp tt
21$ oo oo pppppppppp tt
22$ oo oo ppppppppp tt
23$ oo oo pp tt
24$ oo oo pp tt
25$ oooooooooo pp tt
26$ oooooooo pp tt
27$
28$
29$ t h e s e t l o p t i m i z e r
30$
31$
32$ stefan m. freudenberger
33$ art grand
34$ jacob t. schwartz
35$ micha sharir
36$ leonard vanek
37$
38$
39$ this software is part of the setl programming system
40$ address queries and comments to
41$
42$ setl project
43$ department of computer science
44$ new york university
45$ courant institute of mathematical sciences
46$ 251 mercer street
47$ new york, ny 10012
48$
49$
50$
51$
52$ table of contents
53$ ----- -- --------
54$
55$ 1. intent of the optimiser
56$
57$ 2. data structures
58$
59$ 2a. internal form of the program
60$ 2b. the program
61$ maps on blocks, on instructions, instruction macros
62$ iteration macros
63$ 2c. code sequences for calls, entries,exits
64$ 2d. scopes and routines
65$ maps on scopes, scope types, procedure values, macros
66$ 2e. effects of separate compilation
67$ 2f. code for iterative set and tuple formers
68$ 2g. code for case statement and multiparameter retrievals
69$
70$ 3. variable declarations
71$
72$ 3a. the symbol table
73$ 3b. values of variables
74$ 3c. occurences
75$ 3d. q1-opcodes
76$ 3e. control graph and interval analysis,
77$ data flow maps, call graph
78$ 3f. types
79$ 3g. forms
80$ 3h. call paths
81$ 3i. various initial maps
82$ 3j. control parameters
83$
84$ 4. global variable declarations
85$
86$ 5. module specifications
87$
88$ 5a. main program
89$ 5b. compiler interface, utilities
90$ 5c. call graph analysis
91$ 5d. interval analysis
92$ 5e. redundant expression elimination and code motion
93$ 5f. live analysis
94$ 5g. data flow analysis package
95$ 5h. data flow analysis - bfrom computation
96$ 5i. type finding
97$ 5k. automatic data structure selection
98$ 5l. conversion optimisation
99$ 5m. copy optimisation
100$ 5n. output to the code generator
101$
102$ 6. data structure declarations for global variables
103$
104$ 7. main program for the optimiser
105$
106$ 8. interface to little-written portions
107$
108$ 8a. read_q1, get_header
109$ 8b. get_forms
110$ 8c. get_symtab, cnvval
111$ 8d. get_code
112$ 8e. write_q1, set_ltl_maps, put_header
113$ 8f. put_forms
114$ 8g. put_symtab
115$ 8h. put_code
116$ 8i. bld_val, elmt_sym
117$ 8j. reset
118$
119$ 9. routines for the preliminary pass
120$
121$ ... opt_ini, readcc,
122$ first_pass,
123$ shortcut, get_temp, transclose, exp_name
124$ 9a. satisfy_members
125$ 9b. satisfy_procs
126$ 9c. bld_body
127$ 9d. bld_entry, bld_label, bld_use, bld_def, bld_call,
128$ bld_exitstop
129$
130$ 10. interval analysis
131$
132$ 10a. find_intervals, find_graph
133$ 10b. find_ints
134$ 10c. update
135$ 10d. dfst, .intof_lim, get_targ
136$
137$ 11. available expressions analysis
138$
139$ 11a. csx
140$ 11b. interproc_csx
141$ 11c. intraproc_csx
142$ 11d. move_eliminate, insert_exp
143$ 11e. csx_blockmaps
144$
145$ 12. live analysis
146$
147$ 12a. live
148$ 12b. interproc_live
149$ 12c. intraproc_live
150$ 12d. live_blockmaps
151$
152$ 11f.bfrom_analysis
153$
154$ 11g. find_bfrom, global_bfrom, local_bfrom
155$ 11h. comp_bfrom
156$ 11i. bfrom_blockmaps, .join
157$
158$ 13. dataflow solver
159$ cgraph_analysis, interproc_fwd_analysis,
160$ interproc_fwd_eliminate, intraproc_fwd_eliminate,
161$ propagate_exposed, fwd_propagate_in, intraproc_fwd_analysis
162$ interproc_back_eliminate, intraproc_back_eliminate,
163$ intra_aux_eliminate, exit_info, back_propagatein,
164$ also auxiliary routines
165$
166$ 14. type finder
167$
168$ 14a. the type lattice, basic algorithm
169$ 14b. type_find
170$ 14c. type_forward, given_type, dfs
171$ 14d. type_backward
172$ 14e. type_final
173$ 14f. forward
174$ 14g. backward
175$ 14h. type_constant, constant_equality
176$ 14i. ntyp, knt_type
177$ 14j. pair_type
178$ 14k. trim, norm
179$ 14l. .con
180$ 14m. .dis
181$ 14n. .sub
182$ 14o. const_typ, sting_length, .is_pair, .is_map
183$ 14p. ads_type
184$
185$ 15. auto_dstruct
186$
187$ ... auto_data
188$ 15a. basegen
189$ 15b. genbases
190$ 15c. genabase
191$ 15d. basemerge
192$ 15e. equibase
193$ 15f. .lim
194$ 15g. baseadjust
195$ 15h. fancy_output
196$ 15i. real_repr, remarks
197$
198$ 16. utilities for code manipulation
199$
200$ add_block,add_sym,add_label,add_int,add_inst,
201$ insert, make_nl,ermesg,abort
202$
203$ 17. dumps
204$ dmp, symdmp,formdmp,codedmp,intdmp, etc.
205$
206$
207$
1 .=member ntent1
2$
3$
4$
5$ i n t e n t o f t h e o p t i m i z e r
6$ --------------------------------------------------
7$
8$ most of the optimizer is concerned with gathering information about a
9$ program being optimized. the optimization algorithms are so complex
10$ that it is easy to loose track of how the optimizer actually improves
11$ the code. before getting started, we take time to discuss this.
12$
13$ the optimizer makes code improvements in five areas:
14$
15$ 1. it performs various classical optimizations such as code motion,
16$ redundant subexpression elimination, removal of dead and
17$ unreachable code, and constant propagation. these optimizations
18$ are reflected in changes to the q1 code.
19$
20$ 2. it determines the types of undeclared and partially declared
21$ variables. this means both type determination in the tennenbaum
22$ sense, and automatic data structure selection. this information
23$ is used to fill in forms.
24$
25$ 3. it determines which routines are recursive, and determines which
26$ temporaries and local variables can be made static (is_stk = om).
27$
28$ 4. it determines when copies must be made as part of an instruction.
29$
30$ 5. it makes various peephole optimizations to the code.
31$
32$ most information generated by the optimizer is in the form of attrib-
33$ utes of variables. the optimizer performs 'name splitting' in order
34$ to insure that the attributes of a variable are the same throughout
35$ the program.
36$
37$ name splitting is a process of dividing the occurrences of each
38$ variable into equivalence classes such that all occurrences in each
39$ class have the same attributes. each equivalence class is then made
40$ into a new variable.
41$
42$ once we have performed name splitting, it is generally possible for
43$ more than one variable to share the same run time address. variables
44$ which can share storage are made into aliases by setting the 'alias'
45$ map.
46$
47$ new names are also added whenever we create bases, labels, etc.
48$ this is done by the routine 'add_sym'.
49$
50
51$
52$ the following section describes all the data structures and modules of
53$ the optimizer. we begin with some comments on the data structures.
54$
1 .=member ifrm2a
2 .title 'data structures'
3
4$ d a t a s t r u c t u r e s
5$ ------------------------------
6
7$ first we give declarations and reprs for all the global data
8$ structures of the optimizer.
9
10
11$ internal form of the program
12$ ----------------------------
13
14$ in this section we discuss the internal form of setl programs and give
15$ the data structures which define it.
16
17$ we begin by defining a few terms.
18$
19$ 1. symbols
20$
21$ each symbol corresponds to a resolved name in a setl source program
22$ or to a compiler generated temporary. symbols are represented as
23$ atoms which are elements of the base 'symbols'.
24$
25$ 2. temporaries
26$
27$ a temporary is a symbol generated by the compiler to serve as the
28$ output of an expression. the output of an expression is always a
29$ temporary; symbols appearing in the source program may only appear
30$ as outputs in assignment instructions.
31$
32$ when the program is read in from the semantic pass, each
33$ instruction generates a unique temporary. temporaries are merged
34$ during redundant subexpression elimination.
35$
36$ 3. forms
37$
38$ a 'form' is a description of how a setl object is represented at
39$ run time. the form of a symbol indicates how values assigned to
40$ that symbol are to be represented. forms may be supplied by the
41$ user through the 'repr' statement, or may be generated
42$ automatically.
43$
44$ forms are represented as atoms on which various maps are defined.
45$
46$ note that the typefinder and the automatic data choice algorithm
47$ do not compute the forms of variables. instead they compute much
48$ simpler type descriptors known as 'types'. 'types' are converted
49$ to 'forms' later on.
50$
51$ 4. the program
52$
53$ the program is divided into routines, basic blocks, and
54$ instructions. each instruction consists of an opcode and a tuple
55$ of arguments. all the inputs and outputs of an instruction
56$ appear explicitly as arguments.
57$
58$ the instructions in each block are arranged in a linked list. this
59$ is designed to give maximum flexibility in the insertion and
60$ deletion of code. if we were to use tuples, then the entire block
61$ might need to be copied if we were to insert or delete an instruc-
62$ tion.
63$
64$ 5. occurrences
65$
66$ an occurrence is a use or definition of a variable. occurrences
67$ are identified by pairs
68$
69$ [ instruction, argument no. ]
70$
71$ occurrences which are used as inputs are called 'ivariables', and
72$ occurrences which are outputs are called 'ovariables'. an
73$ occurrence may be both an i- and o-variable, for example,
74$ 'f' in 'f(x) := y'.
75
76$ plex bases and data abstraction
77$ ------------------------------
78
79$ symbols, forms, etc. can all be thought of as abstract data types. we
80$ treat abstract objects as atoms which have various maps based on them.
81$
82$ the objects of each abstract type form a base. very often we will
83$ have a set 's' which contains all the objects of a given type(say all
84$ symbols). 's' is clearly equivalent to the base of symbols.
85$
86$ generally 's' will not be represented explicitly. instead we will
87$ keep a map which links all the elements of the base in order of
88$ creation. this is done for three reasons:
89$
90$ 1. is allows us to maintain 'symbols' as a plex base and still be able
91$ to iterate over 's'. plex bases are generally much more efficient
92$ than normal bases.
93$
94$ 2. it allows us to iterate over 's' in a standard order for dumping
95$ purposes.
96$
97$ 3. we must be able to iterate over all symbols in their order of
98$ creation in order to build the tables which are passed to the code
99$ generator.
100$
101$ a variety of macros for iterating over link maps are provided in the
102$ section 'iteration macros'.
103$
1 .=member prog2b
2 .title 'the program'
3
4$ the program
5$ -----------
6
7$ the program is divided into routines, basic blocks, and instructions.
8$ each instruction consists of an opcode and a tuple of arguments. all
9$ the inputs and outputs of an instruction appear explicitly as
10$ arguments.
11$
12$ if an instruction has an output, it is always the first argument;
13$ if an instruction has label as an argument, it is always the last
14$ argument.
15$
16$ each instruction has at most one argument which may require copying.
17$ the instruction's 'copy flag' indicates whether the argument must be
18$ copied conditionally, unconditionally, or not at all. the
19$ instruction's opcode determines which argument the copy flag refers
20$ to.
21$
22$ an instruction may also have an argument whose share bit must be set.
23$ the instruction's 'share flag' indicates whether the bit must
24$ actually be set.
25$
26$ the instructions in each block are threaded into a linked list. this
27$ is designed to allow maximum flexibility in code insertion and
28$ deletion.
29$
30$ blocks are 'extended' in the sense that there may be more than one
31$ branch out of a block. the last instruction of a block is always a
32$ procedure exit, stop or goto. calls constitute a single instruction
33$ blocks, but are represented by a 3-instruction block (containing
34$ label, call, and go-to). since each block ends in a goto, we can
35$ generate code for blocks in any order.
36$
37$ when the optimizer reads in the program, it reads blocks in the order
38$ in which they appear in the source. this order is fairly optimal
39$ since it makes the branches at the end of most blocks redundant.
40$
41$ we keep track of this order using the first_block and next_block maps
42$ so that we can write the blocks out optimally.
43$
44
45
46$ maps on blocks
47$ --------------
48
49 macro block_maps;
50 routof, $ routine containing block
51 next_block, $ next block, see above
52 first_inst, $ first instruction of block
53 last_inst $ last instruction of a block
54 endm;
55
56
57$ maps on instructions
58$ --------------------
59
60 macro inst_maps;
61 opcode, $ operation code
62 args, $ tuple of arguments
63 occs, $ tuple of occurrences
64 blockof, $ gives block containing instruction
65 stmtof, $ cummulative statement count of the instruction
66 copy_flag, $ indicates what copy action should be done
67 share_flag, $ indicates setting of a share bit
68 next_inst $ next instruction in block
69 endm;
70
71
72$ macros for accessing instructions
73$ ---------------------------------
74
75 macro arg1(i); args(i)(1) endm;
76 macro arg2(i); args(i)(2) endm;
77 macro arg3(i); args(i)(3) endm;
78
79
80$ the following macro yields the label of a basic block.
81
82 macro blk_label(b); arg1(first_inst(b)) endm;
83
84$ the values for copy flags are:
85
86 macro copy_actions;
87 copy_no, $ no copy required
88 copy_yes, $ always copy
89 copy_test $ test share bit before copy
90 endm;
91
92
93 .title 'iteration macros'
94
95$ iteration macros
96$ ----------------
97
98$ the following macros are used for iterating over all
99$ blocks, forms, symbols, etc.
100
101 macro for_list(x, first, next); $ iterate over a list
102 init x := first; while x /= om step x := next(x);
103 endm;
104
105 macro for_block(b, scope); $ for blocks in a scope
106 for_list(b, first_block(scope), next_block)
107 endm;
108
109 macro for_inst(i, b); $ for instructions in a block
110 for_list(i, first_inst(b), next_inst)
111 endm;
112
113 macro for_form(f, scope); $ for forms in a scope
114 $ see scopes, below
115 for_list(f, first_form(scope), next_form)
116 endm;
117
118 macro for_sym(s, scope); $ for symbols in a scope
119 $ see scopes, below
120 for_list(s, first_sym(scope), next_sym)
121 endm;
122
123
1 .=member clls2c
2 .title 'code sequences for calls, entries, and exits'
3
4$ code sequences for calls, entries, and exits
5$ -------------------------------------------
6
7$ in this section we discuss the representation of calls, entries and
8$ exits in the q1 instructions.
9
10$ note
11$ ----
12
13$ the setl system uses two radically different linkage mechanisms
14$ depending on the 'back' option on the control card.
15$
16$ back=0 is the default, and indicates that backtracking is illegal.
17$ this allows the relatively simple linkage mechanism described below.
18$
19$ back=1 indicates that the program may contain backtracking. in this
20$ case we refuse to optimize it. we may choose to handle backtracking
21$ in a later version of the optimizer.
22
23$ calling sequences
24$ -----------------
25
26$ a calling section consists of:
27$
28$ 1. 'argin' assignments
29$
30$ these are a series of instructions which bind the actual arguments
31$ to the formal parameters. there is one q1_argin instruction for
32$ each argument. these instructions have:
33$
34$ arg1: name of actual argument
35$ arg2: name of procedure being called
36$ arg3: argument number
37$
38$ for write-only arguments, arg1 points to the symbol 'om'.
39$
40$ the run time semantics of an argin instruction is to push arg1 onto
41$ the invocation stack. however the optimizer thinks of it as an
42$ assignment to the formal parameter. in order to do this, it adds
43$ the formal parameter as the first argument of that instruction.
44$
45$ 2. the actual call
46$
47$ this consists of a q1_call instruction with:
48$
49$ arg1: name of procedure
50$ arg2: number of actual arguments
51$
52$ 3. free and argout instructions
53$
54$ 'free' instructions remove the values of read-only arguments from
55$ the invocation stack. they are ignored by the optimizer. argout
56$ instructions assign the values of write and read-write parameters
57$ back to the arguments.
58$
59$ the q1_free and q1_argout instructions have the same arguments as
60$ the q1_argin instruction. the optimizer adds a fourth argument to
61$ argout instructions as its last argument.
62$
63$ note that if a procedure has a variable number of arguments,
64$ such as:
65$
66$ procedurep(a, b(*));
67$
68$ then the extra arguments are gathered into a tuple. thus the call
69$
70$ p(1, 2, 3);
71$
72$ has two argin instructions. the first passes '1' and the second
73$ passes '[ 2, 3 ]'. the q1_call instruction indicates that the call
74$ had 3 arguments. this is the value returned by the 'na' operator.
75
76
77$ entry, exit, and stop blocks
78$ ----------------------------
79
80$ each routine begins with an 'entry' block, and ends with an 'exit'
81$ block followed by a 'stop' block. the entry block has a single
82$ instruction with:
83$
84$ opcode: q1_entry
85$ arg1: name of routine
86$
87$ the exit block has one instruction with:
88$
89$ opcode: q1_exit
90$ arg1: name of routine
91$
92$ the stop block has one instruction with:
93$
94$ opcode: q1_stop
95$
96
1 .=member scor2d
2 .title 'scopes and routines'
3
4$ scopes and routines
5$ -------------------
6
7$ setl programs are divided into separate namescopes. a namescope is
8$ either a directory member, a procedure, or a special system namescope.
9$ when the semantic pass writes out the q1 tables, it writes them one
10$ scope at a time. we must keep lists of the symbols, forms, and blocks
11$ for each scope. this is done by using a series of maps first_xxx
12$ which point to the start of each list and last_xxx which point to the
13$ end of the list.
14$
15$ namescopes are simply identified by their names. the following maps
16$ are defined on scopes:
17
18 macro sc_maps;
19 scopes, $ tuple of scopes in lexical order
20 cont_scopes, $ tuple of containing scopes (inner-to-outer)
21 sc_stmt_ct, $ maps each scope to its statement count
22 sc_estmt_ct, $ maps each procedure scope to the statement
23 $ number of the q1_entry instruction
24 sc_type, $ string sc_xxx giving the type of a scope
25 sc_nprocs, $ number of procedures in a member
26 first_sym, $ first symbol in a scope
27 last_sym, $ last symbol in a scope
28 first_block, $ first block in a scope
29 last_block, $ last block in a scope
30 first_form, $ first form in a scope
31 last_form $ last form in a scope
32 endm;
33
34$ the scope types are:
35
36 macro sc_types;
37 sc_sys, $ system unit
38 sc_lib, $ library
39 sc_dir, $ directory
40 sc_prog, $ program
41 sc_mod, $ module
42 sc_proc, $ procedure
43 sc_end $ indicates end of file
44 endm;
45
46$ the following maps are defined on procedure names:
47$ note that procedure names are also symbols
48
49 macro rout_maps;
50 routs, $ set of all routines
51 rentry, $ entry block
52 rexit, $ exit block
53 rstop, $ stop block
54 rparams, $ tuple of formal parameter names
55 membof $ member in which routine is supplied
56 endm;
57$
58$ there is more information on procedures contained in their 'value'
59$ entries. (see section 'values', below) this information is accessed
60$ by the following macros:
61$
62$ rretn: the global variable used to return the value of a function
63$ call.
64$
65$ rvary: indicates procedure with variable number of arguments
66$
67$ rnargs: indicates number of arguments
68$
69$ rptyps: types of parameters: rd, wr, or rw.
70$
71 macro rretn(p); value(p)(1) endm;
72 macro rvary(p); value(p)(2) endm;
73 macro rnargs(p); value(p)(3) endm;
74 macro rptyps(p); value(p)(4) endm;
75
76
1 .=member secm2e
2$ the effects of separate compilation
3$ -----------------------------------
4
5$
6$ setl allows members to be compiled separately. when we run the opti-
7$ miser, there are four possibilities:
8$
9$ 1. the input is a set of libraries. add a dummy main program which
10$ refers to all the libraries in its 'libraries' list, then go on
11$ to case 2.
12$
13$ 2. the input consists of a program and a set of libraries.
14$ add a dummy directory which contains a description of the
15$ program, and go on to case 3.
16$
17$ 3. the input contains a set of libraries, a directory, and a set
18$ of members which are described in the directory. find all
19$ the members which are described in the directory but not
20$ included in the input and build dummy bodies for their
21$ exported procedures. go on to case 4.
22$
23$ 4. the input is a complete program.
24$
1 .=member spcd2f
2 .title 'code generated for various special operations'
3
4$ code for iterative set and tuple formers
5$ ----------------------------------------
6
7$ the run time library uses a stack for argument
8$ passage, recursion, etc. and also to implement
9$ iterative set and tuple formers.
10$
11$ there are two q1 opcodes which manipulate the stack, and altogether
12$ there are three opcodes used in relation with iterative set and
13$ tuple formers:
14$
15$ q1_push: push a1 onto the stack.
16$
17$ q1_set1: build a set from the top a3 stack entries and
18$ store it in a1.
19$
20$ q1_tup1: similar to q1_set1, but builds a tuple.
21$
22$ note that in these last two operators the first input argument is the
23$ expression in the iterative set or tuple former. this aids in the
24$ type finder.
25$
26$ q1_set1 and q1_tup1 are always used in conjunction with a q1_push
27$ instruction. their second argument is the same as the first argument
28$ of the corresponding push.
29$
30$ the code for 's := {x : x in s1}' looks like:
31$
32$ counter := 0;
33$
34$ (forall x in s1)
35$ push(x);
36$ counter +:= 1;
37$ end forall;
38$
39$ s := set1(x, counter);
40$
41$ 'q1_push' is used only for iterative set and tuple formers.
42$ (procedures use q1_argin instructions to push parameters)
43$ the optimizer can view it as a simple assignment t2 := t2.
44$ (in connection with the computation of bfrom links, etc.)
45$ the code generator will view it as a stack push.
46$
47$ the opcodes q1_set1 and q1_tup1 are used solely for enumerative
48$ set- and tuple-formers, while iterative set- and tuple-formers use
49$ the q1_set and q1_tup instructions, resp.
50$
1 .=member cacd2g
2$
3$ the code generated for "s := { x+1 : x in s1 }" is:
4$
5$ asn t.1 0 $ initialize counter
6$ asn i.3 s1 $ iterate over copy os s1
7$ inext i.1 i.2 i.3
8$ goto l.1
9$
10$ label l.1 $ loop body
11$ next i.1 i.2 i.3 $ advance in s1
12$ eq t.2 i.2 om $ check for iteration end
13$ if t.2 l.3
14$ asn x i.1 $ assign next element to x
15$ add t.3 x 1 $ compute
16$ push t.3 t.4 $ push set element
17$ add t.5 t.1 1 $ increment counter
18$ asn t.1 t.5
19$ goto l.2
20$
21$ label l.2 $ step block
22$ goto l.1
23$
24$ label l.3 $ term block
25$ asn i.1 om
26$ asn i.3 om
27$ set1 t.4 t.3 t.1 $ setformer
28$ asn s t.4
29$
30
31
32$ code for case statement
33$ -----------------------
34
35$ a case statement such as 'case x of' ... '(red):' ... 'end'
36$ is implemented by building a map from tag values to labels.
37$ the actual 'q1_case' instruction has:
38$
39$ arg1: name of map
40$ arg2: name of expression, i.e. 'x'
41$ arg3: label for 'else' clause.
42$
43$ note that the first argument is a constant. by examining
44$ its value, we can determine the labels of all the alternatives
45$ in the case statement.
46$
47
48$ code for f(x1, ..., xn), etc.
49$ -----------------------------
50
51$ multi-variate map retrieval and assignment statements compile into an
52$ enumerative tuple former for the domain element, which is then used to
53$ index the map. if the cardinality of the domain tuple is 1, then the
54$ semantic pass catches the obvious optimization to not create this
55$ tuple.
56
57
1 .=member smtb3a
2
3
4$ variable declarations
5$ ---------------------
6
7$ in this section we declare variables global to the entire optimizer.
8$ the globals can be divided into various logical groupings, such as
9$ the code and the symbol table. we provide a macro to list the
10$ variables in each group.
11
12 .title 'symbol table'
13
14$ the symbol table
15$ ----------------
16
17$ the 'symbol table' is a collection of maps on symbols.
18$ these maps are:
19$
20$ name: a string giving the name of the symbol.
21$
22$ is_internal: flags internally generated name.
23$
24$ value: the value of a symbol. see below.
25$
26$ is_const: indicates constant
27$
28$ scope: maps local variables into their procedures and
29$ global variables into their module, library, etc.
30$
31$ form: gives the form of a symbol
32$
33$ alias: this field is used for symbols which share storage with
34$ each other. these symbols are created by the compiler
35$ when it processes the 'const' statement and are created
36$ by the optimizer during the 'name splitting' phase.
37$
38$ the alias field is used in conjunction with the is_store
39$ field. if two symbols s1 and s2 share storage, then one
40$ of them, say s1, will have:
41$
42$ is_store = 1 indicating storage is required
43$ alias = om
44$
45$ while s2 will have:
46$
47$ is_store = om indicating no separate storage
48$ alias = s1
49$
50$ the alias field is also used to link unsatisfied
51$ external procedures which effect the same global
52$ variables, etc.
53$
54$ is_store: see above
55$
56$ is_temp: flags temporary variables.
57$ (is_temp is a subset of is_internal)
58$
59$ is_read: indicates read permission for constant or variable
60$
61$ is_write: indicates write permission for a variable
62$
63$ is_stk: flags stacked variables
64$
65$ is_param: flags formal parameters
66$
67$ is_repr: indicates that specific information is available about
68$ the internal representation of the object. this
69$ information is either supplied by the user, or
70$ determined by the optimizer.
71$
72$ is_init: flags initialised variables: their alias field will
73$ point to the symbol table entry carrying the initial
74$ value of this symbol.
75$
76$ is_seen: member, procedure, or label has been seen in the input.
77$
78$ is_back: flags backtracked variables: we do not attempt to opti-
79$ mise programs with backtracking, yet this flag must be
80$ transmitted from the sem to cod.
81$
82$ is_rec: flags recursive routines. by default, we assume that
83$ all routines are recursive. call graph analysis will
84$ tell us which routines are not recursive, and thus do
85$ not require (more expensive) recursive routine prologs
86$ and epilogs.
87$
88$ next_sym: links the symbols of each scope in order of creation
89$ note that if a procedure has 'n' parameters then they
90$ are the first 'n' symbols in its scope.
91
92
93 macro symbol_table;
94 name,
95 is_internal,
96 value,
97 is_const,
98 scope,
99 form,
100 alias,
101 is_store,
102 is_temp, $ flags temporaries
103 is_read, $ indicates reads permission for a variable
104 is_write, $ indicates write permission for a variable
105 is_stk, $ flags local stacked variables
106 is_param, $ flags formal parameters
107 is_repr, $ indicates data structure info is available
108 is_init, $ flags initalised (global) variables
109 is_seen, $ flags members seen in the input
110 is_back, $ flags backtracked variables
111 is_rec, $ flags recursive routines
112 next_sym
113 endm;
114
1 .=member valu3b
2 .title 'value of variables'
3
4$ value of variables
5$ ------------------
6
7$ the 'value' map is defined for constants(is_const = 1) and variables
8$ appearing in an 'init' statement. constants have:
9$
10$ is_const: 1
11$ value: gives value of constant
12$
13$ uninitialized variables have:
14$
15$ is_const: om
16$ value: om
17$
18$ we can distinguish between constants and initialized variables
19$ by noting that constants have their 'is_write' bit = om, whereas
20$ initialized variables have their 'is_write' bit = 1 (true).
21$
22$ we can distinguish between two types of 'value' entries:
23$
24$ 1. run time values
25$
26$ these are values for constant denotations, etc. for example, the
27$ value of the symbol '1' is the integer 1, and the value of the
28$ symbol 'nl' is a null set.
29$
30$ 2. compile time values
31$
32$ symbols such as labels, module names, and procedures can be said to
33$ have values even though they can never appear in expressions. their
34$ values are of interest only to the compiler.
35$
36$ a. labels
37$
38$ the value of a label is the instruction which defines it.
39$
40$ b. perform blocks
41$
42$ the value of a perform block is a pair [ l1, l2 ] where l1 is
43$ the label for the perform block and l2 is the label for the
44$ point it returns to. perform blocks are compiled into the
45$ sequence 'go to l1; l2:'.
46$
47$ c. procedures
48$
49$ the value of a procedure is a (procedure descriptor) tuple whose
50$ components are:
51$
52$ 1. the name of the variable used to return the procedure value
53$
54$ 2. a flag indicating whether the procedure has a variable number
55$ of arguments.
56$
57$ 3. the number of arguments (or minimum number if the procedure
58$ can have a variable number of arguments).
59$
60$ 4. a tuple whose i-th component is either 'rd', 'wr', or 'rw',
61$ indicating the type of the i-th parameter.
62$
63$ d. libraries, programs, and modules
64$
65$ the value (descriptor) of a library, program, or module is a
66$ tuple [ libraries, reads, writes, imports, exports ] where
67$ 'libraries' is the set of libraries referenced, 'reads' is a
68$ list of globals read, 'writes' is a set of globalswritten,
69$ 'exports' is a set of procedures exported, and 'imports' is a
70$ set of procedures, exported from other modules which are called
71$ from the member.
72$
73$ note that directories have no value.
74$
75$ when the compiler processes a statement such as
76$
77$ const s = { [ 1, 2 ], [ 2, 3 ] };
78$
79$ it generates three symbol table entries, one for 's' and one for each
80$ of its components. the value of 's' is then represented as a list of
81$ symbol table pointers to its elements. the symbol table entries for
82$ the components always appear before the symbol table entry for 's'.
83$
84$ whenever a new composite value is added to a scope, we first have to
85$ find (or add) its components to the current scope, or an enclosing
86$ scope (i.e. a scope which is 'larger' than the current scope). this
87$ process is neccessarily recursive.
88$
89$ during constant propagation, the optimizer may find that a variable
90$$$ ????? may be simplified
91$ 'x' has a constant value of 'v'. it must then do three things:
92$
93$ 1. set is_const(x) = 1.
94$
95$ 2. set value(x) = v.
96$
97$ 3. if 'v' is a set or tuple then iterate over its elements 'e' making
98$ sure that there is a symbol table entry with value 'e' and the
99$ proper scope and type. the entry for 'e' must appear before the
100$ entry for 'x'.
101$
102$ step (3) is done using a map called value_inv which sends a value,
103$$$ ????? may be simplified
104$ type, and scope into a symbol.
105
106
1 .=member occr3c
2 .title 'occurrences'
3
4$ occurrences
5$ -----------
6
7$ an occurrence is a use or definition of a variable. it is identified
8$ as a triple
9$
10$ [ instruction identifier, argument number, call path ].
11$
12$ but in our initial debugging we ignore the third argument and treat
13$ occurences as pairs.
14$
15$ 'call paths' are discussed in the next section.
16$
17$ occurrences which are inputs are called 'ivariables', and occurrences
18$ which are outputs are called 'ovariables'. an occurrence may be both
19$ an i- and o-variable, for example 'f' in 'f(x) := y'.
20$
21$ o-variables always appear in the first argument position, while
22$ i-variables may appear anywhere.
23$
24$ the set ops_ovar contains all opcodes whose first argument is an
25$ ovariable, and the set ops_ivar contains all opcodes whose first
26$ argument is an ivariable. these sets are not mutually exclusive,
27$ as seen from the 'f(x)' example above.
28
29
30$ the following macros are used for occurrences:
31$
32$ oi_op: the opcode of their instruction
33$ oi_sym: the symbol for the occurrence
34$ oi_val: the symbols value
35$ oi_sib: the n-th argument of the instruction containing i
36
37 macro ocrs_maps;
38 instno, $ the instruction number of an occurrence
39 argno $ the argument number of an occurrence
40 endm;
41
42 macro path(oi); oi(3) endm;
43
44 macro oi_op(oi); opcode(instno(oi)) endm;
45 macro oi_sym(oi); args(instno(oi))(argno(oi)) endm;
46 macro oi_form(oi); form(oi_sym(oi)) endm;
47 macro oi_name(oi); name(oi_sym(oi)) endm;
48 macro oi_val(oi); value(oi_sym(oi)) endm;
49 macro oi_str(oi); (str instno(oi)+'/'+str argno(oi)) endm;
50 macro oi_rout(oi); routof(blockof(instno(oi))) endm;
51
52 macro oi_stmt(oi);
53 ( name(oi_rout(oi)) + '.' +
54 str(stmtof(instno(oi)) - sc_stmt_ct(oi_rout(oi)) + 1) )
55 endm;
56
57$ in order to speed up iterations and test the types of occurrences,
58$ we provide the following sets:
59
60 macro oi_sets;
61 all_oi, $ set of all occurrences
62 all_o, $ set of all o-variables
63 all_i $ set of all i-variables
64 endm;
65
66
67 macro is_ovar(oi); (oi in all_o) endm;
68 macro is_ivar(oi); (oi in all_i) endm;
69
70 macro get_oi(i, j); occs(i)(j) endm;
71 macro get_ovar(oi); get_oi(instno(oi), 1) endm;
72
73 macro first_ivar(op); $ argument number of first i-variable
74 if op in ops_ivar then 1 else 2 end
75 endm;
76
77 macro get_ivars(oi; j);
78 [ get_oi(instno(oi), j) :
79 j in [ first_ivar(oi_op(oi))..#args(instno(oi)) ] ]
80 endm;
81
82
1 .=member opcd3d
2 .title 'q1 opcodes'
3
4$ the set opcodes defines all the operations in the internal program
5$ representation.
6
7 macro opcodes;
8$
9$ binary operators
10$
11 q1_add, $ +
12 q1_div, $ div
13 q1_exp, $ **
14 q1_eq, $ =
15 q1_ge, $ >=
16 q1_lt, $ <
smfh 1 q1_pos, $ > 0 (used only for arithmetic iterators)
17 q1_in, $ in
18 q1_incs, $ incs, subset
19 q1_less, $ less
20 q1_lessf, $ lessf
21 q1_max, $ max
22 q1_min, $ min
23 q1_mod, $ //
24 q1_mult, $ *
25 q1_ne, $ /=
26 q1_notin, $ notin
27 q1_npow, $ npow
28 q1_atan2, $ atan2
29 q1_slash, $ /
30 q1_sub, $ -
31 q1_with, $ with
32$
33$ unary operators - of form a1 := op a2 except where noted
34$
35 q1_abs, $ abs
36 q1_char, $ char
37 q1_ceil, $ ceiling
38 q1_floor, $ floor
39 q1_isint, $ is_integer
40 q1_isreal, $ is_real
41 q1_isstr, $ is_string
42 q1_isbool, $ is_boolean
43 q1_isatom, $ is_atom
44 q1_istup, $ is_tuple
45 q1_isset, $ is_set
46 q1_ismap, $ is_map
47 q1_arb, $ arb
48 q1_val, $ val
49 q1_dom, $ domain
50 q1_fix, $ fix
51 q1_float, $ float
52 q1_nelt, $ #
53 q1_not, $ not
54 q1_pow, $ pow
55 q1_rand, $ random
56 q1_sin, $ sin
57 q1_cos, $ cos
58 q1_tan, $ tan
59 q1_arcsin, $ asin
60 q1_arccos, $ acos
61 q1_arctan, $ atan
62 q1_tanh, $ tanh
63 q1_expf, $ exp
64 q1_log, $ log
65 q1_sqrt, $ sqrt
66 q1_range, $ range
67 q1_type, $ type
68 q1_umin, $ unary minus
69 q1_even, $ even
70 q1_odd, $ odd
71 q1_str, $ str
72 q1_sign, $ sign
73$
74$ miscellaneous
75$
76 q1_end, $ a1 := a2(a3..)
77 q1_subst, $ a1 := a2(a3..a4)
78 q1_newat, $ a1 := newat
79 q1_time, $ a1 := time
80 q1_date, $ a1 := date
81 q1_na, $ a1 := number of arguments of current routine
82 q1_set, $ enumerative set former
83 q1_set1, $ iterative set former
84 q1_tup, $ enumerative tuple former
85 q1_tup1, $ iterative tuple former
86 q1_from, $ a1 from a2;
87 q1_fromb, $ a1 fromb a2
88 q1_frome, $ a1 frome a2
89$
90$ iterators
91$
92 q1_next, $ a1 := next element of a3
93 q1_nextd, $ a1 := next element of domain a3
94 q1_inext, $ initialize next loop
95 q1_inextd, $ initialize nextd loop
96$
97$ mappings
98$
99 q1_of, $ a1 := a2(a3)
100 q1_ofa, $ a1 := a2<>
101
102 q1_sof, $ a1(a2) := a3
103 q1_sofa, $ a1<> := a3
104 q1_send, $ a1(a2..) := a3
105 q1_ssubst, $ a1(a2..a3) := a4
106$
107$ assignments - all assign a2 to a1
108$
109 q1_asn, $ a1 := a2
110
111$ argument passage - a1 is argument, a2 is routine, a3 is argument no.
112
113 q1_argin, $ assign argument to formal parameter
114 q1_argout, $ assignment back to argument
115
116 q1_push, $ push element for set former
117 q1_free, $ free stack space after call
118$
119$ control statements
120$
121 q1_call, $ call a1. a2 is number of arguments
122 q1_goto, $ goto a1
123
124 q1_if, $ if a1 then goto a2
125 q1_ifnot, $ if not a1 then goto a2
smfg 1 q1_bif, $ if a1 then goto a2 (a1 is boolean)
smfg 2 q1_bifnot, $ if not a1 then goto a2 (a1 is boolean)
smfg 3 q1_ifasrt, $ if getipp('assert=1/2') = 0 then goto a1
126 q1_case, $ t := a1(a2); if t = om then goto a3
127 q1_stop, $ stop
128
129 q1_entry, $ procedure entry point. a1 is the routine
130 q1_exit, $ routine exit. a1 is the routine name
131
132 q1_ok, $ ok
133 q1_lev, $ get ok level
134 q1_fail, $ fail
135 q1_succeed, $ succeed
136
137 q1_asrt, $ if not a1 then error; end;
138 q1_stmt, $ indicates start of new statement
139 q1_label, $ 'a1:' defines label a1
140 q1_tag, $ label for case tag
141 q1_debug, $ debugging request
142 q1_trace, $ trace request
143 q1_notrace, $ cancel trace request
144 q1_error, $ compile time error
145 q1_noop, $ indicates dead instruction
146$
147$ auxiliary operations for external procedure simulation
148$
149 q1_ifrand, $ if random go to a1
150 q1_use, $ most general use of a1
151 q1_def, $ most general definition of a1
smfg 4 q1_isom, $ argument is omega
smfg 5 q1_notom, $ argument is not omega
152 q1_arbb, $ arb to simulate q1_fromb
153 q1_arbe, $ arb to simulate q1_frome
154 q1_lessb, $ less to simulate q1_fromb
155 q1_lesse, $ less to simulate q1_frome
156 q1_sargin, $ argin for system routine call
157 q1_sargout $ argout for system routine call
158 endm;
159
160
161
162 macro ops_classes; $ collection of operator classes
163 ops_typeback, $ - backwards type propagation is meaningful
164 ops_exps, $ - operators yielding valid expressions
165 ops_modify, $ - operators which modify program variables
166 ops_extract, $ - extractions
167 ops_retrieve, $ - retrievals
168 ops_update, $ - updates
169 ops_sin, $ - sinister assignments
170 ops_bin, $ - binary operators
171 ops_un, $ - unary operators
172 ops_goto, $ - all branches
173 ops_iter, $ - iterators
smfe 1 ops_typepred, $ - type predicates
174 ops_ovar, $ - operators with o-variables
175 ops_ivar, $ - operators with arg1 an i-variable
176 ops_destuse1, $ - first i-variable is used destructively
177 ops_destuse3, $ - third i-variable is used destructively
178 ops_destuse4, $ - fourth i-variable is used destructively
179 ops_share1, $ - first argument becomes shared
180 ops_share2, $ - second argument becomes shared
181 ops_share3, $ - third argument becomes shared
182 ops_share4, $ - fourth argument becomes shared
183 ops_smap, $ - operators modifying maps leaving it s-maps
184 ops_local, $ - operators supporting local basing
185 ops_sparse, $ - operators supporting sparse representation
186 ops_nonewval, $ - operators which only transmit values
187 ops_fold, $ - constant folding possible
188 ops_arith $ - arithmetic operations
189 endm;
190
191
192 macro q1_vars; $ variables which define q1
193 symbol_table, $ - all symbol table maps
194 sym_om, $ - symtab pointer for omega
195 sym_sys, $ - symtab pointer for system scope
196 sym_dir, $ - symtab pointer for directory scope
197 sym_prog, $ - symtab pointer for program scope (member)
198 sym_main, $ - symtab pointer for main program (routine)
199 form_table, $ - all form table maps
200 std_form, $ - maps basic forms to their form table entry
201 system_routs, $ - set of all system-defined routines
202 sc_maps, $ - all maps defined for scopes
203 rout_maps, $ - all maps defined for routines
204 block_maps, $ - all maps defined for blocks
205 inst_maps $ - all maps defined for instructions
206 endm;
207
208
209 macro q1_consts; $ related constants
210 sc_types, $ - scope types: range values for sc_type
211 tup_sc_types, $ - ...
212 ft_types, $ - form types: range values for ft_type
213 tup_ft_types, $ - ...
214 ft_mapcs, $ - map types: range values for ft_mapc
215 tup_ft_mapcs, $ - ...
216 ft_predicates, $ - form table predicates is_fint, etc.
217 simple_type, $ - maps specific form types into classes
218 opcodes, $ - range values for opcode
219 tup_opcodes, $ - ...
220 copy_actions, $ - range values for copy_flag
221 tup_copy_actions, $ ...
222 ops_classes $ - collection of operator classes
223 endm;
224
225
1 .=member flow3e
2 .title 'control graph and interval analysis'
3
4$ control graph and interval analysis
5$ -----------------------------------
6
7$ one of the first steps of the optimizer is the construction of the
8$ 'control graph'. this graph consists of two maps on basic blocks:
9$
10$ after we build the control graph we divide the program into regions
11$ known as intervals. each interval corresponds to a loop in the
12$ program.
13$
14$ each time we construct an interval we add a new basic block called
15$ the interval's 'target block'. when we move code out of an interval,
16$ we move it to the interval's target block.
17$
18$ intervals are identified by their target block.
19$
20$ note that we do not build the derived graphs explicitly. instead,
21$ every time we build an interval we add a series of edges from the
22$ interval's target block to the interval's successors. these edges are
23$ called virtual edges since they do not correspond to actual program
24$ paths. we also add edges from the interval's predecessors to its
25$ target block, which replace corresponding edges entering the
26$ interval's head, and we also add an edge linking the target block to
27$ the head. all these edges, however, are real and indicate actual
28$ execution branchings.
29$
30$ the following maps and sets are used in connection with interval
31$ analysis.
32$
33$ intof: maps each block into its interval
34$
35$ int_nodes: maps each interval into a tuple containing the nodes of
36$ the interval in reverse postorder. iterating over
37$ int_nodes(i) is equivalent to iterating forward over the
38$ nodes in i.
39$
40$ ints: maps each routine 'r' into a tuple containing all the
41$ intervals in 'r' in reverse preorder. iterating
42$ backwards (forward) over this tuple is equivalent to
43$ iterating over the intervals of 'r' from outermost to
44$ innermost (innermost to outermost).
45$
46$ proper_ints: set of all proper intervals
47$
48$ vedges: the set of all virtual edges
49
50 macro intv_maps;
51 intof,
52 int_nodes,
53 ints,
54 proper_ints,
55 vedges
56 endm;
57
58$ the following macro maps each interval into its head:
59 macro int_head(i); int_nodes(i)(1) endm;
60
61
62 .title 'data flow maps'
63
64$ data flow maps
65$ --------------
66
67$ data flow analysis produces to maps on occurrences, called bfrom and
68$ ffrom, and a set of occurrences called bfrom_dead. before discussing
69$ these sets, we give the following definition:
70$
71$ an x-clear path is a path through the program which is free of
72$ occurrences of 'x'.
73$
74$ we now define the results of data flow:
75$
76$ 1. bfrom:
77$
78$ let 'i' be a use of 'x'. then bfrom{i} is the set of occurrences
79$ 'oi' of 'x' such that there is an x-clear path from oi to i.
80$
81$ 2. ffrom:
82$
83$ this is the inverse of bfrom.
84$
85$ 3. bfrom_dead:
86$
87$ this is the set of all occurrences 'oi' of 'x' such that there is
88$ an x-clear path from 'oi' to either a stop instruction (or an exit
89$ instruction in the case of local variables) or a redefinition of
90$ 'x'.
91
92
93$ the live analysis routine will compute another global map, known as
94$ 'liveat', which maps each basic block to the set of all variables live
95$ at its start.
96
97
98 .title 'the call graph'
99
100$ the call graph
101$ --------------
102
103$ the call graph is represented by the following maps:
104$
105$ cgraph: this is the actual call graph. it is a set of pairs
106$ [ p, q ] where p and q are procedures and p contains
107$ a call to q.
108$
109$ callsin: maps each procedure to the set of all calls within it.
110$
111$ callproc: maps each call block to the procedure it calls.
112$
113$ the call graph analysis will analyze cgraph and produce the following
114$ objects:
115$
116$ cg_sccs: a tuple of all strongly-connected components of the call
117$ graph arranged in their reverse postorder.
118$
119$ scc_nodes: maps each s.c.c s to the tuple of all its nodes in their
120$ reverse postorder.
121$
122$ scc_d: maps each s.c.c. s to the number of back-edge target
123$ nodes in s.
124$
125$ note that a procedure p is (co-)recursive iff it belongs to a
126$ s.c.c. s for which scc_d(s) > 0.
127
128 macro call_maps;
129 cgraph,
130 callsin,
131 callproc,
132 cg_sccs,
133 scc_nodes,
134 scc_d
135 endm;
136
137
1 .=member typs3f
2 .title 'types'
3
4$ types
5$ -----
6
7$ the typefinder produces a map 'typ' which sends each occurrence
8$ into a tuple with the following fields:
9$
10$ 1. grosstyp
11$
12$ a set of strings indicating all possible 'real types' an
13$ occurrence might take on.
14$
15$ the 'real type' of an occurrence is a string such as 'int'
16$ or 'real' which we might get by applying the setl 'type'
17$ operator to the occurence. the possible real types are:
18$ 'int', 'real', 'string', 'atom', 'tuple', and 'set'.
19$
20$ during automatic data structure choice we make use of additional
21$ descriptors whose grosstyps are 'base' and 'elmt'.
22$
23$ 2. is_knt
24$
25$ a flag which is 1 for known length tuples and om otherwise.
26$
27$ 3. comptyp
28$
29$ this field contains information on the component
30$ types of sets and tuples. it is interpreted in one of two
31$ ways depending on the value of 'is_knt'.
32$
33$ is_knt = 1: comptyp is a tuple whose i-th component is a
34$ type descriptor for the i-th component type.
35$
36$ is_knt = om: comptyp is the component type of the set or tuple.
37$
38$ the type finder exports three predicates for making the above
39$ tests. these predicates are called is_null, is_pair, and is_map.
40$ like the is_om field they have values of yes, no, and maybe.
41$
42$ at the end of the algorithm the type of each ovariable is a function
43$ of the instruction which defines it, while the type of each ivariable
44$ is a function of its use and the definitions and uses of all
45$ occurrences it is linked to.
46$
47$ we may wind up with two occurrences 'o' and 'i' which are linked by
48$ bfrom but have different types. this means that the code generator
49$ must insert a conversion along the path from 'o' to 'i'. the type
50$ finde checks whether such a conversion would be legal, and gives an
51$ error message if it would not.
52$
53$ the typefinder ignores reprs supplied by the user.
54$$$ ****** not consistent
55$ the user supplied reprs are validated later on by the
56$$$ ???? this not consistent with remark made elsewhere
57$ automatic data structure choice algorithm.
58$
59$ note that union types are very often overestimates. for example, the
60$ union of 'set(int)' and 'tuple(string)' is 'set or tuple of int or
61$ string'.
62
63
64$ macros for fields of type descriptors
65$ -------------------------------------
66
67$ the following macros are used to access parts of a type descriptor.
68$ note that the 'comptyp' macro allows for two possibilities:
69$
70$ 1. the type descriptor is 'general'. return general.
71$ 2. otherwise return the second component of the type descriptor.
72
73 macro grosstyp(t); t(1) endm;
74
75 macro comptyp(t);
76 (if t = type_gen or t = type_zero then t else t(2) end)
77 endm;
78
79 macro is_knt(t); t(3) endm;
80 macro is_om(t); (t_om in grosstyp(t)) endm;
81 macro is_notom(t); (t_om notin grosstyp(t)) endm;
82 macro is_based(t); (t(4) = based) endm;
83 macro set_type(t); t(5) endm;
84 macro map_type(t); t(6) endm;
85
86$ domtyp and rangetyp can be used on map types to retrive the domain and
87$ range type descriptor, respectively. we access the component type (a
88$ known-length tuple), its component type (a tuple of types of the known
89$ length tuple), and then the first or second components are the desired
90$ types.
91
92 macro domtyp(t); t(2)(2)(1) endm;
93 macro rangetyp(t); t(2)(2)(2) endm;
94
95$ ctypn is used to retrieve the type descriptor of the i'th component of
96$ a known-length tuple.
97
98 macro ctypn(t, i); t(2)(i) endm;
99
100$ test if grosstype is primitive, i.e. int, real, string, or atom.
101
102 macro is_prim(g); (t_set notin g and t_tuple notin g) endm;
103
104 macro is_const_int(oi); $ test for integer constant
105 (is_const(oi_sym(oi)) = 1 and t_int in grosstyp(typ(oi)))
106 endm;
107
108 macro t_types;
109 t_om,
110 t_int,
111 t_real,
112 t_string,
113 t_atom,
114 t_elmt,
115 t_error,
116 t_tuple,
117 t_set,
118 t_map
119 endm;
120
121 macro based_modes;
122 locl,
123 remt,
124 sprse,
125 neutrl
126 endm;
127
128 macro typ_consts; $ all constants for the type finder
129 no, maybe, yes, max_depth, max_len,
130 t_types, bsctyps, gross_types,
131 type_int, type_real, type_string, type_boolean,
132 type_atom, type_zero, type_gen, type_om, type_notom,
133 type_tuple, type_pair, type_set, type_map,
134 int_real, int_real_str, int_real_str_atom,
135 str_tup, str_tup_set, set_tup, tup_set_map,
136 type_int_real, type_int_real_str, type_str_tup,
137 type_str_tup_set,
138 ft_usetmaps, localtp, remotetp,
139 based_modes,
140 fixed_typ
141 endm;
142
143
144 macro ads_maps;
145 oi_repr,
146 actual_bases,
147 elmt_mode,
148 bscope,
149 userbase
150 endm;
151
152
1 .=member frms3g
2 .title 'forms'
3
4$ forms
5$ -----
6
7$ a 'form' is a complete description of how an object is represented
8$ at run time.
9$
10$ forms are treated as atoms on which various maps are defined. if f1
11$ and f2 are forms then f1 = f2 if and only if f(f1) = f(f2) for all 'f'
12$ defined on forms.
13$
14$ at the beginning of the typefinder phase we extract information from
15$ the 'form' map and build a map from 'occurrences' to 'types'.
16$ a 'type' is a somewhat simplified description of how objects are
17$ represented.
18$
19$ during the name splitting phase we rebuild formtab. when we do this
20$$$ ???? expand this point
21$ we preserve its unique invertibility.
22$
23$ the following maps are defined on forms:
24$
25$ ft_type: a string f_xxx giving the basic type
26$
27$ ft_mapc: a string ft_xxx indicating whether a map is stored as a
28$ map, smap, or mmap.
29$
30$ ft_elmt: gives the form of the elements of sets, maps, and
31$ tuples. in the case of procedures, this gives the form
32$ of the procedure parameters.
33$
34$ note that the form of the return-value of the procedure (if any) can
35$ be found by first retrieving the return value symbol as the first
36$ component in the value of the procedure, and then obtain its form.
37$
38$ ft_dom: gives the form of the domain elements of a map.
39$
40$ ft_im: gives f{x} for mmaps and f(x) for maps and smaps.
41$
42$ ft_imset gives f{x} for maps: always 'sparse set(ft_im)'.
43$
44$ ft_base: gives the form of the base 'b' in 'elmt b',
45$ local set(elmt b) and remote set(elmt b).
46$
47$ ft_low: the lower limit for a short integer.
48$
49$ ft_lim: this field gives various kinds of range information
50$ depending on the value of ft_type:
51$
52$ mixed tuples:
53$
54$ for mixed tuples, ft_lim gives the number of component
55$ types.
56$
57$ homogeneous tuples:
58$
59$ ft_lim indicates the minumum number of components we
60$ should allocate when we build the tuple. suppose 't' is
61$ a tuple which is usually indexed with values <= 5. then
62$ it is useful to allocate 't' with 5 components so that
63$ a large number of range checks can be suppressed. we
64$ indicate this by setting ft_lim = 5.
65$
66$ procedures and user defined operators:
67$
68$ ft_lim is one more than the number of arguments
69$
70$ integers:
71$
72$ if ft_lim is non-zero it indicates the maximum value
73$ which can be stored in the integer.
74$
75$ ft_tup: this field is used only for remote maps.
76$ a 'remote map(elmt b) mode' is represented using a tuple
77$ whose type is 'tuple(mode)'. ft_tup gives the form of
78$ the tuple.
79$
80$ ft_hashok: this is a flag indicating that the hash code of a set or
81$ tuple should be maintained at run time.
82$
83$ ft_neltok: this is a flag indicating that the cardinality of a set
84$ or tuple should be maintained at run time.
85$
86$ ft_pos: gives the position in the base element-block of a local
87$ object, relative to the origin of all similarly repred
88$ local objects of that base
89$
90$ ft_num: maps each base and locally-repred form to the number of
91$ such repred objects
92$
93$ ft_deref: pointer to the form after dereferencing it
94
95
96 macro form_table;
97 ft_type,
98 ft_mapc,
99 ft_elmt,
100 ft_dom,
101 ft_im,
102 ft_imset,
103 ft_base,
104 ft_low,
105 ft_lim,
106 ft_tup,
107 ft_hashok,
108 ft_neltok,
109 ft_pos,
110 ft_num,
111 ft_deref, $ dereferenced form
112 next_form, $ maps each form to the next form in formtab
113 basesymb $ maps each base form to its symtab entry
114 endm;
115$
116$ the ft_type codes are:
117$
118 macro ft_types;
119 f_gen, $ general
120 f_sint, $ short int
121 f_sstring, $ short string
122 f_atom, $ short atom
123 f_latom, $ long atom
124 f_elmt, $ element
125 f_uint, $ untyped int
126 f_ureal, $ untyped real
127 f_int, $ long or short integer
128 f_string, $ long or short chars
129 f_real, $ real
130 f_ituple, $ integer tuple
131 f_rtuple, $ real tuple
132 f_ptuple, $ packed tuple
133 f_tuple, $ std. tuple
134 f_mtuple, $ mixed tuple
135 f_uset, $ standard set
136 f_lset, $ local subset
137 f_rset, $ remote subset
138 f_umap, $ standard map
139 f_lmap, $ local map
140 f_rmap, $ remote map
141 f_limap, $ local integer map
142 f_lrmap, $ local real map
143 f_lpmap, $ local packed map
144 f_rimap, $ remote integer map
145 f_rrmap, $ remote real map
146 f_rpmap, $ remote packed map
147 f_base, $ base
148 f_pbase, $ plex base
149 f_uimap, $ unbased untyped integer map
150 f_urmap, $ unbased untyped real map
151 f_error, $ error
152 f_proc, $ procedure or operator
153 f_memb, $ member
154 f_lab $ label
155 endm;
156$
157$ the various map cases are:
158$
159 macro ft_mapcs;
160 ft_map, $ map
161 ft_smap, $ smap
162 ft_mmap $ mmap
163 endm;
164$
165$ we provide the following predicates on forms:
166$
167$ is_fint: true for typed and untyped integers
168$ is_freal: true for typed and untyped reals
169$ is_funt: true for untyped integers and reals
170$ is_fnum: true for typed and untyped integers and reals
171$ is_fstring: true for short and long strings
172$ is_fprim: true for primitive types
173$ is_ftup: true for tuples
174$ is_fset: true for sets, maps, and bases
175$ is_fmap: true for maps
176$ is_floc: true for local sets and maps
177$ is_frem: true for remote sets and maps
178$ is_fbased: true for based types, bases, and long atoms
179$ is_fimap: true for untyped integer maps
180$ is_frmap: true for untyped real maps
181$ is_fbase: true for bases and plex bases
182$
183 macro is_fint(fm); (ft_type(fm) in ft_fint) endm;
184 macro is_freal(fm); (ft_type(fm) in ft_freal) endm;
185 macro is_funt(fm); (ft_type(fm) in ft_funt) endm;
186 macro is_fnum(fm); (ft_type(fm) in ft_fnum) endm;
187 macro is_fstring(fm); (ft_type(fm) in ft_fstring) endm;
188 macro is_fprim(fm); (ft_type(fm) in ft_fprim) endm;
189 macro is_ftup(fm); (ft_type(fm) in ft_ftup) endm;
190 macro is_fset(fm); (ft_type(fm) in ft_fset) endm;
191 macro is_fmap(fm); (ft_type(fm) in ft_fmap) endm;
192 macro is_floc(fm); (ft_type(fm) in ft_floc) endm;
193 macro is_frem(fm); (ft_type(fm) in ft_frem) endm;
194 macro is_fbased(fm); (ft_type(fm) in ft_fbased) endm;
195 macro is_fimap(fm); (ft_type(fm) in ft_fimap) endm;
196 macro is_frmap(fm); (ft_type(fm) in ft_frmap) endm;
197 macro is_fbase(fm); (ft_type(fm) in ft_fbase) endm;
198
199
200 macro ft_predicates;
201 ft_fint, ft_freal, ft_funt, ft_fnum, ft_fstring, ft_fprim,
202 ft_ftup, ft_fset, ft_fmap, ft_floc, ft_frem, ft_fbased,
203 ft_fimap, ft_frmap, ft_fbase
204 endm;
205
206
1 .=member imps3i
2 .title 'various initial maps'
3
4$ various initial maps
5$ --------------------
6
7$ during the initial code scanning phase (phase 1 below), we
8$ build up varrious maps required by subsequent optimization
9$ phases. these maps are:
10
11 macro var_maps;
12 variables, $ set of all program variables
13 uservars, $ set of all variables appearing in the source
smfe 2 itervars, $ set of all internal iterator variables
14 globalvars, $ set of all global variables
15 localvars, $ maps each routine to its local variables
16 occsof $ maps each variable to all its occurrences
17 endm;
18
19 macro exp_maps;
20 globalexps, $ set of all expressions which depend on
21 $ at least one global variable
22 localexps, $ maps each routine to the set of its strictly
23 $ local expressions
24 allexps, $ set of all expresions appearing in the program
25 opcexp, $ maps each expression to the opcode defining it
26 argsexp, $ maps each expression to the tuple of its input
27 $ arguments
28 dependon $ maps each variable to the set of all expres-
29 $ sions which explicitly depend on it
30 endm;
31
32
1 .=member cpar3j
2 .title 'control parameters'
3
4$ control parameters
5$ ------------------
6
7$ the following variables are read from the control card:
8$
9$ default value variable set meaning
10$ ------------- ------------ -------
11$
12$ rem=1/1 rem run time error mode
13$ db=/sfci dump_string first initial of each table to be dumped
14$
15$ a: available expression module
16$ b: bfrom module
17$ c: code after preliminary pass,
18$ conversion analysis
19$ d: data structure module
20$ x: base merging phase
21$ y: base adjustment phase
22$ e: execution statistics
23$ f: form table
24$ i: intervals after find_ints
25$ s: symbol table
26$ t: type finder module
27$
28$ full=0/1 extended debugging diagnostic
29$ summary=/all print final summary
30$
31$ note that code motion can be performed only if the run time error mode
32$ is 0 or 1. any other value indicates that errors detected in code
33$ moved out of loops will cause a run time abort.
34
35 macro control_params;
36 q1_file,
37 ssm_file, $ cstmt_count -> setl source line
38 term_file,
39 prog_level,
40 debug_flag, $ perform error testing
41 at_flag, $ automatic titling
smfk 1 lcp_flag, $ listing control: program parameters
smfk 2 lcs_flag, $ listing control: program statistics
42 rem, $ run-time error mode
43 dump_string
44 endm;
45
46 macro utilities;
47 add_sym(rd), $ add symbol
48 del_sym(rd, rd, rd), $ delete symbol
49 add_var(rd), $ add variable
50 add_int(rd, rd), $ add integer constant
51 add_label(rd), $ add label
52 add_form(rd), $ add form
53 add_block(rd, rd, rd), $ add block to scope
54 add_inst(rd, rd, rd(*)), $ add instruction
55 insert_ins(rw, rd, rd(*)), $ insert instruction after i
56 insert_ins1(rw, rd, rd), $ insert with tuple of args
57 del_block(rd, rd, rd), $ delete block from routine
58 del_inst(rw, rd, rd) $ delete instruction from block
59 endm;
60
61
62 macro print_utils;
63 ermsg(rd), $ print error message
64 abort(rd), $ print error message and abort
65 prints(rd, rd), $ print sorted map
66 format_type(rd), $ format type descriptor into a string
67 format_repr(rd), $ format repr descriptor into a string
68 format_form(rd), $ format form table entry into string
69 format_inst(rd, rd) $ format instruction into source string
70 endm;
71
1 .=member decls4
2
3 directory setl_optimizer;
4
5 var
6 sc_maps, $ maps on scopes
7 block_maps, $ maps on blocks
8 inst_maps; $ maps on instructions
9
10 const
11 copy_actions, $ copy actions for instructions
12 base_copy_actions = { copy_actions },
13 tup_copy_actions = [ copy_actions ],
14 sc_types, $ scope types
15 base_sc_types = { sc_types },
16 tup_sc_types = [ sc_types ];
17
18 var
19 system_routs, $ set of all system routines (like read, print,
20 $ etc.) called by the program being analysed.
21 rout_maps, $ maps on routines
22 symbol_table, $ q1 symbol table maps
23 sym_om, $ - symtab pointer for omega
24 sym_sys, $ - symtab pointer for system scope
25 sym_dir, $ - symtab pointer for directory scope
26 sym_prog, $ - symtab pointer for program scope (member)
27 sym_main; $ - symtab pointer for main program (routine)
28
29 var
30 all_modules; $ set of all modules and program declared
31 $ in a directory
32
33 const
34 opcodes,
35 base_opcodes = { opcodes },
36 tup_opcodes = [ opcodes ],
37
38 ops_exps = $ operations yielding valid expressions
39 { q1_in, q1_notin, q1_incs,
40 q1_eq, q1_ne, q1_lt, q1_ge,
smfh 2 q1_pos,
41 q1_add, q1_sub, q1_mult, q1_slash,
42 q1_div, q1_mod, q1_exp, q1_atan2,
43 q1_max, q1_min, q1_npow,
44 q1_not, q1_even, q1_odd,
45 q1_isint, q1_isreal, q1_isstr, q1_isbool,
46 q1_isatom, q1_istup, q1_isset, q1_ismap,
47 q1_dom, q1_range, q1_pow, q1_nelt,
48 q1_abs, q1_char, q1_ceil, q1_floor,
49 q1_fix, q1_float, q1_sin, q1_cos,
50 q1_tan, q1_arcsin, q1_arccos, q1_arctan,
51 q1_tanh, q1_expf, q1_log, q1_sqrt,
52 q1_sign, q1_type, q1_str, q1_val,
53 q1_umin,
54 q1_of, q1_ofa, q1_subst, q1_end,
55 q1_set, q1_tup },
56
57 ops_modify = $ operations which can modify program variables
58 { q1_with,
59 q1_less, q1_lessb, q1_lesse, q1_lessf,
60 q1_arb, q1_arbb, q1_arbe, q1_rand,
61 q1_newat, q1_time, q1_date, q1_na,
62 q1_set1, q1_tup1,
63 q1_inext, q1_next, q1_inextd, q1_nextd,
64 q1_sof, q1_sofa, q1_ssubst, q1_send,
65 q1_def,
66 q1_asn, q1_argin, q1_argout, q1_sargout },
67
68 ops_extract = $ extractions
69 { q1_from, q1_rand,
70 q1_arb, q1_arbb, q1_arbe,
71 q1_next, q1_nextd, q1_inext, q1_inextd },
72
73 ops_retrieve = $ retrievals
74 { q1_of, q1_ofa, q1_end, q1_subst },
75
76 ops_update = $ updates
77 { q1_add, q1_sub, q1_mult,
78 q1_with, q1_less, q1_lesse, q1_lessb,
79 q1_from, q1_fromb, q1_frome, q1_lessf },
80
81 ops_sin = $ sinister assignments
82 { q1_sof, q1_sofa, q1_ssubst, q1_send },
83
84 ops_bin = $ binary operations
85 { q1_in, q1_notin, q1_incs,
86 q1_eq, q1_ne, q1_lt, q1_ge,
smfh 3 q1_pos,
87 q1_add, q1_sub, q1_mult, q1_slash,
88 q1_div, q1_mod, q1_exp, q1_atan2,
89 q1_max, q1_min, q1_npow, q1_with,
90 q1_less, q1_lessb, q1_lesse, q1_lessf },
91
92 ops_un = $ unary operators
93 { q1_not, q1_even, q1_odd,
94 q1_isint, q1_isreal, q1_isstr, q1_isbool,
95 q1_isatom, q1_istup, q1_isset, q1_ismap,
96 q1_arb, q1_arbb, q1_arbe,
97 q1_dom, q1_range, q1_pow, q1_nelt,
98 q1_abs, q1_char, q1_ceil, q1_floor,
99 q1_fix, q1_float, q1_sin, q1_cos,
100 q1_tan, q1_arcsin, q1_arccos, q1_arctan,
101 q1_tanh, q1_expf, q1_log, q1_sqrt,
102 q1_sign, q1_type, q1_str, q1_val,
103 q1_umin, q1_rand },
104
105 ops_goto = $ all branches
106 { q1_goto, q1_case,
smfg 6 q1_if, q1_ifnot, q1_bif, q1_bifnot,
smfg 7 q1_ifasrt, q1_ifrand },
108
109 ops_ovar = $ operations with o-variables
110 { q1_in, q1_notin, q1_incs,
111 q1_eq, q1_ne, q1_lt, q1_ge,
smfh 4 q1_pos,
112 q1_add, q1_sub, q1_mult, q1_slash,
113 q1_div, q1_mod, q1_exp, q1_atan2,
114 q1_max, q1_min, q1_npow,
115 q1_from, q1_fromb, q1_frome, q1_with,
116 q1_less, q1_lessb, q1_lesse, q1_lessf,
117 q1_not, q1_even, q1_odd,
118 q1_isint, q1_isreal, q1_isstr, q1_isbool,
119 q1_isatom, q1_istup, q1_isset, q1_ismap,
120 q1_arb, q1_arbb, q1_arbe,
121 q1_dom, q1_range, q1_pow, q1_nelt,
122 q1_abs, q1_char, q1_ceil, q1_floor,
123 q1_fix, q1_float, q1_sin, q1_cos,
124 q1_tan, q1_arcsin, q1_arccos, q1_arctan,
125 q1_tanh, q1_expf, q1_log, q1_sqrt,
126 q1_sign, q1_type, q1_str, q1_val,
127 q1_umin, q1_rand,
128 q1_newat, q1_time, q1_date, q1_na,
129 q1_set, q1_set1, q1_tup, q1_tup1,
130 q1_inext, q1_next, q1_inextd, q1_nextd,
131 q1_of, q1_ofa, q1_subst, q1_end,
132 q1_sof, q1_sofa, q1_ssubst, q1_send,
133 q1_def,
134 q1_asn, q1_argin, q1_argout, q1_sargout },
135
136 ops_ivar = $ operations whose arg1's are i-variables
137 { q1_push, q1_free, q1_use, q1_sargin,
smfg 8 q1_if, q1_ifnot, q1_bif, q1_bifnot,
smfg 9 q1_case, q1_asrt, q1_isom, q1_notom },
139
140 ops_iter = $ iterators
141 { q1_inext, q1_next, q1_inextd, q1_nextd },
smfe 3
smfe 4 ops_typepred = $ type predicates
smfe 5 { q1_isint, q1_isreal, q1_isstr, q1_isbool,
smfe 6 q1_isatom, q1_istup, q1_isset, q1_ismap },
142
143 ops_typeback = $ operators for which backwards type propagation
144 $ is meaningful.
145 { q1_in, q1_notin, q1_incs,
smfh 5 q1_lt, q1_ge, q1_pos,
147 q1_add, q1_sub, q1_mult, q1_slash,
148 q1_div, q1_mod, q1_exp, q1_atan2,
149 q1_max, q1_min, q1_npow, q1_with,
150 q1_less, q1_lessb, q1_lesse, q1_lessf,
151 q1_not, q1_even, q1_odd,
smfe 7 q1_isint, q1_isreal, q1_isstr, q1_isbool,
smfe 8 q1_isatom, q1_istup, q1_isset, q1_ismap,
152 q1_arb, q1_arbb, q1_arbe,
153 q1_dom, q1_range, q1_pow, q1_nelt,
154 q1_abs, q1_char, q1_ceil, q1_floor,
155 q1_fix, q1_float, q1_sin, q1_cos,
156 q1_tan, q1_arcsin, q1_arccos, q1_arctan,
157 q1_tanh, q1_expf, q1_log, q1_sqrt,
smfe 9 q1_sign, q1_type, q1_str, q1_val,
smfe 10 q1_umin, q1_rand,
159 q1_set, q1_set1, q1_tup, q1_tup1,
160 q1_inext, q1_next, q1_inextd, q1_nextd,
161 q1_of, q1_ofa, q1_subst, q1_end,
162 q1_sof, q1_sofa, q1_ssubst, q1_send,
163 q1_argin, q1_argout, q1_sargin,
smfg 10 q1_if, q1_ifnot, q1_bif, q1_bifnot,
smfg 11 q1_asn, q1_asrt, q1_isom, q1_notom },
165
166 ops_destuse1 = $ ops whose first ivar is used destructively
167 { q1_add, q1_sub, q1_mult, q1_with,
168 q1_less, q1_lessb, q1_lesse, q1_lessf },
169
170 ops_destuse3 = $ same for third ivar
171 { q1_next, q1_sof, q1_sofa, q1_send },
172
173 ops_destuse4 = $ same for fourth ivar
174 { q1_ssubst },
175
176 ops_share1 = $ ops that share their first argument
177 { q1_of, q1_push, q1_asn, q1_next,
178 q1_arb, q1_nextd, q1_ofa,
179 q1_argin, q1_argout },
180
181 ops_share2 = $ second argument
182 { q1_argin, q1_asn },
183
184 ops_share3 = $ third argument
185 { q1_with, q1_sof, q1_sofa },
186
187 ops_share4 = $ forth argument
188 { q1_argout },
189
190 ops_smap = $ ops modifying a map leaving it a smap
191 { q1_sof },
192
193 ops_local = $ ops supporting local representation
194 { q1_in, q1_notin, q1_less, q1_lessf,
195 q1_with, q1_of, q1_ofa, q1_sof,
196 q1_sofa },
197
198 ops_sparse = $ ops supporting sparse repr (no hashing)
199 { q1_npow, q1_arb, q1_from, q1_dom,
200 q1_range, q1_nelt, q1_pow, q1_rand,
201 q1_next, q1_inext, q1_nextd, q1_inextd,
202 q1_asn, q1_argin, q1_sargin, q1_sargout,
203 q1_argout },
204
205 ops_nonewval = $ ops with ovar that only transmit values
206 { q1_from, q1_fromb, q1_frome,
207 q1_arb, q1_arbb, q1_arbe,
208 q1_of, q1_ofa,
209 q1_asn, q1_argin, q1_argout },
210
211 ops_fold = $ operations which can be constant folded
214 { q1_in, q1_notin, q1_incs,
215 q1_eq, q1_ne, q1_lt, q1_ge,
smfh 6 q1_pos,
216 q1_add, q1_sub, q1_mult, q1_slash,
217 q1_div, q1_mod, q1_exp, q1_atan2,
218 q1_max, q1_min, q1_npow, q1_with,
219 q1_less, q1_lessb, q1_lesse, q1_lessf,
220 q1_not, q1_even, q1_odd,
221 q1_isint, q1_isreal, q1_isstr, q1_isbool,
222 q1_isatom, q1_istup, q1_isset, q1_ismap,
223 q1_dom, q1_range, q1_pow, q1_nelt,
224 q1_abs, q1_char, q1_ceil, q1_floor,
225 q1_fix, q1_float, q1_sin, q1_cos,
226 q1_tan, q1_arcsin, q1_arccos, q1_arctan,
227 q1_tanh, q1_expf, q1_log, q1_sqrt,
228 q1_sign, q1_type, q1_str, q1_val,
229 q1_umin,
230 q1_of, q1_ofa, q1_subst, q1_end,
231 q1_sof, q1_sofa, q1_ssubst, q1_send,
smfb 1 q1_asn, q1_argin, q1_argout },
233
234 ops_arith = $ arithmetical operations
235 { q1_add, q1_sub, q1_mult, q1_slash,
236 q1_div, q1_mod, q1_exp,
237 q1_max, q1_min };
238
239
240 var cessor, $ maps each block into its successors
241 pred; $ maps each block into its predecessors
242
243 var intv_maps; $ maps on intervals
244
245 var ocrs_maps, $ maps on occurrences
246 oi_sets; $ sets on occurrences
247
248 var bfrom, $ maps each occurrence to previous ones
249 ffrom, $ maps each occurrence to subsequent ones
250 bfrom_dead; $ set of occurrences that can be dead on a path
251
252 var call_maps; $ maps on call instructions
253
254 var fom_syms, xom_syms,
255 fom_ocrs, xom_ocrs;
256
257 var dead_labs; $ labels of blocks being deleted
258 var cut_blocks; $ blocks bypassed by short_cut
259
260 var typ;
261
262 const
263 no = om,
264 maybe = 1,
265 yes = 1;
266
267 const
268 max_depth = 06, $ max nesting depth for type descriptors
269 max_len = 06; $ maximum length for known-length tuples
270
271 const
272 t_om = 'om',
smfc 1 t_int = 'integer',
274 t_real = 'real',
275 t_string = 'string',
276 t_atom = 'atom',
277 t_elmt = 'elmt',
278 t_error = 'error',
279 t_tuple = 'tuple',
280 t_set = 'set',
281 t_map = 'map',
282 gross_types = { t_types };
283
284 const
285 bsctyps = { t_om, t_int, t_real, t_string, t_atom,
286 t_tuple, t_set };
287
288 const
289 type_zero = [ {} ],
290 type_om = [ { t_om } ],
291 type_gen = [ bsctyps, type_zero, false ],
292
293 type_notom = [ { t_int, t_real, t_string,
294 t_atom, t_tuple, t_set },
295 type_gen, false ],
296
297 type_int = [ { t_int } ],
298 type_real = [ { t_real } ],
299 type_string = [ { t_string } ],
300 type_boolean = [ { t_atom } ],
301 type_atom = [ { t_atom } ],
302
303 type_tuple = [ { t_tuple }, type_gen, false ],
304 type_pair = [ { t_tuple }, [ type_notom,
305 type_notom ], true ],
306
307 type_set = [ { t_set }, type_gen, false ],
308 type_map = [ { t_set }, type_pair, false ];
309
310 const
311 int_real = { t_int, t_real },
312 int_real_str = { t_int, t_real, t_string },
313 int_real_str_atom = { t_int, t_real, t_string, t_atom },
314 str_tup = { t_string, t_tuple },
315 str_tup_set = { t_string, t_tuple, t_set },
316 set_tup = { t_tuple, t_set },
317 tup_set_map = { t_tuple, t_set, t_map };
318
319 const
320 type_int_real = [ int_real ],
321 type_int_real_str = [ int_real_str ],
322 type_str_tup = [ str_tup, type_gen, false ],
323 type_str_tup_set = [ str_tup_set, type_gen, false ];
324$
325$ the following constant map sends opcodes with a fixed output type to
326$ to that type:
327$
328 const
329 fixed_typ =
330 { [ q1_eq, type_boolean ],
331 [ q1_ne, type_boolean ],
332 [ q1_isint, type_boolean ],
333 [ q1_isreal, type_boolean ],
334 [ q1_isstr, type_boolean ],
335 [ q1_isbool, type_boolean ],
336 [ q1_isatom, type_boolean ],
337 [ q1_istup, type_boolean ],
338 [ q1_isset, type_boolean ],
339 [ q1_ismap, type_boolean ],
340 [ q1_type, type_string ],
341 [ q1_str, type_string ],
342 [ q1_date, type_string ],
343 [ q1_time, type_int ],
344 [ q1_na, type_int ],
345 [ q1_newat, type_atom ] };
346
347 const
348 based_modes,
349 base_based_modes = { based_modes };
350
351 var ads_maps;
352
353 var form_table;
354
355 const
356 ft_types,
357 base_ft_types = { ft_types },
358 tup_ft_types = [ ft_types ],
359 ft_mapcs,
360 base_ft_mapcs = { ft_mapcs },
361 tup_ft_mapcs = [ ft_mapcs ];
362
363
364$ the variable 'std_form' maps the basic types 'f_xxx' into their
365$ forms. it is built when the q1 tables are read in.
366$$$ ???? logic here unclear, needs careful check
367
368 var std_form;
369
370$ the following constant map is used to obtain the
371$ type class of each of the above 'f_xxx' form types
372 const
373 simple_type =
374 { [ f_gen, 'gen' ],
375 [ f_sint, 'int' ],
376 [ f_sstring, 'string' ],
377 [ f_atom, 'atom' ],
378 [ f_latom, 'atom' ],
379 [ f_elmt, 'elmt' ],
380 [ f_uint, 'int' ],
381 [ f_ureal, 'real' ],
382 [ f_int, 'int' ],
383 [ f_string, 'string' ],
384 [ f_real, 'real' ],
385 [ f_ituple, 'tuple' ],
386 [ f_rtuple, 'tuple' ],
387 [ f_ptuple, 'tuple' ],
388 [ f_tuple, 'tuple' ],
389 [ f_mtuple, 'tuple' ],
390 [ f_uset, 'set' ],
391 [ f_lset, 'set' ],
392 [ f_rset, 'set' ],
393 [ f_umap, 'map' ],
394 [ f_lmap, 'map' ],
395 [ f_rmap, 'map' ],
396 [ f_lpmap, 'map' ],
397 [ f_limap, 'map' ],
398 [ f_lrmap, 'map' ],
399 [ f_rpmap, 'map' ],
400 [ f_rimap, 'map' ],
401 [ f_rrmap, 'map' ],
402 [ f_base, 'base' ],
403 [ f_pbase, 'base' ],
404 [ f_uimap, 'map' ],
405 [ f_urmap, 'map' ],
406 [ f_error, 'error' ],
407 [ f_proc, 'proc' ],
408 [ f_memb, 'memb' ],
409 [ f_lab, 'lab' ] };
410
411
412 const
413 ft_fint = { f_sint, f_uint, f_int },
414 ft_freal = { f_ureal, f_real },
415 ft_funt = { f_uint, f_ureal },
416 ft_fnum = { f_sint, f_uint, f_int,
417 f_ureal, f_real },
418 ft_fstring = { f_sstring, f_string },
419 ft_fprim = { f_sint, f_sstring, f_atom, f_uint,
420 f_ureal, f_int, f_string, f_real },
421 ft_ftup = { f_tuple, f_ituple, f_rtuple, f_ptuple,
422 f_mtuple },
423 ft_fset = { f_uset, f_lset, f_rset,
424 f_umap, f_uimap, f_urmap,
425 f_lmap, f_limap, f_lrmap, f_lpmap,
426 f_rmap, f_rimap, f_rrmap, f_rpmap,
427 f_base, f_pbase },
428 ft_fmap = { f_umap, f_uimap, f_urmap,
429 f_lmap, f_limap, f_lrmap, f_lpmap,
430 f_rmap, f_rimap, f_rrmap, f_rpmap },
431 ft_floc = { f_lset,
432 f_lmap, f_limap, f_lrmap, f_lpmap },
433 ft_frem = { f_rset,
434 f_rmap, f_rimap, f_rrmap, f_rpmap },
435 ft_fbased = { f_elmt, f_lset, f_rset,
436 f_lmap, f_limap, f_lrmap, f_lpmap,
437 f_rmap, f_rimap, f_rrmap, f_rpmap },
438 ft_fimap = { f_limap, f_rimap, f_uimap },
439 ft_frmap = { f_lrmap, f_rrmap, f_urmap },
440 ft_fbase = { f_base, f_pbase };
441
442
443 const
444 ft_usetmaps =
445 { f_uset, f_umap, f_uimap, f_urmap };
446
447 const
448 localtp =
449 { [ f_uset, f_lset ],
450 [ f_umap, f_lmap ],
451 [ f_uimap, f_limap ],
452 [ f_urmap, f_lrmap ] };
453
454 const
455 remotetp =
456 { [ f_uset, f_rset ],
457 [ f_umap, f_rmap ],
458 [ f_uimap, f_rimap ],
459 [ f_urmap, f_rrmap ] };
460
461 var push_former; $ maps each push instruction to the set or
462 $ tuple former following it.
463
464 var
465 var_maps, $ maps on variables
466 exp_maps, $ maps on expressions
467 control_params; $ program parameters
468 var statistics; $ used to collect execution statistics
469$
470$ the following global objects are used for program annotation purposes.
471$ we annotate each program analysed in the following manner:
472$
473$ 1. for each routine p, we print a summary of all global variables
474$ referenced or defined, formatted as reads/writes lists.
475$
476$ 2. for each routine p, we print a summary of all routines q which are
477$ called from p, formatted as an imports list. (this information is
478$ contained in the call graph.)
479$
480$ 3. for each destructive use du of a global variable x in a routine p,
481$ we print warning message.
482$
483 var
484 globals_du, $ routine -> destructive use occurrence
smfk 3 globals_e, $ maps routines to globals exposed
485 globals_r, $ maps routines to globals used
486 globals_w, $ maps routines to globals defined
487 messages; $ cstmt_count -> severity -> message
488
489
490$
491$ initialise the maps in the setl data structures to the null set.
492$
493 init
494 $ initilise symbol table maps
495 name := {}, value := {}, scope := {},
496 form := {}, alias := {},
497 is_read := {}, is_write := {}, is_const := {},
498 is_internal := {}, is_temp := {}, is_store := {},
499 is_stk := {}, is_param := {}, is_repr := {},
500 is_init := {}, is_seen := {}, is_back := {},
501 is_rec := {}, next_sym := {},
502
503 $ initialise form maps
504 ft_type := {}, ft_mapc := {}, ft_elmt := {},
505 ft_dom := {}, ft_im := {}, ft_imset := {},
506 ft_base := {},
507 ft_low := {}, ft_lim := {}, ft_tup := {},
508 ft_hashok := {}, ft_neltok := {}, ft_pos := {},
509 ft_num := {}, ft_deref := {}, next_form := {},
510 basesymb := {}, std_form := {},
511
512 $ initialise scope maps
513 scopes := [], cont_scopes := {},
514 sc_type := {}, sc_nprocs := {},
515 sc_stmt_ct := {}, sc_estmt_ct := {},
516 first_sym := {}, last_sym := {},
517 first_form := {}, last_form := {},
518 first_block := {}, last_block := {},
519 all_modules := {},
520
521 $ initialise routine maps
522 routs := {}, rentry := {}, rexit := {},
523 rstop := {}, rparams := {}, system_routs := {},
524 membof := {},
525
526 $ initialise interval maps
527 ints := {}, proper_ints := {},
528
529 $ initialise block maps
530 routof := {}, next_block := {}, first_inst := {},
531 last_inst := {}, cessor := {}, pred := {},
532 intof := {}, int_nodes := {}, vedges := {},
533 cut_blocks := {}, dead_labs := {},
534
535 $ initialise instruction maps
536 opcode := {}, args := {}, occs := {},
537 blockof := {}, stmtof := {}, copy_flag := {},
538 share_flag := {}, next_inst := {},
539
540 $ initialise maps on call instructions
541 cgraph := {}, callsin := {}, callproc := {},
542 cg_sccs := [], scc_nodes := {}, scc_d := {},
543
544 $ initilise maps on occurrences
545 instno := {}, argno := {},
546 all_oi := {}, all_o := {}, all_i := {},
547
548 $ initialise maps on variables
smfe 11 variables := {}, uservars := {}, itervars := {},
smfe 12 globalvars := {}, localvars := {}, occsof := {},
551
552 $ initilise maps on expressions
553 globalexps := {}, localexps := {}, allexps := {},
554 opcexp := {}, argsexp := {}, dependon := {},
555
556 $ initialise maps for automatic documentation
smfk 4 globals_du := {}, globals_e := {}, globals_r := {},
smfk 5 globals_w := {},
smfk 6
558 messages := {},
560 statistics := [],
561 push_former := {};
562
563
1 .=member mman5a
2 .title 'module specifications'
3
4$ overall design of the optimizer
5$ -------------------------------
6
7$ in this section we describe the overall organization of the optimizer.
8$ the optimizer contains one top level routine for each section; these
9$ routines are called in sequence from the main program.
10
11$ in describing each section, we concentrate on the following points:
12
13$ 1. the general purpose of the section
14$ 2. the algorithm used
15$ 3. the principal routines contained in the section
16$ 4. the tables produced as output of the section
17$ 5. the diagnostics, warnings, etc. issued to the user.
18
19
20 .title 'main program'
21
22$ main program
23$ ------------
24
25$ the main program simply calls successive phases of the optimizer
26$ till the program converges.
27
28 program setl_optimizer - main:
29
30 imports
31 opt_ini, $ initialize
32 cgraph_analysis, $ call graph analysis
33 find_intervals, $ interval analysis
34 live, $ live variable analysis
35 csx, $ common subexpr elimination+code motion
36 find_bfrom, $ bfrom computation
smfb 2 find_region_constants, $ flow-constant loop analysis
37 type_find, $ type analysis
38 auto_data, $ automatic data structure selection
39 conv_optimize, $ conversion optimization
40 copy_optimize, $ copy optimization
41 opt_term; $ print tables, etc.
42
43 writes
44 statistics;
45
46
1 .=member mutl5b
2 .title 'utilities'
3
4$ utilities
5$ ---------
6
7 module setl_optimizer - util:
8
9 exports
10 print_utils,
11 utilities;
12
13 writes
14 oi_sets, $ sets on occurrences
15 var_maps, $ maps on variables
16 exp_maps, $ maps on expressions
17 ocrs_maps, $ maps defining occurrences
18 dead_labs,
19 q1_vars, $ variables defining q1
20 messages; $ cstmt_count -> severity -> message
21
22 reads
23 q1_consts, q1_vars, $ constants and variables defining q1
24 typ_consts, $ all constants for the type finder
25 cessor,
26 pred,
27 intv_maps; $ maps on intervals
28
29
30 .title 'compiler interface'
31
32$ compiler interface
33$ ------------------
34
35$ the setl compiler is written in a low level language called 'little'.
36$ the semantic pass writes the q1 tables onto a binary file, which is
37$ then read in by the code generator.
38
39$ the interface module contains two main routines. the first reads in
40$ the file created by the semantic pass using the setl binary i/o, and
41$ converts the q1 tables to setl data structures. the second routine
42$ converts the setl data structures back to little data structures and
44$ writes them onto the q1 file.
45
46 module setl_optimizer - interface:
47
48 reads
49 q1_consts, $ constants used to define q1
50 control_params; $ program parameters
51
52 writes
53 all_modules,
54 ocrs_maps, $ maps defining occurrences
55 q1_vars; $ variables defining q1
56
57 exports
58 read_q1,
59 write_q1;
60
61 imports
62 can_conv(rd, rd),
63 utilities,
64 print_utils,
65 dmp(rd, rd(*));
66
67
68 module setl_optimizer - dumps:
69
70 exports
71 dmp(rd, rd(*)),
72 print_summary(rd); $ print scope summary
73
74 imports
75 print_utils;
76
77 reads
78 q1_consts, $ constants used to define q1
79 q1_vars, $ variables defining q1
80 var_maps, $ maps on variables
81 all_modules, $ set of all modules
smfk 7 globals_e, $ maps routines to globals exposed
82 globals_r, $ maps routines to globals used
83 globals_w, $ maps routines to globals defined
84 globals_du, $ destructively used global variables
85 call_maps, $ maps on the call graph
86 ocrs_maps, $ maps defining occurrences
87 cessor,
smfk 8 ffrom,
88 intv_maps; $ maps on intervals
89
90
91 .title 'initialization'
92
93$ phase 1. initialization
94$ -----------------------
95
96$ in this phase we read the control card, read the q1 tables generated
97$ by the semantic pass, and make a prepass over the program.
99
100$ the prepass does the following things:
101
102$ 1. modify the input so that it appears to be a complete program.
103$ 2. compute the 'oi_sets' such as all_oi.
104$ 3. fill in the fourth arguments of argin and argout instructions.
105$ 4. replace each 'from' instruction with an 'arb' followed by a 'less'
106$ 5. compute the 'var_maps', 'exp_maps' and some of the 'call_maps'
107$ (see section on 'various initial maps' for details).
108
109$ steps (3) and (4) are reversed before the program is written out for
110$ the code generator.
111
112 module setl_optimizer - optinit:
114
115 imports
116 print_utils,
117 read_q1,
118 dmp(rd, rd(*)),
119 utilities;
120
121 reads
122 q1_consts; $ constants used to define q1
123
124 writes
125 control_params, $ program parameters
126 q1_vars, $ variables defining q1
127 all_modules,
128 push_former,
129 cut_blocks,
130 var_maps, $ maps on variables
131 exp_maps, $ maps on expressions
132 ocrs_maps, $ maps defining occurrences
133 call_maps, $ maps on the call graph
134 oi_sets, $ sets on occurrences
135 messages, $ cstmt_count -> severity -> message
136 statistics; $ used to collect execution statistics
137$ note that these names are macros for groups of variables defined
138$ above.
139
140 exports
141 opt_ini;
142
143
1 .=member mcgr5c
2 .title 'call graph analysis'
3
4$ phase 2. call graph analysis
5$ ----------------------------
6
7$ this phase analyses the call graph and builds up some auxiliary
8$ related maps. the relevant procedures are contained in the
9$ 'dataflow_solver' module. for details see the section 'data-flow
10$ analysis package' below.
11
1 .=member mint5d
2 .title 'interval analysis'
3
4$ phase 3. interval analysis
5$ --------------------------
6
7$ interval analysis is performed using a variation of tarjans
8$ algorithm. the outputs of the algorithm are described in the
9$ previous section, 'control graph and interval analysis'.
10
11
13 module setl_optimizer - interval_analysis:
14
16 imports
17 dmp(rd, rd(*)),
18 print_utils,
19 utilities;
20
21 reads
22 control_params, $ program parameters
23 q1_consts; $ constants used to define q1
24
25 writes
26 q1_vars, $ variables defining q1
27 dead_labs,
28 cut_blocks,
29 intv_maps, $ maps on intervals
30 cessor,
31 pred,
32 statistics; $ used to collect execution statistics
33
34 exports
35 find_intervals;
36
38
1 .=member mcdm5e
2 .title 'redundant expression elimination'
3
4$ phase 4. redundant expression elimination and code motion
5$ ---------------------------------------------------------
6
7$ this phase finds redundant subexpressions using available
8$ expression determination. it also moves code out of loops and
9$ eliminates all redundant expression computations.
10
11$ the code motion procedure uses the interval structure to move code
12$ out of intervals. each interval is entered through a block known
13$ as the interval head; each interval head has a single predecessor
14$ block which is outside the interval. this is known as the
15$ target block of the interval. code moved out of an interval is
16$ moved to the interval's target block. this is essentialy a
17$ matter of concatenating the instruction to the target block.
18
19$ instructions are deleted either by changing their opcode to
20$ 'q1_noop', or, more efficiently, when the previous instruction
21$ is also available, by deleting them from the linked list of
22$ their block.
23
24
25 module setl_optimizer - availexp_analysis:
26
27 exports
28 csx;
29
30 imports
31 print_utils,
32 utilities,
33 .comp_syms(rd, rd),
34 interproc_fwd_analysis_syms
35 (rw, wr, rd, rd, rd, rd, rw, wr, rd),
36 intraproc_fwd_analysis_syms
37 (rd, rw, wr, rd, rd, rd, rd, rw, wr, rd);
38$ see the section 'data flow analysis package' below for details
39$ concerning these routines.
40
41 reads
42 control_params, $ program parameters
43 q1_consts, $ constants used to define q1
44 call_maps, $ maps on the call graph
45 intv_maps, $ maps on intervals
46 cessor, pred;
48
49 writes
50 fom_syms, xom_syms,
51 oi_sets, $ sets on occurrences
52 var_maps, $ maps on variables
53 exp_maps, $ maps on expressions
54 q1_vars, $ variables defining q1
55 messages, $ cstmt_count -> severity -> message
56 statistics; $ used to collect execution statistics
57
58
1 .=member mlva5f
2 .title 'live variable analysis'
3
4 module setl_optimizer - live_analysis:
5
6 exports
7 live;
8
9 imports
10 utilities,
11 print_utils,
12 .comp_syms(rd, rd),
13 interproc_back_analysis_syms(rw, wr, rd, rd, rd),
14 intraproc_back_analysis_syms(rd, rw, wr, rd, rd, rd);
15
16 reads
17 all;
18
19 writes
20 fom_syms, xom_syms,
21 messages, $ cstmt_count -> severity -> message
22 statistics; $ used to collect execution statistics
23
24
1 .=member dfap5g
2 .title 'data-flow analysis package'
3
4$ data-flow analysis package
5$ ---------------------------
6
7$ to facilitate several previously mentioned optimization phases, we
8$ provide a general purpose package of routines which solve data flow
9$ problems of the bitvectoring class under various situations (forward
10$ or backward problems, interprocedural or intraprocedural solution).
11$ this package also includes the call graph analysis routine mentioned
12$ earlier.
13$
14$ nb. there are actually two modules which are almost identical.
15$ they differ in that the first module is used for problems where the
16$ the lattice elements are symbols (elmt syms), while the second
17$ module is used for problems where the lattice elements are oc-
18$ currences (elmt ocrs).
19$
20 module setl_optimizer - dataflow_solver_syms:
21
22 imports
23 print_utils;
24
25 exports
26 .comp_syms(rd, rd),
27 cgraph_analysis,
28$
29$ the following routines perform data flow analysis for the
30$ following respective cases: interprocedurally and forward,
31$ intraprocedurally and forward, interprocedurally and backwards,
32$ intraprocedurally and backwards.
33$
34 interproc_fwd_analysis_syms
35 (rw, wr, rd, rd, rd, rd, rw, wr, rd),
36 intraproc_fwd_analysis_syms
37 (rd, rw, wr, rd, rd, rd, rd, rw, wr, rd),
38$
39$ the parameters of the interprocedural analyser are as follows:
40$ f: maps each flow edge into a data-flow map
41$ soln: the solution map (soln: flow node --> bitvector data)
42$ id: identity map for analysis
43$ zero: initial (default) data-value for analysis
44$ meet_flag: true if meet analysis, false if join analysis
45$ move_code: true if code motion required, false otherwise
46$ exposed: exposed block 'events' (needed only for code motion)
47$ insert: maps each interval to 'events' to be inserted at
48$ its entry (meaningless if code motion not required)
49$
50$ the intraprocedural analyser has the same parameters, with an
51$ additional first parameter, equal to the procedure to be analysed
52$
53 interproc_back_analysis_syms
54 (rw, wr, rd, rd, rd),
55 intraproc_back_analysis_syms
56 (rd, rw, wr, rd, rd, rd);
57$
58$ the parameters of the interprocedural analyser coincide with
59$ the first five parameters of the corresponding forward analyser.
60$ similar correspondence exists between the intraprocedural
61$ analysers.
62$
63 reads
64 name,
65 fom_syms, xom_syms,
66 cessor, pred,
67 routof, sym_main,
68 rout_maps,
69 control_params; $ program parameters
70
71 writes
72 is_rec, $ flags recursive routines (symtab)
73 intv_maps, $ maps on intervals
74 call_maps; $ maps on the call graph
75
76
77 module setl_optimizer - dataflow_solver_ocrs:
78
79 exports
80 .comp_ocrs(rd, rd),
81 interproc_fwd_analysis_ocrs
82 (rw, wr, rd, rd, rd, rd, rw, wr, rd),
83 intraproc_fwd_analysis_ocrs
84 (rd, rw, wr, rd, rd, rd, rd, rw, wr, rd),
85 interproc_back_analysis_ocrs
86 (rw, wr, rd, rd, rd),
87 intraproc_back_analysis_ocrs
88 (rd, rw, wr, rd, rd, rd);
89
90 reads
91 fom_ocrs, xom_ocrs,
92 cessor, pred,
93 routof, sym_main,
94 rout_maps,
95 call_maps; $ maps on the call graph
96
97 writes
98 intv_maps; $ maps on intervals
99
100
1 .=member mflo5h
2 .title 'data flow analysis'
3
4$ phase 5. data flow analysis
5$ ---------------------------
6
7$ this phase builds bfrom, ffrom, and bfrom_dead. these maps are
8$ defined in the section 'data flow maps' above.
9
10
11 module setl_optimizer - bfrom_analysis:
12
13 exports
14 find_bfrom;
15
16 imports
17 print_utils,
18 .comp_ocrs(rd, rd),
19 interproc_fwd_analysis_ocrs
20 (rw, wr, rd, rd, rd, rd, rw, wr, rd),
21 intraproc_fwd_analysis_ocrs
22 (rd, rw, wr, rd, rd, rd, rd, rw, wr, rd);
23$ see description of 'data flow analysis package' above for
24$ detailed account of parameters of these routines.
25
26 reads
27 var_maps, $ maps on variables
28 q1_consts, $ constants used to define q1
29 q1_vars, $ variables defining q1
30 call_maps, $ maps on the call graph
31 ocrs_maps, $ maps defining occurrences
32 oi_sets, $ sets on occurrences
33 intv_maps, $ maps on intervals
34 cessor, pred,
36 control_params; $ program parameters
37
38 writes
39 fom_ocrs, xom_ocrs,
40 bfrom, ffrom,
42 bfrom_dead,
smfk 9 globals_e, $ maps routines to globals exposed
43 globals_r, $ maps routines to globals used
44 globals_w, $ maps routines to globals defined
45 messages, $ cstmt_count -> severity -> message
46 statistics; $ used to collect execution statistics
47
48
smfb 3
smfb 4
smfb 5 module setl_optimizer - region_constants:
smfb 6
smfb 8 exports
smfb 9 find_region_constants;
smfb 10 reads
smfb 11 q1_consts, $ constants used to define q1
smfb 12 q1_vars, $ variables defining q1
smfb 13 var_maps, $ maps on variables
smfb 14 ocrs_maps, $ maps defining occurrences
smfb 15 oi_sets, $ sets on occurrences
smfb 16 bfrom, $ occurrence -> preceding occurrences
smfb 17 intv_maps, $ maps on intervals
smfb 18 call_maps, $ maps on the call graph
smfb 19 control_params; $ program parameters
smfb 20 writes
smfb 21 messages, $ cstmt_count -> severity -> message
smfb 22 statistics; $ used to collect execution statistics
smfb 23
smfb 24
1 .=member mtyp5i
2 .title 'type finding'
3
4$ phase 8 - type finding
5$ ----------------------
6
7$ this phase is an extension of the type finder described in a ph.d.
8$ thesis by aaron tannenbaum. it calculates a map called 'typ' which
9$ sends each occurrence into a 'type descriptor'. the structure of
10$ type descriptors is described above in the section 'types'.
11$
12$ essentially the type finder collects two pieces of information
13$ about each occuurrence:
14$
15$ 1. its type, in the sense of the setl 'type' operator.
16$
17$ 2. a flag indicating whether the occurrence is definitely omega,
18$ possibly omega, or definitely not omega.
19$
20$ (1) and (2) are determined recursively for the components of sets and
21$ tuples.
22$
23$ the type finder is driven by the bfrom and ffrom maps. it exports
24$ a main procedure and three predicates on types. these predicates
25$ use a three valued logic, and return values given by the constants
26$ yes, no, and maybe.
27
28 module setl_optimizer - typfind:
29
30 reads
31 q1_consts, $ constants used to define q1
32 q1_vars, $ variables defining q1
33 ocrs_maps, $ maps defining occurrences
34 oi_sets, $ sets on occurrences
35 typ_consts, $ all constants for the type finder
36 var_maps, $ maps on variables
37 exp_maps, $ maps on expressions
38 cessor, pred,
39 intv_maps, $ maps on intervals
40 call_maps, $ maps on the call graph
41 bfrom, ffrom, bfrom_dead,
42 control_params; $ program parameters
43
44 writes
45 typ, $ maps occurrences to their types
smfg 12 bfrom, ffrom, bfrom_dead,
46 messages, $ cstmt_count -> severity -> message
47 statistics; $ used to collect execution statistics
48
49 imports
50 print_utils,
51 utilities;
52
53 exports
54 type_find, $ top level routine
55 .is_pair(tp), $ true for pairs
56 .is_map(tp); $ true for maps
57
1 .=member adac5k
2 .title 'automatic data structure selection'
3
4$ phase 10 - automatic data structure selection
5$ ---------------------------------------------
6
7$ the automatic data structure selection algorithm, which is described
8$ in detail in the member admn15 below, is driven by the data flow maps
9$ and the typ map, the result of the type finder module.
10$
11$ to allow for the results of the automatic data structure selection,
12$ we ultimately take three types of action:
13$
14$ 1. we add a new symbol table entry for each base.
15$ 2. we build a map 'basetyp' from bases to type descriptors.
16$ 3. we reset typ(oi) for each oi we decide to base.
17
18$ type descriptors for bases have:
19$
20$ grosstyp: 'base'
21$ comptyp: type of elements
22$
23$ type descriptors for elements have:
24$
25$ grosstyp: 'elmt'
26$ comptyp: not used
27$ basenam: symbol table pointer for base
28$
29$ type descriptors for primitive types (ie. integer, real, string, and
30$ atom) have a grosstype of t_int, t_real, etc., and a component type of
31$ type_zero, our error type. non-primitive types (ie. tuple, set, and
32$ map) have a grosstype of t_tuple, t_set, or t_map, and their component
33$ type is itself a type descriptor for the component type of the tuple,
34$ the element type of the set, etc. thus a type descriptor for a map
35$ from string to atom would have a component type of known-length tuple
36$ of length two, whose first component must be a string, and whose
37$ second component must be an atom.
38$
39$ the automatic data-structure selection algorithm can take one of two
40$ choices with respect to user-supplied reprs. it is not clear which
41$ choice is correct:
42$
43$ 1. it can begin by using the user supplied reprs to refine and
44$ validate the 'typ' map.
45$
46$ 2. it can ignore the user-supplied reprs until it is done, then use
47$ them to refine and validate its results.
48$
49 module setl_optimizer - auto_dstruct:
50
51 exports
52 auto_data;
54 imports
55 utilities,
56 print_utils,
57 .is_pair(tp), $ true for pairs
58 .is_map(tp); $ true for maps
60 reads
61 q1_consts, $ constants used to define q1
62 variables, $ set of all variables
63 typ_consts, $ all constants for the type finder
64 bfrom, ffrom, bfrom_dead,
65 ocrs_maps, $ maps defining occurrences
66 oi_sets, $ sets on occurrences
67 control_params; $ program parameters
69 writes
70 q1_vars, $ variables defining q1
71 typ, $ maps occurrences to their types
72 ads_maps,
73 statistics; $ used to collect execution statistics
74
75
1 .=member cnvo5l
2 .title 'conversion optimization'
3
4$ phase 11 - conversion optimization
5$ ----------------------------------
6
7$ conversion optimization completes the work begun with the type finding
8$ and automatic data structure selection phases.
9$
10$ at this point the 'typ' map contains as much information on the type
11$ and representation of each occurrence as we know how to collect.
12$
13$ we must now split each variable 'x' into several variables x1, ..., xn
14$ such that each xi has the same 'typ' for all its occurrences. in the
15$ process it may be necessary to add assignments of the form 'xi = xj'.
16$ these assignments will actually be treated as conversions by the code
17$ generator.
18$
19$ once we have done name splitting we are able to talk about the type of
20$ a variable 'xi'. we then convert the xi's type descriptor into a form
21$ and set form(xi).
22$
23$ then we perform a data flow analysis to determine when and where
24$ should conversions from one split variable to another be performed.
25
26
27 module setl_optimizer - conversion_analysis:
28
29 exports
30 conv_optimize,
31 can_conv(rd, rd);
33 imports
34 utilities,
35 print_utils,
36 dmp(rd, rd(*)),
37 .comp_syms(rd, rd),
38 interproc_fwd_analysis_syms
39 (rw, wr, rd, rd, rd, rd, rw, wr, rd),
40 intraproc_fwd_analysis_syms
41 (rd, rw, wr, rd, rd, rd, rd, rw, wr, rd),
42 interproc_back_analysis_syms
43 (rw, wr, rd, rd, rd),
44 intraproc_back_analysis_syms
45 (rd, rw, wr, rd, rd, rd);
47 reads
48 q1_consts, $ constants used to define q1
49 var_maps, $ maps on variables
50 ocrs_maps, $ maps defining occurrences
51 intv_maps, $ maps on intervals
52 typ_consts, $ all constants for the type finder
53 control_params; $ program parameters
55 writes
56 fom_syms, xom_syms,
57 q1_vars, $ variables defining q1
58 basesymb,
smfk 10 occsof, $ maps variables to their occurrences
59 variables, $ set of all variables
60 uservars, $ set of all user-defined variables
61 bfrom, ffrom, bfrom_dead,
62 typ, $ maps occurrences to their type
63 ads_maps,
64 oi_sets, $ sets on occurrences
65 messages, $ cstmt_count -> severity -> message
66 statistics; $ used to collect execution statistics
67
1 .=member mcpy5m
2 .title 'copy optimisation'
3
4$ phase 9 - copy optimisation
5$ ---------------------------
6
7$ copy optimisation is done using the technique described in
8$ newsletter 176. we associate a dummy share bit variable with
9$ each variable in the program. suppose that 'x' is a
10$ variable and 'sx' is its shadow variable.
11$
12$ we assume that every operaton whch puts 'x' into a set or
13$ tuple causes 'x' to be shared, i.e. causes its share bit to
14$ be set to true. we treat this as a definition of 'sx'.
15$
16$ we also assume that each time 'x' is used destructively it
17$ is conditionally copied. by this we mean that the library
18$ checks x's share bit. if the share bit is set, the library
19$ copies 'x' and resets it's share bit to false.
20$
21$ the copy optimisation algorithm begins by indicating the
22$ uses and definitions of the share bits 'sx'. it then performs
23$ code motion, redundant subexpression elimination, dead code
24$ elimination and constant propagation on the shadow variables.
25$
26$ at the end of the algorithm we have filled in estimates concerning
27$ uses and definitions of share bits. we then create two maps on
28$ instructions:
29$
30$ copy_flag:
31$
32$ if 'i' is an instruction, then copy_flag(i) has the
33$ following values:
34$
35$ copy_pre: copy arg1(i) before executing 'i'
36$
37$ copy_test: copy arg1(i) before executing 'i' iff its
38$ share bit is set.
39$
40$ copy_no: don't copy arg1(i).
41$
42$ note that arg1 is the only argument which is ever used
43$ destructively.
44$
45$ share_flag:
46$
47$ share_flag(i) is true if one of i's inputs must have
48$ its share bit set. it is always obvious from the opcode of 'i'
49$ which input we are talking about.
50
51 module setl_optimizer - copy_optimization:
52
53 exports
54 copy_optimize;
55
56 imports
57 utilities,
58 print_utils,
59 .comp_syms(rd, rd),
60 .comp_ocrs(rd, rd),
61 interproc_back_analysis_syms
62 (rw, wr, rd, rd, rd),
63 intraproc_back_analysis_syms
64 (rd, rw, wr, rd, rd, rd),
65 interproc_fwd_analysis_ocrs
66 (rw, wr, rd, rd, rd, rd, rw, wr, rd),
67 intraproc_fwd_analysis_ocrs
68 (rd, rw, wr, rd, rd, rd, rd, rw, wr, rd);
69
70 reads
71 q1_consts, $ constants used to define q1
72 typ, $ maps occurrences to their types
73 typ_consts, $ all constants for the type finder
74 bfrom, ffrom, $ data flow maps
75 var_maps, $ maps on variables
76 ocrs_maps, $ maps defining occurrences
77 oi_sets, $ sets on occurrences
78 cessor, $
79 control_params; $ program parameters
80
81 writes
82 fom_syms, xom_syms,
83 fom_ocrs, xom_ocrs,
84 q1_vars, $ variables defining q1
85 globals_du, $ destructively used global variables
86 messages, $ cstmt_count -> severity -> message
87 statistics; $ used to collect execution statistics
88
89
1 .=member outp5n
2 .title 'interface with code generator'
3
4$ phase 13 - output to the code generator
5$ --------------------------------------------
6
7$ this is the final phase of the optimizer. we do three things:
8
9$ 1. change all code sequences 'a := arb b; b less:= a;' to 'a from b'
10$ 2. remove the fourth argument of all argin and argout instructions.
11$ 3. write out the q1 tables.
12
13 module setl_optimizer - optend:
15
16 exports
17 opt_term;
19 imports
20 utilities,
21 print_utils,
22 dmp(rd, rd(*)),
23 print_summary(rd), $ print scope summary
24 write_q1;
26 writes
27 q1_vars, $ variables defining q1
28 statistics; $ used to collect execution statistics
30 reads
31 control_params, $ program parameters
32 exp_maps, $ maps on expressions
33 push_former,
34 dead_labs,
35 q1_consts, $ constants used to define q1
36 messages; $ cstmt_count -> severity -> message
37
38
1 .=member reprs6
2 .title 'reprs'
3
4$ data structures for global variables and procedures
5$ --------------- --- ------ --------- --- ----------
6
7 repr
8$
9$ there are two ways to represent booleans in setl, namely as setl
10$ booleans, or as integers in the range from 1 to 1. while the former
11$ is somewhat more elegant, the latter requires, when packed, only one
12$ bit of storage. note that the range 'integer 1 .. 1' is dual-valued,
13$ since this range implicitly includes om. in this mode, we represent
14$ true as 1, and false as om.
15$
16 mode bool: integer 1..1;
17
18 mode index: integer 1..65535;
19
20
21$$-- plex base syms; $ symbol table
22 plex base forms; $ form table
23 plex base blocks; $ basic block table
24 plex base insts; $ instruction or code table
25$$-- plex base ocrs; $ symbol occurrences
26
27 base syms: atom;
28 mode symbol: elmt syms;
29
30 base ocrs: atom;
31 mode occurrence: elmt ocrs;
32
33 base df_base_ocrs: occurrence;
34 mode df_elmt_ocrs: remote set(elmt df_base_ocrs);
35 mode df_map_ocrs: tuple(df_elmt_ocrs, df_elmt_ocrs);
36
37 base df_base_syms: symbol;
38 mode df_elmt_syms: remote set(elmt df_base_syms);
39 mode df_map_syms: tuple(df_elmt_syms, df_elmt_syms);
40
41 base df_nodes: elmt blocks;
42 mode df_node: elmt df_nodes;
43
44 base df_edges: tuple(df_node, df_node);
45 mode df_edge: elmt df_edges;
46
47 base expressions: symbol;
48 mode expression: elmt expressions;
49$
50$ there are several maps from scopes and routines defined. for greater
51$ space efficiency, we create bases for their domains, and base their
52$ respective ranges locally on these two bases.
53$
54 base base_scopes: symbol;
55
56 base base_routs: elmt base_scopes;
57 mode routine: elmt base_routs;
58
59 base
60 base_sc_types,
61 base_ft_types,
62 base_ft_mapcs,
63 base_opcodes,
64 base_based_modes,
65 base_copy_actions: string;
66
67 base tent_bases: atom;
68 mode tent_base: elmt tent_bases;
69
70 base gross_types: string;
71 mode basic_type: elmt gross_types;
72 mode gross_type: remote set(basic_type);
73$
74$ although there are no maps on types, or sets on types, we store all
75$ type descriptors in a base. this allows us to do fast type equality
76$ tests.
77$
78 base types: tuple(
79 gross_type,
80 general,
81 boolean,
82 *, $$-- is_based
83 elmt base_based_modes,
84 elmt base_ft_mapcs
85 );
86$
87$ maps on symbols use the following data structures:
88$ (see section symbol table for a more detailed account of these maps)
89$
90 name: local smap(symbol) string;
91 value: local smap(symbol) general;
92 scope: local smap(symbol) elmt base_scopes;
93 form: local smap(symbol) elmt forms;
94 alias: local smap(symbol) symbol;
95 is_read: packed local smap(symbol) bool;
96 is_write: packed local smap(symbol) bool;
97 is_const: packed local smap(symbol) bool;
98 is_internal: packed local smap(symbol) bool;
99 is_temp: packed local smap(symbol) bool;
100 is_store: packed local smap(symbol) bool;
101 is_stk: packed local smap(symbol) bool;
102 is_param: packed local smap(symbol) bool;
103 is_repr: packed local smap(symbol) bool;
104 is_init: packed local smap(symbol) bool;
105 is_seen: packed local smap(symbol) bool;
106 is_back: packed local smap(symbol) bool;
107 is_rec: packed local smap(symbol) bool;
108 next_sym: local smap(symbol) symbol;
109$
110$ maps on scopes use the following data structures:
111$ (see section 'scopes and routines' for a more detailed account of
112$ these maps.)
113$
114 scopes: tuple(elmt base_scopes);
115 cont_scopes: local smap(elmt base_scopes)
116 tuple(elmt base_scopes);
117 sc_type: local smap(elmt base_scopes)
118 elmt base_sc_types;
119 sc_nprocs: local smap(elmt base_scopes) integer;
120 sc_stmt_ct: local smap(elmt base_scopes) integer;
121 sc_estmt_ct: local smap(elmt base_scopes) integer;
122 first_sym: local smap(elmt base_scopes) symbol;
123 last_sym: local smap(elmt base_scopes) symbol;
124 first_block: local smap(routine) elmt blocks;
125 last_block: local smap(routine) elmt blocks;
126 first_form: local smap(elmt base_scopes) elmt forms;
127 last_form: local smap(elmt base_scopes) elmt forms;
128 sc_types: elmt base_sc_types;
129 tup_sc_types: tuple (elmt base_sc_types);
130 sym_om: symbol;
131 sym_sys: elmt base_scopes;
132 sym_dir: elmt base_scopes;
133 sym_prog: elmt base_scopes;
134 sym_main: routine;
135 all_modules: sparse set(elmt base_scopes);
136$
137$ maps on routines use the following data structures:
138$ (see section 'scopes and routines' for a more detailed account of
139$ these maps.)
140$
141 routs: sparse set(routine);
142 rentry: local smap(routine) elmt blocks;
143 rexit: local smap(routine) elmt blocks;
144 rstop: local smap(routine) elmt blocks;
145 rparams: local smap(routine) tuple(symbol);
146 membof: local smap(routine) elmt base_scopes;
147 system_routs: sparse set(symbol);
148$
149$ maps on intervals use the following data structures:
150$ see section 'data flow maps' for more details.
151$
152 ints: local smap(routine) tuple(elmt blocks);
153 proper_ints: local set(elmt blocks);
154$
155$ there are several constants relating to forms. they use the following
156$ data structures:
157$ (see section forms for further details.)
158$
159 ft_types: elmt base_ft_types;
160 tup_ft_types: tuple(elmt base_ft_types);
161 ft_mapcs: elmt base_ft_mapcs;
162 tup_ft_mapcs: tuple(elmt base_ft_mapcs);
163 std_form: local smap(elmt base_ft_types)
164 elmt forms;
165 ft_predicates: local set(elmt base_ft_types);
166$
167$ maps on forms use the following data structures:
168$ (see the section on forms for further details)
169$
170 ft_type: packed local smap(elmt forms)
171 elmt base_ft_types;
172 ft_mapc: packed local smap(elmt forms)
173 elmt base_ft_mapcs;
174 ft_elmt: local smap(elmt forms) *;
175 ft_dom: local smap(elmt forms) elmt forms;
176 ft_im: local smap(elmt forms) elmt forms;
177 ft_imset: local smap(elmt forms) elmt forms;
178 ft_base: local smap(elmt forms) elmt forms;
179 ft_low: local smap(elmt forms) integer;
180 ft_lim: local smap(elmt forms) integer;
181 ft_tup: local smap(elmt forms) elmt forms;
182 ft_hashok: packed local smap(elmt forms) bool;
183 ft_neltok: packed local smap(elmt forms) bool;
184 ft_pos: local smap(elmt forms) integer;
185 ft_num: local smap(elmt forms)
186$ nb. 'string' should be element of base of local types
187 smap(string) integer;
188 ft_deref: local smap(elmt forms) elmt forms;
189 next_form: local smap(elmt forms) elmt forms;
190 basesymb: sparse smap(elmt forms) symbol;
191$
192$ maps on blocks use the following data structures:
193$ see section '...' for more details.
194$
195 routof: local smap(elmt blocks) routine;
196 next_block: local smap(elmt blocks) elmt blocks;
197 first_inst: local smap(elmt blocks) elmt insts;
198 last_inst: local smap(elmt blocks) elmt insts;
199 cessor: local mmap(elmt blocks) elmt blocks;
200 pred: local mmap(elmt blocks) elmt blocks;
201 intof: local smap(elmt blocks) elmt blocks;
202 int_nodes: local smap(elmt blocks)
203 tuple(elmt blocks);
204 vedges: local mmap(elmt blocks) elmt blocks;
205
206 cut_blocks: sparse set(elmt blocks);
207 dead_labs: sparse set(symbol);
208$
209$ there are various global collections defined on q1 opcodes.
210$ the section q1 opcodes for more details.
211$
212 opcodes: elmt base_opcodes;
213 tup_opcodes: tuple(elmt base_opcodes);
214 copy_actions: elmt base_copy_actions;
215 tup_copy_actions: tuple(elmt base_copy_actions);
216 ops_classes: local set(elmt base_opcodes);
217$
218$ maps on instructions use the following data structures:
219$ (see section 'the program' for more details)
220$
221 opcode: packed local smap(elmt insts)
222 elmt base_opcodes;
223 args: local smap(elmt insts) tuple(symbol);
224 occs: local smap(elmt insts)
225 tuple(occurrence);
226 blockof: local smap(elmt insts) elmt blocks;
227 stmtof: packed local smap(elmt insts) index;
228 copy_flag: packed local smap(elmt insts)
229 elmt base_copy_actions;
230 share_flag: packed local smap(elmt insts) bool;
231 next_inst: local smap(elmt insts) elmt insts;
232$
233$ maps on call instructions use the following data structures:
234$ (see the section on the call graph for further details)
235$
236 cgraph: sparse mmap(routine) routine;
237 callsin: local mmap(routine) elmt blocks;
238 callproc: sparse smap(elmt blocks) routine;
239 cg_sccs: tuple(routine);
240 scc_nodes: local smap(routine) tuple(routine);
241 scc_d: local smap(routine) integer;
242$
243$ sets of and maps on occurrences use the following data structures:
244$ (see section 'occurrences' for further details)
245$
246 all_oi: local set(occurrence);
247 all_o: local set(occurrence);
248 all_i: local set(occurrence);
249
250 typ: remote smap(occurrence) elmt types;
251
252 t_types: basic_type;
253 bsctyps,
254 int_real,
255 int_real_str,
256 int_real_str_atom,
257 str_tup,
258 str_tup_set,
259 set_tup,
260 tup_set_map: gross_type;
261 type_zero,
262 type_om,
263 type_gen,
264 type_notom,
265 type_int,
266 type_real,
267 type_string,
268 type_boolean,
269 type_atom,
270 type_tuple,
271 type_pair,
272 type_set,
273 type_map,
274 type_int_real,
275 type_int_real_str,
276 type_str_tup,
277 type_str_tup_set: elmt types;
278
279 fixed_typ: local smap(elmt base_opcodes)
280 elmt types;
281 simple_type: local smap(elmt base_ft_types) string;
282 $$$ ??? string ???
283 ft_usetmaps: local set(elmt base_ft_types);
284 localtp, remotetp: local smap(elmt base_ft_types)
285 elmt base_ft_types;
286$
287$ maps for the automatic data structure choice phase
288$ (see section on types for declarations.)
289$
290 oi_repr: remote smap(occurrence) elmt types;
291 userbase: remote smap(tent_base) symbol;
292 actual_bases: remote set(tent_base);
293 bscope: local smap(tent_base) elmt base_scopes;
294 elmt_mode: local smap(tent_base) elmt types;
295$
296$ maps on variables use the following data structures:
297$ (see the section on various initial maps for further details)
298$ (this section follows call paths)
299$
300 variables: local set(symbol);
301 uservars: local set(symbol);
smfe 13 itervars: local set(symbol);
302 globalvars: sparse set(symbol);
303 localvars: local mmap{routine}
304 sparse set(symbol);
305 occsof: local mmap{symbol}
306 sparse set(occurrence);
307$
308$ maps on expressions use the following data structures:
309$ (see the section on various initial maps for further details)
310$ (this section follows call paths)
311$
312 globalexps: sparse set(expression);
313 localexps: local mmap{routine}
314 sparse set(expression);
315 allexps: local set(expression);
316 opcexp: local smap(expression)
317 elmt base_opcodes;
318 argsexp: local smap(expression) tuple(symbol);
319 dependon: sparse mmap{symbol}
320 sparse set(expression);
321$
322$ maps on occurrences use the following data structures:
323$ (see the section on occurrences for further details)
324$
325 instno: local smap(occurrence) elmt insts;
326 argno: packed local smap(occurrence) index;
327$
328$ data flow maps use the following data structures:
329$ (see the section on data flow maps for further detail)
330$
331 bfrom: local mmap{occurrence}
332 sparse set(occurrence);
333 ffrom: local mmap{occurrence}
334 sparse set(occurrence);
335 bfrom_dead: local set(occurrence);
336
337 xom_ocrs: df_elmt_ocrs;
338 fom_ocrs: df_map_ocrs;
339 xom_syms: df_elmt_syms;
340 fom_syms: df_map_syms;
341
342 push_former: sparse smap(elmt insts) elmt insts;
343$
344$ maps used to collect information for automatic documentation use the
345$ following data structures:
346$
347 globals_du: sparse mmap(routine) occurrence;
smfk 11 globals_e: sparse mmap(routine) symbol;
348 globals_r, globals_w: sparse mmap(routine) symbol;
349 messages: mmap{integer}
350 mmap{string}
351 set(tuple(string));
352 statistics: tuple(integer)(20);
353$
354$ general system parameters use the following data structures:
355$
356 q1_file: string;
357 ssm_file: string;
358 term_file: string;
359 debug_flag: boolean;
360 at_flag: boolean;
smfk 12 lcp_flag, lcs_flag: boolean;
361 prog_level: string;
362 rem: integer;
363 dump_string: string;
364$
365$ the following procedures are exported by module util
366$
367 add_sym: procedure(elmt base_scopes) symbol;
368 del_sym: procedure(
369 symbol,
370 symbol,
371 elmt base_scopes
372 );
373 add_form: procedure(elmt base_scopes) elmt forms;
374 add_block: procedure(
375 elmt blocks,
376 elmt base_scopes,
377 boolean )
378 elmt blocks;
379 add_inst: procedure(
380 elmt blocks,
381 elmt base_opcodes,
382 tuple(symbol) )
383 elmt insts;
384 del_inst: procedure(
385 elmt insts,
386 elmt insts,
387 elmt blocks
388 );
389 insert_ins1,
390 insert_ins: procedure(
391 elmt insts,
392 elmt base_opcodes,
393 tuple(symbol)
394 );
395 del_block: procedure(
396 elmt blocks, elmt blocks,
397 elmt base_scopes );
398 add_label: procedure(elmt base_scopes) symbol;
399 add_var: procedure(elmt base_scopes) symbol;
400 add_int: procedure(elmt base_scopes, integer)
401 symbol;
402 ermsg, abort: procedure(string);
403 prints: procedure(
404 string,
405 tuple(tuple(string, general))
406 );
407 format_type: procedure(elmt types) string;
408 format_repr: procedure(elmt types) string;
409 format_form: procedure(elmt forms) string;
410 format_inst: procedure(elmt insts, tuple(symbol))
411 string;
412$
413$ the following procedure is exported by the module dumps:
414$
415 dmp: procedure(
416 elmt base_scopes,
417 tuple(string)
418 );
419 print_summary: procedure(sparse set(elmt base_scopes));
420 read_q1, write_q1: procedure;
421 opt_ini, opt_term: procedure;
422$
423$ the following procedures are exported by the modules
424$ interval_analysis, availexp_analysis, live_analysis, and
425$ bfrom_analysis, resp. they are declared here purely to enable us to
426$ use the ur check feature of sem.
427$
428 find_intervals: procedure;
429 csx: procedure;
430 live: procedure;
431 find_bfrom: procedure;
smfb 25 find_region_constants: procedure;
432$
433$ the following procedures are exported by module dataflow_solver:
434$
435$ nb. there are two copies of the dataflow solver around, one operating
436$ on the base of symbols (syms), the other on the base of occurrences
437$ (ocrs). this is due to the fact that setl does not have generic
438$ bases.
439$
440 .comp_ocrs: operator(df_map_ocrs, df_map_ocrs)
441 df_map_ocrs;
442 cgraph_analysis: procedure;
443
444$ nb. the setl system currently does not provide for an efficient
445$ way to handle set operations between remote and sparse sets on
446$ a common base. while some of these operations could be done
447$ more efficiently by source transformation, we have taken the
448$ approach to ignore the potential sparseness of insert, etc, and
449$ for now represent them as bit vectors (df_elmt = remote sets)
450
451 interproc_fwd_analysis_ocrs:
452 procedure(
453 remote smap(df_edge) df_map_ocrs,
454 remote smap(df_node) df_elmt_ocrs,
455 df_map_ocrs,
456 df_elmt_ocrs,
457 boolean,
458 boolean,
459 remote mmap{df_node} df_elmt_ocrs,
460 remote mmap{df_node} df_elmt_ocrs,
461 remote mmap{df_node} df_elmt_ocrs
462 );
463 intraproc_fwd_analysis_ocrs:
464 procedure(
465 routine,
466 remote smap(df_edge) df_map_ocrs,
467 remote smap(df_node) df_elmt_ocrs,
468 df_map_ocrs,
469 df_elmt_ocrs,
470 boolean,
471 boolean,
472 remote mmap{df_node} df_elmt_ocrs,
473 remote mmap{df_node} df_elmt_ocrs,
474 remote mmap{df_node} df_elmt_ocrs
475 );
476 interproc_back_analysis_ocrs:
477 procedure(
478 remote smap(df_edge) df_map_ocrs,
479 remote smap(df_node) df_elmt_ocrs,
480 df_map_ocrs,
481 df_elmt_ocrs,
482 boolean
483 );
484 intraproc_back_analysis_ocrs:
485 procedure(
486 routine,
487 remote smap(df_edge) df_map_ocrs,
488 remote smap(df_node) df_elmt_ocrs,
489 df_map_ocrs,
490 df_elmt_ocrs,
491 boolean
492 );
493 .comp_syms: operator(df_map_syms, df_map_syms)
494 df_map_syms;
495 interproc_fwd_analysis_syms:
496 procedure(
497 remote smap(df_edge) df_map_syms,
498 remote smap(df_node) df_elmt_syms,
499 df_map_syms,
500 df_elmt_syms,
501 boolean,
502 boolean,
503 remote mmap{df_node} df_elmt_syms,
504 remote mmap{df_node} df_elmt_syms,
505 remote mmap{df_node} df_elmt_syms
506 );
507 intraproc_fwd_analysis_syms:
508 procedure(
509 routine,
510 remote smap(df_edge) df_map_syms,
511 remote smap(df_node) df_elmt_syms,
512 df_map_syms,
513 df_elmt_syms,
514 boolean,
515 boolean,
516 remote mmap{df_node} df_elmt_syms,
517 remote mmap{df_node} df_elmt_syms,
518 remote mmap{df_node} df_elmt_syms
519 );
520 interproc_back_analysis_syms:
521 procedure(
522 remote smap(df_edge) df_map_syms,
523 remote smap(df_node) df_elmt_syms,
524 df_map_syms,
525 df_elmt_syms,
526 boolean
527 );
528 intraproc_back_analysis_syms:
529 procedure(
530 routine,
531 remote smap(df_edge) df_map_syms,
532 remote smap(df_node) df_elmt_syms,
533 df_map_syms,
534 df_elmt_syms,
535 boolean
536 );
537$
538$ the following routines are exported by module typfind
539$
540 type_find: procedure;
541 .is_pair: operator(elmt types) boolean;
542 .is_map: operator(elmt types) boolean;
543$
544$ the following procedure is exported by the module auto_dstruct:
545$
546 auto_data: procedure;
547$
548$ the following routines are exported by the module conversion_analysis:
549$
550 conv_optimize: procedure;
551 can_conv: procedure(elmt forms, elmt forms)
552 boolean;
553$
554$ the following procedure is exported by the module copy_optimization:
555$
556 copy_optimize: procedure;
557 end repr;
558
559
560 end directory;
561
562
1 .=member maino7
2
3
4 program setl_optimizer - main;
5$
6$ this is the main program of the optimizer. we begin by reading in the
7$ intermediate tables. we then perform inter- and intra-procedural
8$ analysis, iterating until the control graph of the program converges.
9$ we then perform type analysis, copy optimzation, automatic data
10$ structure selection, etc.
11$
12 statistics with:= time; $ save initial time
13
14 opt_ini; $ initialize
15
16 cgraph_analysis; $ find the call graph
17 find_intervals; $ perform interval analysis
18 live; $ live variable analysis
19 csx; $ common subexpr elimination and code motion
20 find_bfrom; $ bfrom computation
smfb 26 find_region_constants; $ find flow-constant loops
21
22
23 type_find; $ type analysis
24 auto_data; $ automatic data structure selection
25 conv_optimize; $ conversion optimisation
26 copy_optimize; $ copy optimisation
27 opt_term; $ print tables, etc.
28
29
30 end program setl_optimizer - main;
31
32
1 .=member intfa8
2
3
4 module setl_optimizer - interface;
5$
6$ this module handles the interface between the optimizer and the
7$ rest of the compiler. it exports two procedures:
8$
9$ read_q1: reads in the q1 code
10$ write_q1: writes it back out
11$
12
13$ the q1 data structures
14$ ----------------------
15
16$
17$ the optimizer inttterfaces with the rest of the compiler via an
18$ intermediate-code file called 'q1', which is written out by the
19$ semantic pass in a form suitable to be read in by the setl binary
20$ i-o routine 'getb'. the optimizer will write out a modified q1 file
21$ having a similar format, using the binary i-o routine 'putb', and this
22$ file will be read in by the code generator. this q1 file is different
23$ from the standard q1 file used for direct communication between the
24$ semantic pass and the code generator.
25$
26$ there are three 'main' data structures in the q1 representation each
27$ of these is an array divided into several fields:
28$
29$ symtab: the symbol table
30$ formtab: the form table
31$ codetab: the actual code
32$
33$ codetab contains an entry for each instruction. the codetab entry
34$ contains the opcode, copy flag, etc. plus a list of arguments.
35$
36$ each basic block is assigned an index. this index is used to access an
37$ array called blocktab which in turn gives the codetab index for the
38$ start of the block.
39$
40
41$ sequencing of information in the data to be read
42$ ------------------------------------------------
43
44$
45$ the q1 data structures are set up so that we do not have to keep the
46$ entire program in core during compilation.
47$
48$ the little q1 tables are divided into 'segments'. there is one segment
49$ for each module, procedure, etc. in the program. each segment is
50$ written out as soon as we are done compiling it. when the symbols
51$ defined in a segment are no longer needed we throw away the table
52$ space used to store the segment, and re-use it for the next segment.
53$
54$ each segment consists of a header followed by a slice of each of the
55$ arrays mentioned in the previous section. these slices are arranged
56$ in a standard order.
57$
58$ each header consists of:
59$
60$ 1. an integer code sc_xxx indicating whether the segment represents a
61$ module, library, procedure, etc.
62$
63$ 2. a string giving the name of the current segment.
64$
65$ 3. a symtab pointer to the segment name. (integer)
66$ this pointer is needed for code generation. note also that
67$ the segment name may not be unique, but the pointer would be.
68$
69$ 4. the number of procedures in the current module, library, etc.
70$ this number is used to tell when we have read in the last
71$ procedure in a segment.
72$
73$ 5. the statement count for the current member.
74$
75$ each array slice consists of:
76$
77$ 1. an integer 'org' giving the index in the full table of the
78$ 0-th entry to be read in.
79$
80$ 2. an integer 'last' giving the index in the full table of the
81$ last entry to be read in.
82$
83$ 3. a series of entries, each of which consists of a series of
84$ fields, each of which is a (setl) integer, real or character
85$ string.
86$
87
88$ the following macro is used to iterate over an array slice,
89$ reading entries as it iterates. together with the next macro,
90$ they try to resemble somewhat a loop header and a loop ender
91$ for iteration over a tuple or map. 'index' is the index in full
92$ table of the table entry currently read in.
93
94 macro for_slice(index);
95 getb(q1_file, org, last); $ indices of 0'th and last
96 $ table entry
97
98 (forall index in [ org+1..last ]) $ iterate over entries
99 endm;
100
101 macro end_slice;
102 end forall
103 endm;
104$
105$ the sequencing of information within each segment is as follow
106$
107$ 1. segment type (integer code)
108$ 2. segment name (string)
109$ 3. scope name (integer index to symtab)
110$ 4. number of procedures (integer)
111$ 5. statement count (integer)
112$
113$ 6. formtab org and last (integers)
114$ 7. formtab body (series of integer fields; see below)
115$
116$ 8. symbtab org and last (integers)
117$ 9. symbtab body (series of various fields; see below)
118$
119$ 10. blocktab org and last (integers)
120$ 11. blocktab body (integer pointers to codetab)
121$
122$ 12. codetab org and last (integers)
123$ 13. codetab body (series of integer fields; see below)
124$
125
126$ name and value
127$ --------------
128
129$
130$ some special fields in symtab, giving the name and value of
131$ symbols deserve special comment.
132$
133$ 1. name
134$
135$ the 'name' field of a symtab entry is a string giving the
136$ symbol name. internally generated names have a name field
137$ of ''. rather than generate explicit names entries, we simply
138$ call them 't$xxxx' where xxxx is their symtab index.
139$
140$ 2. value
141$
142$ constant symbols, initialized variables, procedures, members
143$ and labels all have values. the 'vptr' field of a symtab entry
144$ indicates whether the symbol does have a value. if so, then
145$ at the end of the series of fixed fields for that entry, there
146$ follow a series of value-entries, whose format depends on the
147$ form of the symbol, as follows:
148$
149$ reals, integers and strings have one value-entry, giving their
150$ (setl) value.
151$
152$ if 'c' is a constant of type 'elmt b' then c's val entry
153$ is a symtab pointer to the constant you would get by
154$ dereferencing 'c'.
155$
156$ for all other symbols, the first value entry is 'vlen', giving
157$ the number of additional value entries to follow.
158$
159$ if 'c' is an n-tuple or an n-element set then its value
160$ entries are n symtab pointers to its elements,
161$ which may in turn be constant sets or tuples.
162$
163$ if 'c' is a procedure then its value entries are:
164$
165$ a. a pointer to the variable it uses for value return
166$ b. a flag indicating whether it has a variable no. of args
167$ c. its number of arguments
168$ d. a series of symtab pointers to the entries for rd, wr, and rw.
169$
170$ if 'c' is a label its val entry is a codetab pointer to
171$ the instruction defining it.
172$
173$ if 'c' is a module, program, or library then its val
174$ entry consists of 5 lists of, respectively, libraries used,
175$ globals read, globals written, procedures imported, and
176$ procedures exported by the member. each list is an integer n,
177$ followed by 'n' symtab pointers.
178$
179
180
181$
182$ the optimizer represents type codes, opcodes, etc. as character
183$ strings, while the compiler represents them as integers. the
184$ following maps are used to send strings such as 'q1_add' into
185$ the integer codes used by the compiler.
186$
187 var
188 sc_type_no, $ codes sc_xxx
189 ft_type_no, $ codes f_xxx
190 ft_mapc_no, $ codes ft_xxx
191 cflag_no, $ codes copy_xxx
192 opcode_no; $ codes q1_xxx
193$ note that these quantities are initialized in write_q1
194
195
196$ setl symbols are represented by blank atoms, little symbols are
197$ representeed by array indices. the maps below map each array
198$ index into the corresponding atom
199
200 var
201 stl_sym, $ maps (little) symbols to setl symbols (members
202 $ of plex base)
203 stl_form, $ maps (little) forms to setl forms (ditto)
204 stl_block, $ maps (little) block indices to setl blocks
205 $ (ditto)
206 stl_inst; $ maps (little) instruction indices to setl
207 $ instructions (ditto)
208
209$ the output interface builds the inverse mappings:
210
211 var
212 ltl_sym, $ maps setl symbols to (little) symbol indices
213 ltl_form, $ maps setl forms to (little) form indices
214 ltl_block, $ maps setl blocks to (little) block indices
215 ltl_inst; $ maps setl instructions to (little) instruction
216 $ indices
217
218 var
219 blocktab; $ basic block table
220
221
222 var
223 cur_memb, $ setl symbol for current member
224 cur_scope; $ setl symbol for current scope
225
226 var
227 orgind, $ maps each table to origin of current slice
228 lastind, $ maps each table to end of current slice
229 org_stack; $ stack of orgind values of superscopes
230
234 var
235 scp_ind, $ scope index of symbol table entry in its own
236 $ scope, if it exists
237 value_inv; $ maps each scope to the values defined in this
238 $ scope, to the symbol table entries that define
239 $ these values.
240
241 init
242 $ initialise little-to-setl maps
243 stl_sym := {}, stl_form := {}, stl_block := {},
244 stl_inst := {},
245 $ initialise setl-to-little maps
246 ltl_sym := {}, ltl_form := {}, ltl_block := {},
247 ltl_inst := {}, value_inv := {};
248
249 repr
250 stl_sym: smap(integer) symbol;
251 stl_form: smap(integer) elmt forms;
252 stl_block: smap(integer) elmt blocks;
253 stl_inst: smap(integer) elmt insts;
254
255 ft_type_no: smap(elmt base_ft_types) integer;
256 ft_mapc_no: smap(elmt base_ft_mapcs) integer;
257 cflag_no: smap(elmt base_copy_actions) integer;
258 opcode_no: smap(elmt base_opcodes) integer;
259 sc_type_no: smap(elmt base_sc_types) integer;
260
261 ltl_sym: smap(symbol) integer;
262 ltl_form: smap(elmt forms) integer;
263 ltl_block: smap(elmt blocks) integer;
264 ltl_inst: smap(elmt insts) integer;
265
266 value_inv: remote mmap{elmt base_scopes}
267 mmap{general}
268 sparse set(symbol);
270 blocktab: tuple(*);
271 cur_memb, cur_scope: elmt base_scopes;
272 scp_ind: integer;
273 orgind: smap(string) integer;
274 lastind: smap(string) integer;
275 org_stack: tuple(smap(string) integer);
276
277 get_header: procedure(boolean);
278 get_forms: procedure;
279 get_symtab: procedure;
280 cnvval: procedure(
281 symbol,
282 general )
283 general;
284 get_code: procedure;
285 set_ltl_maps: procedure(elmt base_scopes);
286 put_header: procedure(elmt base_scopes);
287 put_trailer: procedure;
288 put_forms: procedure(elmt base_scopes);
289 put_symtab: procedure(elmt base_scopes);
290 put_code: procedure(elmt base_scopes);
291 bld_val: procedure(symbol)
292 tuple(
293 boolean,
294 integer,
295 tuple(general)
296 );
297 elmt_sym: procedure(
298 general,
299 elmt forms,
300 symbol )
301 integer;
302 reset: procedure(
303 elmt base_scopes,
304 elmt base_scopes
305 );
306 end repr;
307
308
1 .=member gthd8a
2
3
4 procedure read_q1;
5$
6$ this is the top level routine for reading the q1 tables generated
7$ by the semantic pass. we read one segment at a time until the
8$ routine for reading a header encounters an end of file.
9$
10 repr
11 done: boolean;
12 end repr;
13
14 loop
15 doing get_header(done); $ read header
16 while not done
17 do
18 get_forms; $ read formtab
19 get_symtab; $ read symtab
20 get_code; $ read code
21 end loop;
22
23 $ delete the static variables global to the module
24 stl_sym := om; stl_form := om; stl_block := om;
25 stl_inst := om;
26
27 end procedure read_q1;
28
29
30
31
32 procedure get_header(wr done);
33$
34$ this routine reads the header for a segment of q1. we set 'done' if
35$ we have reached the end of the input.
36$
37 repr
38 i: integer;
39 tp: elmt base_sc_types;
40 nam: string;
41 nprocs: integer;
42 stmts: integer;
43 estmts: integer;
44 scp: symbol;
45 end repr;
46
47$ first read in the segment type and convert it to a string.
48
49 getb(q1_file, i);
50 tp := tup_sc_types(i);
51$ see introductory section scopes and routines
52$ for the initialisation of this tuple
53
54$ see the 'reprs' section for the plex-base repring of all these
55$ special string constants.
56
57$ the end of the q1 file is indicated by an empty segment whose type is
58$ 'sc_end'. if we have reached this segment we set 'done' and return.
59 if tp = sc_end then
60 done := true;
61 return;
62 else
63 done := false;
64 end if;
65$
66$ read the remaining part of the header record. it consists of
67$ 1. the scope name as a string
68$ 2. the symbol table pointer for the scope name
69$ 3. the number of procedures in the current scope
70$ 4. the global statement count at the start of the scope
71$ 5. the global statement count of the q1_entry instruction (in proce-
72$ dure scopes only)
73$
74 getb(q1_file, nam, i, nprocs, stmts, estmts);
75
76 case tp of
77
78 (sc_sys):
79
80 $ the system scope can be thought of as a standard prelude which
81 $ defines standard symbols such as om, true, etc.
82 $
83 $ even though there is no symbol table entry for this scope, we
84 $ still have to associate the usual scope maps with this scope.
85 $ therefore we generate a new atom for it here.
86
87 sym_sys := cur_scope := scp := newat;
88 scp_ind := om;
89
90 (sc_lib):
91
92 $ the symbol table entry for a library is the first entry in it
93 $ own scope. we open the scope here by generating a new atom,
94 $ and define scp_ind to suppress the generation of a new atom
95 $ in the get_symtab routine.
96
97 cur_scope := scp := newat;
98 first_sym(cur_scope) := last_sym(cur_scope) := scp;
99 scope(scp) := cur_scope;
100 scp_ind := i;
101
102 (sc_dir):
103
104 $ like libraries, the symbol table entry for a directory is the
105 $ first entry in its own scope. again, we open the scope here,
106 $ and in addition define sym_dir to point to it.
107
108 sym_dir := cur_scope := scp := newat;
109 first_sym(cur_scope) := last_sym(cur_scope) := scp;
110 scope(scp) := cur_scope;
111 scp_ind := i;
112
113 (sc_prog):
114
115 $ if we have a directory, then the symbol table entry for the
116 $ program scope has appeared in the directory. otherwise, the
117 $ symbol table entry for the program scope is the first entry in
118 $ its own scope, and we open a new scope here. in addition, we
119 $ set sym_prog to point to the new scope.
120
121 if sym_dir = om then $ no directory: open new scope
122 sym_prog := cur_scope := scp := newat;
123 first_sym(cur_scope) := last_sym(cur_scope) := scp;
124 scope(scp) := cur_scope;
125 scp_ind := i;
126 else $ we previously have seen a directory: define cur_scope
127 scp := cur_scope := sym_prog;
128 scp_ind := om;
129 end if;
130
131 (sc_mod, sc_proc):
132
133 $ we can only have a module if we have a directory. if we have
134 $ a directory, then the symbol table entry for the module
135 $ appears in the directory scope, and stl_sym(i) points to it.
136
137 $ procedures always appear in some enclosing scope: the symbol
138 $ table entry for a procedure appearing in an exports list of a
139 $ library appears in the library's header, while a procedure
140 $ appearing in an exports or imports list of a directory appears
141 $ in the directory scope. procedures defined in a program or
142 $ module scope appear in the program's or module's header, resp.
143
144 scp := cur_scope := stl_sym(i);
145 scp_ind := om;
146
147 end case;
148
149 $ we keep a global tuple of scopes so that segments can be written
150 $ out in the order in which they were read.
151 scopes with:= cur_scope;
152
153 $ define the relevant scope maps
154 sc_type(cur_scope) := tp;
155 sc_nprocs(cur_scope) := nprocs;
156 sc_stmt_ct(cur_scope) := stmts;
157 sc_estmt_ct(cur_scope) := estmts;
158
159 $ mark the current scope as being part of the input. the remaining
160 $ symbol table fields either have been or will be set by get_symtab.
161 name(scp) := nam;
162 is_seen(scp) := 1;
163
164 if sc_type(scp) = sc_proc then
165 membof(scp) := cur_memb;
166 else
167 cur_memb := scp;
168 end if;
169$
170$ note that the correspondence between the little scope index and the
171$ setl atom, needed in the output interface, cannot be saved here since
172$ symbols might be added or deleted during optimisation.
173$
174
175 end procedure get_header;
176
177
1 .=member gtfm8b
2
3
4 procedure get_forms;
5$
6$ this routine reads a segment of formtab.
7$
8 repr
9 org: integer;
10 last: integer;
11 i: integer;
12 formtab_entry: tuple(*);
13 ft_type_: integer;
14 ft_mapc_: integer;
15 ft_elmt_: integer;
16 ft_dom_: integer;
17 ft_im_: integer;
18 ft_imset_: integer;
19 ft_base_: integer;
20 ft_deref_: integer;
21 ft_low_: integer;
22 ft_lim_: integer;
23 ft_pos_: integer;
24 ft_hashok_: boolean;
25 ft_neltok_: boolean;
26 ft_tup_: tuple(integer);
27 frm: elmt forms;
28 tp: elmt base_ft_types;
29 flim: integer;
30 cmpfrm: integer;
31 localtyps: tuple(string);
32 zzz: string;
33 yyy: integer;
34 end repr;
35$
36$ read in formtab entries one at a time and build the setl formtab
37$
38$ see the introductory section "form" for a description of the maps
39$ (fields) being read here.
40$
41 for_slice(i)
42 getb(q1_file, formtab_entry);
43 [ ft_type_, ft_mapc_, ft_elmt_, ft_dom_, ft_im_, ft_imset_,
44 ft_base_, ft_deref_, ft_low_, ft_lim_, ft_pos_,
45 ft_hashok_, ft_neltok_, ft_tup_ ] := formtab_entry;
46
47 $ retain the relation between little and setl forms for later
48 stl_form(i) := frm := add_form(cur_scope);
49$
50$ set various fields. note that in the little data structures
51$ ft_type is zero origined, so we must add one before accessing
52$ tup_ft_types.
53$
54 ft_type(frm) := tp := tup_ft_types(ft_type_ + 1);
55 ft_deref(frm) := stl_form(ft_deref_);
56$
57$ note the correspondence between the little 0 and the setl om in
58$ the following test.
59$ see section forms for the initialisation of tup_ft_types.
60$
61 if ft_mapc_ /= 0 then
62 ft_mapc(frm) := tup_ft_mapcs(ft_mapc_);
63 end if;
64$
65$ the system segment contains a standard entry for each standard type
66$ f_xxx. this entry will always be the first entry whose ft_type is
67$ f_xxx. we detect these entries and use them to fill in a map from
68$ strings f_xxx to standard forms. this map is called std_form.
69$
70$ if this is the first form of type tp, save a pointer to it
71 if std_form(tp) = om then std_form(tp) := frm; end if;
72
73$ note that in what follows, we make use of the fact that the
74$ default (little) values for missing (irrlevant) fields are 0
75
76$ set element type, etc.
77 if tp = f_mtuple or tp = f_proc then
78 ft_lim(frm) := flim := ft_lim_;
79 ft_elmt(frm) := [ stl_form(cmpfrm) : cmpfrm in ft_tup_ ];
80
81 else
82 if tp = f_sint or is_ftup(frm) or is_fbase(frm) then
83 if tp = f_sint then ft_low(frm) := ft_low_; end if;
84 ft_lim(frm) := flim := ft_lim_;
85 end if;
86
87 if is_floc(frm) then
88 ft_pos(frm) := ft_pos_;
89
90 elseif is_frem(frm) and is_fmap(frm) then
91 ft_tup(frm) := stl_form(ft_tup_(1));
92 end if;
93
94 if is_fset(frm) or is_ftup(frm) then
95 ft_elmt(frm) := stl_form(ft_elmt_);
96 end if;
97
98 if is_fmap(frm) then
99 ft_dom(frm) := stl_form(ft_dom_);
100 ft_im(frm) := stl_form(ft_im_);
101 if ft_mapc(frm) = ft_map then
102 ft_imset(frm) := stl_form(ft_imset_);
103 end if;
104 end if;
105
106 if is_fbased(frm) then
107 ft_base(frm) := stl_form(ft_base_);
108 end if;
109 end if;
110
111 if ft_hashok_ then ft_hashok(frm) := 1; end if;
112 if ft_neltok_ then ft_neltok(frm) := 1; end if;
113
114$ see comment in section 3g 'forms' explaining use of 'ft_tup'
115$ and other maps (fields) appearing here
116
117$ compute the nasty 'ft_num' map for bases.
118 if is_fbase(frm) then
119 localtyps :=
120 [ f_lset, f_lmap, f_lpmap, f_limap, f_lrmap ];
121 ft_num(frm) :=
122 { [zzz, ft_tup_(yyy)] : zzz = localtyps(yyy) };
123 end if;
124 end_slice;
125
126
127 end procedure get_forms;
128
129
1 .=member gtst8c
2
3
4 procedure get_symtab;
5$
6$ this routine reads a segment of the symbol table, and then builds the
7$ corresponding (setl) symbol table entries.
8$
9 init
10 $ the following maps are needed to account for forward referen-
11 $ ces within the current segment
12 aliases := {}, $ maps symbols to their alias index
13 values := {}; $ maps members and procedures to their values
14
15 repr
16 org: integer;
17 last: integer;
18 aliases: sparse smap(symbol) integer;
19 values: sparse smap(symbol) general;
20 i: integer;
21 symtab_entry: tuple(*);
22 name_: string;
23 form_: integer;
24 alias_: integer;
25 is_repr_: boolean;
26 is_temp_: boolean;
27 is_stk_: boolean;
28 is_read_: boolean;
29 is_write_: boolean;
30 is_param_: boolean;
31 is_store_: boolean;
32 is_init_: boolean;
33 is_seen_: boolean;
34 is_back_: boolean;
35 is_rec_: boolean;
36 has_value_: boolean;
37 vlen_: integer;
38 value_: general;
39 sym: symbol;
40 alind: integer;
41 end repr;
42
43$ read symtab entries one at a time and build setl symbol table entries.
44
45$ see the introductory section 'the symbol table' for an account
46$ of the maps (fields) being read
47
48$ note that the 'scope' and 'next_sym' fields of a symbol table
49$ entry are set by the 'add_sym' utility while 'tempop' is set
50$ during the initial pass over the code, when temporary (expression)
51$ names are re-constructed; 'tempop' will map each such temporary
52$ to the instruction in which it is computed. see 'symbol table'
53
54 for_slice(i)
55 getb(q1_file, symtab_entry);
56 [ name_, form_, alias_, is_repr_, is_temp_,
57 is_stk_, is_read_, is_write_, is_param_,
58 is_store_, is_init_, is_seen_, is_back_, is_rec_,
59 has_value_, vlen_, value_ ] := symtab_entry;
60
61 if i = scp_ind then
62$ current symbol is the current scope (appearing in its own
63$ symtab slice). retrieve the already generated symbol for it.
64 sym := stl_sym(i) := cur_scope;
65
66 else
67 sym := add_sym(cur_scope); $ get setl symbol
68 stl_sym(i) := sym;
69 end if;
70
71 form(sym) := stl_form(form_);
72 if is_fbase(form(sym)) then basesymb(form(sym)) := sym; end if;
73
74 if name_ = '' then
75 name(sym) := 't.' + str i; is_internal(sym) := 1;
76 else
77 name(sym) := name_; is_internal(sym) := om;
78 end if;
79$
80$ account for possible forward references in the value entry
81$
82 if ft_type(form(sym)) = f_memb then
83
84 $ the value of a member is a quintuple, giving (in this
85 $ order) the libraries referenced, the globals read, the
86 $ globals written, the procedures imported, and the proce-
87 $ dures exported. since the imports and exports lists may
88 $ contain forward references, we cannot process them until
89 $ the entire segment has been read.
90
91 values(sym) := value_;
92
93 elseif ft_type(form(sym)) = f_proc then
94
95 $ the value of a procedure is a quadruple, giving (in this
96 $ order) the global for the return value, a flag indicating
97 $ whether the procedure has a variable number of arguments,
98 $ the number of formal parameters, and a sequence of rd's,
99 $ rw's, and wr's indicating how a parameter was declared.
100 $ since the return value is a forward reference, we cannot
101 $ process the value_ until the entire segment has been read
102
103 values(sym) := value_;
104
105 elseif alias_ /= 0 then
106
107 $ the alias of a symbol may be a forward reference. hence
108 $ we cannot fill in this field now, but have to wait until
109 $ the entire segment has been read. since the value of an
110 $ aliased symbol is the value of the alias, this may be a
111 $ forward reference as well.
112
113 aliases(sym) := alias_;
114
115 elseif has_value_ then
116
117 $ in all other case, we can build the value entry.
118
119 value(sym) := cnvval(sym, value_);
120
121 end if;
122
123 $ if we are currently processing the directory scope, then we
124 $ collect all module names so that we can determine later which
125 $ modules are missing in the input.
126
127 if cur_scope = sym_dir and ft_type(form(sym)) = f_memb then
128
129 $ note that the symbol table entry for a library appears as
130 $ the first symbol of its own scope, and not in the direc-
131 $ tory scope. consequently we collect here only the main
132 $ program, and all modules mentioned in the directory.
133
134 all_modules with:= sym;
135
136 $ if this is the program scope, we must set sym_prog, since
137 $ we cannot be sure that the main program is part of the
138 $ input. note that the first symbol in the directory scope
139 $ is the directory name. the second symbol with a member
140 $ form must be the main program.
141
142 if cur_scope /= sym and sym_prog = om then
143 sym_prog := sym;
144 membof(sym_main) := sym_prog;
145 end if;
146 end if;
147
148 $ when the semantic pass compiles the main program, it treats
149 $ it like a procedure with the reserved name '_main'. if this
150 $ is the system scope, we must find this symbol table entry for
151 $ the main program and set sym_main to point to it.
152
153 if cur_scope = sym_sys and name(sym) = '_main' then
154 sym_main := sym;
155 end if;
156
157 $ set all flags
158 if is_temp_ then is_temp(sym) := 1; end if;
159 if is_stk_ then is_stk(sym) := 1; end if;
160 if is_read_ then is_read(sym) := 1; end if;
161 if is_write_ then is_write(sym) := 1; end if;
162 if is_param_ then is_param(sym) := 1; end if;
163 if is_store_ then is_store(sym) := 1; end if;
164 if is_repr_ then is_repr(sym) := 1; end if;
165 if is_init_ then is_init(sym) := 1; end if;
166 if is_seen_ then is_seen(sym) := 1; end if;
167 if is_back_ then is_back(sym) := 1; end if;
168 if is_rec_ then is_rec(sym) := 1; end if;
169
170 if has_value_ and not is_write_ then
171 is_const(sym) := 1;
172 end if;
173 end_slice;
174$
175$ we have finished to read the current segment, but we still must fill
176$ in all the forward references.
177$
178 (forall value_ = values(sym))
179 value(sym) := cnvval(sym, value_);
180 end forall;
181
182 (forall alind = aliases(sym))
183 alias(sym) := stl_sym(alind);
184 if is_init(sym)=1 then continue forall; end if;
185 value(sym) := value(stl_sym(alind));
186 end forall;
187
188
189 end procedure get_symtab;
190
191
192
193
194 procedure cnvval(sym, value_);
195$
196$ this routine computes the value of a symbol table entry
197$ and returns a pair [value, flag] where 'flag' indicates
198$ whether the symbol has a value.
199$
200 repr
201 frm: elmt forms;
202 tp: elmt base_ft_types;
203 tp1: string;
204 vl: general;
205 j: integer;
206 tup: tuple;
207 k: integer;
208 q: integer;
209 lenx: integer;
210 end repr;
211
212$ see the description of the value fields for details.
213
214$ elements of compound values are represented by pointers to their
215$ symbols; we retrieve these element values using the macro
216$ (note that the elements of a compound value v will always have
217$ been processed before v):
218
219 macro elmt_val(j); value(stl_sym(value_(j))) endm;
220
221
222 frm := form(sym); $ get form of symbol
223 tp := ft_type(frm);
224 tp1 := simple_type(tp); $ int, real, etc.
225$ this map sends (detailed) form indicators, such as "f-sint", "f-uint",
226$ "f-int" into gross form indicators such as "int". it is initialized
227$ in section 3g 'forms'
228
229 case tp1 of
230
231 ('int', 'real', 'string'):
232
233 vl := value_(1);
234
235 ('atom'):
236
237 $ recall that booleans are represented by the short atoms 0 and
238 $ maxsi, where maxsi is an implementation-dependend constant
239 $ giving to the maximum value for a short integer.
240 $ note that there can be no other constants with mode atom.
241
242 if is_boolean value_(1) then
243 vl := value_(1);
244 else
245 print('*** illegal type for constant in input: sym =',
246 sym, name(sym), 'form =', frm, 'value =', value_);
247 end if;
248
249 ('elmt'): $ element
250
251 vl := elmt_val(1);
252
253 ('tuple'): $ tuple
254
255 vl := [ elmt_val(j) : j in [ 1..#value_ ] ];
256
257 ('set', 'map'): $ sets and maps
258
259 vl := { elmt_val(j) : j in [ 1..#value_] };
260
261 ('proc'): $ procedures
262
263 $ the value of a procedure is a quadruple, giving (in this
264 $ order) the global for the return value, a flag indicating
265 $ whether the procedure has a variable number of arguments, the
266 $ number of formal parameters, and a sequence of rd's, rw's,
267 $ and wr's indicating how a parameter was declared.
268 $ note that the return value is a forward reference.
269
270 vl := [];
271 vl(1) := stl_sym(value_(1)); $ global for return value
272 if value_(2) = 1 then vl(2) := 1; end if; $ var # parameters
273 vl(3) := value_(3); $ number of formal parameters
274 vl(4) := [ stl_sym(value_(j)) : j in [ 4..#value_ ] ];
275
276 ('memb'): $ members of directories
277
278 $ the value of a member is a quintuple, giving (in this order)
279 $ the libraries referenced, the globals read, the globals writ-
280 $ ten, the procedures imported, and the procedures exported.
281 $ note the the imports and exports lists may contain forward
282 $ references.
283
284 $ each list consists of an integer n, followed by n symbol table
285 $ pointers.
286
287 tup := []; $ tuple of sets of symbols
288 k := 1;
289
290 (forall q in [1..5])
291 lenx := value_(k); $ length entries in q'th rights list
292
293 tup with:= { stl_sym(value_(k+j)) : j in [1..lenx] };
294 k := k + lenx + 1;
295 end forall;
296
297 vl := tup;
298
299 ('lab'): $ labels and case tags
300
301 $ the value of a label should be the instruction that it points
302 $ to. however, this will not be determined until the get_code
303 $ procedure, and we need a valid map should we encounter a case
304 $ map.
305
306 vl := sym;
307
308 else
309 print('*** illegal type for constant in input: sym =',
310 sym, name(sym), 'form =', frm, 'value =', value_);
311
312 end case;
313
314 return vl;
315
316 end procedure cnvval;
317
318
1 .=member gtcd8d
2
3
4 procedure get_code;
5$
6$ this routine reads segments of blocktab and codetab.
7$
8 repr
9 org: integer;
10 last: integer;
11 i: integer;
12 nxt: smap(integer) integer;
13 codetab_entry: tuple(*);
14 opcode_: integer;
15 blockof_: integer;
16 next_: integer;
17 cflag_: integer;
18 sflag_: integer;
19 nargs_: integer;
20 args_: tuple(*);
21 inst: elmt insts;
22 opc: elmt base_opcodes;
23 blk: elmt blocks;
24 j: integer;
25 i1, i2: integer;
26 cstmt_count: integer;
27 argsi: tuple(symbol);
28 oi: occurrence;
29 occsi: tuple(occurrence);
30 end repr;
31
32$ we begin by reading in blocktab and mapping each little block number
33$ into a setl block (an element of the plex base of setl blocks).
34
35 blocktab := [];
36
37 getb(q1_file, org, last);
38
39 (forall i in [ org+1..last ])
40 getb(q1_file, blocktab(i));
41 end forall;
42
43$ currently, in an attempt to make things easier for the optimiser, the
44$ semantic pass performs basic block decomposition. this decision,
45$ which it may be well to review and change, was made at an earlier
46$ stage of our design.
47
48$ note that all blocktab slices have org = 0 (as only one such table can
49$ be nonempty in any stacking of scopes)
50
51 blk := om;
52 (forall i in [ 1..#blocktab ])
53 stl_block(i) := blk := add_block(blk, cur_scope, true);
54 end forall;
55
56$ read codetab entries one at a time and build entries for the setl
57$ tables. we also build a temporary map 'nxt' sending the compiler-
58$ issued number of each instruction into the number of the next instruc-
59$ tion. once all instructions have been read and plex base atoms
60$ created for them, this map will be converted into a map between these
61$ atoms.
62
63 nxt := {};
64
65 cstmt_count := sc_estmt_ct(cur_scope);
66
67 for_slice(i)
68 getb(q1_file, codetab_entry);
69 [ opcode_, blockof_, next_, cflag_,
70 sflag_, nargs_, args_ ] := codetab_entry;
71
72 if sc_type(cur_scope) /= sc_proc then continue; end;
73
74 $ create an instruction atom in its plex base and note the
75 $ correspondence between the instruction number and atom.
76 stl_inst(i) := inst := newat;
77
78 opcode(inst) := opc := tup_opcodes(opcode_);
79 blockof(inst) := blk := stl_block(blockof_);
80
81 if opc = q1_stmt then cstmt_count +:= 1; end if;
82 stmtof(inst) := cstmt_count;
83
84$ note that the next_ field is 0 for the last instruction in a block
85 if next_ = 0 then
86 last_inst(blk) := inst;
87 else
88 nxt(i) := next_;
89 end if;
90
91$ store arguments. see introductory section 'the program' for an
92$ account of the maps (fields) being read
93
94 argsi := []; occsi := [];
95
96 (forall j in [ 1..nargs_ ])
97 argsi(j) := stl_sym(args_(j));
98
99 oi := newat; $ create new occurrence
100 instno(oi) := inst;
101 argno(oi) := j;
102 occsi(j) := oi;
103 end forall;
104
105 args(inst) := argsi;
106 occs(inst) := occsi;
107
108$ if this is a label or case tag definition, establish its value,
109$ which is the present instruction
110
111 if opcode(inst) in { q1_label, q1_tag } then
112 value(arg1(inst)) := inst;
113 end if;
114 end_slice;
115
116$ build up the maps 'first_inst' and 'next_inst'
117
118 (forall i in [1..#blocktab])
119 first_inst(stl_block(i)) := stl_inst(blocktab(i));
120 end forall;
121
122 (forall i2 = nxt(i1))
123 next_inst(stl_inst(i1)) := stl_inst(i2);
124 end forall;
125
126
127 end procedure get_code;
128
129
1 .=member pthd8e
2
3
4 procedure write_q1;
5$
6$ this is the top level routine for writing the q1 tables generated
7$ by the semantic pass.
8$
9 repr
10 tp: elmt base_ft_types;
11 mapc: elmt base_ft_mapcs;
12 cact: elmt base_copy_actions;
13 opc: elmt base_opcodes;
14 sctp: elmt base_sc_types;
15 i: integer;
16 sc: elmt base_scopes;
17 scx: elmt base_scopes;
18 sym, sym1: symbol;
19 vl: general;
20 end repr;
21
22 printa(term_file, ' - start to write q1 file');
23
24$ initialize various tables and auxiliary variables.
25
26$ first we initialize a map 'orgind' mapping each q1 table to its origin
27$ index in the currently processed scope. for more comments on this
28$ mechanism see introduction to this module.
29
30 orgind :=
31 { [ 'formtab', -1 ],
32 [ 'symtab', 0 ],
33 [ 'blocktab', 0 ],
34 [ 'codetab', 0 ] };
35
36$ initialize 'lastind', mapping each table to its last index in the
37$ currently processed scope
38 lastind := {};
39
40$ we also maintain a stack 'org_stack' for stacking up the orgind maps
41$ of superscopes of the currently processed scope
42 org_stack := [];
43
44$ initialize maps from codes to integers. see introduction to this
45$ module for description of the following tuples.
46
47 $ for ft_type_no, note the zero-origin of the little formtab
48 ft_type_no := { [ tp, i-1 ] : tp = tup_ft_types(i) };
49 ft_mapc_no := { [ mapc, i ] : mapc = tup_ft_mapcs(i) };
50 cflag_no := { [ cact, i-1 ] : cact = tup_copy_actions(i) };
51 opcode_no := { [ opc, i ] : opc = tup_opcodes(i) };
52 sc_type_no := { [ sctp, i ] : sctp = tup_sc_types(i) };
53$
smfb 28$ compute value_inv which maps eahc scope to the values defined in this
smfb 29$ scope, to the symbol table entry which defines the denotation. note
smfb 30$ that we assume here that all run-time constants originate from denota-
smfb 31$ tions. composite denotations refer to more primitive denotations
smfb 32$ which are defined previously. hence if cont_scopes maps each scope to
smfb 33$ a tuple of scopes which contain this scope (this map is build during
smfb 34$ the first pass) then we can assert that
smfb 35$ exists sc in cont_scopes | value_inv{sc}(vl) /= om;
61$
62 (forall sc in scopes)
63 (for_sym(sym, sc))
64 if (vl := value(sym)) /= om then
65 if ft_type(form(sym)) = f_lab then
66 value_inv{sc}{sym} with:= sym;
67 elseif alias(sym) = om and
68 not exists sym1 in value_inv{sc}{vl} |
69 form(sym) = form(sym1) then
70 value_inv{sc}{vl} with:= sym;
71 end if;
72 end if;
73 end;
74 end forall;
75$
76$ next iterate over scopes, and write out the scopes which were seen in
77$ the input stream. thus we suppress scopes added during first pass.
78$ (such as the dummy procedures we added)
79$
80 (forall sc = scopes(i) | is_seen(sc) /= om)
81 set_ltl_maps(sc); $ initialize ltl_xxx maps for sc
82 put_header(sc); $ write out the scope header
83 put_forms(sc); $ write formtab
84 put_symtab(sc); $ write symtab
85 put_code(sc); $ write blocktab and codetab
86 reset(sc, scopes(i+1)); $ reset the orgind map for next scope
87 end forall;
88
89$ finally write a dummy header to indicate end of file
90 put_trailer;
91
92 $ delete the static variables global to the module
93 orgind := om; lastind := om; org_stack := om;
94 ltl_sym := om; ltl_form := om; ltl_block := om;
95 ltl_inst := om; cflag_no := om; opcode_no := om;
96 ft_type_no := om; ft_mapc_no := om; sc_type_no := om;
97 value_inv := om;
98
99 end procedure write_q1;
100
101
102
103
104 procedure set_ltl_maps(sc);
105$
106$ this procedure computes the various 'ltl_xxx' maps for the current
107$ scope 'sc'. the reason for doing it in advance is that there are
108$ various 'forward' cross references between the various tables, such as
109$ symtab aliasing, value of labels, scope symtab pointers, procedure
110$ return value symbols etc.
111$
112 repr
113 $ representation of parameters
114 sc: elmt base_scopes;
115
116 $ representation of local variables
117 frmorg: integer;
118 symorg: integer;
119 blockorg: integer;
120 instorg: integer;
121 frm: elmt forms;
122 sym: symbol;
123 blk: elmt blocks;
124 inst: elmt insts;
125 end repr;
126
127 frmorg := orgind('formtab');
128 symorg := orgind('symtab');
129 blockorg := instorg := 0;
130
133 (for_form(frm, sc))
134 ltl_form(frm) := (frmorg +:= 1);
135 end;
136
137 lastind('formtab') := frmorg;
138
139 (for_sym(sym, sc))
140 ltl_sym(sym) := (symorg +:= 1);
141 end;
142
143 lastind('symtab') := symorg;
144
145 (for_block(blk, sc))
146 ltl_block(blk) := (blockorg +:= 1);
147 (for_inst(inst, blk))
148 ltl_inst(inst) := (instorg +:= 1);
152 end; $ end for_inst;
153 end; $ end for_block;
154
155 lastind('blocktab') := blockorg;
156 lastind('codetab') := instorg;
157
158 end procedure set_ltl_maps;
159
160
161
162
163 procedure put_header(sc);
164
165$ this routine writes the header for a segment of q1.
166
167$ note that any scope other than the system scope will have already
168$ appeared in a previous scope, so that its ltl_sym entry is
169$ already available
170
171 repr
172 sc: elmt base_scopes;
173 tp: elmt base_sc_types;
174 end repr;
175
176 putb(q1_file,
177 sc_type_no(tp := sc_type(sc)),
178 name(sc),
179 if tp = 'sc_sys' then 0 else ltl_sym(sc) end,
180 sc_nprocs(sc),
181 sc_stmt_ct(sc),
182 sc_estmt_ct(sc)
183 );
184
185
186 end procedure put_header;
187
188
189
190
191 procedure put_trailer;
192$
193$ this routine writes out a dummy header to indicate end of file.
194$
195 putb(q1_file, sc_type_no(sc_end), '', 0, 0, 0, 0);
196
197 end procedure put_trailer;
198
199
1 .=member ptfm8f
2
3
4 procedure put_forms(sc);
5
6$ this routine writes a segment of formtab onto the q1 file.
7
8 repr
9 sc: elmt base_scopes;
10 frm: elmt forms;
11 i: integer;
12 tp: elmt base_ft_types;
13 mapc: elmt base_ft_mapcs;
14 ft_type_: integer;
15 ft_mapc_: integer;
16 mttab_: tuple(integer);
17 f: elmt forms;
18 ft_dom_: integer;
19 ft_im_: integer;
20 ft_imset_: integer;
21 ft_base_: integer;
22 ft_deref_: integer;
23 ft_tup_: integer;
24 ft_elmt_: integer;
25 frm1: elmt forms;
26 ft_low_: integer;
27 ft_lim_: integer;
28 flim: integer;
29 ft_pos_: integer;
30 fpos: integer;
31 ft_neltok_: boolean;
32 ft_hashok_: boolean;
33 ft_num_: tuple(integer);
34 localtyps: tuple(string);
35 fm: string;
36 outform: tuple(*);
37 end repr;
38
39$ iterate over formtab writing out entries one at a time.
40
41 putb(q1_file, orgind('formtab'), lastind('formtab'));
42
43 loop for_form(frm, sc) do
44
45$ get little index of form for use just below.
46 i := ltl_form(frm);
47
48 tp := ft_type(frm);
49 mapc := ft_mapc(frm);
50
51 ft_type_ := ft_type_no(tp);
52 ft_mapc_ := if mapc /= om then ft_mapc_no(mapc) else 0 end;
53 ft_deref_ := ltl_form(ft_deref(frm));
54
55 if tp = f_mtuple or tp = f_proc then
56 mttab_ := [ ltl_form(f) : f in ft_elmt(frm) ];
57 ft_dom_ := ft_im_ := ft_base_ := ft_tup_ := 0;
58 ft_elmt_ := ft_imset_ := 0;
59
60 else
61 ft_elmt_ := if ft_elmt(frm) /= om
62 then ltl_form(ft_elmt(frm)) else 0 end;
63 ft_dom_ := if (frm1 := ft_dom(frm)) /= om
64 then ltl_form(frm1) else 0 end;
65 ft_im_ := if (frm1 := ft_im(frm)) /= om
66 then ltl_form(frm1) else 0 end;
67 ft_imset_ := if (frm1 := ft_imset(frm)) /= om
68 then ltl_form(frm1) else 0 end;
69 ft_base_ := if (frm1 := ft_base(frm)) /= om
70 then ltl_form(frm1) else 0 end;
71 ft_tup_ := if (frm1 := ft_tup(frm)) /= om
72 then ltl_form(frm1) else 0 end;
73 end if;
74
75 ft_low_ := ft_low(frm) ? 0;
76 ft_lim_ := ft_lim(frm) ? 0;
77 ft_pos_ := ft_pos(frm) ? 0;
78 ft_neltok_ := ft_neltok(frm) /= om;
79 ft_hashok_ := ft_hashok(frm) /= om;
80
81 ft_num_ := [];
82 if is_fbase(frm) then
83 localtyps :=
84 [ f_lset, f_lmap, f_lpmap, f_limap, f_lrmap ];
85 (forall fm in localtyps)
86 ft_num_ with:= ft_num(frm)(fm);
87 end forall;
88 end if;
89
90 outform :=
91 [ ft_type_, ft_mapc_, ft_elmt_, ft_dom_, ft_im_,
92 ft_imset_, ft_base_, ft_deref_,
93 ft_low_, ft_lim_, ft_pos_, ft_hashok_, ft_neltok_ ];
94
95 if tp = f_mtuple or tp = f_proc then
96 outform with:= mttab_;
97
98 elseif is_frem(frm) and is_fmap(frm) then
99 outform with:= [ ft_tup_ ];
100
101 elseif is_fbase(frm) then
102 outform with:= ft_num_;
103
104 else
105 outform with:= [];
106 end if;
107
108 putb(q1_file, outform);
109 end loop;
110
111
112 end procedure put_forms;
113
114
1 .=member ptst8g
2
3
4 procedure put_symtab(sc);
5$
6$ this routine writes a segment of symtab onto the q1 file.
7$
8 repr
9 sc: elmt base_scopes;
10 sym: symbol;
11 i: integer;
12 name_: string;
13 has_value_: boolean;
14 vlen_: integer;
15 val_: tuple(*);
16 alias_: integer;
17 sym1: symbol;
18 form_: integer;
19 is_temp_: boolean;
20 is_read_: boolean;
21 is_write_: boolean;
22 is_stk_: boolean;
23 is_param_: boolean;
24 is_store_: boolean;
25 is_repr_: boolean;
26 is_init_: boolean;
27 is_seen_: boolean;
28 is_back_: boolean;
29 is_rec_: boolean;
30 outsymb: tuple(*);
31 end repr;
32
33$ iterate over symtab, writing out one entry at a time.
34
35 putb(q1_file, orgind('symtab'), lastind('symtab'));
36
37 loop for_sym(sym, sc) do
38
39 i := ltl_sym(sym);
40 name_ := if is_internal(sym) = 1 then '' else name(sym) end;
41 [ has_value_, vlen_, val_ ] := bld_val(sym);
42
43 alias_ := if (sym1 := alias(sym)) /= om then
44 ltl_sym(sym1) else 0 end;
45
46$ note that the map 'is_internal' is relevant only to the optimizer.
47$ other parts of the compiler identify internal symbols as those having
48$ zero name field. therefore this map is ignored in this table dump.
49
50 form_ := ltl_form(form(sym));
51
52$ set all flags
53 is_temp_ := is_temp(sym) /= om;
54 is_read_ := is_read(sym) /= om;
55 is_write_ := is_write(sym) /= om;
56 is_stk_ := is_stk(sym) /= om;
57 is_param_ := is_param(sym) /= om;
58 is_store_ := is_store(sym) /= om;
59 is_repr_ := true;
60 is_init_ := is_init(sym) /= om;
61 is_seen_ := is_seen(sym) /= om;
62 is_back_ := is_back(sym) /= om;
63 is_rec_ := is_rec(sym) /= om;
64
65 outsymb :=
66 [ name_, form_, alias_, is_repr_, is_temp_,
67 is_stk_, is_read_, is_write_, is_param_,
68 is_store_, is_init_, is_seen_, is_back_, is_rec_,
69 has_value_ ];
70
71 if has_value_ then $ the symbol has a value entry
72 outsymb with:= vlen_;
73 outsymb with:= val_;
74 end if;
75
76 putb(q1_file, outsymb);
77 end loop;
78
79
80 end procedure put_symtab;
81
82
1 .=member ptcd8h
2
3
4 procedure put_code(sc);
5
6$ this routine writes segments of blocktab and codetab.
7
8 repr
9 sc: elmt base_scopes;
10 block: elmt blocks;
12 inst: elmt insts;
13 i: integer;
14 opcode_: integer;
15 nargs_: integer;
16 blockof_: integer;
17 next_: integer;
18 inst1: elmt insts;
19 cflag_: integer;
smfb 36 cf: elmt base_copy_actions;
21 sflag_: integer;
22 argsi: tuple(symbol);
23 args_: tuple(*);
24 j: integer;
25 outcode: tuple(*);
26 end repr;
27
28 putb(q1_file, orgind('blocktab'), lastind('blocktab'));
29
30 loop for_block(block, sc) do
33 putb(q1_file, ltl_inst(first_inst(block)));
34 end loop;
35
36
37$ finally build up codetab entries and write them out one at a time.
38
39 putb(q1_file, orgind('codetab'), lastind('codetab'));
40
41 loop for_block(block, sc) do loop for_inst(inst, block) do
42 i := ltl_inst(inst);
43
44 opcode_ := opcode_no(opcode(inst));
45 nargs_ := # args(inst);
46 blockof_ := ltl_block(block);
47
48 next_ := if (inst1 := next_inst(inst)) /= om then
49 ltl_inst(inst1) else 0 end;
50
51 cflag_ := if (cf := copy_flag(inst)) /= om then
52 cflag_no(cf) else 0 end;
53
54 sflag_ := if share_flag(inst) /= om then 1 else 0 end;
55
56 argsi := args(inst);
57 args_ := [ ltl_sym(argsi(j)) : j in [ 1..nargs_ ] ];
58
59 outcode :=
60 [ opcode_, blockof_, next_, cflag_, sflag_,
61 nargs_, args_ ];
62
63 putb(q1_file, outcode);
64 end loop;
65 end loop;
66
67 end procedure put_code;
68
69
1 .=member bldv8i
2
3
4 procedure bld_val(sym);
5$
6$ this routine computes for a given symbol 'sym' three value-related
7$ entries:
8$
9$ has_value_: a flag indicating whether the symbol has a value
10$ vlen_: the length of the value (see below)
11$ val_ : the value itself, as a series of subentries.
12$
13$ this routine uses an auxiliary routine, elmt_sym, to find, given a
14$ value v, a form fm, and a scope sc, a symbol with value v and form fm
15$ in the containing scopes (inner-to-outer), or, if no such symbol
16$ exists, a symbol with value v and a form fm' so that fm' can be con-
17$ verted to fm. again, this search is done inner-to-outer through the
18$ containing scopes. note that such a symbol must exists unless there
19$ is a compiler bug.
20$
21 repr
22 sym: symbol;
23 vl: general;
24 fm: elmt forms;
25 sc: elmt base_scopes;
26 tp: elmt base_ft_types;
27 tp1: string;
28 v: general;
29 i, j, n: integer;
30 val_: tuple(integer);
31 vli: sparse set(symbol);
32 sm: symbol;
33 end repr;
34
35
36 $ constants and initialised variables with omega as their value are
37 $ aliased to sym_om, and thus will be rebuild in the code generator
38 $ interface correctly, as we copy the value of aliased symbols from
39 $ the symbol they are alised to.
40
41 if value(sym) = om then return [ false, 0 ]; end if;
42
43 vl := value(sym);
44 fm := form(sym);
45 sc := scope(sym);
46 tp := ft_type(fm);
47 tp1 := simple_type(tp); $ int, real, etc.
48$ 'simple_type' maps each ft_type string to a string describing
49$ the 'basic' type of hat form, such as 'int', 'tuple', 'base' etc.
50
51 case tp1 of
52
53 ('int', 'real', 'string'):
54
55 return [ true, 1, [ vl ] ];
56
57 ('atom'):
58
59 $ recall that booleans are represented by the short atoms 0 and
60 $ maxsi, where maxsi is an implementation-dependend constant
61 $ giving to the maximum value for a short integer.
62 $ note that there can be no other constants with mode atom.
63
64 if is_boolean vl then
65 return [ true, 1, [ vl ] ];
66 else
67 print('*** illegal type for constant in output:',
68 'sym =', sym, name(sym), 'form =', fm, 'scope =', sc);
69 end if;
70
71 ('elmt'): $ element
72
73 return
74 [ true, 1, [ elmt_sym(vl, ft_elmt(ft_base(fm)), sym) ] ];
75
76 ('tuple', 'set', 'map'):
77
78 return
79 [ true,
80 # vl,
81 if tp = f_mtuple then
82 [ elmt_sym(v, ft_elmt(fm)(j), sym) : v = vl(j) ]
83 else
84 [ elmt_sym(v, ft_elmt(fm), sym) : v in vl ]
85 end
86 ];
87
88 ('proc'): $ procedures
89
90 $ the value of a procedure is a quadruple, giving (in this
91 $ order) the global for the return value, a flag indicating
92 $ whether the procedure has a variable number of arguments, the
93 $ number of formal parameters, and a sequence of rd's, rw's,
94 $ and wr's indicating how a parameter was declared.
95
96 return
97 [ true,
98 3 + # vl(4), $ 3 + length of sequence of rd's, ...
99 [ ltl_sym(vl(1)), $ global for the return value
100 if vl(2) = om then 0 else 1 end, $ variable #parameters
101 vl(3) ] + $ number of formal parameters
102 [ ltl_sym(vl(4)(i)) : i in [ 1..#vl(4) ] ] ];
103$ note that here we use pointers to the little symbol table entries for
104$ the actual symbols rd/wr/rw; see the corresponding input routine
105$ cnvval.
106
107 ('memb'): $ members
108
109 $ the value of a member is a quintuple, giving (in this order)
110 $ the libraries referenced, the globals read, the globals writ-
111 $ ten, the procedures imported, and the procedures exported.
112
113 n := 0; val_ := [];
114
115 (forall i in [ 1..5 ])
116 vli := vl(i);
117
118 n +:= (#vli + 1);
119
120 val_ with:= #vli;
121 (forall sm in vli)
122 val_ with:= ltl_sym(sm);
123 end forall;
124 end forall;
125
126 return [ true, n, val_ ];
127
128 ('lab'): $ labels
129
smfi 1 return [ true, 1, [ ltl_inst(value(sym)) ] ];
131
132 else
133 print('*** illegal type for constant in output:',
134 'sym =', sym, name(sym), 'form =', fm, 'scope =', sc);
135 end case;
136
137 end procedure bld_val;
138
139
140
141
142 procedure elmt_sym(vl, fm, sym);
143$
144$ this routine returns the name of a setl symbol whose value is vl,
145$ whose type is fm, and whose scope is sc or a containing scope.
146$
147 repr
148 vl: general;
149 fm: elmt forms;
150 sym: symbol;
151 sc, scx: elmt base_scopes;
152 s: symbol;
153 end repr;
154
155 sc := scope(sym);
156
157 if exists scx in cont_scopes(sc), s in value_inv{scx}{vl} |
158 form(s) = fm then
159 return ltl_sym(s);
160
161 elseif exists scx in cont_scopes(sc), s in value_inv{scx}{vl} |
162 can_conv(form(s), fm) then
163 return ltl_sym(s);
164
165 else
166 print('*** error in elmt_sym: scope = ' + str sc +
167 ', form = ' + str fm +
168 ', value = ' + str vl + ' ***' );
169
170 print;
171 print('value_inv =', value_inv);
172 print;
173 end if;
174
175
176 end procedure elmt_sym;
177
178
1 .=member rset8j
2
3
4 procedure reset(sc, nxt);
5$
6$ this procedure is called to reset the 'orgind' map when we are done
7$ writing out the table entries for a scope. 'sc' is the scope name,
8$ and 'nxt' is the next scope.
9$
10$ the following cases may arise:
11$
12$ 1. sc is not a procedure. in this case nxt is a subscope of sc; we
13$ stack the 'orgind' value for sc in 'org_stack', and take 'lastind' for
14$ sc to be the new 'orgind' value for nxt.
15$
16$ 2. sc is a procedure and nxt is also a procedure. in this case we do
17$ nothing, as the current 'orgind' map is appropriate for nxt also, and
18$ there is no need to stack it.
19$
20$ 3. sc is a procedure, and nxt is a library, the directory, or the
21$ main program. in this case we observe that the library and directory
22$ headers are static. in the case of libraries their headers are still
23$ needed since it contains the procedure symbol table entries for the
24$ exported procedures. since we like to keep these headers, we do
25$ nothing since the current orgind value is appropriate for nxt, too.
26$$-- for libraries, this is an overestimate: only the entries for ex-
27$$-- ported procedures and thei return values remain visible, but not
28$$-- their and
29$
30$ 4. sc is a procedure, and nxt is a module header. in this case we pop
31$ org_stack to obtain the orgind map for nxt. note that the preceding
32$ scope must have been the main program or a module scope.
33$
34 if sc_type(sc) = sc_proc then
35 if nxt = om or sc_type(nxt) = sc_mod then
36 orgind frome org_stack;
37 end if;
38 else $ keep entries till end of member
39 org_stack with:= orgind;
40 orgind := lastind;
41 end if;
42
43 end procedure reset;
44
45
46 end module setl_optimizer - interface;
47
48
1 .=member fpass9
2
3
4 module setl_optimizer - optinit;
5
6
7$ this module contains routines to initialize the optimizer.
8
9 var
10 expsym, $ maps expression opcode and args to the
11 $ expresion identifying temporary
12 expdepend, $ explicit dependency relation between
13 $ expressions
14 live_temps; $ live temporaries
15
16 init
17 expsym := {}, expdepend := {}, live_temps := {};
18
19 repr
20 expsym: smap(tuple(
21 elmt base_opcodes,
22 tuple(symbol) ))
23 symbol;
24 expdepend: sparse mmap{symbol}
25 remote set(expression);
26 live_temps: sparse set(symbol);
27
28 readcc: procedure;
29 first_pass: procedure;
30 shortcut: procedure(symbol) symbol;
31 get_temp: procedure(
32 elmt base_opcodes,
33 tuple(symbol),
34 routine,
35 elmt insts )
36 symbol;
smfc 24 exp_name: procedure(
smfc 25 elmt base_opcodes,
smfc 26 tuple(symbol),
smfc 27 elmt insts )
smfc 28 string;
39 transclose: procedure(
40 sparse set(symbol),
41 sparse mmap{symbol}
42 remote set(expression) )
43 sparse mmap{symbol}
44 remote set(expression);
45 satisfy_members: procedure;
46 satisfy_procs: procedure;
47 bld_body: procedure(
48 routine,
49 sparse set(symbol),
50 sparse set(symbol),
51 sparse set(routine)
52 );
53 bld_entry: procedure(routine);
54 bld_label: procedure(routine, symbol);
55 bld_use: procedure(routine, symbol);
56 bld_def: procedure(routine, symbol);
57 bld_call: procedure(routine, routine);
58 bld_exitstop: procedure(routine);
59 end repr;
60
61
62 procedure opt_ini;
63
64 readcc; $ read control card parameters
65
smfl 1 prog_level := 'opt(85023)';
67
68 title('cims.setl.' + prog_level);
69
smfk 14 if lcp_flag then $ print phase heading
smfk 15 print('parameters for this compilation:');
smfk 16 print;
smfk 17 print('q1 file: q1 =', q1_file);
smfk 18 print('source map file: ssm =', ssm_file);
smfk 19 print('run-time error mode: rem =', rem);
smfk 20 print('dumps requested: db =', dump_string);
smfk 21 print;
smfk 22 end if;
78
79 $ start log on terminal file
80 open(term_file, 'text-out');
81 printa(term_file, ' start cims.setl.' + prog_level, date);
82
83 $ read the q1 file written by the semantic pass
84 open(q1_file,'binary'); read_q1; close(q1_file);
85 statistics with:= time; $ save initial time
86
87 first_pass; $ a priliminary pass through the code
88
89 $ dump tables
90 if 's' in dump_string then dmp(om, 'symtab'); end if;
91 if 'f' in dump_string then dmp(om, 'formtab'); end if;
92 if 'c' in dump_string then dmp(om, 'codetab'); end if;
93
94 statistics with:= time; $ save initial time
95
96
97 end procedure opt_ini;
98
99
100
101
102 procedure readcc;
103$
104$ this routine reads the control card parameters relevant to the
105$ optimizer.
106$
107$ control card parameters are read in using two procedures in the
108$ standard prelude:
109$
110$ getipp(s): returns the value of an integer control card parameter
111$ getspp(s): returns the value of a string control card parameter
112$
113$ 's' is a string of the form 'xxx=yyy/zzz' where:
114$
115$ 'xxx' is the name of the parameter as it appears on the control card
116$ 'yyy' is the default if the parameter is not supplied
117$ 'zzz' is the default if only the parameter name is supplied.
118$
119 q1_file := getspp('q1=q1/q1'); $ q1 file name
120 ssm_file := getspp('ssm=/'); $ optimiser source map
121 term_file := getspp('sterm=0/0'); $ terminal file name
122 rem := getipp('rem=1/1'); $ run-time error mode
123 debug_flag := getipp('odebug=1/1') = 1; $ perform debugging code
124 at_flag := getipp('at=0/1') = 1; $ automatic titling
smfk 23 lcp_flag := getipp('lcp=0/1') = 1; $ list program parms
smfk 24 lcs_flag := getipp('lcs=1/1') = 1; $ list program stats
125 dump_string := getspp('db=/sfci'); $ dump options
126
127
128 end procedure readcc;
129
130
131
132
133 procedure first_pass;
134$
135$ this procedure does a preliminary pass over the program performing
136$ the following tasks:
137$
138$ 1. it generates a dummy routine for each unsatisfied external
139$ procedure.
140$
141$ 2. it iterates over the code making various local cleanups which
142$ simplify later algorithms. at the same time it builds various
143$ auxiliary sets and maps.
144$
145 init
smfh 8 varofexps := {}, push_of := {},
smfh 9 all_eq := {}, all_system_routs := {};
148
149 repr
150 sc, scx: elmt base_scopes;
151 all_system_routs: sparse set(symbol);
smfg 16 all_eq: sparse set(elmt insts);
152 sym: symbol;
153 r: routine;
154 params: tuple(symbol);
155 varofexps: sparse set(symbol);
156 expoftmp: sparse smap(symbol) symbol;
157 b: elmt blocks;
158 i, iprev: elmt insts;
159 opc: elmt base_opcodes;
160 oi1: occurrence;
161 a1, a2, a3: symbol;
162 p1: symbol;
163 formpar: symbol;
165 x, s: symbol;
166 y: occurrence;
smfg 17 i1, i2: elmt insts;
smfg 18 op1, op2: elmt base_opcodes;
smfg 19 opc1, opc2: elmt base_opcodes;
smfg 20 l: symbol;
168 opcarb, opcless: elmt base_opcodes;
169 j: integer;
170 a, aa, aivs: tuple(symbol);
171 aj, bj: symbol;
172 tsym: symbol;
173 opcrev: elmt base_opcodes;
174 lsin: integer;
175 presym: symbol;
181 rem_all_oi: remote set(occurrence);
182 oi: occurrence;
183 v: symbol;
184 push_of: sparse smap(symbol) elmt insts;
185 casemap, cas: general;
186 lab: symbol;
187 end repr;
188
189
190$ the cleanups performed here are as follows:
191$$$ ??????? art: supply description of cleanups
192$ the auxiliary sets and maps built are as follows:
193$ we begin by building the set of all procedures in the input.
194 routs := { sc in scopes | sc_type(sc) = sc_proc };
195 $ note that this set includes main program, too.
196
197 (for_sym(sym, sym_sys))
198 if ft_type(form(sym)) = f_proc and sym /= sym_main then
199 all_system_routs with:= sym;
200 end if;
201 if name(sym) = 'om' then sym_om := sym; end if;
202 end;
203
204$ check whether the input contains a directory and a main program.
205$ if not, build dummies.
206
207 satisfy_members;
208
209$ next fill in the bodies of all procedures mentioned in the directory
210$ but not supplied by the user.
211
212$ sometimes we will find two unsatisfied externals p1 and p2 which can
213$ have the same dummy body. rather than building separate bodies for
214$ each of them we will set alias(p1) = p2. when we iterate over the
215$ code we will substitute p2 for each occurrence of p1.
216
217 satisfy_procs;
218
219$ build 'rparams' sending each procedure into a tuple containing its
220$ formal parameters. if a procedure has 'n' formal parameters they are
221$ always its first 'n' symbols.
222
223 (forall r in routs)
224 params := [];
225
226 (for_sym(sym, r))
227 if is_param(sym)=1 then
228 params with:= sym;
229 elseif ft_type(form(sym)) /= f_lab then
230 quit;
231 end if;
232 end;
233 rparams(r) := params;
234 end forall;
235
236$ next we make a pass over the code to build the 'oi_sets', 'exp_maps',
237$ and 'var_maps', and to accomplish various cleanups.
238
239$ the loop body consists of two parts. the first part is a case
240$$$ ???? reword this enigmatic paragraph
241$ statement which performs various special actions and putting
242$ the instruction's first occurrence into the appropriate sets.
243$ the second part adds the instructions remaining occurrences
244$ to all_oi and all_i.
245
246$ the loop builds the following sets and maps listed above:
247$
248$ a. rentry: sends each routine into its entry block
249$ b. rexit: sends each routine into its exit block
250$ c. rstop: sends each routine into its stop block
251$ d. all_oi: set of all occurrences
252$ e. all_o: set of ovariables
253$ f. all_i: set of ivariables
254$ g. callsin: maps each routine to its call blocks
255$ h. callproc: maps each call block to the routine it calls
256$ i. cgraph: the call graph itself.
257$ j. globalvars: set of global variables
258$ k. localvars: maps each routine to its local variables
259$ variables: set of all program variables
260$ l. occsof: maps each variable to its occurrences
261$ m. globalexps: set of global expressions
262$ n. localexps: maps each routine to its local expressions
263$ o. expdepend: explicit dependency relation between expressions
264$ varofexps: user variables which are expression operands
265$ live_temps: all temporaries still needed after code modification
266$ system_routs: system routines call by the program
267$ allexps: set of all expressions
268$ opcexp: maps expressions to their defining opcode
269$ argsexp: maps expressions to tuple of their input args
270$$$ ??????? micha: it may be most efficient to build
271$$$ ??????? some block propagation maps right here
272$
273$ let us comment on the way we handle expressions in the optimiser. the
274$ semantic pass generates a temporary variable as an output variable for
275$ for each expression computation, but maintains uniqeness of these
276$ names only within a basic block, so that the same expression, computed
277$ in different blocks, may be assigned (i.e. identified with) different
278$ target temporaries. however, for our redundant expression elimination
279$ phase, we want to maintain this unique representation of expressions
280$ by their target temporaries throughout the whole program. this
281$ requires renaming of temporaries, which is performed in this loop.
282$
283$ this is done as follows: for each basic block we build a map
284$ 'expoftmp', mapping each temporary to its new expression-identifying
285$ temporary symbol. when we process an instruction i of the form
286$ 't := op(a1, a2...an)' which is known to yield an expression which is
287$ well defined and has no side effects (thus excluding expressions com-
288$ puted e.g. by 'q1_arb' or 'q1_rand' operators), we replace each
289$ temporary among the i-variables by its 'expoftmp' value (which must be
290$ already available) to obtain a new list (b1, b2...bn) of input argu-
291$ ments. then the pair tn = [ op, input args ] uniquely identifies the
292$ expression being computed by this instruction; we maintain a map
293$ 'expsym' which maps each such pair to the corresponding expression-
294$ identifying temporary symbol. using this map we get the required
295$ target variable for i and replace t, if necessary, by that variable.
296$
297$ we also try to re-use temporaries generated by the semantic pass as
298$ the new expression names. any temporary that is not re-used is marked
299$ as a dead symbol and will be later removed from the symbol table.
300$
301 (forall r in routs)
302 expoftmp := {};
303 (for_block(b, r))
304 iprev := om; $ keep previous instruction
305
306 (for_inst(i, b))
307 opc := opcode(i);
308 oi1 := get_oi(i, 1); $ first occurrence
309
310 case opc of
311
312 (q1_stmt):
313
314 iprev := i;
315 continue;
316
317 (q1_argin, q1_argout, q1_free):
318
319 $ the second parameter of the current instruction, a2,
320 $ gives the name of the routine called. if this is a
321 $ call to an unsatisfied external procedure, we must
322 $ account for the possibility that satisfy_procs might
323 $ have determined that a2 belongs to a class of proce-
324 $ dures p1, p2, ..., pn, all with identical parameters,
325 $ globals accessed, etc., and decided not to supply a
326 $ dummy body for each pi, but rather to supply a dummy
327 $ body for some pj, and to set alias(pi) = pj for the
328 $ remaining pi's. if this is the case, we substitute pj
329 $ for pi in the instruction.
330 $
331 $ furthermore, we recall that the data flow algorithms
332 $ require that the formal parameter name appears as an
333 $ explicit, assignment-like argument to the argin and
334 $ argout instructions. we add it at this time.
335 $
336 $ if, on the other hand, this instruction is part of a
337 $ call to a setl systems routine such as read or print,
338 $ then we account for the fact that we do not know the
339 $ structure of these routines by replacing argin and
340 $ argout instructions by sargin and sargout instruc-
341 $ tions, and thus are able to distinguish the calling
342 $ sequences. note that we consider the first argument
343 $ of an sargin instruction to be an i-variable, while
344 $ the first argument of an sargout is an o-variable.
345 $
346 $ note that the above remarks also hold for q1_free
347 $ instructions, since the code generator needs to know
348 $ the forms of the formal parameters to be able to emit
349 $ the proper stack pops.
350
351 a2 := arg2(i);
352 if a2 in all_system_routs then
353 system_routs with:= a2;
354 if opc = q1_argin then
355 opc := opcode(i) := q1_sargin;
356 elseif opc = q1_argout then
357 opc := opcode(i) := q1_sargout;
358 end if;
359
360 else
361 p1 := alias(a2);
362 if p1 /= om then arg2(i) := a2 := p1; end if;
363
364 formpar := rparams(a2)(value(arg3(i)));
365 if opc = q1_argin then
366 args(i) := [ formpar ] + args(i);
367 elseif opc = q1_argout then
368 args(i) with:= formpar;
369 end if;
370
smfc 30 if #args(i) /= #occs(i) then
smfc 31 oi := newat; $ record additional occurrence
smfc 32 instno(oi) := i;
smfc 33 argno(oi) := #args(i);
smfc 34 occs(i) with:= oi;
smfc 35 end if;
375 end if;
376
377 (q1_call):
378
379 $ here the first argument, a1, is the procedure name.
380 $ as explained above, a1 may be an alias for some other
381 $ procedure.
382
383 a1 := arg1(i);
384 if a1 in all_system_routs then
385 system_routs with:= a1;
386
387 $ assure that this is not a call to host
388 if name(a1) = 'host' then
389 abort('attempt to optimise program with host');
390 end if;
391
392 $ define the return value
393 i1 := i;
394 insert_ins(i1, q1_def, value(a1)(1));
395 else
396 p1 := alias(a1);
397 if p1 /= om then arg1(i) := a1 := p1; end if;
398
smfg 21 cgraph with:= [ r, a1 ]; $ 'r' calls 'a1'
smfg 22 callsin with:= [ r, b ]; $ call block in 'r'
smfg 23 callproc(b) := a1; $ 'b' calls 'a1'
smfg 24
smfg 25 $ this is a 'single-instruction' block, i.e. it
smfg 26 $ consists of a label, a call, and a goto.
smfg 27 $ assert opcode(first_inst(b)) = q1_label;
smfg 28 $ assert next_inst(first_inst(b)) = i;
smfg 29 $ assert next_inst(i) = last_inst(i);
400 end if;
401
402 (q1_entry):
403
404 rentry(r) := b;
405
406 (q1_exit):
407
408 rexit(r) := b;
409
410 (q1_stop):
411
412 rstop(r) := b;
413
414 (q1_sof, q1_sofa, q1_send, q1_ssubst, q1_next):
415
416 $ these are opcodes whose first argument is both an
417 $ i-variable and an o-variable. to simplify our task,
418 $ we add a last argument, equal to the first argument,
419 $ to account for the i-occurrence.
420
smfg 30 args(i) with:= arg1(i);
423
424 oi := newat; $ record additional occurrence
425 instno(oi) := i;
426 argno(oi) := #args(i);
427 occs(i) with:= oi;
428
429 (q1_from, q1_fromb, q1_frome):
430
431 $ the second argument for these opcodes is both an
432 $ i-variable and an o-variable. since 'x from s' is
433 $ semantically equivalent to 'x := arb s; s less:= x',
434 $ we merely transform the former to the latter. note
435 $ that neither from nor arb yield valid expressions.
436 $ this observation is important if we later want to
437 $ reverse the arbb and arbe sequences into fromb's and
438 $ frome's, resp. (this is done in the output interface
439 $ cleanup).
440
441 [ x, s ] := args(i);
442
443 opcode(i) := q1_noop;
444 args(i) := [];
445 occs(i) := [];
446
447 if opc = q1_from then
448 opcarb := q1_arb;
449 opcless := q1_less;
450 elseif opc = q1_frome then
451 opcarb := q1_arbe;
452 opcless := q1_lesse;
453 else
454 opcarb := q1_arbb;
455 opcless := q1_lessb;
456 end if;
457
458 if is_temp(s) /= om then is_temp(s) := om; end if;
459 assert is_temp(x) = om;
460 i1 := i;
461 insert_ins(i1, opcarb, x, s );
462 insert_ins(i1, opcless, s, s, x);
463 opc := q1_noop;
smfg 31
smfg 32 (q1_eq, q1_ne):
smfg 33
smfg 34 if arg2(i) /= arg3(i) then
smfg 35 if arg2(i) = sym_om or arg3(i) = sym_om then
smfg 36 all_eq with:= i;
smfg 37 end if;
smfg 38 end if;
464
465 (q1_inext, q1_inextd):
466
467 $ precede the iterator variable a2 by a q1_def, so that
468 $ we don't have to worry about the two o-variables.
469 $ note that this variable has no influence on optimisa-
470 $ tion, except that it appears as the operand to a test
471 $ for omega which signals the end of the iteration.
smfi 3 if #name(x := arg1(i)) > 2 and name(x)(1..2) = 't.' then
smfi 4 if 'c' notin dump_string then
smfi 5 name(x) := '';
smfi 6 end if;
smfi 7 end if;
smfe 15
smfe 16 itervars with:= arg2(i);
smfk 25
smfk 26 if #name(x := arg3(i)) > 2 and name(x)(1..2) = 't.'
smfk 27 and opcode(iprev) = q1_asn and x = arg1(iprev)
smfk 28 and 'c' notin dump_string
smfk 29 then
smfk 30 name(x) := name(arg2(iprev));
smfk 31 end if;
472
473 i1 := iprev;
474 insert_ins(i1, q1_def, arg2(i));
475
476 (q1_push):
477 x frome args(i);
478 y frome occs(i);
479 push_of(x) := i;
smfi 8
smfi 9 if 'c' notin dump_string then
smfi 10 if is_temp(x := arg1(i)) /= om
smfi 11 and opcode(iprev) = q1_asn
smfi 12 and arg1(iprev) = arg1(i) then
smfi 13 name(x) := name(arg2(iprev));
smfi 14 end if;
smfi 15 end if;
480
481 (q1_set1, q1_tup1):
482 push_former(push_of(arg1(i))) := i;
smfi 16
smfi 17 if #name(x := arg1(i)) > 2 and name(x)(1..2) = 't.' then
smfi 18 if 'c' notin dump_string then
smfi 19 name(x) := format_inst(i, om);
smfi 20 end if;
smfi 21 end if;
483
484 (q1_case):
485 casemap := value(arg1(i));
486 value(arg1(i)) :=
487 { [ cas, shortcut(lab) ] : lab = casemap(cas) };
488
489 (q1_goto):
490 arg1(i) := shortcut(arg1(i));
491 last_inst(b) := i;
492 next_inst(i) := om;
493
smfg 39 (q1_if, q1_ifnot, q1_bif, q1_bifnot):
495 arg2(i) := shortcut(arg2(i));
smfg 40
smfg 41 (q1_ifasrt):
smfg 42 arg1(i) := shortcut(arg1(i));
496
497 (q1_error):
498 abort('optimisation terminated due to '
499 'prior compilation error');
500
501 (q1_ok, q1_fail, q1_succeed, q1_lev):
502 abort('attempt to optimise program with backtracking');
503
504 end case;
505
506$ add occurrences in i to the various 'oi_sets'.
507 (forall j in [ first_ivar(opc)..#args(i) ])
508 oi := get_oi(i, j);
509
510 all_oi with:= oi;
511 all_i with:= oi;
512 end forall;
513
514 if opc in ops_ovar then
515 all_oi with:= oi1;
516 all_o with:= oi1;
517 end if;
518
519$ update the various 'exp_maps'
520
521 a := args(i); $ get arguments
522 if opc in ops_exps then
523 (forall j in [ 2..#a ])
524 aj := a(j);
525 if (bj := expoftmp(aj)) /= om then
526 a(j) := aj := bj;
527 else
528 if is_const(aj) = om and aj /= sym_om then
529 varofexps with:= aj;
530 end if;
531 end if;
532 end forall;
533
534 aivs := a(2..); $ get input arguments
535
536 $ get expression-identifying temporary
537 tsym := get_temp(opc, aivs, r, i);
538
539 $ replace the output temporary by the new one and note
540 $ that correspondence.
541 a(1) := expoftmp(a(1)) := tsym;
542
543 else
544 $ not an expression-producing instruction: in this case
545 $ just replace temporaries by their new expression-
546 $ identifying symbols.
547 (forall j in [ first_ivar(opc)..#a ])
548 if (bj := expoftmp(a(j))) /= om then
549 a(j) := bj;
550 end if;
551 end forall;
552
553 $ if a sinister assignment, e.g. 'f(x) := y', replace it
554 $ by the pair 't := y' 'f(x) := t', where t is the
555 $ expression-identifying temporary for 'f(x)'.
556
557 if opc in ops_sin then
558 if a(1) /= (a1 := a(#a)) then
559 a(1) := a1;
560 varofexps with:= a1;
561 end if;
562
563 opcrev := $ the reverse opcode
564 case opc of
565 (q1_sof): q1_of,
566 (q1_sofa): q1_ofa,
567 (q1_send): q1_end,
568 (q1_ssubst): q1_subst
569 else om end;
570 lsin := if opc = q1_ssubst then 3 else 2 end;
571 aa := a(1..lsin);
572 tsym := get_temp(opcrev, aa, r, i);
573 if a(lsin+1) /= tsym then
574 insert_ins(iprev, q1_asn, tsym, a(lsin+1));
575 a(lsin+1) := tsym;
576 end if;
577 end if;
578
579 if opc in ops_ovar then
580 live_temps with:= a(1);
581 end if;
582 end if;
583
584 $ restore argument list
585 args(i) := a;
586 iprev := i;
587 end; $ end for_inst;
588 end; $ end for_block;
589 end forall;
590$
591$ next delete all dead temporaries from the symbol table
592$
593 (forall sc in scopes)
594 presym := om; $ note previous symbol
595 (for_sym(sym, sc))
596 if is_temp(sym)=1 and sym notin live_temps then
597 del_sym(sym, presym, sc);
598 sym := presym;
599 else
600 presym := sym;
601 end if;
602 end; $ end for_sym;
603 end forall;
smfg 43$
smfg 44$ iterate over all equality tests with one constant operand to see
smfg 45$ whether control flow information should be made explicit for the type
smfg 46$ finder.
smfg 47$
smfg 48 (forall i1 in all_eq)
smfg 49 i2 := next_inst(i1);
smfg 50 op1 := opcode(i1);
smfg 51 op2 := opcode(i2);
smfg 52
smfg 53 if op2 notin { q1_if, q1_ifnot, q1_bif, q1_bifnot } then
smfg 54 continue forall;
smfg 55 end if;
smfg 56 if arg1(i1) /= arg1(i2) then continue forall; end if;
smfg 57
smfg 58 if arg2(i1) = sym_om or arg3(i1) = sym_om then
smfg 59 a1 := if arg2(i1) /= sym_om then arg2(i1) else arg3(i1) end;
smfg 60 opc1 := q1_isom; opc2 := q1_notom;
smfg 61 end if;
smfg 62
smfg 63 if op1 = q1_eq and op2 in { q1_ifnot, q1_bifnot }
smfg 64 or op1 = q1_ne and op2 in { q1_if, q1_bif } then
smfg 65 [ opc1, opc2 ] := [ opc2, opc1 ];
smfg 66 end if;
smfg 67
smfg 68 r := routof(blockof(i2));
smfg 69
smfg 70 b := add_block(om, r, true);
smfg 71 l := add_label(r);
smfg 72 i := add_inst(b, q1_label, l);
smfg 73 value(l) := i;
smfg 74 stmtof(i) := stmtof(i1);
smfg 75
smfg 76 insert_ins(i, opc1, a1);
smfg 77 insert_ins(i, q1_goto, arg2(i2));
smfg 78
smfg 79 arg2(i2) := l;
smfg 80
smfg 81 insert_ins(i2, opc2, a1);
smfg 82
smfg 83 end forall;
661$
662$ next compute globalvars, localvars and occsof.
663$
664 (forall oi in (rem_all_oi := all_oi))
665 v := oi_sym(oi);
666
667 $ record only occurrences which are not constant, thus ignoring
668 $ constant variables, denotations, labels, procedures, etc.
669
670 if is_const(v) = om and v /= sym_om then
671
672 variables with:= v;
673 occsof{v} with:= oi;
674
675 $ in addition, separate the variables which appear in the
676 $ user's source program, thus ignoring temporaries, return
677 $ values, etc.
678
679 if is_internal(v) = om then
smff 2 if '(' notin name(v) and '$' notin name(v) then
681 uservars with:= v;
682 end if;
683 end if;
684 end if;
685 end forall;
686
687 (forall sc in scopes)
688 (for_sym(v, sc))
689 if v in variables then
690 if sc_type(sc) = sc_proc then
691 localvars{sc} with:= v;
692 else
693 globalvars with:= v;
694 end if;
695 end if;
696
697 $ mark all variables which occur only once in the input
698
699 if #occsof{v} = 1 and v in uservars then
smfc 36 messages{stmtof(instno(occsof(v)))}{'i'} with:=
701 [ '"' + name(v) + '" appears only here.' ];
smfe 17
smfe 18 elseif occsof{v} = {} and v in uservars then
smfe 19 messages{sc_estmt_ct(scope(v))}{'i'} with:=
smfe 20 [ '"' + name(v) + '" is declared but not used.' ];
702 end if;
703 end; $ end for_sym;
704
smfb 38 $ take the opportunity to build cont_scopes which maps each
smfb 39 $ scope to a tuple of scopes which contain it.
706
707 scx := membof(sc) ? sc; $ scx is the first non-procedure scope
708
709 case sc_type(scx) of
710 (sc_sys): cont_scopes(sc) := [ sym_sys ];
711 (sc_lib): cont_scopes(sc) := [ scx, sym_sys ];
712 (sc_dir): cont_scopes(sc) := [ sym_dir, sym_sys ];
713 (sc_prog): cont_scopes(sc) := [ scx, sym_dir, sym_sys ];
714 (sc_mod): cont_scopes(sc) := [ scx, sym_dir, sym_sys ];
715 end case;
716
717 if sc_type(sc) = sc_proc then
718 cont_scopes(sc) := [ sc ] + cont_scopes(sc);
719 end if;
720 end forall;
721$
722$ finally, compute the 'dependon' relation as the transitive closure of
723$ 'expdepend', domain-restricted to 'varofexps'.
724$
725 dependon := transclose(varofexps, expdepend);
726
727 $ delete the static variables global to the module
728 expsym := om; expdepend := om; live_temps := om;
729
730
731 end procedure first_pass;
732
733
734
735
736 procedure shortcut(lab);
737$
738$ this routine returns the label of the first non-empty block that can
739$ be reached from the label lab.
740$
741 repr
742 lab: symbol;
743 seenlabs: sparse set(symbol);
744 i1, i2: elmt insts;
745 end repr;
746
747 seenlabs := {};
748
749 loop
750 doing
751 i1 := first_inst(blockof(value(lab)));
752 i2 := next_inst(i1);
753 $ nb. the first instruction of each basic block is either a
754 $ q1_label or a q1_tag instruction, and the last instruction
755 $ of each basic block is branch instruction. hence a block
756 $ whose second instruction is an unconditional branch
757 $ instruction is a trivial block, and can be deleted. if the
758 $ first instruction is a q1_tag instruction, the corresponding
759 $ case map must be changed. since this case should arise
760 $ rarely, we ignore it, and only short-cut q1_label/q1_goto-
761 $ blocks.
762 while
763 opcode(i1) = q1_label and opcode(i2) = q1_goto
764 do
765 if lab in seenlabs then
766 print(' *** warning: an infinite loop starting at', lab);
767 quit loop;
768 end if;
769
770 seenlabs with:= lab;
771 cut_blocks with:= blockof(i1);
772 lab := arg1(i2);
773 end loop;
774
775 return lab;
776
777
778 end procedure shortcut;
779
780
781
782
783 procedure get_temp(opc, aivs, r, i);
784
785 repr
786 opc: elmt base_opcodes;
787 aivs: tuple(symbol);
788 r: routine;
789 i: elmt insts;
790 tn: tuple(elmt base_opcodes, tuple(symbol));
791 tsym: symbol;
792 scps: sparse set(elmt base_scopes);
793 scr, scexp: elmt base_scopes;
794 aj: symbol;
795 j: integer;
796 end repr;
797
798
799 tn := [ opc, aivs ]; $ expression-identifying pair
800
801 if (tsym := expsym(tn)) = om then
802$ first find scope of tsym, and whether it has to be analysed
803$ locally or globally.
804 scps := { scope(aj) : aj in aivs};
805$$$ ???? note that here we also take into account constant arguments of
806$$$ ???? the expression. thus 'x + 2' where x is local to r will be
807$$$ ???? analyzed globally, as '2' is a global constant. the reason for
808$$$ ???? doing so is that cases like 'x + 375', where 'x' is global but
809$$$ ???? '375' is a constant local to r, will be handled incorrectly if
810$$$ ???? we ignore constant arguments; namely, this expression will be
811$$$ ???? regarded as a global expression. this is o.k. if and only if
812$$$ ???? we move '375' to the symbol table of the global scope of this
813$$$ ???? expression. eventually we will do this, but for the time being
814$$$ ???? we do not exclude constants.
815
816 scexp :=
817 if r in scps then
818 r
819$ allow for the peculiar phenomenon that '_main' belongs
820$ to the system scope rather than to the containing program scope
821 elseif r = sym_main and sym_prog in scps then
822 sym_prog
823 elseif (scr := scope(r)) in scps then
824 scr
825 else
826 arb scps
827 end;
828
829 tsym := add_sym(scexp);
830$
831$ define the relevant symbol table maps
832$
smfc 37 name(tsym) := exp_name(opc, aivs, i);
834 form(tsym) := std_form(f_gen);
835 is_temp(tsym) := 1;
836 is_internal(tsym) := 1;
837 is_read(tsym) := 1;
838 is_write(tsym) := 1;
839 is_store(tsym) := 1;
840
841 if exists aj in aivs | is_stk(aj) = 1 or is_param(aj) = 1 then
842 is_stk(tsym) := 1;
843 end if;
844$
845$ update the relevant epression sets and maps
846$
847 if exists aj in aivs |
848 aj in globalexps or
849 is_const(aj) = om and aj /= sym_om and scope(aj) /= r
850 then
851 globalexps with:= tsym;
852 else
853 localexps{r} with:= tsym;
854 end if;
855
856 (forall aj in aivs | is_const(aj) = om and aj /= sym_om)
857 expdepend{aj} with:= tsym;
858 end forall;
859
860 expsym(tn) := tsym;
861 opcexp(tsym) := opc;
862 argsexp(tsym) := aivs;
863 allexps with:= tsym;
864 live_temps with:= tsym;
865
866 else
867 $ we re-use the same temporary for this expression. this
868 $ implies that we have to change the temporary to an internal
869 $ variable since the storage allocation algorithm assumes that
smfi 22 $ each temporary is used exactly once.
871 is_temp(tsym) := om;
872 end if;
873
874 return tsym;
875
876
877 end procedure get_temp;
878
879
880
881
882 procedure transclose(a, rel);
883
884$ compute the transitive closure of the relation rel, domain-restricted
885$ to the set a.
886
887$ although transclose is a general routine, its sole use in
888$ first_pass justifies the representations below.
889
890 repr
891 a: sparse set(symbol);
892 rel: sparse mmap{symbol}
893 remote set(expression);
894 tcl: sparse mmap{symbol}
895 remote set(expression);
896
897 x: symbol;
898 y: expression;
899 tclx, newx, delta: remote set(expression);
900 end repr;
901
902 tcl := {};
903 (forall x in a)
904 tclx := newx := rel{x};
905 (while newx /= {})
906 y from newx;
907 delta := rel{y} - tclx;
908 newx +:= delta;
909 tclx +:= delta;
910 end while;
911 tcl{x} := tclx;
912 end forall;
913
914 return tcl;
915
916 end procedure transclose;
917
918
919
920
smfc 38 procedure exp_name(opc, aivs, i);
922$
923 repr
smfc 39 opc: elmt base_opcodes;
smfc 40 aivs: tuple(symbol);
924 i: elmt insts;
smfc 41 a: tuple(symbol);
925 end repr;
926
927 if 'c' in dump_string then return 't' + str i; end if;
928
smfc 42 if opc = opcode(i) then
smfc 43 return format_inst(i, aivs);
smfc 44 elseif opc in ops_retrieve and opcode(i) in ops_sin then
smfc 45 a := aivs(2..); a(#aivs+1) := aivs(1);
smfc 46 return format_inst(i, a);
smfc 47 else
smfc 48 return 't' + str i;
smfc 49 end if;
931
932
933 end procedure exp_name;
934
935
1 .=member smem9a
2
3
4 procedure satisfy_members;
5$
6$ this routine satisfies missing members, so that we get the program
7$ into a normal form. this simplifies the optimisation of separately
8$ compiled members considerably, and assures that we will always have a
9$ main program.
10$
11$ a member is a library, a directory, a program, or a module.
12$
13$ the semantic pass can compile program and module members separately,
14$ provided that the program has a directory specifying the rights of the
15$ individual modules w.r.t. read/write access to globals, and what pro-
16$ cedures are imported/exported by which member. libraries are by their
17$ definition independent to separate compilation since we always require
18$ all libraries accessed by any member to be present during the semantic
19$ pass. thus the following are some examples for valid separate compi-
20$ lations:
21$
22$ 1. zero or more libraries
23$ 2. zero or more libraries, plus a directory
24$ 3. a directory, plus a main program
25$ 4. a directory, plus zero or more modules
26$
27$ note that it does not make sense to speak about separate compilation
28$ for a simple setl program, as such a program consists of a program
29$ scope only.
30$
31$ to simplify our algorithms, we normalise the input so that we have:
32$
33$ zero or more libraries,
34$ followed by a directory,
35$ followed by a main program,
36$ followed by zero or more modules.
37$
38$ this means that in case 1, above, we have to generate a new directory
39$ and a new main program, and in cases 2 and 4, a main program.
40$
41 repr
42 j: integer 0..65536;
43 s: symbol;
44 sc: elmt base_scopes;
45 end repr;
46$
47$ if the input supplied a directory, then simply return; otherwise, add
48$ a new scope for a dummy directory, and initialise it.
49$
50 if sym_dir /= om then return; end if;
51
52 sym_dir := s := newat; $ add a new scope for the directory
53
54 $ initialise the relevant scope maps
55 sc_type(sym_dir) := sc_dir;
56 sc_nprocs(sym_dir) := 0;
57 sc_stmt_ct(sym_dir) := 0;
58 sc_estmt_ct(sym_dir) := 0;
59
60 last_sym(sym_dir) := first_sym(sym_dir) := sym_dir;
61
62 $ add the new scope to the tuple of all scopes
smfi 23 if exists sc = scopes(j) |
smfi 24 sc_type(sc) = sc_prog or sc_type(sc) = sc_mod then
64 $ insert the directory before the main program
65 scopes(j..j-1) := [ sym_dir ];
66 else
67 $ input has only libraries
68 $ (if it had main program, we would have found its scope above.)
69 $ (if it had no main program, but zero or more modules, it would
70 $ have a directory.)
71 $ (note that this means that we will build a dummy main program
72 $ as well.)
73 scopes with:= sym_dir;
74 end if;
75
76 $ initialise the symbol table entry just created
77 $ (note that a direcory member has no value due to a current bug in
78 $ grm/prs/sem - implementation restriction...)
79 name(s) := '_directory';
80 scope(s) := sym_dir;
81 form(s) := std_form(f_memb);
82$
83$ if the input supplied a main program, we move it into the directory we
84$ just created, and for simplicity mark the directory as seen, thus
85$ eventually writing it out for the code generator. this is ok since
86$ we look at a simple program, which cannot be part of a separate com-
87$ pilation. if the input did not supply a main program, we create a
88$ dummy main program and have it reference all libraries. note that if
89$ we don't have a directory, we cannot have any modules either. this
90$ is a consequence of the definition of module programs.
91$
92 if sym_prog /= om then $ we have a main program: move it
93
94 last_sym(sym_dir) := next_sym(sym_dir) := sym_prog;
95 first_sym(sym_prog) := next_sym(sym_prog);
96 next_sym(sym_prog) := om;
97 if first_sym(sym_prog) = om then last_sym(sym_prog) := om; end;
98
99 scope(sym_prog) := sym_dir;
100 all_modules with:= sym_prog;
101
102 is_seen(sym_dir) := 1;
103
104 else
105 sym_prog := s := newat; $ add a new program scope
106 last_sym(sym_dir) := next_sym(sym_dir) := sym_prog;
107
108 $ (the relevant scope maps will be initialised in satisfy_procs)
109
110 $ initialise the relevant symbol table maps
111 name(s) := '_program';
112 scope(s) := sym_dir;
113 form(s) := std_form(f_memb);
114 is_const(s) := 1;
115 value(s) := [ { sc in scopes | sc_type(sc) = sc_lib },
116 {}, {}, {}, {} ];
117 end if;
118
119
120 end procedure satisfy_members;
121
122
1 .=member sprc9b
2
3
4 procedure satisfy_procs;
5$
6$ this routine generates dummy routines for all unsatisfied external
7$ procedures.
8$
9$ before we outline our algorithm, let us stress once more that a mem-
10$ ber can always import all routines exported by the libraries it refe-
11$ rences.
12$
13$ we begin by assuming that all the modules are missing, then iterate
14$ over the list of supplied modules, removing them from missing_mods.
15$ this iteration is done by scanning forward through the scopes tuple
16$ which is created by the input interface and contains a list of all the
17$ modules seen in the input.
18$
19$ then we determine the set of all missing procedures, namely the set of
20$ all procedures exported by a missing module. at the same time, we
21$ determine which globals each of these missing procedures could access
22$ and which other procedures they might call. (the latter set is, of
23$ course, the set of all procedures imported by the module).
24$
25$ finally we fill in the dummy bodies of the missing procedures. we
26$ iterate over missing_procs building one dummy body at a time. each
27$ time we process a procedure p we look for all equivalent procedures q
28$ and make them aliases for p.
29$
30 repr
31 l: sparse set(elmt base_scopes);
32 r, w: sparse set(symbol);
33 i, e: sparse set(routine);
34 missing_mods: sparse set(elmt base_scopes);
35 missing_procs: sparse set(routine);
36 lb, m, s: elmt base_scopes;
37 p, q: routine;
38 rds, wrts: sparse mmap{routine}
39 sparse set(symbol);
40 clls: sparse mmap{routine}
41 sparse set(routine);
42 end repr;
43
44
45 $ recall that all_modules is the set of all modules referenced by
46 $ the directory, and is build by get_symtab.
47 $ scopes is a tuple containing all the scopes seen in the input.
48
49 missing_mods := { m in all_modules | m notin scopes };
50
51 if sym_prog notin all_modules then
52 $ the main program was generated by satisfy_members: we have to
53 $ build a body for it.
54 missing_mods with:= sym_prog;
55 end if;
56$
57$ find the libraries used, the variables read and written, and the pro-
58$ cedures imported and exported.
59$
60 missing_procs := {}; rds := {}; wrts := {}; clls := {};
61
62 (forall m in missing_mods)
63
64 $ (the value of a member is a quintuple, giving (in this order)
65 $ the libraries referenced, the globals read, the globals writ-
66 $ ten, the procedures imported, and the procedures exported.)
67 [ l, r, w, i, e ] := value(m);
68
69 $ the missing procedures for this module are the procedures of
70 $ its exports list.
71 missing_procs +:= e;
72
73 $ open the scope for this module and initialise the relevant
74 $ scope maps.
75 if m = sym_prog then
76 sc_type(m) := sc_prog;
77
78 $ we can (conceptually) think that the main program scope
79 $ sym_prog exports the main program procedure sym_main to
80 $ the system scope.
81 e with:= sym_main; missing_procs with:= sym_main;
82
83 else
84 sc_type(m) := sc_mod;
85 end if;
86
87 $ initialise the remaining relevant scope maps
88 sc_nprocs(m) := #e;
89 sc_stmt_ct(m) := 0;
90 sc_estmt_ct(m) := 0;
91 scopes with:= m;
92 all_modules with:= m;
93
94 $ the imports list of the missing procedure is really the union
95 $ of its imports list and of all procedures exported by all the
96 $ libraries referenced.
97 i := i +/[ value(lb)(5) : lb in l ];
98
99 (forall p in e)
100 $ initialise the routine scope
101 sc_type(p) := sc_proc;
102 sc_nprocs(p) := 0;
smfi 25 sc_stmt_ct(p) := 1;
smfi 26 sc_estmt_ct(p) := 1;
105 scopes with:= p;
106 routs with:= p;
107 membof(p) := m;
108
109 $ all procedures exported by this module are assumed to
110 $ read, write and call all the globals read, the globals
111 $ written, and procedures imported by this module.
112 rds{p} := r; wrts{p} := w; clls{p} := i;
113 end forall;
114 end forall;
115$
116$ finally fill in the dummy bodies of the missing procedures.
117$
118 (while missing_procs /= {})
119
120 p from missing_procs;
121
122 bld_body(p, rds{p}, wrts{p}, clls{p});
123
124 if p = sym_main then continue; end if;
125
126 loop while
127 (exists q in missing_procs | q /= sym_main and
128 rvary(p) = rvary(q) and $ varying # of arguments
129 rptyps(p) = rptyps(q) and $ same parameter types
130 scope(p) = scope(q) and $ same scope
131 form(p) = form(q) and $ same form
132 rds{p} = rds{q} and $ same variables read
133 wrts{p} = wrts{q} and $ same variables written
134 clls{p} = clls{q} $ same procedures called
135 )
136 do
137 missing_procs less:= q;
138 alias(q) := p;
139
140 scopes := [ m in scopes | m /= q ];
141 routs less:= q;
142 membof lessf:= q;
143
144 sc_type lessf:= q;
145 sc_nprocs lessf:= q;
146 sc_stmt_ct lessf:= q;
147 sc_estmt_ct lessf:= q;
148 end loop;
149 end while;
150
151
152 end procedure satisfy_procs;
153
154
1 .=member blbd9c
2
3
4 procedure bld_body(p, rds, wrts, clls);
5$
6$ this routine generates a dummy procedure body for the unsatisfied
7$ external procedure p. rds is the set of global variables read, wrts
8$ the set of global variables written, and clls the set of precedures
9$ called by p.
10$
11$ each dummy procedure body looks as follows. we start by adding new
12$ symbol table entries for the formal parameters of p, and then proceed
13$ to generate, after the standard code sequence for a routine prelude,
14$ random uses and definitions of each of the formal parameters, depen-
15$ ding on how they are declared (ie. rd, rw, or wr). next we generate
16$ code to use each variable in rds, followed by code to use and define
17$ each variable in wrts, followed by a call to each procedure called by
18$ p, ie. the procedures mentioned in clls. finally, after we added a
19$ random branch back to start of p, we define p's return value, and end
20$ p with the standard routine postlude. note that we must include a
21$ random jump to the routine's stop block.
22$
23 repr
24 p: routine;
25 rds, wrts: sparse set(symbol);
26 clls: sparse set(routine);
27 l: symbol;
28 fms: tuple(elmt forms);
29 tps: tuple(symbol);
30 j: integer 0..65536;
31 sym: symbol;
smfi 27 q: routine;
32 end repr;
33
34 $ build an entry block for the procedure
35 bld_entry(p);
36
37 $ add 'l:' and save a pointer to l. we will build a conditional
38 $ branch back to l at the end of the routine.
39 l := add_label(p);
40 bld_label(p, l);
41
42 $ generate symbols for the parameters and build dummy uses and defi-
43 $ nitions.
44
45 fms := ft_elmt(form(p)); $ forms of parameters
46 tps := rptyps(p); $ types of parameters
47
48 (forall j in [ 1..#tps ])
49 sym := add_sym(p); $ build symbol table entry
50
51 is_param(sym) := 1;
52 form(sym) := fms(j);
53
54 case name(tps(j)) of
55
56 ('rd'): $ read-only parameter: generate use
57
58 is_read(sym) := 1;
59 bld_use(p, sym);
60
61 ('wr'): $ write-only parameter: generate def
62
63 is_write(sym) := 1;
64 bld_def(p, sym);
65
66 ('rw'): $ read-write parameter
67
68 is_read(sym) := 1;
69 is_write(sym) := 1;
70
71 bld_use(p, sym);
72 bld_def(p, sym);
73
74 end case;
75 end forall;
76
77 $ add uses of reads variables
78 (forall sym in rds) bld_use(p, sym); end forall;
79
80 $ add definitions and uses of writes variables
81 (forall sym in wrts) bld_use(p, sym); bld_def(p, sym); end forall;
82
83 $ add calls to imported procedures
smfi 28 (forall q in clls) bld_call(p, q); end forall;
85
86 $ build a conditional branch to the top of the routine
87 add_inst(last_block(p), q1_ifrand, l);
88
89 $ each procedure p has a global variable associated with it which is
90 $ used to return the value of function calls. the name of this
91 $ is given by rretn(p). build an assignment to it
92 bld_def(p, rretn(p));
93
94 $ build exit and stop blocks
95 bld_exitstop(p);
smfk 32 assert opcode(first_inst(first_block(p))) = q1_entry;
smfk 33 stmtof(first_inst(first_block(p))) := 1; $ for initialised vars
96
97
98 end procedure bld_body;
99
100
1 .=member blde9d
2
3
4 procedure bld_entry(p);
5$
6$ this routine builds the entry block for p.
7$
8 repr
9 p: routine;
10 b: elmt blocks;
11 end repr;
12
13
14 b := add_block(om, p, true);$ add a block to the end of p
15 add_inst(b, q1_entry, p); $ add instruction to the end of b
16 rentry(p) := b; $ record that this is the entry block
17
18
19 end procedure bld_entry;
20
21
22
23
24 procedure bld_label(p, l);
25$
26$ add 'sym:' to the code for procedure p.
27$
28 repr
29 p: routine;
30 l: symbol;
31 b: elmt blocks;
32 i: elmt insts;
33 end repr;
34
35
36 b := last_block(p); $ current end of p
37
38 add_inst(b, q1_goto, l); $ add a branch to l
39
40 $ add a new block to define the label 'l'
41 b := add_block(b, p, true);
42 i := add_inst(b, q1_label, l);
43 value(l) := i;
44
45
46 end procedure bld_label;
47
48
49
50
51 procedure bld_use(p, sym);
52$
53$ this routine adds the code for
54$
55$ if random [ true, false ] then use(sym); end if;
56$
57$ to the end of procedure 'p'. 'use' is a general use of sym.
58$
59 repr
60 p: routine;
61 sym: symbol;
62 b: elmt blocks;
63 i: elmt insts;
64 l: symbol;
65 end repr;
66
67
68 b := last_block(p); $ current end of p
69 l := add_label(p); $ label for end
70
71 add_inst(b, q1_ifrand, l );
72 add_inst(b, q1_use, sym);
73 add_inst(b, q1_goto, l );
74
75 $ add a new block for the end and define l
76 b := add_block(b, p, true);
77 i := add_inst(b, q1_label, l);
78 value(l) := i;
79
80
81 end procedure bld_use;
82
83
84
85
86 procedure bld_def(p, sym);
87$
88$ this routine adds the code for
89$
90$ if random [ true, false ] then def(sym); end if;
91$
92$ to the end of procedure 'p'. 'def' is a general definition of sym.
93$
94 repr
95 p: routine;
96 sym: symbol;
97 b: elmt blocks;
98 i: elmt insts;
99 l: symbol;
100 end repr;
101
102
103 b := last_block(p); $ current end of p
104 l := add_label(p); $ label for end
105
106 add_inst(b, q1_ifrand, l );
107 add_inst(b, q1_def, sym);
108 add_inst(b, q1_goto, l );
109
110 $ add a new block for the end and define l
111 b := add_block(b, p, true);
112 i := add_inst(b, q1_label, l);
113 value(l) := i;
114
115
116 end procedure bld_def;
117
118
119
120
121 procedure bld_call(p, q);
122$
123$ this routine adds the code for
124$
125$ if random [ true, false ] then q(...); end if;
126$
127$ to the end of procedure p.
128$
129 repr
130 p, q: routine;
131 b: elmt blocks;
132 i: elmt insts;
133 l: symbol;
134 a: tuple(symbol);
135 x: symbol;
136 j: integer 0..65536;
137 end repr;
138
139
140 b := last_block(p); $ current end of p
141 l := add_label(p); $ label for end
142
143 add_inst(b, q1_ifrand, l); $ add a random branch to the end block
144
145$ next we must invent arguments for the procedure call. since we have
146$ already emitted uses and definitions for all the relevant global
147$ variables, we can assume that all the arguments are local.
148
149 $ generate new local variables for the arguments and define them
150 a := [ add_var(p) : j in [ 1..rnargs(q) ] ];
151 (forall x in a) bld_def(p, x); end forall;
smfi 29 b := last_block(p); $ current end of p after bld_def call
152
smfi 30 $ emit the argins
154 (forall x = a(j))
155 if name(rptyps(q)(j)) /= 'wr' then
156 add_inst(b, q1_argin, x, q, add_int(p, j));
157 else
158 add_inst(b, q1_argin, sym_om, q, add_int(p, j));
159 end if;
160 end forall;
161
smfi 31 $ emit the call block
smfi 32 bld_label(p, add_label(p)); $ branch to and define the call block
smfi 33 add_inst(last_block(p), q1_call, q, add_int(p, rnargs(q)));
smfi 34 bld_label(p, add_label(p)); $ branch to and define the successor
smfi 35 b := last_block(p); $ current end of p after call block
164
165 $ emit argouts
166 (forall x = a(j))
smfl 2 if name(rptyps(q)(j)) = 'rd' then
168 add_inst(b, q1_free, x, q, add_int(p, j));
169 else
170 add_inst(b, q1_argout, x, q, add_int(p, j));
171 end if;
172 end forall;
173
smfi 36 bld_label(p, l); $ define the end label
180
181
182 end procedure bld_call;
183
184
185
186
187 procedure bld_exitstop(p);
188$
189$ this routine builds the exit and stop blocks for p.
190$
191 repr
192 p: routine;
193 b: elmt blocks;
194 i: elmt insts;
195 l1, l2: symbol;
196 end repr;
197
198
199 b := last_block(p); $ current end of p
200 l1 := add_label(p); $ label for exit block
201 l2 := add_label(p); $ label for stop block
202
203 add_inst(b, q1_ifrand, l2); $ add a random branch to the stop block
204 add_inst(b, q1_goto, l1); $ branch to the exit block
205
206 $ add a new block, the exit block
207 b := add_block(b, p, true);
208 i := add_inst(b, q1_label, l1);
209 value(l1) := i;
210
211 add_inst(b, q1_exit, p);
212 rexit(p) := b;
213
214 $ add a new block, the stop block
215 b := add_block(b, p, true);
216 i := add_inst(b, q1_label, l2);
217 value(l2) := i;
218
219 add_inst(b, q1_stop);
220 rstop(p) := b;
221
222
223 end procedure bld_exitstop;
224
225
226 end module setl_optimizer - optinit;
227
228
1 .=member end17a
2
3
4 module setl_optimizer - optend;
5
6
7 repr
8 clean_up: procedure;
9 end repr;
10
11
12 procedure opt_term;
13$
14 const binary;
15 const tab = ' ';
16 const blank_tab = ' ';
17 const alphameric = 'abcdefghijklmnopqrstuvwxyz'
18 'abcdefghijklmnopqrstuvwxyz'
19 '0123456789'
20 '_';
21 const headers = [ 'input interface: ',
22 'preliminary first pass: ',
23 'call graph & interval analysis:',
24 'initial live variable analysis:',
25 'available expression analysis: ',
26 'bfrom computation: ',
smfb 40 'flow-constant loop detection: ',
27 'type analysis: ',
28 'data structure selection: ',
29 'conversion optimisation: ',
30 'copy optimisation: ',
31 'output interface: ',
32 'total: ' ];
33
34 repr
35 l, s, v: string;
36 sc: elmt base_scopes;
37 todo: remote set(elmt base_scopes);
38 source_map: smap(integer) tuple(string);
39 message: tuple(string);
40 src_line, msg_line: string;
41 i, k: integer 0..65536;
42 j, stmt_lo, stmt_hi: integer;
43 elapsed_time: integer;
44 total_time: integer;
45 dd, hh, mm, ss, tt: string;
46 pp: string;
47 end repr;
48
49
50
smfk 34 title('cims.setl.' + prog_level);
52
53 s := getspp('interface=all/all');
54
55 if #s = 0 then
56 todo := {};
57 elseif s = 'all' then
58$$-- all forms are currently allocated in the system scope, so that
59$$-- all optimiser-introduced bases appear there. hence we must
60$$-- include the system scope here.
61$$-- todo := { sc : sc in scopes | sc_type(sc) /= sc_sys };
62 todo := { sc : sc in scopes };
63 else
64 loop
65 init todo := {};
66 break(s, alphameric);
67 doing v := span(s, alphameric);
68 break(s, alphameric);
69 while v /= om
70 do
71 todo +:= { sc in scopes | name(sc) = v };
72 end loop;
73 end if;
74
75 print_summary(todo);
76
77 open(ssm_file, binary); getb(ssm_file, source_map); close(ssm_file);
78
79 s := getspp('summary=all/all');
80
81 if #s = 0 then
82 todo := {};
83 elseif s = 'all' then
84 todo := { sc : sc in scopes | sc_type(sc) /= sc_sys };
85 else
86 loop
87 init todo := {};
88 break(s, alphameric);
89 doing v := span(s, alphameric);
90 break(s, alphameric);
91 while v /= om
92 do
93 todo +:= { sc in scopes | name(sc) = v };
94 end loop;
95 end if;
96
97 (forall sc = scopes(i) | is_seen(sc) /= om and sc in todo)
98
99 stmt_lo := sc_stmt_ct(sc);
smfi 37 if exists k in [ i+1..#scopes ] |
smfi 38 scopes(k) /= om and is_seen(scopes(k)) /= om then
smfi 39 stmt_hi := sc_stmt_ct(scopes(k)) - 1;
smfi 40 else
smfi 41 stmt_hi := #source_map;
smfi 42 end if;
101
102 $ if this directory was generated by the optimiser, ignore it.
103 if sc_type(sc) = sc_dir and stmt_lo = 0 then continue; end if;
104
105 if at_flag then
106 src_line := '' +/[ source_map(stmt_lo)(j) :
107 j in [ 1..#source_map(stmt_lo) ] ];
108 span(src_line, blank_tab); rspan(src_line, blank_tab);
109 title(src_line);
110 end if;
111
112 (forall j in [ stmt_lo..stmt_hi ])
113 (forall src_line in source_map(j))
114 print(lpad(str (j-stmt_lo+1), 6) + tab + src_line);
115 end forall;
smfd 2 (forall l in 'fewis' | l in getspp('all=fewi/fewis'))
117 (forall message in messages{j}{l})
118 if #message = 0 then continue; end if;
119 print('opt-' + l + '>' + tab + message(1));
120 (forall k in [ 2..#message ])
smfk 35 print(tab + ' ' + message(k));
122 end forall;
123 end forall;
124 end forall;
125 end forall;
126 end forall;
127
128 $ reverse the temporary changes to the q1 code
129 clean_up;
130
131 if 's' in dump_string then dmp(om, 'symtab'); end if;
132 if 'f' in dump_string then dmp(om, 'formtab'); end if;
133 if 'c' in dump_string then dmp(om, 'codetab'); end if;
134
135 $ write the q1 file for the code generator
136 open(q1_file, binary); write_q1; close(q1_file);
137 statistics with:= time;
smfk 36
smfk 37 if not lcs_flag then return; end if;
138
139 title('cims.setl.' + prog_level + ' - execution statistics');
140
141 total_time := statistics(#statistics) - statistics(1);
142
143 (forall i in [ 1..#statistics ])
144
145 if i = #statistics then
146 elapsed_time := total_time;
147 print;
148 else
149 elapsed_time := statistics(i+1) - statistics(i);
150 end if;
151
152 tt := str (elapsed_time mod 1000);
153 ss := str (elapsed_time div 1000 mod 60);
154 mm := str (elapsed_time div 60000 mod 60);
155 hh := str (elapsed_time div 3600000 mod 24);
156 dd := str (elapsed_time div 86400000 );
157 if #tt = 1 then tt := '00' + tt; end if;
158 if #tt = 2 then tt := '0' + tt; end if;
159 if #ss = 1 then ss := '0' + ss; end if;
160 if #mm = 1 then mm := '0' + mm; end if;
161 if #hh = 1 then hh := '0' + hh; end if;
162 if #dd = 1 then dd := ' ' + dd; end if;
163
164 pp := str fix(1000.0*(float elapsed_time/float total_time)+0.5);
165
166 print(
167 headers(i),
168 dd, hh + ':' + mm + ':' + ss + '.' + tt,
169 lpad(str(elapsed_time div 1000), 11) + '.' + tt,
170 lpad(pp(1..#pp-1), 6) + '.' + pp(#pp) + '%'
171 );
172 end forall;
173
174
175 end procedure opt_term;
176
177
178
179
180 procedure clean_up;
181$
182$ this routine scans the q1 code and restores some of the changes that
183$ have been made only for the sake of the optimizer itself and which are
184$ not acceptable by the code generator. specifically, the following is
185$ done in this routine:
186$
187$ 1. change back q1_arbb + q1_lessb to q1_fromb, and similarly for
188$ q1_frome. (q1_from is currently not restored, as it is actually
189$ equivalent to the arb + less sequence.)
190$
191$ 2. eliminate the last argument of sinister assignments, added in the
192$ initialization phase, and which is equal to the first argument.
193$ note that in principle the data type or representation of the last
194$ argument may differ from that of the first (output) argument;
195$ however, the type finder and automatic data-structure selection
196$ choice phases should function in such a manner as to guarantee that
197$ no conversion will be required between these two arguments.
199$
200$ 3. restore the argin and argout instructions. this amounts to
201$ (a) if a system routine has been called, change the temporary
202$ sargin and sargout opcodes back to argin and argout;
203$ (b) otherwise, remove the extra argument added to these
204$ instructions in the initialization phase.
205$
206$ 4. the handling of external procedures in the initialization phase is
207$ ugly enough to merit searching for a better way. for this reason,
208$ this routine assumes that there are no such external procedures in
209$ the code. this should of course be later modified.
211$
212$ 5. temporaries are treated in the code generator in a different way
213$ than in the optimizer: the code generator assumes that a
214$ temporary is dead after its first use, so that its storage and
215$ symbol table entry are freed and can be used by other temporaries.
216$ the optimizer, though, assigns a unique temporary to each
217$ computation, so that any computation occurring more than once in
218$ the code should be assigned to an internal variable (i.e. a symbol
219$ whose is_temp bit is off) rather than to a temporary (is_temp is
220$ set)
221$
222 repr
223 noccs_temp: smap(symbol) integer;
224 r: routine;
225 b: elmt blocks;
226 pi, i, ni: elmt insts;
227 opc: elmt base_opcodes;
228 junk: *;
229 a: symbol;
230 t, t1, t2: symbol;
231 avail_temps: remote mmap{elmt base_scopes}
232 sparse set(symbol);
233 j: integer 0..65536;
234 end repr;
235
236 (forall r in routs)
237
238 avail_temps := {};
239
240 (for_block(b, r))
241 pi := om;
242 (for_inst(i, b))
243 opc := opcode(i);
244 case opc of
245
246 (q1_argin):
247 junk fromb args(i);
248
249 (q1_argout):
250 junk frome args(i);
251
252 (q1_sargin):
253 opcode(i) := q1_argin;
254
255 (q1_sargout):
256 opcode(i) := q1_argout;
257
258 (q1_sof, q1_sofa, q1_ssubst, q1_send):
259 junk frome args(i);
260
261 (q1_next):
262 junk frome args(i);
263
264 (q1_arbb):
265 ni := next_inst(i);
266 $ assert ni /= om;
267 $ assert opcode(ni) = q1_lessb;
268 $ assert arg1(i) = arg3(ni);
269 $ assert arg2(i) = arg1(ni);
270 $ assert arg1(ni) = arg2(ni);
271 opcode(i) := q1_fromb;
272 copy_flag(i) := copy_flag(ni);
273
274 (q1_arbe):
275 ni := next_inst(i);
276 $ assert ni /= om;
277 $ assert opcode(ni) = q1_lesse;
278 $ assert arg1(i) = arg3(ni);
279 $ assert arg2(i) = arg1(ni);
280 $ assert arg1(ni) = arg2(ni);
281 opcode(i) := q1_frome;
282 copy_flag(i) := copy_flag(ni);
283
284 (q1_lessb, q1_lesse, q1_def, q1_noop):
285 del_inst(i, pi, b);
286 continue;
287
288 (q1_push):
289 args(i) with:= arg1(push_former(i));
290
291 end case;
292
293 if opc in ops_ovar and
294 is_temp(t := args(i)(1)) /= om then
295
296 if (t1 := alias(t)) /= om
297 and is_seen(t) = om
298 and is_seen(t1) /= om then
299 alias(t) := alias(t1) ? t1;
300 is_store(t) := om;
301 is_seen(t) := 1;
302
303 elseif is_seen(t) = om then
304 is_seen(t) := 1;
305 if t1 /= om then is_seen(t1) := 1; end if;
306
307 if avail_temps{scope(t)} /= {} then
308 t2 from avail_temps{scope(t)};
309
310 alias(t) := t2;
311 is_store(t) := om;
312
313 if t1 /= om then
314 alias(t1) := t2;
315 is_store(t1) := om;
316 end if;
317 end if;
318 end if;
319 end if;
320
321 (forall j in [ first_ivar(opc)..#args(i) ] |
322 is_temp(t := args(i)(j)) /= om and
323 opc /= q1_push )
324 avail_temps{scope(t)} with:= alias(t) ? t;
325 end forall;
326 pi := i;
327 end;
328 end;
329 end forall;
330
331 end procedure clean_up;
332
333
334 end module setl_optimizer - optend;
335
336
1 .=member inta10
2
3
4 module setl_optimizer - interval_analysis;
5$
6$ this module contains the interval analysis algorithm described in
7$ section 3 of the technical report.
8$
9$ flow graph analysis produces two maps which serve as input to the
10$ interval analysis:
11$
12$ 1. cessor: the successor map for basic blocks
13$
14$ 2. pred: the predecessor map for basic blocks
15$
16$ interval analysis produces five maps:
17$
18$ 1. intof: a map from each node to the interval immediately
19$ containing it.
20$
21$ 2. ints: maps each routine to a tuple of all its intervals in
22$ reverse preorder. note that iterating over ints(rout)
23$ is equivalent to iterating from innermost to outermost
24$ interval.
25$
26$ 3. int_nodes: a map sending each interval into a tuple containing the
27$ nodes of the interval in reverse postorder. iterating
28$ over int_nodes(i) is equivalent to iterating forward
29$ over the nodes in i.
30$
31$ 4. proper_ints: the set of proper (reducible) intervals.
32$
33$ 5. vedges: the set of all virtual edges added to the flow graph
34$ during interval analysis. a virtual edge is an edge
35$ having the form (i, v), where i is an interval and v
36$ is a node outside i which is a successor of some node
37$ in i.
38$
39$ all these variables are assumed to be globally accessible in the
40$ setl optimizer. additional global variables that are accessed in
41$ this module are:
42$
43$ routs: set of all routines in the program being analyzed.
44$
45$ rentry: maps each routine to its entry block.
46$
47$ rexit: maps each routine to its exit (return) block.
48$
49$ rstop: maps each routine to its stop block, if it exists.
50$
51$ routof: maps each basic block to the routine containing it.
52$
53$ the module contains three principal routines:
54$
55$ 1. find_intervals: iterates over 'routs' calling other routines
56$
57$ 2. get_graph: builds a flow graph for a routine.
58$
59$ 3. find_ints: finds the intervals of a flow graph.
60$
61$ the following variables are used globally during interval analysis:
62$
63 var
64 nodeno, $ preorder node numbering
65 postno, $ postorder numbering
66 ndescs, $ number of descendants of each node
67 nodes, $ tuple of nodes in preorder
68 postnodes, $ tuple of nodes in postorder
69 npre, $ current pos in preorder numbering
70 npost, $ current pos in postorder numbering
71 seen, $ nodes already in spanning tree
72 impropers; $ set of 'heads' of multiple entry loops
73
74 init
75 impropers := {};
76
77
78 repr
79 nodeno: smap(elmt blocks) integer;
80 postno: smap(elmt blocks) integer;
81 ndescs: smap(elmt blocks) integer;
82 nodes: tuple(elmt blocks);
83 postnodes: tuple(elmt blocks);
84 npre: integer;
85 npost: integer;
86 seen: sparse set(elmt blocks);
87 impropers: sparse set(elmt blocks);
88
89 .intof_lim: operator(elmt blocks) elmt blocks;
90 find_graph: procedure(routine);
91 find_ints: procedure(routine);
92 update: procedure(
93 elmt blocks,
94 elmt blocks,
95 sparse set(elmt blocks)
96 );
97 dfst: procedure(elmt blocks);
98 get_targ: procedure(elmt blocks) elmt blocks;
99 end repr;
100
101
1 .=member fns10a
2
3
4 procedure find_intervals;
5$
6$ this routine iterates over all the routines in a setl program
7$ finding the interval graph for each routine.
8$
9 repr
10 r: routine;
12 end repr;
13
smfc 51
14 title('cims.setl.' + prog_level + ' - interval analysis');
15 printa(term_file, ' - interval analysis');
16
17
20 (forall r in routs)
21 find_graph(r);
22 find_ints(r);
23 end forall;
24
25
26 $ delete the static variables global to the module
27 nodeno := om; postno := om; ndescs := om;
28 nodes := om; postnodes := om; seen := om;
29 impropers := om;
30
31 cut_blocks := om;
32
33 $ print the interval graph if requested
34 if 'i' in dump_string then
35 (forall r in routs) dmp(r, 'igraph'); end forall;
36 end if;
37
38 statistics with:= time; $ save time for final statistics
43
44
45 end procedure find_intervals;
46
47
48
49
50 procedure find_graph(r);
51$
52$ this routine builds the original control flow graph for a routine r.
53$
54 repr
55 r: routine;
56 work: sparse set(elmt blocks);
57 blks: sparse set(elmt blocks);
58 b: elmt blocks;
59 i: elmt insts;
60 opc: elmt base_opcodes;
61 labels: sparse set(symbol);
62 lab: symbol;
63 new_blks: sparse set(elmt blocks);
64 b1: elmt blocks;
65 bprev: elmt blocks;
66 lprev: symbol;
67 end repr;
68$
69$ we examine blocks starting with the routine's entry block. this way
70$ we find any unreachable blocks.
71$
72 work := { rentry(r) };
73 blks := {};
74
75 (while work /= {})
76 b from work;
77 blks with:= b;
78
79 $ iterate over b, looking for branch instrctions
80 (for_inst(i, b))
81 opc := opcode(i);
82
83 if opc = q1_case then
84 $ arg1 is a map from case values to labels
85 labels := range value(arg1(i));
86 new_blks := { blockof(value(lab)): lab in labels };
87
88 elseif opc in ops_goto then
89 lab := args(i)(# args(i));
90 new_blks := { blockof(value(lab)) };
91
92 else
93 continue;
94 end if;
95
96 (forall b1 in new_blks)
97 cessor{b} with:= b1;
98 pred{b1} with:= b;
99 end forall;
100
101 work +:= (new_blks - blks);
102 end;
103 end while;
104$
105$ now check that all blocks in r are reachable from the entry block.
106$
107 bprev := om;
108 (for_block(b, r))
109 if b notin blks then
110 if b /= rstop(r) and b /= rexit(r) then
111 if b notin cut_blocks then
112 ermsg(str b + ' is unreachable from entry of ' +
113 name(r));
114 end if;
115 del_block(b, bprev, r);
116 b := bprev;
117 end if;
118 end if;
119 bprev := b;
120 end;
121
122 $ delete the labels defining the blocks which were deleted in the
123 $ preceding loop.
124 lprev := om;
125 (for_sym(lab, r))
126 if lab in dead_labs then
127 del_sym(lab, lprev, r);
128 lab := lprev;
129 end if;
130 lprev := lab;
131 end;
132
133
134 end procedure find_graph;
135
136
1 .=member fnt10b
2
3
4 procedure find_ints(r);
5$
6$ this routine calculates the intervals of an intraprocedural flow
7$ graph corresponding to a given routine r.
8$
9$ find_ints is called once to process each procedure 'r'.
10$ it produces five maps:
11$
12$ 1. intof: a map from each node to its interval.
13$
14$ 2. ints: a map sending each routine 'r' into a tuple
15$ containing the intervals of 'r' in reverse preorder.
16$ note that iterating backward (forward) through
17$ ints(r) is equivalent to iterating from outermost
18$ to innermost(innermost to outermost) interval.
19$
20$ the outermost interval is not really an interval
21$ at all. instead it contains all nodes not contained
22$ in other intervals. it is acyclic in the reducible
23$ case.
24$
25$ 3. int_nodes: a map sending each interval into a tuple containing
26$ the nodes of the interval in reverse postorder.
27$ iterating over int_nodes(i) is equivalent to iterating
28$ forward over the nodes in i.
29$
30$ 4. vedges: the set of all edges which are part of some higher
31$ order graph.
32$
33$ 5. proper_ints: a set of all proper (reducible) intervals.
34$
35 repr
36 r: routine;
37 backinv: mmap(elmt blocks) elmt blocks;
38 x, y, z: elmt blocks;
39 root, hd, tbx: elmt blocks;
40 targback: tuple(elmt blocks);
41 reachunder: sparse set(elmt blocks);
42 newreachunder: sparse set(elmt blocks);
43 i: integer;
44 end repr;
45$
46$ step 1: calculate the following objects:
47$
48$ 1. nodeno: maps each node into its preorder index
49$ 2. postno: maps each node into its postorder index
50$ 3. ndescs: maps each node into the number of its descendants
51$ 4. nodes: tuple of nodes in preorder.
52$ 5. postnodes: tuple of nodes in postorder
53$ 6. backinv: the set of all (y, x) such that (x, y) is a back edge
54$ 7. targback: a tuple of targets of back edges in preorder.
55$
56$ (1) - (5) are built by an auxiliary depth-first searching routine
57$ 'dfst'. when we build the node indices we use only even numbers.
58$ this leaves the odd numbers for target blocks (i.e. interval
59$ preheaders). initially only the even elements of nodes and postnodes
60$ are filled in.
61$
62 $ the following macro tests for tree descendancy
63 macro is_desc(x, y);
64 (nodeno(y) <= nodeno(x) and nodeno(x) <= nodeno(y)+ndescs(y))
65 endm;
66
67 $ initialize the globals for the depth-first spanning tree routine
68 nodeno := {}; postno := {}; ndescs := {};
69 nodes := []; postnodes := []; seen := {};
70 npre := 0; npost := 0;
71
72 $ build the depth-first spanning tree rooted at the entry block of r
73 dfst(rentry(r));
74
75 $ construct the set backinv of all reverse back edges
76 backinv := {};
77 (for_block(x, r))(forall y in pred{x} | is_desc(y, x))
78 backinv with:= [ x, y ];
79 end forall; end;
80
81 $ construct the tuple targback of all back edge target nodes,
82 $ arranged in reverse preorder.
83 targback := [ nodes(i) : i in [ #nodes, #nodes-1..1 ] |
84 nodes(i) /= om and nodes(i) in domain backinv ];
85$
86$ step 2
87$
88$ at this point 'targback' contains all potential interval heads in
89$ reverse preorder. we iterate over x in targback doing three things:
90$
91$ 1. build the set 'impropers' of such nodes x which are heads of
92$ multiple-entry loops, and thus are 'sources of irreducibility'.
93$
94$ 2. for each x find the set 'reachunder' of nodes (in the reduced
95$ graph in which each already processed proper or improper
96$ interval has been logically 'squashed', i.e. identified with
97$ a single node - its target block) which reach x along a path
98$ not passing through x whose final edge is a back edge. if any
99$ node which is not a descendant of x belongs to 'reachunder',
100$ then x is a head of a multiple-entry loop, and we add x to
101$ 'impropers'. otherwise x is a head of a single-entry loop,
102$ and thus is an interval head in our sense; if
103$ reachunder * impropers = {}, then that interval is a proper
104$ interval, and we add it to 'proper_ints'; otherwise it is an
105$ improper interval.
106$
107$ 3. if x is an interval head then:
108$
109$ a. create a new target block 'tbx'.
110$ b. add tbx to 'ints(r)' and set int_nodes(tbx) to [].
111$ c. for all y in reachunder, set intof(y) := tbx
112$ d. update the flow graph to show the insertion of tbx.
113$
114 root := rentry(r);
115
116 ints(r) := [];
117
118 (forall x in targback)
119 reachunder := {x};
120 newreachunder := { .intof_lim y : y in backinv{x} } - {x};
121 $ intof .lim y is the largest interval constructed so far
122 $ which contains y (see below for details).
123
124 (while newreachunder /= {})
125 y from newreachunder;
126 reachunder with:= y;
127
128 if not is_desc(y, x) then $ a multiple-entry loop
129 impropers with:= x;
130 quit while;
131 else
132 newreachunder +:=
133 ({ .intof_lim z : z in pred{y} } - reachunder);
134 end if;
135 end while;
136
137 if x in impropers then continue forall; end if;
138$
139$ here x is an interval head.
140$
141 tbx := get_targ(x);
142 int_nodes(tbx) := [];
143
144 ints(r) with:= tbx;
145 $ check if tbx is proper
146 if reachunder * impropers = {} then
147 proper_ints with:= tbx;
148 end if;
149
150 $ map each node in reachunder to its containing interval tbx
151 (forall y in reachunder) intof(y) := tbx; end forall;
152
153 $ update the flow graph to account for the insertion of tbx
154 $ into it. this involves the following actions:
155 $ 1. add an edge [ tbx, x ] to the graph.
156 $ 2. replace all edges entering the interval through 'x' by
157 $ edges entering tbx, and change the corresponding branch
158 $ instructions in the program code.
159 $ 3. for each edge [u, v] leaving the interval whose head
160 $ is x, add a 'virtual' edge [tbx,v] to the graph. this
161 $ edge is added to 'vedges'.
162
163 update(x, tbx, reachunder);
164 end forall;
165$
166$ build the outermost 'interval', identified by the entry node 'root'.
167$
168 ints(r) with:= root;
169 int_nodes(root) := [];
170 proper_ints with:= root; $ root will be removed from this set if
171 $ actually improper
172$
173$ iterate over the nodes in reverse postorder, adding each node to
174$ int_nodes. if a node has its interval head undefined put it in the
175$ outermost interval.
176$
177 (forall i in [ #postnodes, #postnodes-1..1 ])
178 x := postnodes(i);
179 if x = om then continue forall i; end if;
180
181 hd := intof(x);
182 if hd = om then
183 hd := intof(x) := root;
184 if x in impropers then
185 proper_ints less:= root;
186 end if;
187 end if;
188
189 int_nodes(hd) with:= x;
190 end forall;
191
192
193 end procedure find_ints;
194
195
1 .=member upd10c
2
3
4 procedure update(x, tbx, inodes);
5$
6$ this routine updates the flow graph to show the insertion of
7$ the target block 'tbx'. its arguments are:
8$
9$ x: the interval head
10$ tbx: the target block
11$ inodes: the nodes in the interval
12$
13 repr
14 x, tbx: elmt blocks;
15 inodes: sparse set(elmt blocks);
16 i: elmt insts;
17 y: elmt blocks;
18 l1, l2: symbol;
19 opc: elmt base_opcodes;
20 a1: symbol;
21 a, b: symbol;
22 u: elmt blocks;
23 end repr;
24$
25$ we begin by adding a branch from tbx to x, and adding the corres-
26$ ponding edge to the flow graph.
27$
28 i := add_inst(tbx, q1_goto, blk_label(x));
29 stmtof(i) := stmtof(first_inst(x));
30
31 cessor{tbx} with:= x;
32 pred{x} with:= tbx;
33$
34$ next we iterate over all the predecessors of x which are not in
35$ the interval modifying the cessor and pred maps as we go.
36$
37 (forall y in pred{x} | y notin inodes and y /= tbx)
38
39 $ update the branch instructions in y
40 l1 := blk_label(x);
41 l2 := blk_label(tbx);
42
43 (for_inst(i, y))
44 opc := opcode(i);
45
46 if opc in ops_goto then
47 if args(i)(#args(i)) = l1 then
48 args(i)(#args(i)) := l2;
49 end if;
50 if opc = q1_case then
51 a1 := arg1(i);
52
53 (forall [ a, b ] in value(a1) | b = l1)
54 value(a1)(a) := l2;
55 end forall;
56 end if;
57 end if;
58 end;
59
60 $ update the flow graph
61 cessor{y} less:= x;
62 cessor{y} with:= tbx;
63
64 pred{x} less:= y;
65 pred{tbx} with:= y;
66 end forall;
67$
68$ find all edges which leave the interval and add a virtual edge
69$ from tbx for each such edge.
70$
71 (forall u in inodes, y in cessor{u} |
72 y notin inodes and intof(y) /= u)
73 cessor{tbx} with:= y;
74 pred{y} with:= tbx;
75 vedges{tbx} with:= y;
76 end forall;
77
78
79 end procedure update;
80
81
1 .=member dft10d
2
3
4 procedure dfst(x);
5$
6$ this routine builds the depth-first spanning tree rooted at the node x
7$
8 repr
9 x: elmt blocks;
10 y: elmt blocks;
11 end repr;
12
13
14 nodeno(x) := (npre +:= 2); $ note the use of even indices only
15 ndescs(x) := 0;
16
17 nodes(npre) := x;
18 seen with:= x;
19
20 (forall y in cessor{x} | y notin seen)
21 dfst(y);
22 ndescs(x) +:= (ndescs(y) + 2);
23$ each node is counted as two descendants, to match the usage of
24$ only even indices in nodeno and postno.
25 end forall;
26
27 postno(x) := (npost +:= 2);
28 postnodes(npost) := x;
29
30 end procedure dfst;
31
32
33
34
35 operator .intof_lim(x);
36$
37$ this operator is an adaption of the general .lim(f,x) operator
38$ restricted by the assumption that the only left operand it is used
39$ with is intof.
40$
41$ the general operator finds a value 'y' such that y = f(f(f..f(x)..)))
42$ and f(y) = om.
43$
44$ note that unlike tarjan's original approach we omit path
45$ compression, tree balancing, etc. for the sake of simplicity,
46$ though these could easily be added.
47$
48$
49$ the data structure choices used here derive from the use
50$ of .lim in this module. the routine itself, however, is
51$ of a more general nature.
52$
53 repr
54 x: elmt blocks;
55 y: elmt blocks;
56 end repr;
57
58
59 y := x;
60 (while intof(y) /= om) y := intof(y); end while;
61
62 return y;
63
64 end operator .intof_lim;
65
66
67
68
69 procedure get_targ(x);
70$
71$ this routine adds a target block before x. we give the target block
72$ a postno of postno(x) + 1.
73$
74 repr
75 x: elmt blocks;
76 p: routine;
77 targ: elmt blocks;
78 l: symbol;
79 i: elmt insts;
80 end repr;
81
82
83 p := routof(x);
84 targ := add_block(x, p, false);
85 l := add_label(p);
86 i := add_inst(targ, q1_label, l);
87
88 stmtof(i) := stmtof(first_inst(x));
89 value(l) := i; $ the value of a label is its instruction
90
91 nodeno(targ) := nodeno(x) - 1;
92 nodes(nodeno(targ)) := targ;
93
94 postno(targ) := postno(x) + 1;
95 postnodes(postno(targ)) := targ;
96
97 return targ;
98
99
100 end procedure get_targ;
101
102
103 end module setl_optimizer - interval_analysis;
104
105
1 .=member avex11
2
3
4 module setl_optimizer - availexp_analysis;
5$
6$ this module performs the available expressions and code motion
7$ analyses, using the data flow solver package. this can be accom-
8$ plished by performing a single data flow analysis, namely the
9$ available expression analysis in the code motion mode (see module
10$ dataflow_solver for more detail).
11$
12$ in this mode, in addition to the local flow maps of the available
13$ expression analysis, we also have to supply another kind of local
14$ information, which is a map sending each basic block to the set of
15$ all expressions exposed within that block, ie. expressions which are
16$ computed within that block with no prior computation or kill. this
17$ map is denoted as 'exposed', and can be computed in a manner rather
18$ similar to the computation of the local expression availability maps
19$ (see below for more comments on the required initialization phase).
20$
21$ in addition to the availability map, the availability analysis will
22$ also compute a map 'insert', which maps each interval i into the set
23$ of all expressions movable to the target block of i but not redundant
24$ there. the actual insertion of these computations into the end of
25$ the target block of i, as well as the actual elimination of redundant
26$ computations, has to be done in an auxiliary routine called by the
27$ code motion driver routine.
28$
29$ standard available expressions analysis is a 'forward-meet' analysis,
30$ whose semi-lattice l is the power set of (ie. all bit vectors over)
31$ the set of all (relevant) program expressions. in this analysis we
32$ associate with each flow edge (m, n) a data propagation map f(m, n),
33$ so that for each x in l
34$
35$ f(m,n)(x) = x * nokill(m,n) + gen(m,n)
36$
37$ where
38$
39$ nokill(m,n) = set of all expressions t such that any kill of t along
40$ any path through m to n is followed by a recomputation
41$ of t.
42$
43$ gen(m,n) = set of all expressions t such that t is computed with
44$ no subsequent kill along each path through m to n.
45$
46$ we briefly describe the way in which code motion is accomplished by
47$ our algorithm.
48$
49$ suppose that i is an interval such that for each node nd of i we have
50$ already computed the following two objects:
51$
52$ aux_f(nd) = a flow map representing the flow from the entry to the
53$ loop of i, through that loop, to the entry to nd; let
54$ aux_f(nd) be represented by the sets aux_nokill(nd) and
55$ aux_gen(nd), in complete analogy to the representation
56$ of the f maps themselves.
57$
58$ exposed(nd) = set of all expressions t for which there exists a
59$ computation of t in nd which becomes redundant iff t is
60$ available at the entry to nd.
61$
62$ then
63$ (aux_nokill(nd) - aux_gen(nd)) * exposed(nd)
64$
65$ yields precisely those expressions t with the property that nd
66$ contains a computation of t which becomes redundant iff t is
67$ available just before entering the loop of i. hence, the union of
68$ the above sets over all nodes nd in i yields the set of all
69$ expressions movable out of the loop of i, if we use the criterion
70$ that it is profitable to move a computation of an expression t out of
71$ a loop i iff at least one computation of t within i is made redundant
72$ by that motion. note that we do not impose any safety criteria on
73$ code motion, as we assume that code motion will be performed only in
74$ association with the use of a special 'run-time error mode' of the
75$ setl system in which invalid computations do not cause program abort.
76$
77$ the above description gives the general outline of our approach; for
78$ more technical details see the dataflow_solver module.
79$
80$
81$ we assume that the following global objects are available:
82$
83$ globalexps - set of all expressions which depend on at least one
84$ global variable, and so must participate in the inter-
85$ procedural analysis.
86$
87$ localexps - maps each procedure p to the set of all expressions
88$ strictly local to p, ie. depending only on local
89$ variables of p.
90$
91$ dependon - maps each user-defined variable to the set of all
92$ expressions which depend (explicitly or implicitly) on
93$ that variable.
94$
95$ ops_exps - constant set of all opcodes of instructions which
96$ compute expressions with a well defined value and with
97$ no side effects.
98$
99$ ops_modify - constant set of all opcodes of instructions which can
100$ modify a program variables.
101$
102
1 .=member csx11a
2
3 macro df_base; df_base_syms endm;
4 macro .comp; .comp_syms endm;
5 macro interproc_fwd_analysis; interproc_fwd_analysis_syms endm;
6 macro intraproc_fwd_analysis; intraproc_fwd_analysis_syms endm;
7 macro fom; fom_syms endm;
8 macro xom; xom_syms endm;
9
10 var
11 avail, $ maps each block to set of expressions
12 $ available at its entry.
13 insert, $ maps each interval to the set of
14 $ expressions to be inserted at the
15 $ end of its target block.
16 ppi, $ instruction for code motion
17 already_there; $ set of moved expressions
18
19 repr
20 mode df_elmt: df_elmt_syms;
21 mode df_map: df_map_syms;
22
23 avail: sparse smap(elmt blocks)
24 remote set(expression);
25 insert: sparse mmap{elmt blocks}
26 remote set(expression);
27 ppi: elmt insts;
28 already_there: remote set(expression);
29
30 interproc_csx: procedure;
31 intraproc_csx: procedure(routine);
32 move_eliminate: procedure;
33 insert_exp: procedure(expression);
34 csx_blockmaps: procedure(routine, df_elmt)
35 tuple(
36 remote smap(df_edge) df_map,
37 remote mmap{df_node} df_elmt
38 );
39 .meet: operator(df_map, df_map) df_map;
40 end repr;
41
42
43 procedure csx;
44$
45$ this is the master procedure for performing the optimizations
46$ described above. it consists of the following phases:
47$
48$ 1. interprocedural analysis of global variables and expressions.
49$ this phase will move and eliminate expressions involving global
50$ variables and formal parameters of procedures.
51$
52$ 2. intraprocedural analysis of each procedure, in which strictly
53$ local expressions are moved and eliminated.
54$
55 repr
56 p: routine;
57 usym1, usym2: symbol;
59 end repr;
60
61 title('cims.setl.' + prog_level + ' - available expressions');
62 printa(term_file, ' - available expression analysis');
65
66 $ initialize the static variables global to this module
67 avail := {}; insert := {};
68
69 $ define the undefined lattice element and flow map
70 xom := { usym1 := newat };
71 fom := [ { usym1 := newat }, { usym2 := newat } ];
72
73 interproc_csx; $ interprocedural analysis
74
75 (forall p in routs) $ intraprocedural analysis
76 intraproc_csx(p);
77 end forall;
78
79 $ perform actual motion and elimination of expressions
80 move_eliminate;
81
82 $ delete the static variables global to this module
83 avail := om; insert := om;
84 ppi := om; already_there := om;
85
86 $ delete the expression maps which are not needed anymore
87 globalexps := om; localexps := om; allexps := om;
88 opcexp := om; argsexp := om; dependon := om;
89
90 statistics with:= time; $ save time for final statistics
91
98
99 end procedure csx;
100
101
1 .=member erx11b
2
3
4 procedure interproc_csx;
5$
6$ this routine performs the optimizations described above interproce-
7$ durally for expressions involving global variables and formal para-
8$ meters. it uses the relevant routines in the general data flow
9$ solver package. it consists of the following phases:
10$
11$ 1. compute the local maps associated with basic blocks (other than
12$ call blocks) for the available expressions analysis, and also
13$ compute 'exposed' information, using the global objects
14$ 'globalexps' and 'dependon' mentioned above.
15$
16$ it is probably best to define the 'exposed' map in a manner which
17$ puts exposed{c} := {} for each call block c. this will make
18$ code motion strictly intraprocedural, which is probably the right
19$ choice.
20$
21$ 2. perform available expressions analysis in 'code motion mode',
22$ using 'exposed' information also. this analysis returns two
23$ objects: 'avail', mapping each basic block to the set of all
24$ expressions known to be available at its entry, and 'insert',
25$ mapping each interval to the set of all expressions which should
26$ be inserted into the end of its target block. together, these
27$ steps accomplish code motion.
28$
29$ 3. a final pass in which expressions are actually moved and
30$ eliminated. it iterates through each basic block b; if b is not
31$ a target block of an interval, start with the set avail(b) of
32$ expressions found to be available at its start; update this set as
33$ kills and generations within the block are encountered, and use it
34$ to eliminate any computation of an expression which is known to be
35$ available just before this computation. if the basic block is a
36$ target block, we do essentially the same thing, but in addition
37$ insert all expressions belonging to insert{b} at the end of b
38$ (recall that b represents its interval).
39$
40$ we suggest two alternative techniques for accomplishing this
41$ insertion:
42$
43$ (a) first topologically sort the set insert{b} according to the
44$ relative dependency relation between expressions, so that if
45$ an expression t1 depends on another expression t2, then t2
46$ precedes t1 in this order. then for each expression t in this
47$ order, insert the instruction defining t.
48$
49$ (b) proceed in any random order over all the expressions t in
50$ insert{b}. for each such expression t, insert the whole
51$ sequence of instructions needed to compute t from scratch,
52$ and, while doing so, record the availability of subexpressions
53$ of t thus generated. then eliminate computations of available
54$ subexpressions. for example, if both a*b and (a*b)*c are to
55$ be inserted, then if we first insert the whole computation of
56$ (a*b)*c, after which a*b will become available, then its
57$ subsequent insertion can be bypassed.
58$
59$ our current data structures facilitate the first approach, which
60$ is the one that we will implement.
61$
62 repr
63 $ data structures for local variables
64 globexps: df_elmt;
65 id: df_map;
66 zero: df_elmt;
67 f: remote smap(df_edge) df_map;
68 exposed: remote mmap{df_node} df_elmt;
69 end repr;
70
71 if globalexps = {} then return; end if;
72
73 globexps := globalexps; $ assign to split variable
74 zero := {}; $ initial availability information
75 id := [ globexps, zero ]; $ identity map
76$
77$ perform phase 1: computation of local flow maps and exposed
78$ expressions for basic blocks.
79$
80 [ f, exposed ] := csx_blockmaps(om, globexps);
81 $ (om indicates interprocedural analysis)
82$
83$ perform phase 2: availability analysis
84$
85 interproc_fwd_analysis
86 (f, avail, id, zero, true, true, exposed, insert, om);
87 $ meet_flag is true in the 'code motion mode' (the sixth parm
88 $ move_code is true, supplying it with the 'exposed' map and
89 $ obtaining the output 'avail' which maps each block to the set
90 $ of all expressions available at its start; we also compute a
91 $ map 'insert' which sends each target block into the set of
92 $ expressions to be inserted at its end.
93
94
95 end procedure interproc_csx;
96
97
1 .=member arx11c
2
3
4 procedure intraproc_csx(p);
5$
6$ this routine performs the optimizations described above intraproce-
7$ durally for expressions which depend only on local variables of the
8$ procedure p. apart from this difference, it is quite similar to its
9$ interprocedural analog; the same method and phases are used here.
10$
11 repr
12 $ data structure for parameter
13 p: routine;
14
15 $ data structures for local variables
16 procexps: df_elmt;
17 id: df_map;
18 zero: df_elmt;
19 f: remote smap(df_edge) df_map;
20 avalx: remote smap(df_node) df_elmt;
21 exposed: remote mmap{df_node} df_elmt;
22 insrtx: remote mmap{df_node} df_elmt;
23 x: elmt blocks;
24 y: remote set(expression);
25 end repr;
26
27 procexps := localexps{p};
28
29 if procexps = {} then return; end if;
30
31 zero := {}; $ initial information at the entry of p
32 id := [ procexps, zero ]; $ identity map
33
34 $ perform phase 1
35 [ f, exposed ] := csx_blockmaps(p, procexps);
36
37 $ perform phase 2
38 intraproc_fwd_analysis
39 (p, f, avalx, id, zero, true, true, exposed, insrtx, om);
40
41 $ update the avail and insert maps
42 (forall y = avalx(x))
43 if avail(x) = om then
44 avail(x) := y;
45 else
46 avail(x) +:= y;
47 end if;
48 end forall;
49
50 (forall y = insrtx{x})
51 insert{x} +:= y;
52 end forall;
53
54
55 end procedure intraproc_csx;
56
57
1 .=member mel11d
2
3
4 procedure move_eliminate;
5
6
7 init
8 elimexps := {};
9
10 repr
11 r: routine;
12 b: elmt blocks;
13 i, pi: elmt insts;
14 opc: elmt base_opcodes;
15
16 availb: remote set(expression);
17 insexps, elimexps: remote set(expression);
18 temps, killedexps: remote set(expression);
19 oi: occurrence;
20 t: expression;
21 v: symbol;
22 lsin: integer 0..65536;
23
24 x: elmt blocks;
25 y: remote set(expression);
26 z: expression;
27 end repr;
28
29
30 (forall r in routs)
31 (for_block(b, r))
32 availb := avail(b); $ expressions available at entry to b
33 if availb = om then continue; end;
34 pi := om; $ previous instruction (for deletion)
35 (for_inst(i, b))
36 opc := opcode(i);
37
38 if opc in ops_modify then
39 v := arg1(i);
40 killedexps := dependon{v};
41 if opc in ops_iter then
42 killedexps +:= dependon{arg2(i)};
43 end if;
44 availb := availb - killedexps;
45 if opc in ops_sin then
46 lsin := if opc = q1_ssubst then 4 else 3 end;
47 t := args(i)(lsin);
48 if t in availb then $ redundant embedding
49 del_inst(i, pi, b);
50 elimexps with:= t;
smfc 52 messages{stmtof(i)}{'s'} with:=
52 [ 'use available embedding of '
53 '"' + name(t) + '".' ];
54 else
55 availb with:= t;
56 end if;
57 end if;
58
59 elseif opc in ops_exps then
60 t := arg1(i);
61 if t in availb then $ redundant computation
62 del_inst(i, pi, b);
63 elimexps with:= t;
smfc 53 messages{stmtof(i)}{'s'} with:=
65 [ 'use available computation for '
66 '"' + name(t) + '".' ];
67 else
68 availb with:= t;
69 end if;
70
71 elseif opc = q1_entry then $ kill stacked expressions
72 availb := { t in availb | is_stk(t) = om };
73 end if;
74 pi := i;
75 end;
76 if (insexps := insert{b}) /= {} and
77 b /= rentry(r) then
78 $ b is an interval (a target block) out of which we
79 $ move code
80
81 $ find one-before-last instruction in b
82 $ (an ugly procedure)
83 pi := om;
84 (for_inst(i, b))
85 ppi := pi;
86 pi := i;
87 end;
88 already_there := availb;
89 (forall t in insexps)
90 is_temp(t) := om;
91 if t notin already_there then
92 insert_exp(t);
93 end if;
smfc 54 messages{stmtof(ppi)}{'s'} with:=
95 [ 'insert computation of "'+name(t)+'".' ];
96 end forall;
97 end if;
98 end;
99 end forall;
100$
101$ at this point, elimexps contains all common subexpressions and
102$ expresions moved out of loops. to clean up the code, we iterate
103$ again over it and look for pairs of the form
104$
105$ t := exp;
106$ a := t;
107$
108$ where t is not a common subexpression (and hence bound to be dead
109$ after the second instruction), and change it into
110$
111$ a := exp;
112$
113$ this will shorten the code, and facilitate the detection os locally
114$ based sets, etc.
115$
116 (forall r in routs)
117 (for_block(b, r))
118 pi := om; $ preceding instruction
119 (for_inst(i, b))
120 if opcode(i) = q1_asn and pi /= om then
121 if (t := arg2(i)) = arg1(pi) and
122 is_temp(t) = 1 and t notin elimexps then
123 v := arg1(i);
124 del_inst(i, pi, b);
125 arg1(pi) := v;
126 oi := get_oi(pi, 1);
127 occsof{t} less:= oi;
128 occsof{v} with:= oi;
129 end if;
130 end if;
131 pi := i;
132 end; $ end for_inst
133 end; $ end for_block
134 end forall;
135
136 if 'a' notin dump_string then return; end if;
137
138 print;
139 print('common subexpression elimination and code motion maps =');
140 print;
141 prints('avail =',
142 [ [ str x, { '"'+name(z)+'"': z in y } ]: y = avail(x) ] );
143 prints('insert =',
144 [ [ str x, { '"'+name(z)+'"': z in y } ]: y = insert{x} ] );
145
146
147 end procedure move_eliminate;
148
149
150
151
152 procedure insert_exp(t);
153$
154$ this procedure inserts in a recursive manner an expression into a
155$ target block of an interval. it uses two global-within-the-module
156$ objects:
157$
158$ ppi: the instruction after which t should be inserted
159$ already_there: set of expressions already inserted (or already
160$ available at this point).
161$
162$ the insertion is performed in the following recursive manner:
163$ if all arguments of t are either not expressions or else are
164$ expressions in already_there, insert after ppi an instruction
165$ defining t.
166$ otherwise, call insert_exp(t1) for each argument of t not
167$ satisfying the above condition and then insert the computation
168$ of t.
169$
170 repr
171 t: expression;
172 tt: expression;
173 end repr;
174
175
176 (forall tt in argsexp(t) |
177 tt in allexps and tt notin already_there)
178 insert_exp(tt);
179 end forall;
180$
181$ next insert t
182$
183 insert_ins1(ppi, opcexp(t), [ t ] + argsexp(t));
184 already_there with:= t;
185
186 end procedure insert_exp;
187
188
1 .=member bma11e
2
3
4 procedure csx_blockmaps(p, exps);
5$
6$ this routine computes the data-flow block maps and the exposed map
7$ for the available expressions analysis. as always, p = om indicates
8$ the interprocedural case, otherwise p is the routine to be scanned.
9$
10$ note that call blocks will be assigned identity data-flow maps and
11$ null exposed value, which is correct in the intraprocedural case.
12$ in the interprocedural case, the data-flow maps will be reset anyway,
13$ and this choice of the exposed value will cause, as noted above, code
14$ motion to be strictly intraprocedural.
15$
16 repr
17 $ data structures for parameters
18 p: routine;
19 exps: df_elmt;
20
21 $ data structures for returned variables
22 f: remote smap(df_edge) df_map;
23 exposed: remote mmap{df_node} df_elmt;
24
25 $ data structures for local variables
26 todo: sparse set(routine);
27 r: routine;
28 b: df_node;
29 i: elmt insts;
30 opc: elmt base_opcodes;
31
32 a: tuple(symbol);
33 v: symbol;
34 lsin: integer;
35 fblk: df_map;
36 t: elmt df_base;
37 thruexps: df_elmt;
38 temps: df_elmt;
39 sblks: sparse set(elmt blocks);
40 lb: symbol;
41 b1: df_node;
42 end repr;
43
44 if p = om then todo := routs; else todo := { p }; end if;
45
46 f := {}; exposed := {};
47
48 (forall r in todo)
49 (for_block(b, r))
50 fblk := [exps, {}]; $ initialize block map to identity
51 (for_inst(i, b))
52 opc := opcode(i);
53 if opc in ops_modify then
54 v := arg1(i);
55 thruexps := exps - dependon{v};
56 if opc in ops_iter then
57 thruexps -:= dependon{arg2(i)};
58 end if;
59 fblk := [ thruexps, {} ] .comp fblk;
60$ however, if opc is a sinister assignment, then the item to be
61$ assigned will be the temporary representing the inverse operation,
62$ and this instruction makes this temporary available.
63 if opc in ops_sin then
64 lsin :=
65 if opc = q1_ssubst then 4 else 3 end;
66 t := args(i)(lsin); $ get expression
67 if t in exps then
68 fblk :=
69 [ exps, (temps := {t}) ] .comp fblk;
70 end if;
71 end if;
72 elseif opc in ops_exps then
73 t := arg1(i); $ get expression computed
74 if t in exps then
75 if t in fblk(1) - fblk(2) then
76 exposed{b} with:= t;
77 end if;
78 fblk :=
79 [ exps, (temps := {t}) ] .comp fblk;
80 end if;
81 elseif opc in ops_goto then
82 a := args(i);
83 if opc = q1_case then
84 sblks := { blockof(value(lb)) :
85 lb in range value(a(1)) };
86 else
87 sblks := { blockof(value(a(#a))) };
88 end if;
89 (forall b1 in sblks)
90 if b1 = rexit(r) then
91 $ upon return, all stacked expressions of r
92 $ will be killed. we account for this by
93 $ killing these exps along the flow to the
94 $ exit block, and so unify our algoritm.
95 thruexps := { t in exps | is_stk(t) = om };
96 fblk := [ thruexps, {} ] .comp fblk;
97 end if;
98 f([b, b1]) := fblk .meet f([b, b1]);
99 end forall;
100 elseif opc = q1_entry then
101 $ all stacked expressions are killed at this point
102 thruexps := { t in exps | is_stk(t) = om };
103 fblk := [ thruexps, {} ] .comp fblk;
104 end if;
105 end; $ end for_inst
106 end; $ end for_block
107 end forall;
108
109 return [ f, exposed ];
110
111 end procedure csx_blockmaps;
112
113
114
115
116 operator .meet(f, g);
117$
118$ functional meet of f and g, where only g can be undefined (om). for
119$ convenience, we avoid using a similar, though slightly different
120$ operator available in the dataflow_solver module.
121$
122 repr
123 $ data structures for parameters
124 f, g: df_map;
125 end repr;
126
127 if g = om then
128 return f;
129 else
130 return [ f(1) * g(1), f(2) * g(2) ];
131 end if;
132
133 end operator .meet;
134
135
136 drop
137 df_base,
138 .comp,
139 interproc_fwd_analysis,
140 intraproc_fwd_analysis,
141 fom,
142 xom;
143
144
145 end module setl_optimizer - availexp_analysis;
146
147
1 .=member live12
2
3
4 module setl_optimizer - live_analysis;
5$
smfb 41$ live-dead analysis establishes the live/dead status of variables.
smfb 42$ a variable is said to be 'live' at a program point n if there exists a
smfb 43$ path leading from n to some use of v which is free of any other
smfb 44$ occurrence of v (implying that the current value of v may be used
smfb 45$ subsequenlty, and therefore cannot be destroyed or discarded);
smfb 46$ otherwise v is said to be 'dead' at n.
smfb 47$
smfb 48$ standard live variable analysis is a 'backward-join' analysis whose
smfb 49$ semi-lattice l = pow(e) is the power set of (i.e. all bit vectors
smfb 50$ over) the set of all (relevant) program variables, and where lattice
smfb 51$ meet is set-union. in this analysis we associate with each flow edge
smfb 52$ (m, n) a data propagation map f(m, n) so that for each x in l we have
smfb 53$
smfb 54$ f(m, n)(x) = thru(m, n) * x + livein(m, n)
smfb 55$
smfb 56$ where
smfb 57$
smfb 58$ thru(m, n) = the set of all variables v in e for which there exists a
smfb 59$ path through the flow of f which is either free of any
smfb 60$ other occurrence of v or else contains a use of v not
smfb 61$ preceded by any other occurrence of v.
smfb 62$
smfb 63$ livein(m,n) = the set of all variables v in e for which there exists a
smfb 64$ path through the flow of f which contains a use of v not
smfb 65$ preceded by any other occurrence of v.
smfb 66$
smfb 67$ the output of live-dead analysis is a map liveat, mapping each basic
smfb 68$ block n to a set liveat(n) of all variables live at the start of n.
smfb 69$ this set can then be propagated (backward) through basics blocks to
smfb 70$ establish variable liveness at any program point.
smfb 71$
smfb 72$ live variable calculation is performed straightforwardly using our
smfb 73$ general-purpose dataflow solver module. the algorithm used are
smfb 74$ described in more (technical) detail in the dataflow_solver module.
smfb 75$
6 macro df_base; df_base_syms endm;
7 macro .comp; .comp_syms endm;
8 macro interproc_back_analysis; interproc_back_analysis_syms endm;
9 macro intraproc_back_analysis; intraproc_back_analysis_syms endm;
10 macro fom; fom_syms endm;
11 macro xom; xom_syms endm;
12
13
14 repr
15 mode df_elmt: df_elmt_syms;
16 mode df_map: df_map_syms;
17
18 .join: operator(df_map, df_map) df_map;
19 interproc_live: procedure;
20 intraproc_live: procedure(routine);
21 live_blockmaps: procedure(routine, df_elmt)
22 remote smap(df_edge) df_map;
23 end repr;
24
25
1 .=member lva12a
2
3
4 procedure live;
5$
6$ this is the master procedure which drives the live analysis. it
7$ consists of the following phases:
8$
9$ interprocedural analysis for liveness of global variables.
10$
11$ intraprocedural analysis for liveness of local variables within each
12$ routine.
13$
14$ for efficiency, we restrict the elements for our analysis here to the
15$ variables which appear in the user's program, or were directly derived
16$ from program variables. also note that formal parameters need not be
17$ analysed. beyond these modifications, the algorithm which follows is
18$ the standard live variable algorithm. furthermore, the results of
19$ each analysis are used as soon as they become available.
20$
21 repr
22 p: routine;
23 usym1, usym2: symbol;
25 end repr;
26
27
28 title('cims.setl.' + prog_level + ' live analysis');
29 printa(term_file, ' - live analysis');
30
33 $ define the undefined lattice element and flow map
34 xom := { usym1 := newat };
35 fom := [ { usym1 := newat }, { usym2 := newat } ];
36
37 interproc_live; $ interprocedural analysis
38
39 (forall p in routs)
40 intraproc_live(p); $ intraprocedural analysis
41 end forall;
42
43 statistics with:= time; $ save time for final statistics
48
49
50 end procedure live;
51
52
1 .=member ine12b
2
3
4 procedure interproc_live;
5$
6$ this procedure performs interprocedural live analysis for the relevant
7$ global variables.
8$
9 repr
10 pi: elmt insts;
11 v: symbol;
12 globvars: df_elmt;
13 id: df_map;
14 zero: df_elmt;
15 f: remote smap(df_edge) df_map;
16 liveat: remote smap(df_node) df_elmt;
17 end repr;
18
19
20 $ note that we restrict the elements for our analysis here to the
21 $ variables which appear in the user's program, or were directly
22 $ derived from program variables. also note that formal parameters
23 $ need not be analysed. beyond these modifications, the algorithm
24 $ which follows is the standard live variable algorithm.
25
26 globvars := { v in globalvars | is_internal(v) = om };
27
28 if globvars = {} then return; end if;
29
30 zero := {}; $ nothing live at program exit
31 id := [ globvars, zero ]; $ identity map for the analysis
32
33 $ compute the global flow maps
34 f := live_blockmaps(om, globvars);
35 $ (om indicates interprocedural analysis)
36
37 $ perform interprocedural live analysis
38 interproc_back_analysis(f, liveat, id, zero, false);
39 $ meet_flag is false for the join analysis.
40
41 pi := first_inst(rentry(sym_main));
42 (forall v in liveat(rentry(sym_main)))
43 if is_init(v)=1 then
44 insert_ins(pi, q1_asn, v, alias(v));
45 else
46 insert_ins(pi, q1_asn, v, sym_om);
smfk 38 messages{sc_stmt_ct(scope(v))}{'w'} with:=
48 [ 'init ' + name(v) + ' := om;'
smfi 43 ' $ uninitialised variable.' ];
50 end if;
51 end forall;
52
53
54 end procedure interproc_live;
55
56
1 .=member ina12c
2
3
4 procedure intraproc_live(p);
5$
6$ this procedure performs intraprocedural live analysis for the relevant
7$ local variables of the procedure p.
8$
9 repr
10 p: routine;
11 pi: elmt insts;
12 v: symbol;
13 procvars: df_elmt;
14 id: df_map;
15 zero: df_elmt;
16 f: remote smap(df_edge) df_map;
17 liveat: remote smap(df_node) df_elmt;
18 end repr;
19
20
21 $ note that we restrict the elements for our analysis here to the
22 $ variables which appear in the user's program, or were directly
23 $ derived from program variables. also note that formal parameters
24 $ need not be analysed. beyond these modifications, the algorithm
25 $ which follows is the standard live variable algorithm.
26
27 procvars := { v in localvars{p} |
28 is_internal(v) = om and is_param(v) = om };
29
30 if procvars = {} then return; end if;
31
32 zero := {}; $ nothing live at routine exit
33 id := [ procvars, zero ]; $ identity map for the analysis
34
35 $ compute the local flow maps
36 f := live_blockmaps(p, procvars);
37
38 $ perform intraprocedural live analysis
39 intraproc_back_analysis(p, f, liveat, id, zero, false);
40 $ meet_flag is false for the join analysis.
41
42 pi := first_inst(rentry(p));
43 (forall v in liveat(rentry(p)))
44 insert_ins(pi, q1_asn, v, sym_om);
45 messages{sc_estmt_ct(scope(v))}{'w'} with:=
46 [ 'init ' + name(v) + ' := om;'
smfi 44 ' $ uninitialised variable.' ];
48 end forall;
49
50
51 end procedure intraproc_live;
52
53
1 .=member lbk12d
2
3
4 procedure live_blockmaps(p, vars);
5$
6$ this procedure computes the data-flow block maps for live analysis.
7$
8$ as always, p = om indicates the interprocedural case, otherwise p is
9$ the routine to be scanned.
10$
11 repr
12 p: routine;
13 vars: df_elmt;
14
15 todo: sparse set(routine);
16 f: remote smap(df_edge) df_map;
17 r: routine;
18 b: elmt blocks;
19 i: elmt insts;
20 opc: elmt base_opcodes;
21 argsi: tuple(symbol);
22 fblk: df_map;
23 killed, gen: df_elmt;
24 k: integer 0..65536;
25 sblks: sparse set(elmt blocks);
26 lb: symbol;
27 b1: elmt blocks;
28 end repr;
29
30 if p = om then todo := routs; else todo := { p }; end if;
31
32 f := {};
33
34 (forall r in todo)
35 (for_block(b, r))
36 fblk := [ vars, {} ]; $ start with the identity
37
38 (for_inst(i, b))
39 opc := opcode(i);
40 argsi := args(i);
41
42 killed := gen := {};
43
44 (forall k in [ first_ivar(opc)..#argsi ] |
45 argsi(k) in vars)
46 if k = 2 and (opc = q1_set1 or opc = q1_tup1) then
47 continue forall;
48 end if;
49
50 gen with:= argsi(k);
51 end forall;
52
53 if opc in ops_ovar and argsi(1) in vars then
54 killed with:= argsi(1);
55 end if;
56
57 fblk := fblk .comp [ vars - killed + gen, gen ];
58
59 if opc in ops_goto then
60 if opc = q1_case then
61 sblks := { blockof(value(lb)) :
62 lb in range value(argsi(1)) };
63 else
64 sblks := { blockof(value(argsi(#argsi))) };
65 end if;
66
67 (forall b1 in sblks)
68 f([b, b1]) := fblk .join f([b, b1]);
69 end forall;
70 end if;
71 end; $ end for_inst
72 end; $ end for_block
73 end forall;
74
75 return f;
76
77
78 end procedure live_blockmaps;
79
80
81
82
83 operator .join(f, g);
84$
85$ functional join of f and g, where only g can be undefined (om).
86$
87$ for convenience, we avoid using a similar, thought slightly different
88$ operator available in the dataflow_solver module.
89$
90 if g = om then
91 return f;
92 else
93 return [ f(1) + g(1), f(2) + g(2) ];
94 end if;
95
96
97 end operator .join;
98
99
100 drop
101 df_base,
102 .comp,
103 interproc_back_analysis,
104 intraproc_back_analysis,
105 fom,
106 xom;
107
108
109 end module setl_optimizer - live_analysis;
110
111
1 .=member bfd11f
2
3
4 module setl_optimizer - bfrom_analysis;
5$
6$ this module computes the bfrom map and some related maps, using the
7$ general data flow analysis algorithms in the 'dataflow_solver' module.
8$ this version does not employ call strings, and thus may loose a bit of
9$ accuracy, even though the bfrom map for global variables is computed
10$ correctly, using the interprocedural forward algorithm.
11$
12$ as usual, our analysis is partitioned into interprocedural analysis of
13$ global variable occurrences, followed by intraprocedural analysis of
14$ local variable occurrences within each procedure.
15$
16$ the bfrom map is defined on variable uses as follows: let vo be a use
17$ of some variable v; then bfrom is defined to be the set of all
18$ occurrences vo1 of v (definitions or uses) which can reach vo along a
19$ path clear of any other occurrences of v.
20$
21$ we compute the bfrom map rather than the traditional use-definition
22$ map, for the following reasons:
23$
24$ 1. some optimization analyses use 'shadow variables' rather than the
25$ variables themselves. for example, copy optimization applies to the
26$ share bits of variables. definitions and uses of these shadow
27$ variables need not coincide with definitions and uses of the actual
28$ variables. the use of bfrom allows a uniform treatment of all these
29$ optimizations.
30$
31$ 2. we expect that using the bfrom instead of the use-def map will
32$ speed up various iterative algorithms, such as the type finder.
33$
34$ 3. the automatic data structure selection algorithm makes special use
35$ of the bfrom map, and will not function properly if use-def chains are
36$ used instead.
37$
38$ the data-flow analysis used to compute bfrom is a 'reaching occur-
39$ rences' analysis, which is a forward-join analysis, in which, for each
40$ flow graph node n, we wish to compute a set reach(n) of all occur-
41$ rences vo which can reach n along a path which is free of any other
42$ occurrences of the variable of vo. using this map, we can compute the
43$ bfrom map in one additional linear scan of each basic block, as shown
44$ below.
45$
46$ this analysis is obviously of the bitvectoring class. indeed, let
47$ 'vars' denote the set of all variables whose occurrences are to be
48$ analysed (global variables or local variables within some procedure),
49$ and let 'occs' denote the set of all their occurrences. then the
50$ lattice l of our analysis is the power set of occs, and for each
51$ flow-graph edge (m, n) we assign a data-flow map f(m, n), defined as:
52$
53$ f(m, n)(x) = reachthru(m,n) * x + reachfrom(m,n) , x in l
54$
55$ where
56$
57$ reachthru(m,n) = set of all occurrences in occs which reach the start
58$ of n if they reach the start of m. (note that this set also includes
59$ occurrences occurring within m that can reach the start of n.)
60$
61$ reachfrom(m,n) = set of all occurrences in occs occurring within m
62$ which can reach the start of n.
63$
64$ after establishing the block maps we solve the corresponding data-flow
65$ problem using our general package. a final step computes the required
66$ bfrom map, its inverse map ffrom, and an auxiliary set bfrom_dead,
67$ defined as the set of all occurrences which can either reach a program
68$ exit (or a procedure exit for local variable occurrences) or a
69$ redefinition of their variable.
70$
71$ we assume that the following global variables are available.
72$
73$ globalvars: set of all global variables
74$
75$ localvars: maps each routine to the set of its local variables
76$
77$ occsof: maps each variable to the set of its occurrences
78$
1 .=member fbf11g
2
3
4 macro .comp; .comp_ocrs endm;
5 macro interproc_fwd_analysis; interproc_fwd_analysis_ocrs endm;
6 macro intraproc_fwd_analysis; intraproc_fwd_analysis_ocrs endm;
7 macro fom; fom_ocrs endm;
8 macro xom; xom_ocrs endm;
9
10
11 var
12 def_def, $ maps definitions to definitions reached
13 def_exit, $ set of definitions which reach the exit block
14 rem_bfrom_dead; $ split variable to the global bfrom_dead
15
16
17 repr
18 mode df_elmt: df_elmt_ocrs;
19 mode df_map: df_map_ocrs;
20
21 def_def: sparse mmap{occurrence}
22 sparse set(occurrence);
23 def_exit: df_elmt;
24 rem_bfrom_dead: df_elmt;
25
26 .join: operator(df_map, df_map) df_map;
27 global_bfrom: procedure()
28 tuple(
29 remote smap(df_node) df_elmt,
30 df_elmt
31 );
32 local_bfrom: procedure(routine)
33 tuple(
34 remote smap(df_node) df_elmt,
35 df_elmt
36 );
37 comp_bfrom: procedure(
38 routine,
39 df_elmt,
40 remote smap(df_node) df_elmt
41 );
42 bfrom_blockmaps: procedure(routine, df_elmt)
43 remote smap(df_edge) df_map;
44 end repr;
45
46
47 procedure find_bfrom;
48$
49$ this is the master procedure which drives the bfrom computation.
50$ it consists of the following phases:
51$
52$ interprocedural analysis for occurrences of global variables.
53$
54$ intraprocedural analysis for occurrences of local variables within
55$ each routine.
56$
57$ for efficiency, the results of each such analysis are used immediately
58$ to add entries to bfrom and bfrom_dead, and are discarded when
59$ proceeding to the next analysis.
60$
61 repr
62 foccs: df_elmt;
63 freach: remote smap(df_node) df_elmt;
64 r: routine;
65 roccs: sparse set(occurrence);
66 uocrs1, uocrs2: occurrence;
67 vo1, vo2: occurrence;
68 errois: remote set(occurrence);
69 x: occurrence;
71 end repr;
72
73 $ initialize output objects
74 bfrom := {}; ffrom := {}; rem_bfrom_dead := {};
75 def_def := {}; def_exit := {};
76
77 title('cims.setl.' + prog_level + ' - bfrom analysis');
78 printa(term_file, ' - bfrom analysis');
79
82 $ define the undefined lattice element and flow map
83 xom := { uocrs1 := newat };
84 fom := [ { uocrs1 := newat }, { uocrs2 := newat } ];
85
86 $ compute reaching occurrences for global variables
87 [ freach, foccs ] := global_bfrom();
88
89 $ compute corresponding bfrom entries immediately
90 $ (the first parameter = om to indicate the interprocedural case)
91 comp_bfrom(om, foccs, freach);
92
93 (forall r in routs)
94 $ compute reaching occurrences for local variables of r
95 [ freach, foccs ] := local_bfrom(r);
96 $ as before, add corresponding entries to bfrom immediately
97 comp_bfrom(r, foccs, freach);
98 end forall;
99
100 bfrom_dead := rem_bfrom_dead; $ convert between data structures
101
smfi 45 if debug_flag then
smfi 46
102 errois := {};
103 (forall [ vo1, vo2 ] in def_def | oi_sym(vo1) in uservars)
104 if oi_op(vo1) = q1_asn and arg2(instno(vo1)) = sym_om then
105 continue forall;
106 end if;
107 if oi_op(vo2) = q1_asn and arg2(instno(vo2)) = sym_om then
108 continue forall;
109 end if;
110 if ffrom{vo1} = {} then
111 if vo1 in errois then continue; end if;
112 errois with:= vo1;
smfc 55 messages{stmtof(instno(vo1))}{'i'} with:=
smfc 56 [ 'this definition of "' + oi_name(vo1) + '"'
115 ' is not used and thus redundant.' ];
116 elseif getipp('full=0/1') = 1 then
smfc 57 messages{stmtof(instno(vo1))}{'i'} with:=
smfc 58 [ 'this definition of "' + oi_name(vo1) + '"'
119 ' is not used before being redefined at ' +
120 oi_stmt(vo2) + '.' ];
121 end if;
122 end forall;
123
124 (forall vo1 in def_exit | oi_sym(vo1) in uservars)
125 if oi_op(vo1) = q1_asn and arg2(instno(vo1)) = sym_om then
126 continue forall;
127 end if;
128 if #occsof{oi_sym(vo1)} = 1 then continue forall; end if;
129 if ffrom{vo1} = {} then
130 if vo1 in errois then continue; end if;
131 errois with:= vo1;
smfc 59 messages{stmtof(instno(vo1))}{'i'} with:=
smfc 60 [ 'this definition of "' + oi_name(vo1) + '"'
134 ' is not used and is thus redundant.' ];
135 elseif getipp('full=0/1') = 1 then
smfc 61 messages{stmtof(instno(vo1))}{'i'} with:=
smfc 62 [ 'this definition of "' + oi_name(vo1) + '"'
smfc 63 ' is not used before the program exit.' ];
139 end if;
140 end forall;
smfi 47
smfi 48 end if;
141
142 $ delete the static variables global to this module
143 def_def := om; def_exit := om;
144 rem_bfrom_dead := om;
145
146 if 'b' in dump_string then
149 print;
150 print('variable occurrence reaching occurences');
151 print('---------------------------------------------');
152 print;
153 prints('',
154 [ [ rpad(oi_name(vo1), 12) + ' ' +
155 rpad(oi_str(vo1), 12),
156 +/[ rpad(oi_str(vo2), 10) : vo2 in roccs ] ] :
157 roccs = bfrom{vo1}] );
158 print;
159 prints('bfrom_dead =',
160 [ [ rpad(oi_name(vo1), 12), oi_str(vo1) ] :
161 vo1 in bfrom_dead ] );
166 end if;
167
168 statistics with:= time; $ save time for final statistics
176
177
178 end procedure find_bfrom;
179
180
181
182
183 procedure global_bfrom;
184$
185$ this routine computes the 'reaching occurrences' map for occurrences
186$ of global variables, using our general interprocedural data flow
187$ algorithm.
188$
189 repr
190 r: routine;
191 v: symbol;
smfi 49 c: elmt blocks;
192 globaloccs: df_elmt;
193 id: df_map;
194 zero: df_elmt;
195 f: remote smap(df_edge) df_map;
196 reach: remote smap(df_node) df_elmt;
197 dum1, dum2: remote mmap{df_node} df_elmt;
198 end repr;
199$
200$ the following code sequence has been lowered in level to allow for
201$ greater efficiency. the original code has been left as a comment.
202$
203$ globlvrs := globalvars + { pr : r in routs, pr in rparams(r) };
204$
205$ if globlvrs = {} then
206$ print(' no global bfrom entries');
207$ return [];
208$ end if;
209$
210$ globaloccs := +/ [ occsof{v} : v in globlvrs ];
211$
212 globaloccs := {};
213 (forall v in globalvars)
214 globaloccs +:= occsof{v};
215 end forall;
216 (forall r in routs, v in rparams(r))
217 globaloccs +:= occsof{v};
218 end forall;
smfi 50
smfi 51 if globaloccs = {} and not debug_flag then
smfi 52 return [ {}, {} ];
smfi 53 end if;
220
221 id := [ globaloccs, {} ]; $ identity map for analysis
222 zero := {}; $ initial set of reaching occurrences
223
224 $ compute the block data-flow maps. the first parameter is om to
225 $ indicate that all procedures are to be scanned.
226 f := bfrom_blockmaps(om, globaloccs);
227
228 $ perform reaching occurrences analysis.
229 interproc_fwd_analysis
230 (f, reach, id, zero, false, false, dum1, dum2, om);
231 $ here the meet_flag parameter is false (join analysis), the
232 $ move_code parameter is also false (no code motion), and the
233 $ last two parameters (needed only for code motion) are dummies
smfi 54
smfi 55 $ next we test for infinite recursion. this is done by testing the
smfi 56 $ flow maps from each call block to its successor for fom.
smfi 57 if debug_flag then
smfi 58 (forall [ -, c ] in callsin | f([c, cessor(c)]) = fom)
smfi 59 messages{sc_stmt_ct(callproc(c))}{'e'} with:=
smfi 60 [ 'no control path exists to '
smfi 61 'this routine''s exit block.' ];
smfi 62 end forall;
smfi 63 end if;
234
235 return [ reach, globaloccs ];
236
237
238 end procedure global_bfrom;
239
240
241
242
243 procedure local_bfrom(r);
244$
245$ this routine computes the reach map for occurrences of local variables
246$ within the routine r.
247$
248 repr
249 $ data structures for parameters
250 r: routine;
251
252 $ data structures for local variables
253 localsofr: sparse set(symbol);
254 pr: symbol;
255 localoccs: df_elmt;
256 v: symbol;
257 reach: remote smap(df_node) df_elmt;
258 id: df_map;
259 zero: df_elmt;
260 f: remote smap(df_edge) df_map;
261 dum1, dum2: remote mmap{df_node} df_elmt;
262 end repr;
263$
264$ the following code sequence has been lowered in level to allow for
265$ greater efficiency. the original code has been left as a comment.
266$
267$ localsofr := localvars{r} - { pr : pr in rparams(r)};
268$
269$ if localsofr = {} then
270$ print(' no local bfrom entries in routine', name(r));
271$ return [];
272$ end if;
273$
274$ localoccs := +/[occsof{v} : v in localsofr];
275 localoccs := {};
276 (forall v in localvars{r} | v notin rparams(r))
277 localoccs +:= occsof{v};
278 end forall;
279 if localoccs = {} then return [ {}, {} ]; end if;
280
281 reach := {};
282 id := [ localoccs, {} ]; $ identity map for analysis
283 zero := {}; $ initially reaching occurrences
284
285 $ compute data flow maps for basic blocks
286 f := bfrom_blockmaps(r, localoccs);
287
288 $ perform 'reaching occurrences' analysis
289 intraproc_fwd_analysis(r, f, reach, id, zero, false, false,
290 dum1, dum2, om);
291 $ (see comment in global_bfrom for the significance of these
292 $ parameters.)
293
294 return [ reach, localoccs ];
295
296
297 end procedure local_bfrom;
298
299
1 .=member cbf11h
2
3
4 procedure comp_bfrom(p, foccs, freach);
5$
6$ this routine performs a final scan of the code to add entries to the
7$ bfrom map and the bfrom_dead set. this scan will consider all occur-
8$ rences in the set 'occs'. p = om indicates interprocedural analysis,
9$ in which all routines have to be scanned (but only for occurrences of
10$ global variables); otherwise p is the routine to be scanned, and
11$ 'occs' is the set of all occurrences of local variables of p. 'reach'
12$ is the reaching occurrences map, as defined in the introduction to
13$ this module, and as computed by our general data-flow algorithms.
14$
15 repr
16 $ data structures for parameters
17 p: routine;
18 foccs: df_elmt;
19 freach: remote smap(df_node) df_elmt;
20
21 $ data structures for local variables
22 todo: sparse set(routine);
23 r: routine;
24 b: elmt blocks;
25 i: elmt insts;
26 opc: elmt base_opcodes;
27 v: symbol;
28 argsi: tuple(symbol);
29 vo, vo1: occurrence;
30 iva1: integer;
31 k: integer;
32 reachb: df_elmt;
33 reachd: df_elmt;
34 gen, killed: df_elmt;
35 voccs: df_elmt;
36 end repr;
37
38
39 if p = om then todo := routs; else todo := { p }; end if;
40
41 (forall r in todo)
42 (for_block(b, r))
43 reachb := freach(b);
44 if reachb = om then continue; end if;
45 (for_inst(i, b))
46 opc := opcode(i);
47
48 if opc = q1_exit and (r = sym_main or p /= om)
49 or opc = q1_stop then
50$ a program or procedure exit, at which all occurrences in
51$ reachb 'become' dead. add these occurrences to bfrom_dead
52 if debug_flag then
53 def_exit := { vo1 in reachb | is_ovar(vo1) };
54 end if;
55 rem_bfrom_dead +:= reachb;
56 end if;
57
58 argsi := args(i); $ tuple of inst. arguments
59 $ get the index of the first ivariable
60 iva1 := first_ivar(opc);
61
62$ iterate over all arguments of i in reverse order. as we do this, we
63$ update the value of reachb, to account for killing of the reachabi-
64$ lity of all other occurrences of these variables, and generation of
65$ new occurrences within i. also, the bfrom value of each ivariable
66$ (use) is computed.
67$
68$ note that we 'freeze' the value of reachb when scanning the
69$ ivariables of i, and treat the ovariable in a different manner than
70$ the ivariables. to understand this, consider the case where i is
71$ 'v1 := v2 + v3' (where all arguments are occurrences of the same
72$ variable v). here we want both ivariables to be linked to the same
73$ preceding occurrences of v, so that none of them should kill reacha-
74$ bility of these occurrences until all ivariables are processed.
75$ however, when we come to process the ovariable, we will want to
76$ regard the ivariables as killing reachability of all preceding occur-
77$ rences. this will yield, for the above i,
78$ bfrom{v2} = bfrom{v3} = all preceding reaching occurrences of v,
79$ and bfrom{ any succeeding occ. of v } = { v1 }.
80$
81$ note also that if the first argument of i is both an ivariable and an
82$ ovariable, e.g. if i is 'f(x) := f', then an argument quite analogous
83$ to the above one implies that the bfrom value of both these occur-
84$ rences of f is the set of all preceding reaching occurrences of f,
85$ whereas bfrom of a succeeding occurrence of f contains only the
86$ ovariable occurrence in i.
87
88 killed := gen := {};
89
90 (forall k in [ #argsi, #argsi-1..iva1 ])
91 vo := get_oi(i, k); $ get occurrence
92 if vo notin foccs then continue forall; end if;
93 v := argsi(k);
94 voccs := occsof{v};
95 bfrom{vo} := voccs * reachb;
96 if debug_flag then
97 if p = om and v in uservars and
smfk 39 opc /= q1_argout then
102 globals_r{r} with:= v;
smfk 40 if exists vo1 in bfrom{vo} |
smfk 41 oi_rout(vo1) /= r then
smfk 42 globals_e{r} with:= v;
smfk 43 end if;
103 end if;
104 end if;
105 (forall vo1 in bfrom{vo})
106 ffrom{vo1} with:= vo;
107 end forall;
108 gen with:= vo;
109 killed +:= voccs;
110 end forall;
111
112 vo := get_oi(i, 1); $ potential output occurrence
113 if is_ovar(vo) and vo in foccs then
114 v := argsi(1);
115 voccs := occsof{v};
117 reachd := (reachb - killed + gen) * voccs;
120 rem_bfrom_dead +:= reachd;
smfb 78 if debug_flag then
smfb 79 def_def +:=
smfb 80 { [ vo1, vo ] : vo1 in reachd | is_ovar(vo1) };
121 if p = om and v in uservars and
122 opc /= q1_argin then
123 globals_w{r} with:= v;
124 end if;
125 end if;
smfk 44
126$ note that if i is 'v1 := v2 + v3', then the last statement will cause
127$ only v2 and v3 to be added to bfrom_dead, whereas preceding
128$ occurrences of v do not become dead.
129 gen := gen - voccs + {vo};
130$ note that for the above i, the last statement makes only v1 generated
131$ through i, whereas v2 and v3 are killed.
132 killed +:= voccs;
133 end if;
134
135$ finally, update the reachb value
136 reachb := reachb - killed + gen;
137 end; $ end for_inst
138 end; $ end for_block
139 end forall;
140
141 end procedure comp_bfrom;
142
143
1 .=member bma11i
2
3
4 procedure bfrom_blockmaps(p, foccs);
5$
6$ this routine computes the basic block data flow maps for the
7$ occurrences in 'occs'. p = om indicates the interprocedural case
8$ (in which we process all procedures, but only for occurrences of
9$ global variables); otherwise p is the routine to be scanned.
10$
11$ note that the identity map will be associated with call blocks.
12$ this is ok for intraprocedural analysis, and does not matter in
13$ the interprocedural analysis, as these maps are reset then later
14$ anyway.
15$
16 repr
17 $ data structures for parameters
18 p: routine;
19 foccs: df_elmt;
20
21 $ data structures for local variables
22 todo: sparse set(routine);
23 f: remote smap(df_edge) df_map;
24 r: routine;
25 b: elmt blocks;
26 fblk: df_map;
27 i: elmt insts;
28 opc: elmt base_opcodes;
29 argsi: tuple(symbol);
30 iva1: integer;
31 killed: df_elmt;
32 gen: df_elmt;
33 k: integer;
34 vo: occurrence;
35 voccs: df_elmt;
36 sblks: sparse set(elmt blocks);
37 lb: symbol;
38 b1: elmt blocks;
39 end repr;
40
41
42 if p = om then todo := routs; else todo := { p }; end if;
43 f := {}; $ initialize the edge map f
44
45 (forall r in todo)
46 (for_block(b, r))
47 fblk := [ foccs, {} ]; $ start with the identity
48 (for_inst(i, b))
49 opc := opcode(i);
50 argsi := args(i);
51 iva1 := first_ivar(opc);
52
53$ update fblk with the effect of the instruction i.
54$ i is scanned from right to left, and the ovariable occurrence
55$ of i will kill other ivariable occurrences of the same variable.
56$ note that if i is 'v1 := v2 + v3' then only the ovariable v1 is
57$ to be generated in i, and neither v2 nor v3 reach the next
58$ instruction (i.e. both are killed by i). for more details, see
59$ similar comments in the procedure comp_bfrom above.
60
61 killed := gen := {};
62 (forall k in [ #argsi, #argsi-1..iva1 ])
63 vo := get_oi(i, k); $ get occurrence
64 if vo notin foccs then continue forall; end if;
65 gen with:= vo;
66 killed +:= occsof{argsi(k)};
67 end forall;
68
69 vo := get_oi(i, 1); $ potential output occurrence
70 if is_ovar(vo) and vo in foccs then
71 voccs := occsof{argsi(1)};
72 gen := gen - voccs + {vo};
73 killed +:= voccs;
74 end if;
75
76 fblk := [ foccs-killed+gen, gen ] .comp fblk;
77$ (.comp is exported from the dataflow_solver module.)
78
79 if opc in ops_goto then
80$ get successor blocks. the last argument of each branch instruction
smfb 81$ is a target label. for case statements, the last argument is a con-
smfb 82$ stant map from case tag values to their labels.
85
86$ note also that one argument of a case statement (the 'x' in
87$ 'case x of ...' is not a constant, and so may participate in our
88$ analysis. in particular, the effect of this occurrence of x on the
89$ block map has to be analysed before this statement can be treated as
90$ a block exit.
91
92 if opc = q1_case then
93 sblks := { blockof(value(lb)) :
94 lb in range value(argsi(1)) };
95 else
96 sblks := { blockof(value(argsi(#argsi))) };
97 end if;
98
99 (forall b1 in sblks)
100 f([b, b1]) := fblk .join f([b, b1]);
101 end forall;
102 end if;
103 end; $ end for_inst
104 end; $ end for_block
105 end forall;
106
107 return f;
108
109 end procedure bfrom_blockmaps;
110
111
112
113
114 operator .join(f, g);
115$
116$ functional join of f and g, where only g can be undefined (om).
117$ for convenience, we avoid using a similar, though slightly
118$ different operator available in the 'dataflow_solver' module.
119$
120 if g = om then
121 return f;
122 else
123 return [ f(1) + g(1), f(2) + g(2) ];
124 end if;
125
126 end operator .join;
127
128
129 drop
130 .comp,
131 interproc_fwd_analysis,
132 intraproc_fwd_analysis,
133 fom,
134 xom;
135
136
137 end module setl_optimizer - bfrom_analysis;
138
139
smfc 64
smfc 65
smfc 66 module setl_optimizer - region_constants;
smfc 67$
smfc 68$ 1. mark as 'invariant' all statements whose operands are all either
smfc 69$ constant or have their reaching definitions outside the current
smfc 70$ interval.
smfc 71$
smfc 72$ 2. repeat step (3) until at some repetition no new statements are
smfc 73$ marked 'invariant'.
smfc 74$
smfc 75$ 3. mark 'invariant' all those statements not previously so marked
smfc 76$ whose operands all are either constant, have their reaching
smfc 77$ definitions outside the current interval, or have exactly one
smfc 78$ reaching definition, and that definition is an statement in the
smfc 79$ current interval marked invariant.
smfc 80$
smfc 81$ 4. flag all conditional branches which are determined by
smfc 82$ loop-invariant computations. in addition, flag the interval if all
smfc 83$ conditional branches are determined by loop-invariant computations.
smfc 84$
smfc 85 macro ud(oi); (ud_memo(oi) ? ud_rout(oi)) endm;
smfc 86
smfc 87 var
smfc 88 ud_memo; $ use-definition map, computed on demand
smfc 89
smfc 90 repr
smfc 91 ud_memo: smap(occurrence)
smfc 92 sparse set(occurrence);
smfc 93
smfc 94 comp_region_constants: procedure(routine);
smfc 95 ud_rout: procedure(occurrence)
smfc 96 sparse set(occurrence);
smfc 97 end repr;
smfc 98
smfc 99
smfc 100 procedure find_region_constants;
smfc 101$
smfc 102$ this routine is the main driver routine to detect potentially infinite
smfc 103$ loops.
smfc 104$
smfc 105 repr
smfc 106 p: routine;
smfc 107 end repr;
smfc 108
smfc 109
smfc 110 title('cims.setl.' + prog_level + ' - flow-constant loops');
smfc 111 printa(term_file, ' - flow-constant loop analysis');
smfc 112
smfc 113 $ initialise global-to-module objects
smfc 114 ud_memo := {};
smfc 115
smfc 116 (forall p in routs)
smfc 117 comp_region_constants(p);
smfc 118 end forall;
smfc 119
smfc 120 $ delete global-to-module objects
smfc 121 ud_memo := om;
smfc 122
smfc 123 statistics with:= time; $ save time for final statistics
smfc 124
smfc 125
smfc 126 end procedure find_region_constants;
smfc 127
smfc 128
smfc 129
smfc 130
smfc 131 procedure comp_region_constants(p);
smfc 132$
smfc 133$ this routine performs the analysis required to detect region-constant
smfc 134$ branches.
smfc 135$
smfc 136 init
smfc 137 is_called := {}, $ maps each interval to the routines
smfc 138 $ which might be called from within it.
smfc 139 is_desc := {}, $ maps each interval to the intervals it
smfc 140 $ contains.
smfc 141 need_process := {}; $ set of intervals which need to be
smfc 142 $ processed, either because they have
smfc 143 $ more than one successor or because
smfc 144 $ they are potentially loop-invariant.
smfc 145
smfc 146 repr
smfc 147 p, q, r: routine;
smfc 148 is_called: mmap{elmt blocks} set(routine);
smfc 149 is_desc: mmap{elmt blocks} set(elmt blocks);
smfc 150 need_process: set(elmt blocks);
smfc 151 invariants: set(elmt insts);
smfc 152 b, c, i, i1: elmt blocks;
smfc 153 inst: elmt insts;
smfc 154 opc: elmt base_opcodes;
smfc 155 workpile, seen: set(routine);
smfc 156 j, k: integer 0..65536;
smfc 157 vo, vox, voy: occurrence;
smfc 158 convrgd: boolean;
smfc 159 has_const, has_cond: boolean;
smfc 160 inv_count: integer;
smfi 64 l_messages: mmap{integer}
smfi 65 mmap{string}
smfi 66 set(tuple(string));
smfc 161 end repr;
smfc 162
smfc 163
smfc 164 if 'e' in dump_string then $ print heading for statistics
smfc 165 print('interval #desc #called #scans #invar step 4');
smfc 166 print('-----------------------------------------------------');
smfc 167 end if;
smfc 168
smfc 169$ compute is_desc, which maps each interval to the set of all intervals
smfc 170$ which are contained in it. note that since intervals are strictly an
smfc 171$ intraprocedural structure, we only need the is_descendant predicate
smfc 172$ for the intervals of the routine currently being analysed. since
smfc 173$ is_desc is a multi-valued map, this will not cause any problems.
smfc 174
smfc 175 $ iterate over the intervals of p in reverse preorder, i.e. inner-
smfc 176 $ to-outer. note that we do not include the outer-most interval.
smfc 177
smfc 178 (forall j in [ 1..#ints(p)-1 ])
smfc 179 i := ints(p)(j); $ i is the interval header
smfc 180 is_desc{i} := { i } +/[ is_desc{b} : b in int_nodes(i) ];
smfc 181 is_called{i} := {} +/[ is_called{b} : b in int_nodes(i) ];
smfc 182 need_process +:= { b in int_nodes(i) | #vedges{b} > 1 };
smfc 183
smfc 184 $ find all routines which can be invoked from within this
smfc 185 $ interval. when we copmute the transitive closure of the call
smfc 186 $ graph, domain-restricted to the routines called within i, we
smfc 187 $ can use the fact that we have already computed the closure for
smfc 188 $ all routines in called within an interval contained in the
smfc 189 $ current interval, i.
smfc 190
smfc 191 workpile := {}; seen := is_called{i};
smfh 10 (forall c in callsin{p} |
smfh 11 intof(c) = i and callproc(c) notin seen)
smfc 193 workpile with:= callproc(c);
smfh 12 end forall;
smfh 13
smfc 195 (while workpile /= {})
smfc 196 q from workpile; seen with:= q;
smfc 197 is_called{i} with:= q;
smfc 198 (forall r in cgraph{q} | r notin seen)
smfc 199 workpile with:= r;
smfc 200 end forall;
smfc 201 end while;
smfc 202
smfc 203 $ next we determine for each expression whether it is constant
smfc 204 $ within the current interval or not. racall that we do not
smfc 205 $ include the outer-most interval.
smfc 206
smfc 207 $ step 1: mark 'invariant' those instructions whose operands are
smfc 208 $ all either constant or have all their reaching definitions
smfc 209 $ outside the interval i.
smfc 210
smfc 211 $ step 2: repeat step (3) until at some repetition no new
smfc 212 $ instructions are marked 'invariant'.
smfc 213
smfc 214 $ step 3: mark 'invariant' al those instructions not previously
smfc 215 $ so marked whose operands all are either constant, have all
smfc 216 $ their reaching definitions outside i, or have exactly one
smfc 217 $ reaching definition, and that definition is an instruction in
smfc 218 $ i marked invariant.
smfc 219
smfc 220 $ note that we can merge steps (1) and (3) since the high-level
smfc 221 $ implementation of invariants requires no separate pass to
smfc 222 $ initialise the data structure properly.
smfc 223
smfc 224 $ possibly we could speed up this step dramatically if after the
smfc 225 $ first iteration over the code we would use a work pile and du
smfc 226 $ links to only check instructions which might become invariant,
smfc 227 $ rather than scan the entire code over again. however, we must
smfc 228 $ be careful when we use ffrom links to make sure that we propa-
smfc 229 $ gate correctly, or we must compute du and ud links.
smfc 230
smfc 231 loop
smfc 232 init invariants := {}; $ invariant computations in i
smfc 233 inv_count := 0; $ number of code scans
smfc 234 doing convrgd := true; $ flag indicating convergence
smfc 235 inv_count +:= 1;
smfc 236 until convrgd
smfc 237 do
smfc 238 (forall i1 in is_desc{i}, b in int_nodes(i1))
smfc 239 (for_inst(inst, b))
smfc 240 if inst in invariants then continue; end if;
smfc 241 opc := opcode(inst);
smfc 242 if opc notin ops_fold then continue; end if;
smfc 243 if forall k in [ first_ivar(opc)..#args(inst) ] |
smfc 244 is_const(args(inst)(k))=1
smfh 14 or args(inst)(k) = sym_om
smfc 245 or # ud(get_oi(inst, k)) = 1
smfc 246 and instno(arb ud(get_oi(inst, k)))
smfc 247 in invariants
smfc 248$$-- the next sub-test would test that whenever there exists exactly
smfc 249$$-- one preceding definition for a global in a routine within the
smfc 250$$-- current region, then we assume that this definition is invariant.
smfc 251$$-- this represents a save overestimate.
smfc 252$$-- or # ud(get_oi(inst, k)) = 1
smfc 253$$-- and oi_rout(arb ud(get_oi(inst, k)))
smfc 254$$-- /= p
smfc 255$$-- and oi_rout(arb ud(get_oi(inst, k)))
smfc 256$$-- in is_called{i}
smfc 257 or forall vo in ud(get_oi(inst, k)) |
smfc 258 oi_rout(vo) = p
smfc 259 and intof(blockof(instno(vo)))
smfc 260 notin is_desc{i}
smfc 261 or oi_rout(vo) /= p
smfc 262 and oi_rout(vo) notin is_called{i}
smfc 263 then
smfc 264 invariants with:= inst;
smfc 265 convrgd := false;
smfc 266 end if;
smfc 267 end; $ end for_inst;
smfc 268 end forall i1;
smfc 269 end loop;
smfc 270
smfc 271 if 'e' in dump_string then
smfc 272 print(
smfc 273 lpad(str i, 8),
smfc 274 lpad(str(#(is_desc{i})), 8),
smfc 275 lpad(str(#(is_called{i})), 8),
smfc 276 lpad(str inv_count, 8),
smfc 277 lpad(str(#(invariants)), 8),
smfc 278 lpad(str(#(is_desc{i} * need_process with i)), 8)
smfc 279 );
smfc 280 end if;
smfc 281
smfc 282 $ step 4: flag all conditional branches which are determined by
smfc 283 $ loop-invariant computations. in addition, flag the interval
smfc 284 $ if all conditional branches are determined by loop-invariant
smfc 285 $ computations.
smfc 286
smfi 67 has_const := false; has_cond := false; l_messages := {};
smfc 288
smfc 289 $ iterate over the code
smfc 290 (forall i1 in is_desc{i} | i1 = i or i1 in need_process)
smfc 291 (forall b in int_nodes(i1))
smfc 292 (for_inst(inst, b))
smfc 293
smfc 294 $ look for conditional branches
smfc 295 if opcode(inst) notin ops_goto then continue; end if;
smfc 296 if opcode(inst) notin ops_ivar then continue; end if;
smfg 84 if opcode(inst) = q1_bif then continue; end if;
smfg 85 if opcode(inst) = q1_bifnot then continue; end if;
smfc 297
smfc 298 $ this is a conditional branch
smfe 21 if opcode(inst) = q1_case then
smfe 22 vox := get_oi(inst, 2);
smfe 23 else
smfe 24 vox := get_oi(inst, 1);
smfe 25 end if;
smfh 15
smfh 16 if forall voy in ud(vox) | oi_op(voy) = q1_pos then
smfh 17 continue;
smfh 18 end if;
smfh 19
smfe 26 voy := arb ud(vox);
smfh 20 if is_const(oi_sym(vox))=1 or oi_sym(vox) = sym_om
smfc 301 or # ud(vox) = 1 and instno(voy) in invariants
smfc 302$$-- the next sub-test would test that whenever there exists exactly
smfc 303$$-- one preceding definition for a global in a routine within the
smfc 304$$-- current region, then we assume that this definition is invariant.
smfc 305$$-- this represents a save overestimate.
smfc 306$$-- or # ud(vox) = 1
smfc 307$$-- and oi_rout(voy) /= p
smfc 308$$-- and oi_rout(voy) in is_called{i}
smfc 309 or forall voy in ud(vox) |
smfc 310 oi_rout(voy) = p
smfc 311 and intof(blockof(instno(voy)))
smfc 312 notin is_desc{i}
smfc 313 or oi_rout(voy) /= p
smfc 314 and oi_rout(voy)
smfc 315 notin is_called{i}
smfc 316 then
smfi 68 l_messages{stmtof(inst)}{'i'} with:=
smfc 318 [ 'expression controlling conditional branch '
smfc 319 + if is_called{i} = {}
smfc 320 then 'is'
smfc 321 else 'appears to be'
smfc 322 end
smfc 323 + ' loop-invariant'
smfc 324 + if is_called{i} = {}
smfc 325 then ' in the loop'
smfc 326 else ''
smfc 327 end,
smfc 328 if is_called{i} = {}
smfc 329 then ''
smfc 330 else 'in the loop '
smfc 331 end
smfc 332 + 'starting at statement '
smfc 333 + str(stmtof(first_inst(i))-sc_stmt_ct(p)+1)
smfc 334 ];
smfc 335 has_const := true; $ i has constant branch
smfc 336 else
smfc 337 has_cond := true; $ i has conditional branch
smfc 338 end if;
smfc 339 end; $ end for_inst;
smfc 340 end forall;
smfc 341 end forall;
smfc 342
smfc 343 if has_const then
smfc 344 messages{stmtof(first_inst(i))}
smfc 345 {if has_cond then 'i' else 'w' end} with:=
smfc 346 [ 'this loop '
smfc 347 + if not has_cond and is_called{i} = {}
smfc 348 then 'is'
smfc 349 else 'could be'
smfc 350 end
smfc 351 + ' flow-constant: '
smfc 352 + if has_cond then 'some' else 'all' end
smfc 353 + ' conditional branches '
smfc 354 + if is_called{i} = {} then
smfc 355 if has_cond
smfc 356 then 'are'
smfc 357 else 'are controlled by'
smfc 358 end
smfc 359 else
smfc 360 'appear to'
smfc 361 end,
smfc 362 if is_called{i} = {} then
smfc 363 if has_cond then 'controlled by ' else '' end
smfc 364 else
smfc 365 'be controlled by '
smfc 366 end
smfc 367 + 'loop-invariant expressions.' ];
smfi 69
smfi 70 if has_cond then messages +:= l_messages; end if;
smfc 368
smfc 369 $ we might have to scan this interval again
smfc 370 need_process with:= i;
smfc 371 end if;
smfc 372
smfc 373 end forall j;
smfc 374
smfc 375
smfc 376 end procedure comp_region_constants;
smfc 377
smfc 378
smfc 379
smfc 380 procedure ud_rout(oi);
smfc 381$
smfc 382$ this procedure computes the transitive closure of bfrom for the
smfc 383$ occurrence oi.
smfc 384$
smfc 385 repr
smfc 386 oi: occurrence;
smfc 387 workoccs, seenoccs: set(occurrence);
smfc 388 vox, voy: occurrence;
smfc 389 end repr;
smfc 390
smfc 391 workoccs := { oi }; $ workpile of preceding occurrences
smfc 392 seenoccs := {}; $ occurrences already processed
smfc 393
smfc 394 (while workoccs /= {})
smfc 395 vox from workoccs; seenoccs with:= vox;
smfc 396 (forall voy in bfrom{vox})
smfc 397 if is_ovar(voy) or
smfc 398 oi_op(voy) in ops_iter and argno(voy) = 2 then
smfc 399 if ud_memo(oi) = om then
smfc 400 ud_memo(oi) := { voy };
smfc 401 else
smfc 402 ud_memo(oi) with:= voy;
smfc 403 end if;
smfc 404 else
smfc 405 if ud_memo(voy) /= om then
smfc 406 if ud_memo(oi) = om then
smfc 407 ud_memo(oi) := ud_memo(voy);
smfc 408 else
smfc 409 ud_memo(oi) +:= ud_memo(voy);
smfc 410 end if;
smfc 411 elseif voy notin seenoccs then
smfc 412 workoccs with:= voy;
smfc 413 end if;
smfc 414 end if;
smfc 415 end forall;
smfc 416 end while;
smfl 3
smfl 4 if UD_MEMO(OI) = om then UD_MEMO(OI) := {}; end if;
smfc 417
smfc 418 return ud_memo(oi);
smfc 419
smfc 420
smfc 421 end procedure ud_rout;
smfc 422
smfc 423
smfc 424 drop
smfc 425 ud;
smfc 426
smfc 427
smfc 428 end module setl_optimizer - region_constants;
smfc 429
smfc 430
1 .=member dsol13
2
3
4 module setl_optimizer - dataflow_solver_syms;
5$
6$ this module contains a package of general purpose routines to solve
7$ bit vector data flow problems either intraprocedurally or interpro-
8$ cedurally. we can distinguish between four basic types of such
9$ analyses, according to the character of the desired analysis:
10$
11$ forward - data is to be propagated in the direction of the flow,
12$ from procedure entries forward.
13$
14$ backward - data is to be propagated in the reverse direction of the
15$ flow, from exits backward.
16$
17$ meet - whenever two paths converge (for forward analysis) or
18$ diverge (for backward analysis) take the meet (set inter-
19$ section) of data values propagated along these paths.
20$
21$ join - as in meet, except that the join (set union) of the
22$ corresponding data values is to be taken.
23$
24$ typical examples are: expression availability analysis is a
25$ forward - meet analysis, unconditional exposure of wxpressions (also
26$ known as 'very busy' expressions analysis) is a backward - meet ana-
27$ lysis; reaching definitions analysis is a forward - join analysis,
28$ and live variables analysis is a backward - join analysis.
29$
30$ as noted in chapters 5 and 6, forward and backward analyses require
31$ substantially different logic, so that each of them is executed in a
32$ different subpackage; however, the difference between meet and join
33$ problems turns out to be rather minor, so that they both can be
34$ handled by the same (forward or backward) package, using a switch to
35$ indicate whether a particular analysis is of meet or join type.
36$
37$ this module exports the following procedures:
38$
39$ cgraph_analysis - call graph analysis routine, to be called once
40$ before solving any data flow problem interproce-
41$ durally.
42$
43$ interproc_fwd_analysis - call this to solve interprocedural
44$ forward data flow analyses.
45$
46$ intraproc_fwd_analysis - call this to solve intraprocedural
47$ forward data flow analysis for a given
48$ procedure.
49$
50$ interproc_back_analysis - call this to solve interprocedural
51$ backward data flow analysis
52$
53$ intraproc_back_analysis - performs intraprocedural backward
54$ analysis for a given procedure.
55$
56$ this package assumes the following global objects to be
57$ available:
58$
59$ cgraph - the program call graph, represented as a set
60$ of edges; an edge (p,q) is in cgraph iff p is a
61$ procedure which contains a call to the procedure q.
62$
63$ routs - set of all program procedures (i.e. all nodes
64$ of the call graph).
65$
66$ sym_main - main-program identifier (i.e. the entry node of the
67$ call graph).
68$
69$ routof - maps each block to the procedure containing it.
70$
71$ rentry - maps each procedure to its entry block.
72$
73$ rexit - maps each procedure to its exit (return) block.
74$
75$ rstop - maps each procedure to its stop block, if any.
76$
77$ callsin - maps each procedure to the set of all call blocks
78$ in it.
79$
80$ callproc - maps each call block to the procedure it calls.
81$
82$ cessor - the program flow graph, as a union of the flow graphs of
83$ all procedures. an edge (m, n) is in cessor iff either m
84$ contains a branch to n, or else m is a call block and n
85$ is the block immediately following n. the nodes of the
86$ flow graph are either basic blocks or derived intervals
87$ (which are represented by their target blocks), in which
88$ case an edge (int, v) in cessor can indicate the possi-
89$ bility of a transfer of control from the interval int to
90$ a successor v of some node in int. these edges are
91$ called virtual edges (as above; see the interval analysis
92$ package for more details).
93$
94$ pred - the inverse map of cessor.
95$
96$ ints - maps each procedure to the tuple of its intervals
97$ in reverse preorder (relative to a depth first
98$ spanning tree of its flow graph).
99$
100$ int_nodes - maps each interval to the sequence of its nodes
101$ in interval order (i.e., reverse postorder).
102$
103$ proper_ints - the set of all proper intervals (those which do
104$ not contain irreducible nucleii).
105$
106$ intof - maps each flow graph node to the interval containing
107$ it.
108$
109$ vedges - set of all virtual edges (see the description of
110$ cessor above).
111$
112$ in addition this module uses the following global-within-
113$ the-module variables, the first three of which are used
114$ to transmit flags and analysis constants between inner routines,
115$ while the rest are built by a recursive depth-first search
116$ procedure during call-graph analysis, and are used later in that
117$ analysis.
118$
119 macro .comp; .comp_syms endm;
120 macro interproc_fwd_analysis; interproc_fwd_analysis_syms endm;
121 macro intraproc_fwd_analysis; intraproc_fwd_analysis_syms endm;
122 macro interproc_back_analysis; interproc_back_analysis_syms endm;
123 macro intraproc_back_analysis; intraproc_back_analysis_syms endm;
124 macro fom; fom_syms endm;
125 macro xom; xom_syms endm;
126
127 var
128 id, $ identity flow map
129 zero, $ null data state
130 meet_flag, $ true if meet analysis; otherwise false
131 seen, $ procedures already in dfst of cgraph
132 cnpre, $ current preorder index in dfst
133 cnpost, $ current postorder index in dfst
134 nodeno, $ preorder numbering map
135 postno, $ postorder numbering map
136 ndescs; $ no. of descendants map
137
138
139 repr
140 mode df_elmt: df_elmt_syms;
141 mode df_map: df_map_syms;
142
143 .meetjoin: operator(df_map, df_map) df_map;
144 .mjv: operator(df_elmt, df_elmt) df_elmt;
145 .of: operator(df_map, df_elmt) df_elmt;
146
147 cdfst: procedure(routine);
148
149 interproc_fwd_eliminate: procedure(
150 remote smap(df_edge) df_map )
151 remote smap(df_node) df_map;
152 intraproc_fwd_eliminate: procedure(
153 routine,
154 remote smap(df_node) df_map,
155 remote smap(df_edge) df_map,
156 string )
157 boolean;
158 propagate_exposed: procedure(
159 routine,
160 remote smap(df_edge) df_map,
161 remote smap(df_node) df_map,
162 remote mmap{df_node} df_elmt,
163 remote mmap{df_node} df_elmt,
164 remote mmap{df_node} df_elmt
165 );
166 entry_info: procedure(
167 remote smap(df_edge) df_map,
168 remote smap(df_node) df_map,
169 boolean,
170 remote mmap{df_node} df_elmt )
171 remote smap(routine) df_elmt;
172 fwd_propagate_in: procedure(
173 routine,
174 remote smap(df_edge) df_map,
175 remote smap(df_node) df_map,
176 remote smap(df_node) df_elmt,
177 df_elmt,
178 boolean,
179 remote mmap{df_node} df_elmt
180 );
181 interproc_back_eliminate:
182 procedure(remote smap(df_edge) df_map)
183 remote smap(df_edge) df_map;
184 intraproc_back_eliminate:
185 procedure(
186 routine,
187 remote smap(df_edge) df_map,
188 remote smap(df_edge) df_map,
189 remote smap(routine) df_map,
190 * ) $$-- flow_flag
191 boolean;
192 intra_aux_eliminate: procedure(
193 routine,
194 remote smap(df_edge) df_map,
195 remote smap(df_edge) df_map,
196 remote smap(df_node) df_map
197 );
198 exit_info: procedure(
199 remote smap(df_edge) df_map,
200 remote smap(df_edge) df_map,
201 remote smap(df_node) df_map )
202 remote smap(routine) df_elmt;
203 back_propagate_in: procedure(
204 routine,
205 remote smap(df_node) df_map,
206 remote smap(df_node) df_elmt,
207 df_elmt
208 );
209
210 $ data structures for variables global to this module
211 id: df_map;
212 zero: df_elmt;
213 meet_flag: boolean;
214 cnpre: integer;
215 cnpost: integer;
216 nodeno: remote smap(routine) integer;
217 postno: remote smap(routine) integer;
218 ndescs: remote smap(routine) integer;
219 seen: remote set(routine);
220 end repr;
221
222
1 .=member cga13a
2
3 procedure cgraph_analysis;
4$
5$ this procedure performs the call graph analysis needed for
6$ our interprocedural data flow analysis solver. it computes
7$ the following objects:
8$
9$ cg_sccs - a tuple of (roots of the) strongly connected
10$ components of cgraph, arranged in reverse postorder.
11$
12$ scc_nodes - maps each (root of a) strongly connected component
13$ into a tuple containing its nodes in reverse
14$ postorder.
15$
16$ scc_d - maps each (root of a) strongly connected component
17$ s into an estimate of its loop-interconnectedness
18$ parameter d, defined as the maximal number of back
19$ edges along any acyclic path in s (we do not attempt to
20$ obtain that precise value, but rather use a crude
21$ upper bound for it, namely the number of back
22$ edge targets contained in s.)
23$
24 repr
25 inverse: remote mmap{routine}
26 remote set(routine);
27 p, q, r: routine;
28 invpostnodes: smap(integer) routine;
29 n: integer;
30 backinv: remote mmap{routine}
31 remote set(routine);
32 targback: remote set(routine);
33 junk: remote set(routine);
34 sccroot: remote smap(routine) routine;
35 i: integer;
36 newnodes: remote set(routine);
37 tcl: remote mmap{routine}
38 remote set(routine);
39 tcl_p, new_p, delta: remote set(routine);
41 end repr;
42$
43$ begin by calling a standard depth first spanning tree
44$ routine, which will compute the following objects:
45$
46$ nodeno - preorder node numbering map.
47$ postno - postorder node numbering map.
48$ ndescs - number of descendants map.
49$
50
51 title('cims.setl.' + prog_level + ' - call graph analysis');
52 printa(term_file, ' - call graph analysis');
55
56 $ initialize the globals for depth-first spanning tree routine
57 nodeno := {}; postno := {}; ndescs := {};
58 seen := {}; cnpre := 0; cnpost := 0;
59
60 cdfst(sym_main); $ build the call graph for the main program
61
62 if exists p in routs | p notin seen then $ disconnected call graph
63 (forall p in routs | p notin seen)
64 ermsg(name(p)+' cannot be reached from the main program');
65 end forall;
66
67 abort('disconnected call graph');
68 end if;
69
70 $ delete the globals we are done with
71 seen := om; cnpre := om; cnpost := om;
72
73 $ tree-descendancy macro, identical to the one used for interval
74 $ analysis.
75 macro is_desc(p, q); $ test whether p is a descendant of q
76 (nodeno(p) >= nodeno(q) and nodeno(p) <= nodeno(q)+ndescs(q))
77 endm;
78$
79$ next compute some auxiliary objects:
80$
81 inverse := { [ p, q ] : [ q, p ] in cgraph }; $ inverse call graph
82 invpostnodes := { [ #routs+1-n, p ] : n = postno(p) };
83 $ procedures in their reverse postorder
84 backinv := { [ p, q ] in inverse | is_desc(q, p) };
85 $ set of all inverse back edges
86 targback := domain backinv; $ back edge targets
87
88 $ initialize globals (rf. above)
89 cg_sccs := []; scc_nodes := {}; scc_d := {};
90
91 sccroot := {}; $ strongly connected component root map
92$
93$ iterate through the procedures, looking for strongly
94$ connected components.
95$
96 (forall i in [ 1..#invpostnodes ])
97 p := invpostnodes(i);
98 if sccroot(p) = om then $ a new root of a s.c.c.
99 sccroot(p) := p;
100 cg_sccs with:= p; $ p corresponds to a new component
101 scc_nodes(p) := [ p ];
102 if p in targback then $ a non-trivial s.c.c.
103 newnodes := backinv{p} less p; $ new nodes in s.c.c.
104 scc_d(p) := 1; $ no. of backedge targets in s.c.c.
105 (while newnodes /= {})
106 q from newnodes;
107 sccroot(q) := p; $ mark q belongs to s.c.c.
108 if q in targback then scc_d(p) +:= 1; end if;
109 newnodes +:=
110 { r in inverse{q} |
111 is_desc(r, p) and sccroot(r) = om };
112 end while;
113
114 else $ a trivial s.c.c.
115 scc_d(p) := 0;
116 end if;
117
118 else $ p belongs to a scc already scanned
119 scc_nodes(sccroot(p)) with:= p;
120 end if;
121 end forall;
122$
123$ determine which routines are recursive: this is done by computing the
124$ transitive closure of the call cgraph.
125$
126 tcl := {};
127 (forall p in routs)
128 tcl_p := new_p := cgraph{p};
129 (while new_p /= {})
130 q from new_p;
131 delta := cgraph{q} - tcl_p;
132 new_p +:= delta;
133 tcl_p +:= delta;
134 end while;
135 tcl{p} := tcl_p;
136 end forall;
137
138 (forall p in routs)
139 if p in tcl{p} then is_rec(p) := 1; else is_rec(p) := om; end;
140 end forall;
141
142 $ delete the static variables global to the module
143 nodeno := om; postno := om; ndescs := om;
148
149
150 end procedure cgraph_analysis;
151
152
153
154
155 procedure cdfst(p);
156$
157$ this routine builds the depth first spanning tree starting with
158$ node 'p'. this routine differs in various details from the depth
159$ first spanning routine used for interval analysis.
160$
161 repr
162 q: routine;
163 end repr;
164
165 nodeno(p) := (cnpre +:= 1);
166 ndescs(p) := 0;
167
168 seen with:= p;
169
170 (forall q in cgraph{p} | q notin seen)
171 cdfst(q);
172 ndescs(p) +:= (ndescs(q) + 1);
173 end forall;
174
175 postno(p) := (cnpost +:= 1);
176
177 end procedure cdfst;
178
179
1 .=member efa13b
2
3
4 procedure interproc_fwd_analysis(rw f, wr soln, id_prm, zero_prm,
5 meet_flag_prm, move_code,
6 rw exposed, wr insert, safe);
7$
8$ note declarations of 'read-write' parameters ('rw') and 'write-only'
9$ parameters ('wr').
10$
11$ this is the master routine to perform a specific data flow
12$ analysis interprocedurally. its parameters are:
13$
14$ f - maps each edge (m, n) in the flow graph to a compact
15$ representation of its data-propagation map f(m,n).
16$ initially this information has to be provided only for
17$ basic blocks (but not for call blocks); the first phase
18$ of the analysis will fill in the additional entries.
19$ each f(m,n) is represented as a pair [a, b] in l x l,
20$ such that for each x in l, f(m,n)(x) = x*a + b, and
21$ a contains b (this latter condition ensures that the
22$ representation is unique, and also simplifies some
23$ functional manipulations).
24$
25$ soln- the solution vector for the analysis. soln maps each
26$ flow graph node to the data found to be known at its
27$ entry.
28$
29$ the next three parameters are transmitted internally between
30$ subprocedures by assigning them to global variables, as they
31$ are constant per analysis. the corresponding globals are:
32$
33$ id - the identity map representation. id = [u, {}], where
34$ u is the universal set over which bitvectors are taken
35$ in this analysis (e.g. set of all program expressions,
36$ set of all variables etc.)
37$
38$ zero - the initial data value, i.e. flow data assumed at the main
39$ program entry.
40$
41$ meet_flag - a flag indicating whether the analysis is a meet
42$ analysis or a join analysis.
43$
44$ aux_f - these are auxiliary propagation maps. for each flow
45$ graph node u, aux_f(u) denotes the effect of propagation
46$ from the entry to i, the interval containing u, through
47$ i, to the entry of u.
48$
49$ move_code - a flag indicating that code motion is required.
50$
51$ exposed - this is initially the set of computations (corresponding
52$ to analysis elements (bits)) exposed at the start of each
53$ basic block n (i.e. computed with no prior kill in n). the
54$ inner-to-outer phase of our analysis attaches an 'exposed'
55$ value to each interval processed. exposed{i} is the set of all
56$ expressions t for which there exists a computation of t
57$ within the interval i which would become redundant if and
58$ only if t became available at the entry to (the target block
59$ of) i. note, however, that the logical place at which
60$ computations movable out of an interval i should be inserted
61$ is the end of the target block of i, rather than its start.
62$ thus if that target block is nonempty then exposed{i}
63$ need not represent those movable computations. for this
64$ reason we provide the parameter 'insert' which gives the
65$ desired set of movable code.
66$
67$ insert - this output parameter will map each interval into
68$ the set of all computations movable out of its loop,
69$ which are to be inserted at the end of the target
70$ block of the interval. the actual insertion should be
71$ performed by the calling procedure.
72$
73$ our analysis procedures makes frequent use of the following
74$ operators (which could be also written as macros, if it were
75$ not for the convenience of the infix notation that we prefer
76$ to use):
77$
78$ .comp - functional composition
79$ .meetjoin - functional meet or join, depending on meet_flag
80$ .mjv - meet or join of lattice values
81$ .of - functional application
82$
83$ all these operators have elementary set expressions; see below
84$ for details.
85$
86$ note also that these operators must be prepared to handle
87$ undefined flow values, which will be represented
88$ by a special constant 'fom'; for example,
89$ g .comp fom = fom .comp g = fom;
90$ (concatenation of an undefined flow with a defined
91$ one is still undefined)
92$ g .meetjoin fom = fom .meetjoin g = g.
93$ (a join or a meet of an undefined flow with a defined
94$ flow yields the defined flow.)
95$
96$ another special constant 'xom' is used to denote the undefined data
97$ state in l.
98$
99 repr
100 $ data structures for parameters
101 f: remote smap(df_edge) df_map;
102 soln: remote smap(df_node) df_elmt;
103 id_prm: df_map;
104 zero_prm: df_elmt;
105 meet_flag_prm: boolean;
106 move_code: boolean;
107 exposed: remote mmap{df_node} df_elmt;
108 insert: remote mmap{df_node} df_elmt;
109 safe: remote mmap{df_node} df_elmt;
110
111 $ data structures for local variables
112 aux_f: remote smap(df_node) df_map;
113 ent_inf: remote smap(routine) df_elmt;
114 p: routine;
115 end repr;
116$
117$ transfer constant parameters to globals
118$
119 id := id_prm;
120 zero := zero_prm;
121 meet_flag := meet_flag_prm;
122$
123$ the master procedure consists of the following three phases:
124$
125$ 1. interprocedural elimination phase
126$
127 aux_f := interproc_fwd_eliminate(f);
128$
129$ if code motion is required then perform an additional
130$ phase, computing the sets of movable code.
131$
132 if move_code then
133 insert := {};
134 (forall p in routs)
135 propagate_exposed(p, f, aux_f, exposed, insert, safe);
136 end forall;
137 end if;
138$
139$ 2. find data at procedure entries
140$
141 ent_inf := entry_info(f, aux_f, move_code, insert);
142$
143$ 3. final propagation phase
144$
145 soln := {}; $ initialize the solution
146 (forall p in routs)
147 fwd_propagate_in(p, f, aux_f, soln, ent_inf(p),
148 move_code, insert);
149 end forall;
150
151 end procedure interproc_fwd_analysis;
152
153
1 .=member efe13c
2
3
4 procedure interproc_fwd_eliminate(rw f);
5$
6$ this is the driver routine for the first interprocedural
7$ inner-to-outer interval pass. procedures are analyzed in
8$ the following order: we process the strongly connected
9$ components of the call graph in their postorder; for each
10$ such component, we iterate through its procedures in their
11$ postorder, no more than 2*d+1 times, where d is the loop-
12$ interconnectedness parameter of the component.
13$
14 repr
15 $ data structures for parameters
16 f: remote smap(df_edge) df_map;
17
18 $ data structures for local variables
19 aux_f: remote smap(df_node) df_map;
20 i: integer;
21 scc: routine;
22 scc_procs: tuple(routine);
23 flow_flag: string;
24 j: integer;
25 proc_converge: boolean;
26 k: integer;
27 p: routine;
28 end repr;
29
30
31 aux_f := {}; $ initialize auxiliary maps
32
33 $ iterate through the s.c.c.'s of cgraph
34 (forall i in [ #cg_sccs, #cg_sccs-1..1 ])
35
36 scc := cg_sccs(i); $ get a s.c.c.
37 scc_procs := scc_nodes(scc); $ procedures in that s.c.c.
38 flow_flag := 'first_inter'; $ first processing of the s.c.c.
39
40 (forall j in [ 1..2*scc_d(scc)+1 ])
41 proc_converge := true;
42
43 (forall k in [ #scc_procs, #scc_procs-1..1 ])
44 p := scc_procs(k);
45 proc_converge :=
46 intraproc_fwd_eliminate(p, aux_f, f, flow_flag)
47 and proc_converge;
48$ the intraproc_fwd_eliminate routine analyzes p; its fourth parameter
49$ indicates whether the analysis is first-time interprocedural, second
50$ -time interprocedural or intraprocedural; it returns a flag to
51$ indicate whether information in p has stabilized.
52 end forall k;
53
54 flow_flag := 'second_inter'; $ additional passes thru scc
55
56 if proc_converge then quit forall j; end;
57 end forall j;
58 end forall i;
59
60 return aux_f;
61
62 end procedure interproc_fwd_eliminate;
63
64
1 .=member afe13d
2
3
4 procedure intraproc_fwd_eliminate(p, rw aux_f, rw f, flow_flag);
5$
6$ this routine performs an intraprocedural elimination phase
7$ for the procedure p, using interval analysis. the fourth parameter
8$ indicates whether this routine has been invoked by the
9$ intraprocedural solver or by the interprocedural solver, and
10$ in the second case, whether this is the first time p is
11$ being processed or not.
12$
13$ in this pass we iterate through the procedure's intervals
14$ in an inner-to -outer order (i.e. in reverse preorder of their
15$ heads in a dfst of the flow graph of p). for each interval
16$ i processed in this manner we compute a set of data-propagation
17$ maps of the form f(i, u), where
18$
19$ (1) if u is in i, then this map is an auxiliary map (which will
20$ be denoted as aux_f(u), i being implicit in this case) which
21$ represents the propagation effect as control advances from
22$ the start of i, thru i, to the start of u;
23$
24$ (2) if u is not in i, then u is a successor of some node in i.
25$ here the map f(i, u) represents the propagation effect as control
26$ advances from the start of i, through i, to the start of u;
27$ in this case f(i, u) is needed for the processing of the
28$ intervals containing i. note that [i, u] is a virtual edge
29$ in our flow graph; thus the elimination phase extends the
30$ map f so as to be defined also on virtual edges.
31$
32$ any interval i processed in this routine is either a proper
33$ strongly connected interval, or, if it contains 'improper'
34$ nodes (i.e. nucleii of irreducibility), is a single-entry
35$ strongly connected subgraph. in the first case we only have to
36$ iterate thru the nodes of i twice, but in the second case till
37$ convergence.
38$
39$ the outermost 'interval' is either a single entry acyclic
40$ graph (if it does not contain irreducible nucleii), or a
41$ general single-entry graph otherwise. for this 'interval' we
42$ iterate either once in the first case, or till convergence
43$ otherwise.
44$
45$ if the present routine is to be used for interprocedural analysis,
46$ we first reset the propagation maps for call blocks in p. if none of
47$ these maps have changed from the last processing of p,
48$ then obviously analysis of p has stabilized and we can return
49$ immediately. moreover, intervals need be re-processed if and only
50$ if they contain a call block whose local effect has changed,
51$ or, recursively, contain an interval whose local effects
52$ have changed. in terms of the 'intof' tree, we only have to
53$ re-analyze intervals lying along some path from the
54$ root to a call block whose local effect has changed. this
55$ can make reprocessing of a procedure considerably
56$ faster than initial processing.
57$
58 repr
59 $ data structures for parameters
60 p: routine;
61 aux_f: remote smap(df_node) df_map;
62 f: remote smap(df_edge) df_map;
63 flow_flag: string;
64
65 $ data structures for local variables
66 need_process: set(df_node);
67 intt: df_node;
68 c: df_node;
69 v: df_node;
70 p1: routine;
71 ep1: df_node;
72 p_ints: tuple(df_node);
73 outint: df_node;
74 k: integer;
75 nodes: tuple(df_node);
76 head: df_node;
77 conv_control: boolean;
78 n_iter: integer;
79 j: integer;
80 d: integer;
81 convrgd: boolean;
82 nd: df_node;
83 ftemp: df_map;
84 pnd: df_node;
85 pv: df_node;
86 end repr;
87
88 if flow_flag = 'second_inter' then
89 $ process only intervals containing calls with new effect
90 need_process := {};
91 else
92 $ process all intervals
93 need_process := { intt : intt in ints(p) };
94 end if;
95
96 if flow_flag /= 'intra' then
97 $ interprocedural analysis
98 (forall c in callsin{p})
99 v := cessor(c); $ the block following the call
100 p1 := callproc(c); $ c calls p1
101 ep1 := rexit(p1); $ the return block of p1
102
103$ (note here that if this routine is modified to include parameter-
104$ passing assignments as part of call blocks, in the manner suggested
105$ in a concluding remark in section 4, then one might manipulate
106$ aux_f(ep1), which defines the local effect of executing p1, to get
107$ f(c,v), rather than just assign the first map to the second one, as
108$ is done below).
109
110 if f([c, v]) /= aux_f(ep1) then
111
112 $ update flow function for call
113 f([c, v]) := aux_f(ep1) ? fom;
114
115 $ interval containing call must be processed
116 need_process with:= intof(c);
117 end if;
118 end forall c;
119
120 $ if no intervals need be processed then information has
121 $ stabilized and no re-processing of p need be done.
122 if need_process = {} then return true; end if;
123 end if;
124
125 p_ints := ints(p); $ intervals of p in reverse preorder
126 outint := p_ints(#p_ints); $ outermost interval
127
128 (forall intt = p_ints(k) | intt in need_process)
129 need_process with:= intof(intt); $ process containing interval
130 nodes := int_nodes(intt); $ nodes of intt in interval order
131
132 head := nodes(1); $ interval head
133 aux_f(head) := id; $ initialize to the identity
134$
135$ note here that the edge [intt, head] is a real edge in the
136$ flow graph, so that f([intt, head]) will have been pre-computed in
137$ an initialization phase, along with the flow maps for all other
138$ real edges, and is therefore available here.
139$
140$ three cases are now possible:
141$
142$ (1) intt is proper, but not outermost; then iterate twice.
143$ (2) intt is proper, and is outermost; then iterate once.
144$ (3) intt is improper; iterate indefinitely (1 + number of
145$ nodes is an adequate upper bound) until convergence.
146$ (note that we do not make use of the better upper bound on
147$ the number of iterations discussed in section 3).
148$
149 conv_control := intt notin proper_ints;
150 $ test for convergence only in this case
151
152 n_iter := $ maximal number of iterations
153 if intt notin proper_ints then #nodes + 1
154 elseif intt = outint then 1
155 else 2
156 end;
157
158$ if improper interval, initialize aux_f of all non-head nodes
159$ to 'fom'. this is because we cannot guarantee in this case that
160$ when propagating data to a node within intt, all its predecessors
161$ (within intt) have already been processed, so that we have to
162$ prepare for the case where some of these predecessors still
163$ have undefined auxiliary data-flow maps.
164 if conv_control then
165 (forall j in [ 2..#nodes ])
166 aux_f(nodes(j)) := fom;
167 end forall;
168 end if;
169
170 $ iterate through the nodes of intt
171
172 (forall d in [ 1..n_iter ])
173
174 convrgd := conv_control;
175
176 $ iterate thrugh the nodes of intt, other than head
177 (forall j in [ 2..#nodes ])
178
179 nd := nodes(j);
180 ftemp := fom;
181 (forall pnd in pred{nd} | intof(pnd) = intt)
182 ftemp .meetjoin:=
183 (f([pnd,nd]) .comp aux_f(pnd));
184 end forall;
185 convrgd and:= (ftemp = aux_f(nd));
186 aux_f(nd) := ftemp;
187
188 end forall j;
189
190 $ test if processing of intt has terminated
191 if d = n_iter or convrgd then quit forall d; end if;
192
193 $ re-compute aux_f(head), taking back edges into account
194 ftemp := fom;
195 (forall pnd in pred{head} | intof(pnd) = intt)
196 ftemp .meetjoin:= (f([pnd,head]) .comp aux_f(pnd));
197 end forall;
198 ftemp .meetjoin:= aux_f(head);
199
200 if not conv_control then
201 convrgd := aux_f(head) = ftemp;
202 end if;
203
204 aux_f(head) := ftemp;
205 if convrgd then quit forall d; end if;
206 end forall d;
207
208$
209$ compute f([intt, v]), where v is a successor of some node in
210$ intt; note that this loop will be null for the
211$ outermost interval.
212$
213 (forall v in vedges{intt})
214 ftemp := fom;
215 (forall pv in pred{v} | intof(pv) = intt)
216 ftemp .meetjoin:= (f([pv,v]) .comp aux_f(pv));
217 end forall;
218 f([intt, v]) := ftemp .comp f([intt, head]);
219
220 end forall v;
221 end forall intt;
222
223 return false; $ to indicate no convergence
224
225 end procedure intraproc_fwd_eliminate;
226
227
1 .=member pex13e
2
3
4 procedure propagate_exposed(p, rw f, aux_f, rw exposed, rw insert,
5 safe);
6$
7$ this procedure performs an inner-to-outer pass over all
8$ intervals to determine the computations which might be moved
9$ out of the loop of each interval i. as explained above,
10$ these computations are not necessarily those exposed in i;
11$ hence, we build up both sets 'exposed' and 'insert'
12$ simultaneously.
13$
14$ in this analysis, the set of computations movable out of the
15$ loop of i is obtained by taking all computations t with
16$ the property that there exists a node nd in i such that
17$ t is exposed in nd and is available at the start of nd iff
18$ it is available at the end of the target block of i.
19$
20$ the movable code is always assumed to be appended to the
21$ end of the target block of the interval, to avoid any possible
22$ conflict with code that is already present in the target block.
23$ however, this appending takes place physically only at the end
24$ of the elimination phase. thus, we do not attempt to make
25$ use of the fact that these expressions are potentially
26$ available at the head of i in updating any flow function.
27$ this approach is necessary to ensure convergence of our algorithms
28$ in cases of recursive cycles of interprocedural flow.
29$
30 repr
31 $ data structures for parameters
32 p: routine;
33 f: remote smap(df_edge) df_map;
34 aux_f: remote smap(df_node) df_map;
35 exposed: remote mmap{df_node} df_elmt;
36 insert: remote mmap{df_node} df_elmt;
37 safe: remote mmap{df_node} df_elmt;
38
39 $ data structures for local variables
40 p_ints: tuple(df_node);
41 outint: df_node;
42 intt: df_node;
43 k: integer;
44 nodes: tuple(df_node);
45 head: df_node;
46 itemp: df_elmt;
47 nd: df_node;
48 ftarg: df_map;
49 expfromentry: df_elmt;
50 end repr;
51
52 p_ints := ints(p); $ intervals of p in reverse preorder
53$
54$ first extend f to indicate null flow from the entry block to
55$ itself. since the outermost interval has no target block,
56$ and is therefore identified with its head, this trick unifies
57$ the treatment of that interval with the treatment of inner
58$ intervals, as shown below.
59$
60 outint := p_ints(#p_ints);
61 f([outint, outint]) := id;
62
63 (forall intt = p_ints(k))
64 nodes := int_nodes(intt);
65 head := nodes(1);
66$
67$ in computing exposed{intt}, we must reckon with the fact
68$ that the target block of intt (also denoted by intt)
69$ might be non-empty, due to prior code motion. this can mean that
70$ (a) f([intt, head]) is not the identity, and (b) exposed{intt}
71$ (where intt is treated as a basic block) is not null
72$ initially.
73$
74 $ we proceed as follows: first find all exposed computations
75 $ in the loop of intt, assuming the target block of intt to
76 $ be null. these are the computations movable out of the loop
77 $ of intt.
78 itemp := {};
79 (forall nd in nodes)
80 itemp +:= (exposed{nd} * (aux_f(nd)(1) - aux_f(nd)(2)));
81 end forall;
82 if safe /= om then itemp := itemp * safe{intt}; end if;
83 insert{intt} := itemp;
84
85 $ next find the new set of computations which are still
86 $ exposed at the entry to the target block of intt.
87 ftarg := f([intt, head]);
88 expfromentry := insert{intt} * (ftarg(1) - ftarg(2));
89
90 $ add these computations to those exposed in the target block
91 exposed{intt} := exposed{intt} + expfromentry;
92
93 end forall intt;
94
95
96 end procedure propagate_exposed;
97
98
99
100
101 procedure entry_info(f, aux_f, move_code, insert);
102$
103$ this function calculates and returns a mapping which sends
104$ each procedure p into the flow information available at entry
105$ to p. it is called (only in the interprocedural case) just
106$ before we begin the final outer-to-inner propagation phase.
107$
108 repr
109 $ data structures for parameters
110 f: remote smap(df_edge) df_map;
111 aux_f: remote smap(df_node) df_map;
112 move_code: boolean;
113 insert: remote mmap{df_node} df_elmt;
114
115 $ data structures for local variables
116 cgf: smap( tuple(routine, routine) ) df_map;
117 p, q: routine;
118 c: df_node;
119 ftemp: df_map;
120 iu: df_node;
121 hiu: df_node;
122 fins: df_map;
123 ent_inf: remote smap(routine) df_elmt;
124 cgrinv: mmap(routine) routine;
125 i: integer;
126 scc: routine;
127 scc_procs: tuple(routine);
128 n: integer;
129 convrgd: boolean;
130 k: integer;
131 temp: df_elmt;
132 end repr;
133$
134$ first we construct a map 'cgf' assigning to each edge (p, q)
135$ of the call graph a data-propagation map, describing the
136$ propagation effect as control advances from the entry of p
137$ to the entry of q via any call to q from p.
138$
139 cgf := {};
140 (forall [p,q] in cgraph) cgf([p,q]) := fom; end;
141
142 (forall q = callproc(c)) $ for all calls within all procedures
143
144 p := routof(c); $ [p, q] is an edge of the call graph
145
146 $ compute the local effect as control advances from the entry
147 $ of p to c.
148 ftemp := aux_f(c);
149
150 (init iu := intof(c); while iu /= rentry(p))
151
152 hiu := int_nodes(iu)(1); $ head of iu
153 fins := id;
154 $ add also the effect of code moved out of iu
155 if move_code then fins(2) := insert{iu}; end;
156 ftemp := ftemp .comp fins .comp f([iu, hiu])
157 .comp aux_f(iu);
158
159 iu := intof(iu);
160
161 end;
162
163 cgf([p, q]) := cgf([p, q]) .meetjoin ftemp;
164
165 end forall q;
166$
167$ next we iterate through the call graph in 'invocation order', i.e.
168$ process the strongly connected components in reverse postorder and
169$ the set of procedures within each strongly connected component in
170$ reverse postorder also.
171$
172 ent_inf := {[p, xom] : p in routs}; $ initialize solution
173 ent_inf(sym_main) := zero;
174 cgrinv := {[p, q] : [q, p] in cgraph};
175
176 $ pick strongly-connected components in reverse postorder
177 (forall i in [ 2..#cg_sccs ])
178
179 $ nb. here we assume that the main program is non-recursive, so
180 $ that the first strongly-connected component of the call graph
181 $ consists of the main program only. thus we can skip it, for
182 $ the entry value of the main program is already assumed known.
183
184 scc := cg_sccs(i);
185 scc_procs := scc_nodes(scc); $ procs in scc in rev. postorder
186
187 (forall n in [ 1..scc_d(scc)+1 ] )
188
189 convrgd := true;
190
191 (forall p = scc_procs(k))
192
193 temp := xom;
194 (forall q in cgrinv{p})
195 temp .mjv:= (cgf([q,p]) .of ent_inf(q));
196 end forall;
197
198 $ test for convergence
199 convrgd and:= (temp = ent_inf(p));
200
201 ent_inf(p) := temp;
202 end forall p;
203
204 if convrgd then quit forall n; end if;
205 end forall n;
206 end forall i;
207
208 return ent_inf;
209
210 end procedure entry_info;
211
212
1 .=member fpi13f
2
3
4 procedure fwd_propagate_in(p, rw f, aux_f, rw soln, ent_val,
5 move_code, rw insert);
6$
7$ this procedure performs outer-to-inner propagation for a
8$ routine p, using the 'interval-effect' flow functions aux_f
9$ to modify the solution map 'soln'. the parameter ent_val
10$ gives the flow information assumed (or known) at procedure
11$ entry.
12$
13$ if code motion is required, then the computations in insert{i}
14$ are assumed to be available at the end of the target block
15$ of an interval i (but only for the purpose of propagation
16$ inside i). in addition, computations in insert{i} already
17$ available at exit from the target block of i are removed from
18$ insert{i}.
19$
20$ note that movable computations are assumed to be such that the
21$ insertion of any of them will not 'kill' any others.
22$
23 repr
24 $ data structures for parameters
25 p: routine;
26 f: remote smap(df_edge) df_map;
27 aux_f: remote smap(df_node) df_map;
28 soln: remote smap(df_node) df_elmt;
29 ent_val: df_elmt;
30 move_code: boolean;
31 insert: remote mmap{df_node} df_elmt;
32
33 $ data structures for local variables
34 p_ints: tuple(df_node);
35 outint: df_node;
36 k: integer;
37 intt: df_node;
38 nodes: tuple(df_node);
39 soln1: df_elmt;
40 u: df_node;
41 end repr;
42
43 soln(rentry(p)) := ent_val;
44 p_ints := ints(p); $ intervals of p in reverse preorder
45$
46$ extend f to indicate null flow from the entry block to
47$ itself. since the outermost interval has no target block,
48$ and is therefore identified with its head, this trick unifies
49$ the treatment of that interval with the treatment of inner
50$ intervals, as shown below.
51$
52 outint := p_ints(#p_ints);
53 f([outint, outint]) := id;
54
55 (forall k in [ #p_ints, #p_ints-1..1 ])
56
57 intt := p_ints(k);
58 nodes := int_nodes(intt); $ nodes of intt
59
60 soln1 := soln(intt); $ data value at entry to intt
61
62 $ convert soln1 to the data attribute value at the end of the
63 $ target block of intt.
64 $ propagate through the target block of intt; if
65 $ intt = outint, the trick noted above will make the following
66 $ statement a no-op.
67 soln1 := f([intt, nodes(1)]) .of soln1;
68
69 $ if code motion is also required, then update insert{intt}
70 $ and add it to soln1.
71 if move_code and intt /= outint then
72 insert{intt} := insert{intt} - soln1;
73 soln1 := soln1 + insert{intt};
74 end if;
75
76 $ now propagate attributes to the nodes of intt
77 (forall u in nodes)
78 soln(u) := aux_f(u) .of soln1;
79 end forall u;
80
81 end forall;
82
83
84 end procedure fwd_propagate_in;
85
86
1 .=member afa13g
2
3
4 procedure intraproc_fwd_analysis(p, rw f, wr soln, id_prm, zero_prm,
5 meet_flag_prm, move_code,
6 rw exposed, wr insert, safe);
7$
8$ this is the master routine to perform a specific data flow
9$ analysis intraprocedurally for a given routine p, within which
10$ local variables are analyzed.
11$
12$ for more details and comments and description of parameters see the
13$ corresponding interprocedural analyser.
14$
15 repr
16 $ data structures for parameters
17 p: routine;
18 f: remote smap(df_edge) df_map;
19 soln: remote smap(df_node) df_elmt;
20 id_prm: df_map;
21 zero_prm: df_elmt;
22 meet_flag_parm: boolean;
23 move_code: boolean;
24 exposed: remote mmap{df_node} df_elmt;
25 insert: remote mmap{df_node} df_elmt;
26 safe: remote mmap{df_node} df_elmt;
27
28 $ data structures for local variables
29 aux_f: remote smap(df_node) df_map;
31 end repr;
32
33 id := id_prm;
34 meet_flag := meet_flag_prm;
35
36 aux_f := {};
37
38 intraproc_fwd_eliminate(p,aux_f,f,'intra');
41
42 if move_code then
43 insert := {};
44 propagate_exposed(p, f, aux_f, exposed, insert, safe);
45 end if;
46
47 soln := {};
48 fwd_propagate_in(p, f, aux_f, soln, zero_prm, move_code, insert);
49
50 end procedure intraproc_fwd_analysis;
51
52
53
54
55 procedure interproc_back_analysis(rw f, wr soln, id_prm, zero_prm,
56 meet_flag_prm);
57$
58$ this is the master routine for performing a specific interprocedural
59$ backward data flow analysis. see the corresponding forward routine
60$ for general comments and a description of parameters. here we comment
61$ only on differences between the forward and backward algorithms, which
62$ are as follows:
63$
64$ a. functional composition must be computed in reverse order.
65$
66$ b. the auxiliary maps used in backward analysis are defined as
67$ follows: let i be an interval, u a node in i and v a node outside
68$ i which is a successor of a node in i. then aux_f([u, v]) is
69$ defined to be the propagation effect experienced as control
70$ advances from the start of u, through i, to the start of v.
71$
72$ to compute this map requires iterating through i in reverse
73$ interval order three times (if i is proper) or till convergence
74$ otherwise.
75$
76$ since the outermost interval of a procedure p has no successors,
77$ we regard the blocks rexit(p) and rstop(p) as its successors,
78$ 'hidden' inside that interval. this is needed to enable us to
79$ record the effect of the flow through the outermost interval in
80$ a manner similar to that used for inner intervals.
81$
82$ c. in backward analysis we perform an extra step after the
83$ elimination phase. in this step we compute an additional set
84$ 'fexit' of auxiliary maps. for each node u in p, fexit(u)
85$ represents the propagation effect of the flow from the start
86$ of u to the return block of p, combined with that of flow from
87$ the start of u to the stop block of p.
88$
89$ d. in our backward analysis code motion issues are completely
90$ ignored.
91$
92$ e. the technical problem concerning endless loops discussed in
93$ section 5 is assumed to be resolved by preliminary processing
94$ of the flow graph, in the manner suggested there.
95$
96 repr
97 $ data structures for parameters
98 f: remote smap(df_edge) df_map;
99 soln: remote smap(df_node) df_elmt;
100 id_prm: df_map;
101 zero_prm: df_elmt;
102 meet_flag_prm: boolean;
103
104 $ data structures for local variables
105 aux_f: remote smap(df_edge) df_map;
106 fexit: remote smap(df_node) df_map;
107 p: routine;
108 ex_inf: remote smap(routine) df_elmt;
109 end repr;
110
111 $ transfer constant parmeters to globals
112 id := id_prm;
113 zero := zero_prm;
114 meet_flag := meet_flag_prm;
115$
116$ this master procedure consists of the following four phases:
117$
118$ 1. interprocedural elimination phase
119$
120 aux_f := interproc_back_eliminate(f);
121$
122$ 2. compute auxiliary fexit maps.
123$
124 fexit := {};
125 (forall p in routs)
126 intra_aux_eliminate(p, f, aux_f, fexit);
127 end forall p;
128$
129$ 3. find data at procedure exits
130$
131 ex_inf := exit_info(f, aux_f, fexit);
132$
133$ 4. final propagation phase
134$
135 soln := {}; $ initialize the solution
136 (forall p in routs)
137 back_propagate_in(p, fexit, soln, ex_inf(p));
138 end forall;
139
140 end procedure interproc_back_analysis;
141
142
1 .=member ebe13h
2
3
4 procedure interproc_back_eliminate(rw f);
5$
6$ this is the driver routine for the interprocedural first
7$ inner-to-outer interval pass. procedures are analyzed in
8$ the following order: we process the strongly connected
9$ components of the call graph in their postorder; then, for each
10$ such component, we iterate through its procedures in their
11$ postorder, no more than 2*d+1 times, where d is the loop-
12$ interconnectedness parameter of the component.
13$
14 repr
15 $ data structures for parameters
16 f: remote smap(df_edge) df_map;
17
18 $ data structures for local variables
19 aux_f: remote smap(df_edge) df_map;
20 f_p: remote smap(routine) df_map;
21 i: integer;
22 scc: routine;
23 scc_procs: tuple(routine);
24 flow_flag: string;
25 j: integer;
26 proc_converge: boolean;
27 k: integer;
28 p: routine;
29 end repr;
30
31 aux_f := {}; $ initialize auxiliary maps
32 f_p := {}; $ propagation effect thru procedures
33
34 $ iterate through the s.c.c.s of cgraph
35 (forall i in [ #cg_sccs, #cg_sccs-1..1 ])
36 scc := cg_sccs(i); $ get a s.c.c.
37 scc_procs := scc_nodes(scc); $ procedures in that s.c.c.
38 flow_flag := 'first_inter'; $ first processing of the s.c.c.
39
40 (forall j in [ 1..2*scc_d(scc)+1 ])
41 proc_converge := true;
42
43 (forall k in [ #scc_procs, #scc_procs-1..1 ])
44 p := scc_procs(k);
45 proc_converge :=
46 intraproc_back_eliminate(p,aux_f,f,f_p,flow_flag)
47 and proc_converge;
48 $ this routine analyzes p; its fifth parameter
49 $ indicates whether the analysis is first-time
50 $ interprocedural, second-time interprocedural or
51 $ intraprocedural; it returns a flag to indicate
52 $ whether information has stabilized in p.
53 end forall;
54
55 flow_flag := 'second_inter'; $ additional passes thru scc
56
57 if proc_converge then quit forall j; end if;
58 end forall;
59 end forall;
60
61 return aux_f;
62
63 end procedure interproc_back_eliminate;
64
65
1 .=member abe13i
2
3
4 procedure intraproc_back_eliminate(p, rw aux_f, rw f, rw f_p,
5 flow_flag);
6$
7$ this routine performs an intraprocedural elimination phase of a
8$ backward data flow analysis for a given procedure p.
9$
10$ the overall logic is quite similar to its sister routine
11$ 'intraproc_fwd_eliminate', and the reader should consult comments
12$ given there. the differences between these two phases reflects
13$ mainly the reverse tracing of flow, which implies several minor
14$ modifications of the forward approach, as follows:
15$
16$ a. auxiliary information is computed for each successor of each
17$ interval. that is, for each interval i, each node u in i, and
18$ each successor node v of i, we compute a map aux_f([u, v]),
19$ representing the flow from u through i to v. the outermost
20$ interval has no successors, but we regard the return block of p
21$ and the stop block of p (if any) as its two successors, even
22$ though they lie within it. (note that since these two nodes
23$ can never lie on a cycle through p, they must belong to the
24$ outer-most interval).
25$
26$ b. nodes of an interval are processed in reverse interval order
27$ (i.e. postorder); this is done three times if i is a proper
28$ inner interval, once if i is a proper outer-most inteval, and
29$ till convergence otherwise.
30$
31$ c. functional composition is taken in reverse edge order.
32$
33$ d. an additional data structure f_p is used to hold the propagation
34$ effect through the whole procedure in the interprocedural case.
35$ this is because the flow through p is actually combined of two
36$ flows: one leading to the return block of p, and another leading
37$ to the stop block of p, if any. unlike in the forward case,
38$ where the second flow can be, and is, actually ignored, here we
39$ must take it into account.
40$
41 repr
42 $ data structures for formal parameters
43 p: routine;
44 aux_f: remote smap(df_edge) df_map;
45 f: remote smap(df_edge) df_map;
46 f_p: remote smap(routine) df_map;
47 flow_flag: *;
48
49 $ data structures for local variables
50 need_process: set(df_node);
51 intt: df_node;
52 c: df_node;
53 v: df_node;
54 p1: routine;
55 p_ints: tuple(df_node);
56 outint: df_node;
57 sp: df_node;
58 k: integer;
59 nodes: tuple(df_node);
60 head: df_node;
61 cesors: sparse set(df_node);
62 conv_control: boolean;
63 n_iter: integer;
64 nd: df_node;
65 d: integer;
66 convrgd: boolean;
67 j: integer;
68 ftemp: df_map;
69 snd: df_node;
70 fzero: df_elmt;
71 end repr;
72
73
74 if flow_flag = 'second_inter' then
75 $ process only intervals containing calls with new effects
76 need_process := {};
77 else
78 $ process all intervals
79 need_process := { intt : intt in ints(p) }; $ convert to set
80 end if;
81
82 if flow_flag /= 'intra' then $ interprocedural analysis
83
84 (forall c in callsin{p})
85 v := cessor(c); $ the block following the call
86 p1 := callproc(c); $ c calls p1
87
88 $ (note that if this routine is modified to include
89 $ parameter-passing assignments as part of call blocks,
90 $ in the manner mentioned above, then one might manipulate
91 $ f_p(p1), the local effect of executing p1, to get
92 $ f([c, v]), rather than just assign f_p(p1)
93 $ to f([c, v]), as is done below).
94
95 if f([c, v]) /= f_p(p1) then
96
97 $ update flow function for call
98 f([c, v]) := f_p(p1) ? fom;
99
100 $ interval containing call must be processed
101 need_process with:= intof(c);
102 end if;
103 end forall c;
104
105 $ if no intervals need be processed then information has
106 $ stabilized and no re-processing of p need be done.
107 if need_process = {} then return true; end if;
108 end if;
109
110
111 p_ints := ints(p); $ intervals of p in reverse preorder
112 outint := p_ints(#p_ints); $ outermost interval
113 vedges{outint} := {rexit(p)}; $ 'successors' of outint
114 if (sp := rstop(p)) /= om then
115 vedges{outint} with:= sp;
116 end if;
117
118 (forall intt = p_ints(k) | intt in need_process)
119
120 need_process with:= intof(intt); $ process containing interval
121 nodes := int_nodes(intt); $ nodes of intt in interval order
122 head := nodes(1); $ interval head
123
124 $ get successor nodes
125 cesors := vedges{intt};
126
127 $ initialize aux_f for successor nodes. this trick simplifies
128 $ subsequent code considerably.
129 (forall v in cesors)
130 aux_f([v, v]) := id;
131 end forall;
132$
133$ three cases are now possible:
134$ a. intt is proper, but not outermost; then iterate three times.
135$ b. intt is proper, and is outermost; then iterate once.
136$ c. intt is improper; iterate indefinitely (1 + 2*number of
137$ nodes is an adequate upper bound) until convergence. (here,
138$ again, a better bound can be used; cf. section 6).
139$
140 $ we test for convergence only for improper intervals.
141 conv_control := intt notin proper_ints;
142
143 n_iter := $ maximal number of iterations through nodes of intt
144 if intt notin proper_ints then 1 + 2 * #nodes
145 elseif intt = outint then 1
146 else 3
147 end;
148
149 (forall nd in nodes, v in cesors | nd /= v)
150 aux_f([nd, v]) := fom;
151 end forall;
152
153 $ iterate through the nodes of intt.
154 (forall d in [ 1..n_iter ])
155 convrgd := conv_control;
156
157 $ iterate thrugh the nodes of intt in reverse interval
158 $ order.
159 (forall j in [ #nodes, #nodes-1..1 ])
160 nd := nodes(j);
161
162 (forall v in cesors | v /= nd)
163
164 $ since the 'successors' of the outermost interval
165 $ are nodes of that interval, we may have nd = v.
166 $ in this case it would be erroneouss to compute
167 $ aux_f([nd, v]) (which has already been set to
168 $ id) using the following 'propagation from
169 $ successors' formula, so we just skip such cases.
170
171 ftemp := fom;
172 (forall snd in cessor{nd} |
173 intof(snd) = intt or snd = v)
174 ftemp .meetjoin:=
175 (f([nd,snd]) .comp aux_f([snd,v]));
176 end forall;
177
178 $ note that flow graph edges (virtual or real) are
179 $ either edges within an interval, linking two
180 $ nodes in the same interval, or edges going out
181 $ of an interval, or edges going into an interval
182 $ (these last edges are edges from (a target block
183 $ of) an interval to its head. it is this third
184 $ kind of edge that we wish to avoid propagating
185 $ through in the above formula.
186 $ 'intof(snd) = intt' tests for internal edges
187 $ and 'snd = v' tests for outgoing edges whose
188 $ target is v.
189
190 convrgd and:= (ftemp = aux_f([nd, v]));
191 aux_f([nd, v]) := ftemp;
192 end forall v;
193 end forall j;
194
195 if convrgd then quit forall d; end if;
196 end forall d;
197 $ (note that no special handling of intt's head is required.)
198
199 $ except for the outermost interval, compute f([intt, v]),
200 $ where v is a successor of some node in intt.
201 if intt /= outint then
202 $ f([intt, v]) is trivially calculated in this case; we
203 $ also remove the dummy aux_f([v, v]) entries.
204 (forall v in cesors)
205 f([intt, v]) :=
206 f([intt, head]) .comp aux_f([head, v]);
207 aux_f([v, v]) := om;
208 end forall v;
209 end if;
210 end forall intt;
211
212 f_p(p) := aux_f([head, rexit(p)]); $ head = rentry(p)
213
214 $ if p contains a stop block, calculate propogation effect to that
215 $ block and combine it with 'normal' flow effect.
216 if rstop(p) /= om then
217 fzero := aux_f([head, rstop(p)]) .of zero;
218 f_p(p) := f_p(p) .meetjoin [ fzero, fzero ];
219 $ note that a constant function c is represented by [c, c]
220
221 end if;
222
223 $ remove artificial edges added earlier
224 vedges{outint} := {};
225
226 return false; $ to indicate no convergence
227
228 end procedure intraproc_back_eliminate;
229
230
1 .=member axe13j
2
3
4 procedure intra_aux_eliminate(p, f, aux_f, rw fexit);
5$
6$ this procedure performs an additional intraprocedural elimination,
7$ during which we compute, for each node n in p, a map fexit(n) repre-
8$ senting the effect of flow from the start of n up to an exit of p.
9$
10 repr
11 $ data structures for formal parameters
12 p: routine;
13 f: remote smap(df_edge) df_map;
14 aux_f: remote smap(df_edge) df_map;
15 fexit: remote smap(df_node) df_map;
16
17 $ data structures for local variables
18 p_ints: tuple(df_node);
19 outint: df_node;
20 ep: df_node;
21 sp: df_node;
22 outnodes: tuple(df_node);
23 nd: df_node;
24 i: integer;
25 fzero: df_elmt;
26 ftemp: df_map;
27 j: integer;
28 intt: df_node;
29 cesors: sparse set(df_node);
30 nodes: tuple(df_node);
31 k: integer;
32 v: df_node;
33 end repr;
34
35 p_ints := ints(p);
36 outint := p_ints(#p_ints);
37 ep := rexit(p);
38 sp := rstop(p);
39$
40$ first process nodes of outint
41$
42 outnodes := int_nodes(outint);
43
44 (forall nd = outnodes(i))
45
46 fexit(nd) := aux_f([nd, ep]); $ get the effect of flow to ep
47
48 if sp /= om then $ if there is also a stop block
49
50 fzero := aux_f([nd, sp]) .of zero;
51 ftemp := if fzero = xom then fom else [ fzero, fzero ] end;
52 fexit(nd) := fexit(nd) .meetjoin ftemp;
53
54 end if;
55 end forall nd;
56$
57$ next process all remaining intervals in outer-to-inner order
58$
59 (forall j in [ #p_ints-1, #p_ints-2..1 ])
60
61 intt := p_ints(j);
62 cesors := vedges{intt};
63
64 nodes := int_nodes(intt);
65 (forall nd = nodes(k))
66 ftemp := fom;
67 (forall v in cesors)
68 ftemp .meetjoin:= (aux_f([nd,v]) .comp fexit(v));
69 end forall;
70 fexit(nd) := ftemp;
71 end forall nd;
72 end forall j;
73
74
75 end procedure intra_aux_eliminate;
76
77
1 .=member xnf13k
2
3
4 procedure exit_info(f, aux_f, fexit);
5$
6$ this function calculates and returns a mapping which sends
7$ each procedure p into the flow information available at exit
8$ from p. it is called (only in the interprocedural case) just
9$ before we begin the final outer-to-inner propagation phase.
10$
11 repr
12 $ data structures for formal parameters
13 f: remote smap(df_edge) df_map;
14 aux_f: remote smap(df_edge) df_map;
15 fexit: remote smap(df_node) df_map;
16
17 $ data structures for local variables
18 cgf: smap( tuple(routine, routine) ) df_map;
19 p, q: routine;
20 c: df_node;
21 c1: df_node;
22 ex_inf: remote smap(routine) df_elmt;
23 cgrinv: mmap(routine) routine;
24 i: integer;
25 scc: routine;
26 scc_procs: tuple(routine);
27 n: integer;
28 convrgd: boolean;
29 k: integer;
30 temp: df_elmt;
31 end repr;
32$
33$ first we construct a map 'cgf' assigning, to each edge (p, q)
34$ of the call graph, a data-propagation map describing the
35$ propagation effect as control returns from the exit of q to p
36$ after any call in p to q, and then advances to the exit of p.
37$
38 cgf := {};
39 (forall [ p, q ] in cgraph) cgf([p,q]) := fom; end forall;
40
41 (forall q = callproc(c)) $ for all calls within all procedures
42 p := routof(c); $ [p, q] is an edge of the call graph
43 c1 := cessor(c); $ c1 is the block following c
44 cgf([p, q]) := cgf([p, q]) .meetjoin fexit(c1);
45
46 $ note that since we are dealing with a backward analysis, we
47 $ want to propagate data from the exit of the calling procedure
48 $ p to the exit of the called procedure q. this direction of
49 $ propagation, however, makes our problem a forward problem for
50 $ the call graph.
51
52 end forall;
53$
54$ next we iterate through the call graph in 'invocation order', i.e.
55$ process the strongly connected components in reverse postorder
56$ and the set of procedures within each strongly connected
57$ component in reverse postorder also.
58$
59 ex_inf := { [ p, xom ] : p in routs }; $ initialize solution
60 ex_inf(sym_main) := zero;
61 cgrinv := { [ p, q ] : [ q, p ] in cgraph };
62
63 $ pick strongly-connected components in reverse postorder
64 (forall i in [ 2..#cg_sccs ])
65
66 $ note that we assume here that the main program is non-recur-
67 $ sive, so that the first strongly-connected component of the
68 $ call graph consists of the main program only. thus we need
69 $ not process it, for the exit value of the main program is
70 $ already assumed known.
71
72 scc := cg_sccs(i);
73 scc_procs := scc_nodes(scc); $ procs in scc in rev. postorder
74
75 (forall n in [ 1..scc_d(scc)+1 ] )
76 convrgd := true;
77 (forall p = scc_procs(k))
78 temp := xom;
79 (forall q in cgrinv{p})
80 temp .mjv:= (cgf([q,p]) .of ex_inf(q));
81 end forall;
82
83 $ test for convergence
84 convrgd and:= (temp = ex_inf(p));
85 ex_inf(p) := temp;
86
87 end forall p;
88
89 if convrgd then quit forall n; end if;
90 end forall n;
91 end forall i;
92
93 return ex_inf;
94
95 end procedure exit_info;
96
97
1 .=member bpi13l
2
3
4 procedure back_propagate_in(p, fexit, rw soln, ex_val);
5$
6$ this procedure performs outer-to-inner back propagation for
7$ a routine p, using the 'fexit' information. ex_val is the flow
8$ information assumed (or known) at the procedure return block,
9$ where 'zero' is always assumed at the stop block of p (but this
10$ assumption has already been used in calculating the fexit maps).
11$
12 repr
13 $ data structures for formal parameters
14 p: routine;
15 fexit: remote smap(df_node) df_map;
16 soln: remote smap(df_node) df_elmt;
17 ex_val: df_elmt;
18
19 $ data structures for local variables
20 intt: df_node;
21 u: df_node;
22 end repr;
23
24 (forall intt in ints(p), u in int_nodes(intt))
25 soln(u) := fexit(u) .of ex_val;
26 end forall;
27
28 end procedure back_propagate_in;
29
30
31
32
33 procedure intraproc_back_analysis(p, rw f, wr soln,
34 id_prm, zero_prm, meet_flag_prm);
35$
36$ this is the master routine to perform a specific backward data flow
37$ analysis intraprocedurally for a routine p whose local variables are
38$ to be analyzed. for more details, comments, and description of para-
39$ meters see the corresponding interprocedural analyser.
40$
41 repr
42 $ data structures for formal parameters
43 p: routine;
44 f: remote smap(df_edge) df_map;
45 soln: remote smap(df_node) df_elmt;
46 id_prm: df_map;
47 zero_prm: df_elmt;
48 meet_flag_prm: boolean;
49
50 $ data structures for local variables
51 aux_f: remote smap(df_edge) df_map;
52 f_p: remote smap(routine) df_map;
54 fexit: remote smap(df_node) df_map;
55 end repr;
56
57 id := id_prm;
58 zero := zero_prm;
59 meet_flag := meet_flag_prm;
60
61 aux_f := {}; f_p := {};
62
63 intraproc_back_eliminate(p, aux_f, f, f_p, 'intra');
65
66 fexit := {};
67 intra_aux_eliminate(p, f, aux_f, fexit);
68
69 soln := {};
70 back_propagate_in(p, fexit, soln, zero);
71$
72$ note that in the intraprocedural case the last two procedures
73$ can be combined to form a single procedure almost identical
74$ with 'intra_aux_eliminate', except that this procedure computes the
75$ 'soln' map directly instead of the 'fexit' maps.
76$
77 end procedure intraproc_back_analysis;
78
79
80
81$
82$ here are the operators which manipulate the data propagation maps
83$ and data states.
84$
85 op .comp(g, f); $ functional composition g of f
86
87 if f = fom or g = fom then
88 return fom;
89 else
90 return [ f(1) * g(1) + g(2), f(2) * g(1) + g(2) ];
91 end if;
92
93 end op .comp;
94
95
96 op .meetjoin(g, f); $ functional meet or join
97
98 if f = fom then return g;
99 elseif g = fom then return f;
100 elseif meet_flag then return [ f(1) * g(1), f(2) * g(2) ];
101 else return [ f(1) + g(1), f(2) + g(2) ];
102 end if;
103
104 end op .meetjoin;
105
106
107 op .mjv(x, y); $ meet or join of lattice elements
108
109 if x = xom then return y;
110 elseif y = xom then return x;
111 elseif meet_flag then return x * y;
112 else return x + y;
113 end if;
114
115 end op .mjv;
116
117
118 operator .of(f, x); $ functional application
119 return if x = xom or f = fom then xom
120 else f(1)*x + f(2)
121 end;
122 end operator .of;
123
124
125 drop
126 .comp,
127 interproc_fwd_analysis,
128 intraproc_fwd_analysis,
129 interproc_back_analysis,
130 intraproc_back_analysis,
131 fom,
132 xom;
133
134
135 end module setl_optimizer - dataflow_solver_syms;
136
137
1 .=member dfo13m
2
3
4 module setl_optimizer - dataflow_solver_ocrs;
5$
6$ this module is a duplicate of the preceding module. it differs in
7$ that it operates on the base of occurrences (ocrs) rather than on the
8$ base of symbols (syms).
9$
10$ this module contains a package of general purpose routines to solve
11$ bit vector data flow problems either intraprocedurally or inter-
12$ procedurally. we can distinguish between four basic types of such
13$ analyses, according to the character of the desired analysis:
14$
15$ forward - data is to be propagated in the direction of
16$ the flow, from procedure entries forward.
17$
18$ backward - data is to be propagated in the reverse
19$ direction of the flow, from exits backward.
20$
21$ meet - whenever two paths converge (for forward analysis)
22$ or diverge (for backward analysis) take the meet (set
23$ intersection) of data values propagated along these
24$ paths.
25$
26$ join - as in meet, except that the join (set union) of the
27$ corresponding data values is to be taken.
28$
29$ typical examples are: expression availability analysis
30$ is a forward - meet analysis; unconditional exposure
31$ of expressions (also known as 'very busy' expressions
32$ analysis) is a backward - meet analysis; reaching
33$ definitions analysis is a forward - join analysis, and
34$ live variables analysis is a backward - join analysis.
35$
36$ as noted in chapters 5 and 6, forward and backward analyses
37$ require substantially different logic, so that each of them
38$ is executed in a different subpackage; however, the
39$ difference between meet and join problems turns out to
40$ be rather minor, so that they both can be handled by
41$ the same (forward or backward) package, using a switch
42$ to indicate whether a particular analysis is of meet or
43$ join type.
44$
45$ this module exports the following procedures:
46$
47$ interproc_fwd_analysis - call this to solve interprocedural
48$ forward data flow analyses.
49$
50$ intraproc_fwd_analysis - call this to solve intraprocedural
51$ forward data flow analysis for a given
52$ procedure.
53$
54$ interproc_back_analysis - call this to solve interprocedural
55$ backward data flow analysis
56$
57$ intraproc_back_analysis - performs intraprocedural backward
58$ analysis for a given procedure.
59$
60$ this package assumes the following global objects to be
61$ available:
62$
63$ cgraph - the program call graph, represented as a set
64$ of edges; an edge (p,q) is in cgraph iff p is a
65$ procedure which contains a call to the procedure q.
66$
67$ routs - set of all program procedures (i.e. all nodes
68$ of the call graph).
69$
70$ sym_main - main-program identifier (i.e. the entry node of the
71$ call graph).
72$
73$ routof - maps each block to the procedure containing it.
74$
75$ rentry - maps each procedure to its entry block.
76$
77$ rexit - maps each procedure to its exit (return) block.
78$
79$ rstop - maps each procedure to its stop block, if any.
80$
81$ callsin - maps each procedure to the set of all call blocks
82$ in it.
83$
84$ callproc - maps each call block to the procedure it calls.
85$
86$ cessor - the program flow graph, as a union of the flow
87$ graphs of all procedures. an edge (m, n) is in
88$ cessor iff either m contains a branch to n, or else
89$ m is a call block and n is the block immediately
90$ following n. the nodes of the flow graph are either
91$ basic blocks or derived intervals (which are
92$ represented by their target blocks), in which case
93$ an edge (int, v) in cessor can indicate the possibility
94$ of a transfer of control from the interval int to a
95$ successor v of some node in int. these edges are called
96$ virtual edges (as above; see the interval
97$ analysis package for more details).
98$
99$ pred - the inverse map of cessor.
100$
101$ ints - maps each procedure to the tuple of its intervals
102$ in reverse preorder (relative to a depth first
103$ spanning tree of its flow graph).
104$
105$ int_nodes - maps each interval to the sequence of its nodes
106$ in interval order (i.e., reverse postorder).
107$
108$ proper_ints - the set of all proper intervals (those which do
109$ not contain irreducible nucleii).
110$
111$ intof - maps each flow graph node to the interval containing
112$ it.
113$
114$ vedges - set of all virtual edges (see the description of
115$ cessor above).
116$
117$ in addition this module uses the following global-within-
118$ the-module variables, the first three of which are used
119$ to transmit flags and analysis constants between inner routines,
120$ while the rest are built by a recursive depth-first search
121$ procedure during call-graph analysis, and are used later in that
122$ analysis.
123$
124 macro .comp; .comp_ocrs endm;
125 macro interproc_fwd_analysis; interproc_fwd_analysis_ocrs endm;
126 macro intraproc_fwd_analysis; intraproc_fwd_analysis_ocrs endm;
127 macro interproc_back_analysis; interproc_back_analysis_ocrs endm;
128 macro intraproc_back_analysis; intraproc_back_analysis_ocrs endm;
129 macro fom; fom_ocrs endm;
130 macro xom; xom_ocrs endm;
131
132 var
133 id, $ identity flow map
134 zero, $ null data state
135 meet_flag, $ true if meet analysis; otherwise false
136 seen, $ procedures already in dfst of cgraph
137 cnpre, $ current preorder index in dfst
138 cnpost, $ current postorder index in dfst
139 nodeno, $ preorder numbering map
140 postno, $ postorder numbering map
141 ndescs; $ no. of descendants map
142
143
144 repr
145 mode df_elmt: df_elmt_ocrs;
146 mode df_map: df_map_ocrs;
147
148 .meetjoin: operator(df_map, df_map) df_map;
149 .mjv: operator(df_elmt, df_elmt) df_elmt;
150 .of: operator(df_map, df_elmt) df_elmt;
151
152 interproc_fwd_eliminate: procedure(
153 remote smap(df_edge) df_map )
154 remote smap(df_node) df_map;
155 intraproc_fwd_eliminate: procedure(
156 routine,
157 remote smap(df_node) df_map,
158 remote smap(df_edge) df_map,
159 string )
160 boolean;
161 propagate_exposed: procedure(
162 routine,
163 remote smap(df_edge) df_map,
164 remote smap(df_node) df_map,
165 remote mmap{df_node} df_elmt,
166 remote mmap{df_node} df_elmt,
167 remote mmap{df_node} df_elmt
168 );
169 entry_info: procedure(
170 remote smap(df_edge) df_map,
171 remote smap(df_node) df_map,
172 boolean,
173 remote mmap{df_node} df_elmt )
174 remote smap(routine) df_elmt;
175 fwd_propagate_in: procedure(
176 routine,
177 remote smap(df_edge) df_map,
178 remote smap(df_node) df_map,
179 remote smap(df_node) df_elmt,
180 df_elmt,
181 boolean,
182 remote mmap{df_node} df_elmt
183 );
184 interproc_back_eliminate:
185 procedure(remote smap(df_edge) df_map)
186 remote smap(df_edge) df_map;
187 intraproc_back_eliminate:
188 procedure(
189 routine,
190 remote smap(df_edge) df_map,
191 remote smap(df_edge) df_map,
192 remote smap(routine) df_map,
193 * ) $$-- flow_flag
194 boolean;
195 intra_aux_eliminate: procedure(
196 routine,
197 remote smap(df_edge) df_map,
198 remote smap(df_edge) df_map,
199 remote smap(df_node) df_map
200 );
201 exit_info: procedure(
202 remote smap(df_edge) df_map,
203 remote smap(df_edge) df_map,
204 remote smap(df_node) df_map )
205 remote smap(routine) df_elmt;
206 back_propagate_in: procedure(
207 routine,
208 remote smap(df_node) df_map,
209 remote smap(df_node) df_elmt,
210 df_elmt
211 );
212
213
214 $ data structures for variables global to this module
215 id: df_map;
216 zero: df_elmt;
217 meet_flag: boolean;
218 cnpre: integer;
219 cnpost: integer;
220 nodeno: remote smap(routine) integer;
221 postno: remote smap(routine) integer;
222 ndescs: remote smap(routine) integer;
223 seen: remote set(routine);
224 end repr;
225
226
1 .=member efa13o
2
3 procedure interproc_fwd_analysis(rw f, wr soln, id_prm, zero_prm,
4 meet_flag_prm, move_code,
5 rw exposed, wr insert,safe);
6$
7$ note declarations of 'read-write' parameters ('rw') and 'write-only'
8$ parameters ('wr').
9$
10$ this is the master routine to perform a specific data flow
11$ analysis interprocedurally. its parameters are:
12$
13$ f - maps each edge (m, n) in the flow graph to a compact
14$ representation of its data-propagation map f(m,n).
15$ initially this information has to be provided only for
16$ basic blocks (but not for call blocks); the first phase
17$ of the analysis will fill in the additional entries.
18$ each f(m,n) is represented as a pair [a, b] in l x l,
19$ such that for each x in l, f(m,n)(x) = x*a + b, and
20$ a contains b (this latter condition ensures that the
21$ representation is unique, and also simplifies some
22$ functional manipulations).
23$
24$ soln- the solution vector for the analysis. soln maps each
25$ flow graph node to the data found to be known at its
26$ entry.
27$
28$ the next three parameters are transmitted internally between
29$ subprocedures by assigning them to global variables, as they
30$ are constant per analysis. the corresponding globals are:
31$
32$ id - the identity map representation. id = [u, {}], where
33$ u is the universal set over which bitvectors are taken
34$ in this analysis (e.g. set of all program expressions,
35$ set of all variables etc.)
36$
37$ zero - the initial data value, i.e. flow data assumed at the main
38$ program entry.
39$
40$ meet_flag - a flag indicating whether the analysis is a meet
41$ analysis or a join analysis.
42$
43$ aux_f - these are auxiliary propagation maps. for each flow
44$ graph node u, aux_f(u) denotes the effect of propagation
45$ from the entry to i, the interval containing u, through
46$ i, to the entry of u.
47$
48$ move_code - a flag indicating that code motion is required.
49$
50$ exposed - this is initially the set of computations (corresponding
51$ to analysis elements (bits)) exposed at the start of each
52$ basic block n (i.e. computed with no prior kill in n). the
53$ inner-to-outer phase of our analysis attaches an 'exposed'
54$ value to each interval processed. exposed{i} is the set of all
55$ expressions t for which there exists a computation of t
56$ within the interval i which would become redundant if and
57$ only if t became available at the entry to (the target block
58$ of) i. note, however, that the logical place at which
59$ computations movable out of an interval i should be inserted
60$ is the end of the target block of i, rather than its start.
61$ thus if that target block is nonempty then exposed{i}
62$ need not represent those movable computations. for this
63$ reason we provide the parameter 'insert' which gives the
64$ desired set of movable code.
65$
66$ insert - this output parameter will map each interval into
67$ the set of all computations movable out of its loop,
68$ which are to be inserted at the end of the target
69$ block of the interval. the actual insertion should be
70$ performed by the calling procedure.
71$
72$ our analysis procedures makes frequent use of the following
73$ operators (which could be also written as macros, if it were
74$ not for the convenience of the infix notation that we prefer
75$ to use):
76$
77$ .comp - functional composition
78$ .meetjoin - functional meet or join, depending on meet_flag
79$ .mjv - meet or join of lattice values
80$ .of - functional application
81$
82$ all these operators have elementary set expressions; see below
83$ for details.
84$
85$ note also that these operators must be prepared to handle
86$ undefined flow values, which will be represented
87$ by a special constant 'fom'; for example,
88$ g .comp fom = fom .comp g = fom;
89$ (concatenation of an undefined flow with a defined
90$ one is still undefined)
91$ g .meetjoin fom = fom .meetjoin g = g.
92$ (a join or a meet of an undefined flow with a defined
93$ flow yields the defined flow.)
94$
95$ another special constant 'xom' is used to denote the undefined data
96$ state in l.
97$
98 repr
99 $ data structures for parameters
100 f: remote smap(df_edge) df_map;
101 soln: remote smap(df_node) df_elmt;
102 id_prm: df_map;
103 zero_prm: df_elmt;
104 meet_flag_prm: boolean;
105 move_code: boolean;
106 exposed: remote mmap{df_node} df_elmt;
107 insert: remote mmap{df_node} df_elmt;
108 safe: remote mmap{df_node} df_elmt;
109
110 $ data structures for local variables
111 aux_f: remote smap(df_node) df_map;
112 ent_inf: remote smap(routine) df_elmt;
113 p: routine;
114 end repr;
115$
116$ transfer constant parameters to globals
117$
118 id := id_prm;
119 zero := zero_prm;
120 meet_flag := meet_flag_prm;
121$
122$ the master procedure consists of the following three phases:
123$
124$ 1. interprocedural elimination phase
125$
126 aux_f := interproc_fwd_eliminate(f);
127$
128$ if code motion is required then perform an additional
129$ phase, computing the sets of movable code.
130$
131 if move_code then
132 insert := {};
133 (forall p in routs)
134 propagate_exposed(p, f, aux_f, exposed, insert, safe);
135 end forall;
136 end if;
137$
138$ 2. find data at procedure entries
139$
140 ent_inf := entry_info(f, aux_f, move_code, insert);
141$
142$ 3. final propagation phase
143$
144 soln := {}; $ initialize the solution
145 (forall p in routs)
146 fwd_propagate_in(p, f, aux_f, soln, ent_inf(p),
147 move_code, insert);
148 end forall;
149
150 end procedure interproc_fwd_analysis;
151
152
1 .=member efe13p
2
3
4 procedure interproc_fwd_eliminate(rw f);
5$
6$ this is the driver routine for the first interprocedural
7$ inner-to-outer interval pass. procedures are analyzed in
8$ the following order: we process the strongly connected
9$ components of the call graph in their postorder; for each
10$ such component, we iterate through its procedures in their
11$ postorder, no more than 2*d+1 times, where d is the loop-
12$ interconnectedness parameter of the component.
13$
14 repr
15 $ data structures for parameters
16 f: remote smap(df_edge) df_map;
17
18 $ data structures for local variables
19 aux_f: remote smap(df_node) df_map;
20 i: integer;
21 scc: routine;
22 scc_procs: tuple(routine);
23 flow_flag: string;
24 j: integer;
25 proc_converge: boolean;
26 k: integer;
27 p: routine;
28 end repr;
29
30 aux_f := {}; $ initialize auxiliary maps
31
32$ iterate through the s.c.c.s of cgraph
33 (forall i in [ #cg_sccs, #cg_sccs-1..1 ])
34
35 scc := cg_sccs(i); $ get a s.c.c.
36 scc_procs := scc_nodes(scc); $ procs in that s.c.c.
37 flow_flag := 'first_inter'; $ first processing of the scc
38
39 (forall j in [ 1..2*scc_d(scc)+1 ])
40 proc_converge := true;
41
42 (forall k in [ #scc_procs, #scc_procs-1..1 ])
43 p := scc_procs(k);
44 proc_converge :=
45 intraproc_fwd_eliminate(p, aux_f, f, flow_flag)
46 and proc_converge;
47$ the intraproc_fwd_eliminate routine analyzes p; its fourth parameter
48$ indicates whether the analysis is first-time interprocedural, second
49$ -time interprocedural or intraprocedural; it returns a flag to
50$ indicate whether information in p has stabilized.
51 end forall k;
52
53 flow_flag := 'second_inter'; $ additional passes thru scc
54
55 if proc_converge then quit forall j; end;
56 end forall j;
57 end forall i;
58
59 return aux_f;
60
61 end procedure interproc_fwd_eliminate;
62
63
1 .=member afe13q
2
3
4 procedure intraproc_fwd_eliminate(p, rw aux_f, rw f, flow_flag);
5$
6$ this routine performs an intraprocedural elimination phase
7$ for the procedure p, using interval analysis. the fourth parameter
8$ indicates whether this routine has been invoked by the
9$ intraprocedural solver or by the interprocedural solver, and
10$ in the second case, whether this is the first time p is
11$ being processed or not.
12$
13$ in this pass we iterate through the procedure's intervals
14$ in an inner-to -outer order (i.e. in reverse preorder of their
15$ heads in a dfst of the flow graph of p). for each interval
16$ i processed in this manner we compute a set of data-propagation
17$ maps of the form f(i, u), where
18$
19$ (1) if u is in i, then this map is an auxiliary map (which will
20$ be denoted as aux_f(u), i being implicit in this case) which
21$ represents the propagation effect as control advances from
22$ the start of i, thru i, to the start of u;
23$
24$ (2) if u is not in i, then u is a successor of some node in i.
25$ here the map f(i, u) represents the propagation effect as control
26$ advances from the start of i, through i, to the start of u;
27$ in this case f(i, u) is needed for the processing of the
28$ intervals containing i. note that [i, u] is a virtual edge
29$ in our flow graph; thus the elimination phase extends the
30$ map f so as to be defined also on virtual edges.
31$
32$ any interval i processed in this routine is either a proper
33$ strongly connected interval, or, if it contains 'improper'
34$ nodes (i.e. nucleii of irreducibility), is a single-entry
35$ strongly connected subgraph. in the first case we only have to
36$ iterate thru the nodes of i twice, but in the second case till
37$ convergence.
38$
39$ the outermost 'interval' is either a single entry acyclic
40$ graph (if it does not contain irreducible nucleii), or a
41$ general single-entry graph otherwise. for this 'interval' we
42$ iterate either once in the first case, or till convergence
43$ otherwise.
44$
45$ if the present routine is to be used for interprocedural analysis,
46$ we first reset the propagation maps for call blocks in p. if none of
47$ these maps have changed from the last processing of p,
48$ then obviously analysis of p has stabilized and we can return
49$ immediately. moreover, intervals need be re-processed if and only
50$ if they contain a call block whose local effect has changed,
51$ or, recursively, contain an interval whose local effects
52$ have changed. in terms of the 'intof' tree, we only have to
53$ re-analyze intervals lying along some path from the
54$ root to a call block whose local effect has changed. this
55$ can make reprocessing of a procedure considerably
56$ faster than initial processing.
57$
58 repr
59 $ data structures for parameters
60 p: routine;
61 aux_f: remote smap(df_node) df_map;
62 f: remote smap(df_edge) df_map;
63 flow_flag: string;
64
65 $ data structures for local variables
66 need_process: set(df_node);
67 intt: df_node;
68 c: df_node;
69 v: df_node;
70 p1: routine;
71 ep1: df_node;
72 p_ints: tuple(df_node);
73 outint: df_node;
74 k: integer;
75 nodes: tuple(df_node);
76 head: df_node;
77 conv_control: boolean;
78 n_iter: integer;
79 j: integer;
80 d: integer;
81 convrgd: boolean;
82 nd: df_node;
83 ftemp: df_map;
84 pnd: df_node;
85 pv: df_node;
86 end repr;
87
88 if flow_flag = 'second_inter' then
89 $ process only intervals containing calls with new effect
90 need_process := {};
91 else
92 $ process all intervals
93 need_process := { intt : intt in ints(p) };
94 end if;
95
96 if flow_flag /= 'intra' then
97 $ interprocedural analysis
98 (forall c in callsin{p})
99 v := cessor(c); $ the block following the call
100 p1 := callproc(c); $ c calls p1
101 ep1 := rexit(p1); $ the return block of p1.
102$ (note here that if this routine is modified to include parameter-
103$ passing assignments as part of call blocks, in the manner suggested
104$ in a concluding remark in section 4, then one might manipulate
105$ aux_f(ep1), which defines the local effect of executing p1, to get
106$ f(c,v), rather than just assign the first map to the second one, as
107$ is done below).
108
109 if f([c, v]) /= aux_f(ep1) then
110 $ update flow function for call
111 f([c, v]) := aux_f(ep1) ? fom;
112
113 $ interval containing call must be processed
114 need_process with:= intof(c);
115 end if;
116 end forall c;
117
118 $ if no intervals need be processed then information has
119 $ stabilized and no re-processing of p need be done.
120 if need_process = {} then return true; end if;
121 end if;
122
123 p_ints := ints(p); $ intervals of p in reverse preorder
124 outint := p_ints(#p_ints); $ outermost interval
125
126 (forall intt = p_ints(k) | intt in need_process)
127 need_process with:= intof(intt); $ process containing interva
128 nodes := int_nodes(intt); $ nodes of intt in interval order
129
130 head := nodes(1); $ interval head
131 aux_f(head) := id; $ init aux_f of head to the identity
132$
133$ note here that the edge [intt, head] is a real edge in the
134$ flow graph, so that f([intt, head]) will have been pre-computed in
135$ an initialization phase, along with the flow maps for all other
136$ real edges, and is therefore available here.
137$
138$ three cases are now possible:
139$
140$ (1) intt is proper, but not outermost; then iterate twice.
141$ (2) intt is proper, and is outermost; then iterate once.
142$ (3) intt is improper; iterate indefinitely (1 + number of
143$ nodes is an adequate upper bound) until convergence.
144$ (note that we do not make use of the better upper bound on
145$ the number of iterations discussed in section 3).
146$
147 $ test for convergence only in this case
148 conv_control := intt notin proper_ints;
149
150 n_iter := $ maximal number of iterations
151 if intt notin proper_ints then #nodes + 1
152 elseif intt = outint then 1 else 2 end;
153$
154$ for improper intervals, initialize aux_f of all non-head nodes
155$ to 'fom'. this is because we cannot guarantee in those cases that
156$ when propagating data to a node within intt, all its predecessors
157$ (within intt) have already been processed, so that we have to
158$ prepare for the case where some of these predecessors still
159$ have undefined auxiliary data-flow maps.
160$
161 if conv_control then
162 (forall j in [ 2..#nodes ])
163 aux_f(nodes(j)) := fom;
164 end forall;
165 end if;
166
167 $ iterate through the nodes of intt
168 (forall d in [ 1..n_iter ])
169
170 convrgd := conv_control;
171
172 $ iterate thrugh the nodes of intt, other than head
173 (forall j in [ 2..#nodes ])
174
175 nd := nodes(j);
176 ftemp := fom;
177 (forall pnd in pred{nd} | intof(pnd) = intt)
178 ftemp .meetjoin:= (f([pnd,nd]) .comp aux_f(pnd));
179 end forall;
180
181 convrgd and:= (ftemp = aux_f(nd));
182 aux_f(nd) := ftemp;
183
184 end forall j;
185
186 $ test if processing of intt has terminated
187 if d = n_iter or convrgd then quit forall d; end if;
188
189 $ re-compute aux_f(head), taking back edges into account
190 ftemp := fom;
191 (forall pnd in pred{head} | intof(pnd) = intt)
192 ftemp .meetjoin:= (f([pnd,head]) .comp aux_f(pnd));
193 end forall;
194 ftemp .meetjoin:= aux_f(head);
195
196 if not conv_control then
197 convrgd := aux_f(head) = ftemp;
198 end if;
199
200 aux_f(head) := ftemp;
201 if convrgd then quit forall d; end if;
202 end forall d;
203
204$
205$ compute f([intt, v]), where v is a successor of some node in
206$ intt; note that this loop will be null for the
207$ outermost interval.
208$
209 (forall v in vedges{intt})
210 ftemp := fom;
211
212 (forall pv in pred{v} | intof(pv) = intt)
213 ftemp .meetjoin:= (f([pv,v]) .comp aux_f(pv));
214 end forall;
215
216 f([intt, v]) := ftemp .comp f([intt, head]);
217 end forall v;
218 end forall intt;
219
220 return false; $ to indicate no convergence
221
222 end procedure intraproc_fwd_eliminate;
223
224
1 .=member pex13r
2
3
4 procedure propagate_exposed(p, rw f, aux_f, rw exposed, rw insert,
5 safe);
6$
7$ this procedure performs an inner-to-outer pass over all
8$ intervals to determine the computations which might be moved
9$ out of the loop of each interval i. as explained above,
10$ these computations are not necessarily those exposed in i;
11$ hence, we build up both sets 'exposed' and 'insert'
12$ simultaneously.
13$
14$ in this analysis, the set of computations movable out of the
15$ loop of i is obtained by taking all computations t with
16$ the property that there exists a node nd in i such that
17$ t is exposed in nd and is available at the start of nd iff
18$ it is available at the end of the target block of i.
19$
20$ the movable code is always assumed to be appended to the
21$ end of the target block of the interval, to avoid any possible
22$ conflict with code that is already present in the target block.
23$ however, this appending takes place physically only at the end
24$ of the elimination phase. thus, we do not attempt to make
25$ use of the fact that these expressions are potentially
26$ available at the head of i in updating any flow function.
27$ this approach is necessary to ensure convergence of our algorithms
28$ in cases of recursive cycles of interprocedural flow.
29$
30 repr
31 $ data structures for parameters
32 p: routine;
33 f: remote smap(df_edge) df_map;
34 aux_f: remote smap(df_node) df_map;
35 exposed: remote mmap{df_node} df_elmt;
36 insert: remote mmap{df_node} df_elmt;
37 safe: remote mmap{df_node} df_elmt;
38
39 $ data structures for local variables
40 p_ints: tuple(df_node);
41 outint: df_node;
42 intt: df_node;
43 k: integer;
44 nodes: tuple(df_node);
45 head: df_node;
46 itemp: df_elmt;
47 nd: df_node;
48 ftarg: df_map;
49 expfromentry: df_elmt;
50 end repr;
51
52 p_ints := ints(p); $ intervals of p in reverse preorder
53$
54$ first extend f to indicate null flow from the entry block to
55$ itself. since the outermost interval has no target block,
56$ and is therefore identified with its head, this trick unifies
57$ the treatment of that interval with the treatment of inner
58$ intervals, as shown below.
59$
60 outint := p_ints(#p_ints);
61 f([outint, outint]) := id;
62
63 (forall intt = p_ints(k))
64 nodes := int_nodes(intt);
65 head := nodes(1);
66$
67$ in computing exposed{intt}, we must reckon with the fact
68$ that the target block of intt (also denoted by intt)
69$ might be non-empty, due to prior code motion. this can mean that
70$ (a) f([intt, head]) is not the identity, and (b) exposed{intt}
71$ (where intt is treated as a basic block) is not null
72$ initially.
73$
74 $ we proceed as follows: first find all exposed computations
75 $ in the loop of intt, assuming the target block of intt to
76 $ be null. these are the computations movable out of the loop
77 $ of intt.
78 itemp := {};
79 (forall nd in nodes)
80 itemp +:= (exposed{nd} * (aux_f(nd)(1) - aux_f(nd)(2)));
81 end forall;
82 if safe /= om then itemp := itemp * safe{intt}; end if;
83 insert{intt} := itemp;
84
85 $ next find the new set of computations which are still
86 $ exposed at the entry to the target block of intt.
87 ftarg := f([intt, head]);
88 expfromentry := insert{intt} * (ftarg(1) - ftarg(2));
89
90 $ add these computations to those exposed in the target block
91 exposed{intt} := exposed{intt} + expfromentry;
92
93 end forall intt;
94
95
96 end procedure propagate_exposed;
97
98
99
100
101 procedure entry_info(f, aux_f, move_code, insert);
102$
103$ this function calculates and returns a mapping which sends
104$ each procedure p into the flow information available at entry
105$ to p. it is called (only in the interprocedural case) just
106$ before we begin the final outer-to-inner propagation phase.
107$
108 repr
109 $ data structures for parameters
110 f: remote smap(df_edge) df_map;
111 aux_f: remote smap(df_node) df_map;
112 move_code: boolean;
113 insert: remote mmap{df_node} df_elmt;
114
115 $ data structures for local variables
116 cgf: smap( tuple(routine, routine) ) df_map;
117 p, q: routine;
118 c: df_node;
119 ftemp: df_map;
120 iu: df_node;
121 hiu: df_node;
122 fins: df_map;
123 ent_inf: remote smap(routine) df_elmt;
124 cgrinv: mmap(routine) routine;
125 i: integer;
126 scc: routine;
127 scc_procs: tuple(routine);
128 n: integer;
129 convrgd: boolean;
130 k: integer;
131 temp: df_elmt;
132 end repr;
133$
134$ first we construct a map 'cgf' assigning to each edge (p, q)
135$ of the call graph a data-propagation map, describing the
136$ propagation effect as control advances from the entry of p
137$ to the entry of q via any call to q from p.
138$
139 cgf := {};
140 (forall [p,q] in cgraph) cgf([p,q]) := fom; end;
141
142 (forall q = callproc(c)) $ for all calls within all procedures
143
144 p := routof(c); $ [p, q] is an edge of the call graph
145
146 $ compute the local effect as control advances from the entry
147 $ of p to c.
148 ftemp := aux_f(c);
149
150 (init iu := intof(c); while iu /= rentry(p))
151
152 hiu := int_nodes(iu)(1); $ head of iu
153 fins := id;
154 $ add also the effect of code moved out of iu
155 if move_code then fins(2) := insert{iu}; end;
156 ftemp := ftemp .comp fins .comp f([iu, hiu])
157 .comp aux_f(iu);
158
159 iu := intof(iu);
160
161 end;
162
163 cgf([p, q]) := cgf([p, q]) .meetjoin ftemp;
164
165 end forall q;
166$
167$ next we iterate through the call graph in 'invocation order', i.e.
168$ process the strongly connected components in reverse postorder and the
169$ set of procedures within each strongly connected component in reverse
170$ postorder also.
171$
172 ent_inf := { [ p, xom ] : p in routs}; $ initialize solution
173 ent_inf(sym_main) := zero;
174 cgrinv := { [ p, q ] : [ q, p ] in cgraph };
175
176 $ pick strongly-connected components in reverse postorder
177 (forall i in [ 2..#cg_sccs ])
178
179 $ nb. here we assume that the main program is non-recursive, so
180 $ that the first strongly-connected component of the call graph
181 $ consists of the main program only. thus we can skip it, for
182 $ the entry value of the main program is already assumed known.
183
184 scc := cg_sccs(i);
185 scc_procs := scc_nodes(scc); $ procs in scc in rev. postorder
186
187 (forall n in [ 1..scc_d(scc)+1 ] )
188
189 convrgd := true;
190
191 (forall p = scc_procs(k))
192
193 temp := xom;
194 (forall q in cgrinv{p})
195 temp .mjv:= (cgf([q,p]) .of ent_inf(q));
196 end forall;
197
198 $ test for convergence
199 convrgd and:= (temp = ent_inf(p));
200
201 ent_inf(p) := temp;
202 end forall p;
203
204 if convrgd then quit forall n; end if;
205 end forall n;
206 end forall i;
207
208 return ent_inf;
209
210 end procedure entry_info;
211
212
1 .=member fpi13s
2
3
4 procedure fwd_propagate_in(p, rw f, aux_f, rw soln, ent_val,
5 move_code, rw insert);
6$
7$ this procedure performs outer-to-inner propagation for a
8$ routine p, using the 'interval-effect' flow functions aux_f
9$ to modify the solution map 'soln'. the parameter ent_val
10$ gives the flow information assumed (or known) at procedure
11$ entry.
12$
13$ if code motion is required, then the computations in insert{i}
14$ are assumed to be available at the end of the target block
15$ of an interval i (but only for the purpose of propagation
16$ inside i). in addition, computations in insert{i} already
17$ available at exit from the target block of i are removed from
18$ insert{i}.
19$
20$ note that movable computations are assumed to be such that the
21$ insertion of any of them will not 'kill' any others.
22$
23 repr
24 $ data structures for parameters
25 p: routine;
26 f: remote smap(df_edge) df_map;
27 aux_f: remote smap(df_node) df_map;
28 soln: remote smap(df_node) df_elmt;
29 ent_val: df_elmt;
30 move_code: boolean;
31 insert: remote mmap{df_node} df_elmt;
32
33 $ data structures for local variables
34 p_ints: tuple(df_node);
35 outint: df_node;
36 k: integer;
37 intt: df_node;
38 nodes: tuple(df_node);
39 soln1: df_elmt;
40 u: df_node;
41 end repr;
42
43 soln(rentry(p)) := ent_val;
44 p_ints := ints(p); $ intervals of p in reverse preorder
45$
46$ extend f to indicate null flow from the entry block to
47$ itself. since the outermost interval has no target block,
48$ and is therefore identified with its head, this trick unifies
49$ the treatment of that interval with the treatment of inner
50$ intervals, as shown below.
51$
52 outint := p_ints(#p_ints);
53 f([outint, outint]) := id;
54
55 (forall k in [ #p_ints, #p_ints-1..1 ])
56
57 intt := p_ints(k);
58 nodes := int_nodes(intt); $ nodes of intt
59
60 soln1 := soln(intt); $ data value at entry to intt
61
62 $ convert soln1 to the data attribute value at the end of the
63 $ target block of intt.
64 $ propagate through the target block of intt; if
65 $ intt = outint, the trick noted above will make the following
66 $ statement a no-op.
67 soln1 := f([intt, nodes(1)]) .of soln1;
68
69 $ if code motion is also required, then update insert{intt}
70 $ and add it to soln1.
71 if move_code and intt /= outint then
72 insert{intt} := insert{intt} - soln1;
73 soln1 := soln1 + insert{intt};
74 end if;
75
76 $ now propagate attributes to the nodes of intt
77 (forall u in nodes)
78 soln(u) := aux_f(u) .of soln1;
79 end forall;
80
81 end forall;
82
83
84 end procedure fwd_propagate_in;
85
86
1 .=member afa13t
2
3
4 procedure intraproc_fwd_analysis(p, rw f, wr soln, id_prm, zero_prm,
5 meet_flag_prm, move_code,
6 rw exposed, wr insert, safe);
7$
8$ this is the master routine to perform a specific data flow
9$ analysis intraprocedurally for a given routine p, within which
10$ local variables are analyzed.
11$
12$ for more details and comments and description of parameters see the
13$ corresponding interprocedural analyser.
14$
15
16 repr
17 $ data structures for parameters
18 p: routine;
19 f: remote smap(df_edge) df_map;
20 soln: remote smap(df_node) df_elmt;
21 id_prm: df_map;
22 zero_prm: df_elmt;
23 meet_flag_parm: boolean;
24 move_code: boolean;
25 exposed: remote mmap{df_node} df_elmt;
26 insert: remote mmap{df_node} df_elmt;
27 safe: remote mmap{df_node} df_elmt;
28
29 $ data structures for local variables
30 aux_f: remote smap(df_node) df_map;
32 end repr;
33
34 id := id_prm;
35 meet_flag := meet_flag_prm;
36
37 aux_f := {};
38
39 intraproc_fwd_eliminate(p, aux_f, f, 'intra');
42
43 if move_code then
44 insert := {};
45 propagate_exposed(p, f, aux_f, exposed, insert, safe);
46 end if;
47
48 soln := {};
49 fwd_propagate_in(p, f, aux_f, soln, zero_prm, move_code, insert);
50
51 end procedure intraproc_fwd_analysis;
52
53
54
55
56 procedure interproc_back_analysis(rw f, wr soln, id_prm, zero_prm,
57 meet_flag_prm);
58$
59$ this is the master routine for performing a specific interprocedural
60$ backward data flow analysis. see the corresponding forward routine
61$ for general comments and a description of parameters. here we comment
62$ only on differences between the forward and backward algorithms, which
63$ are as follows:
64$
65$ a. functional composition must be computed in reverse order.
66$
67$ b. the auxiliary maps used in backward analysis are defined as
68$ follows: let i be an interval, u a node in i and v a node outside
69$ i which is a successor of a node in i. then aux_f([u, v]) is
70$ defined to be the propagation effect experienced as control
71$ advances from the start of u, through i, to the start of v.
72$
73$ to compute this map requires iterating through i in reverse
74$ interval order three times (if i is proper) or till convergence
75$ otherwise.
76$
77$ since the outermost interval of a procedure p has no successors,
78$ we regard the blocks rexit(p) and rstop(p) as its successors,
79$ 'hidden' inside that interval. this is needed to enable us to
80$ record the effect of the flow through the outermost interval in
81$ a manner similar to that used for inner intervals.
82$
83$ c. in backward analysis we perform an extra step after the
84$ elimination phase. in this step we compute an additional set
85$ 'fexit' of auxiliary maps. for each node u in p, fexit(u)
86$ represents the propagation effect of the flow from the start
87$ of u to the return block of p, combined with that of flow from
88$ the start of u to the stop block of p.
89$
90$ d. in our backward analysis code motion issues are completely
91$ ignored.
92$
93$ e. the technical problem concerning endless loops discussed in
94$ section 5 is assumed to be resolved by preliminary processing
95$ of the flow graph, in the manner suggested there.
96$
97 repr
98 $ data structures for parameters
99 f: remote smap(df_edge) df_map;
100 soln: remote smap(df_node) df_elmt;
101 id_prm: df_map;
102 zero_prm: df_elmt;
103 meet_flag_prm: boolean;
104
105 $ data structures for local variables
106 aux_f: remote smap(df_edge) df_map;
107 fexit: remote smap(df_node) df_map;
108 p: routine;
109 ex_inf: remote smap(routine) df_elmt;
110 end repr;
111
112 $ transfer constant parmeters to globals
113 id := id_prm;
114 zero := zero_prm;
115 meet_flag := meet_flag_prm;
116$
117$ this master procedure consists of the following four phases:
118$
119$ 1. interprocedural elimination phase
120$
121 aux_f := interproc_back_eliminate(f);
122$
123$ 2. compute auxiliary fexit maps.
124$
125 fexit := {};
126 (forall p in routs)
127 intra_aux_eliminate(p, f, aux_f, fexit);
128 end forall p;
129$
130$ 3. find data at procedure exits
131$
132 ex_inf := exit_info(f, aux_f, fexit);
133$
134$ 4. final propagation phase
135$
136 soln := {}; $ initialize the solution
137 (forall p in routs)
138 back_propagate_in(p, fexit, soln, ex_inf(p));
139 end forall;
140
141 end procedure interproc_back_analysis;
142
143
1 .=member ebe13u
2
3
4 procedure interproc_back_eliminate(rw f);
5$
6$ this is the driver routine for the interprocedural first
7$ inner-to-outer interval pass. procedures are analyzed in
8$ the following order: we process the strongly connected
9$ components of the call graph in their postorder; then, for each
10$ such component, we iterate through its procedures in their
11$ postorder, no more than 2*d+1 times, where d is the loop-
12$ interconnectedness parameter of the component.
13$
14 repr
15 $ data structures for parameters
16 f: remote smap(df_edge) df_map;
17
18 $ data structures for local variables
19 aux_f: remote smap(df_edge) df_map;
20 f_p: remote smap(routine) df_map;
21 i: integer;
22 scc: routine;
23 scc_procs: tuple(routine);
24 flow_flag: string;
25 j: integer;
26 proc_converge: boolean;
27 k: integer;
28 p: routine;
29 end repr;
30
31 aux_f := {}; $ initialize auxiliary maps
32 f_p := {}; $ propagation effect thru procedures
33
34 $ iterate through the s.c.c.s of cgraph
35 (forall i in [ #cg_sccs, #cg_sccs-1..1 ])
36 scc := cg_sccs(i); $ get a s.c.c.
37 scc_procs := scc_nodes(scc); $ procs in that s.c.c.
38 flow_flag := 'first_inter'; $ first processing of the scc
39
40 (forall j in [ 1..2*scc_d(scc)+1 ] )
41 proc_converge := true;
42
43 (forall k in [ #scc_procs, #scc_procs-1..1 ])
44 p := scc_procs(k);
45 proc_converge :=
46 intraproc_back_eliminate(p,aux_f,f,f_p,flow_flag)
47 and proc_converge;
48 $ this routine analyzes p; its fifth parameter
49 $ indicates whether the analysis is first-time
50 $ interprocedural, second-time interprocedural or
51 $ intraprocedural; it returns a flag to indicate
52 $ whether information has stabilized in p.
53 end forall k;
54
55 flow_flag := 'second_inter'; $ additional passes thru scc
56
57 if proc_converge then quit forall j; end if;
58 end forall j;
59 end forall i;
60
61 return aux_f;
62
63 end procedure interproc_back_eliminate;
64
65
1 .=member abe13v
2
3
4 procedure intraproc_back_eliminate(p, rw aux_f, rw f, rw f_p,
5 flow_flag);
6$
7$ this routine performs an intraprocedural elimination phase of a
8$ backward data flow analysis for a given procedure p.
9$
10$ the overall logic is quite similar to its sister routine
11$ 'intraproc_fwd_eliminate', and the reader should consult comments
12$ given there. the differences between these two phases reflects
13$ mainly the reverse tracing of flow, which implies several minor
14$ modifications of the forward approach, as follows:
15$
16$ a. auxiliary information is computed for each successor of each
17$ interval. that is, for each interval i, each node u in i, and
18$ each successor node v of i, we compute a map aux_f([u, v]),
19$ representing the flow from u through i to v. the outermost
20$ interval has no successors, but we regard the return block of p
21$ and the stop block of p (if any) as its two successors, even
22$ though they lie within it. (note that since these two nodes
23$ can never lie on a cycle through p, they must belong to the
24$ outer-most interval).
25$
26$ b. nodes of an interval are processed in reverse interval order
27$ (i.e. postorder); this is done three times if i is a proper
28$ inner interval, once if i is a proper outer-most inteval, and
29$ till convergence otherwise.
30$
31$ c. functional composition is taken in reverse edge order.
32$
33$ d. an additional data structure f_p is used to hold the propagation
34$ effect through the whole procedure in the interprocedural case.
35$ this is because the flow through p is actually combined of two
36$ flows: one leading to the return block of p, and another leading
37$ to the stop block of p, if any. unlike in the forward case,
38$ where the second flow can be, and is, actually ignored, here we
39$ must take it into account.
40$
41 repr
42 $ data structures for formal parameters
43 p: routine;
44 aux_f: remote smap(df_edge) df_map;
45 f: remote smap(df_edge) df_map;
46 f_p: remote smap(routine) df_map;
47 flow_flag: *;
48
49 $ data structures for local variables
50 need_process: set(df_node);
51 intt: df_node;
52 c: df_node;
53 v: df_node;
54 p1: routine;
55 p_ints: tuple(df_node);
56 outint: df_node;
57 sp: df_node;
58 k: integer;
59 nodes: tuple(df_node);
60 head: df_node;
61 cesors: sparse set(df_node);
62 conv_control: boolean;
63 n_iter: integer;
64 nd: df_node;
65 d: integer;
66 convrgd: boolean;
67 j: integer;
68 ftemp: df_map;
69 snd: df_node;
70 fzero: df_elmt;
71 end repr;
72
73
74 if flow_flag = 'second_inter' then
75 $ process only intervals containing calls with new effects
76 need_process := {};
77 else
78 $ process all intervals
79 need_process := { intt : intt in ints(p)}; $ convert to set
80 end if;
81
82 if flow_flag /= 'intra' then $ interprocedural analysis
83 (forall c in callsin{p})
84 v := cessor(c); $ the block following the call
85 p1 := callproc(c); $ c calls p1
86
87 $ (note that if this routine is modified to include
88 $ parameter-passing assignments as part of call blocks,
89 $ in the manner mentioned above, then one might manipulate
90 $ f_p(p1), the local effect of executing p1, to get
91 $ f([c, v]), rather than just assign f_p(p1)
92 $ to f([c, v]), as is done below).
93
94 if f([c, v]) /= f_p(p1) then
95 $ update flow function for call
96 f([c, v]) := f_p(p1) ? fom;
97
98 $ interval containing call must be processed
99 need_process with:= intof(c);
100 end if;
101 end forall c;
102
103 $ if no intervals need be processed then information has
104 $ stabilized and no re-processing of p need be done.
105 if need_process = {} then return true; end if;
106 end if;
107
108
109 p_ints := ints(p); $ intervals of p in reverse preorder
110 outint := p_ints(#p_ints); $ outermost interval
111 vedges{outint} := {rexit(p)}; $ 'successors' of outint
112 if (sp := rstop(p)) /= om then
113 vedges{outint} with:= sp;
114 end if;
115
116 (forall intt = p_ints(k) | intt in need_process)
117 need_process with:= intof(intt); $ process containing interva
118 nodes := int_nodes(intt); $ nodes of intt in interval order
119 head := nodes(1); $ interval head
120
121 $ get successor nodes
122 cesors := vedges{intt};
123
124 $ initialize aux_f for successor nodes. this trick simplifies
125 $ subsequent code considerably.
126 (forall v in cesors)
127 aux_f([v, v]) := id;
128 end forall v;
129
130$
131$ three cases are now possible:
132$ a. intt is proper, but not outermost; then iterate three times.
133$ b. intt is proper, and is outermost; then iterate once.
134$ c. intt is improper; iterate indefinitely (1 + 2*number of
135$ nodes is an adequate upper bound) until convergence. (here,
136$ again, a better bound can be used; cf. section 6).
137$
138 $ we test for convergence only for improper intervals.
139 conv_control := intt notin proper_ints;
140
141 n_iter := $ maximal number of iterations thru nodes of intt
142 if intt notin proper_ints then 1 + 2 * #nodes
143 elseif intt = outint then 1 else 3 end;
144
145 (forall nd in nodes, v in cesors | nd /= v)
146 aux_f([nd, v]) := fom;
147 end forall;
148
149 $ iterate through the nodes of intt.
150 (forall d in [ 1..n_iter ])
151 convrgd := conv_control;
152
153 $ iterate thrugh the nodes of intt in reverse interval
154 $ order.
155 (forall j in [ #nodes, #nodes-1..1 ])
156 nd := nodes(j);
157
158 (forall v in cesors | v /= nd)
159
160 $ since the 'successors' of the outermost interval
161 $ are nodes of that interval, we may have nd = v.
162 $ in this case it would be erroneouss to compute
163 $ aux_f([nd, v]) (which has already been set to
164 $ id) using the following 'propagation from
165 $ successors' formula, so we just skip such cases.
166
167 ftemp := fom;
168 (forall snd in cessor{nd} |
169 intof(snd) = intt or snd = v)
170 ftemp .meetjoin:=
171 (f([nd,snd]) .comp aux_f([snd,v]));
172 end forall;
173
174 $ note that flow graph edges (virtual or real) are
175 $ either edges within an interval, linking two
176 $ nodes in the same interval, or edges going out
177 $ of an interval, or edges going into an interval
178 $ (these last edges are edges from (a target block
179 $ of) an interval to its head. it is this third
180 $ kind of edge that we wish to avoid propagating
181 $ through in the above formula.
182 $ 'intof(snd) = intt' tests for internal edges
183 $ and 'snd = v' tests for outgoing edges whose
184 $ target is v.
185
186 convrgd and:= (ftemp = aux_f([nd, v]));
187 aux_f([nd, v]) := ftemp;
188 end forall;
189 end forall;
190
191 if convrgd then quit forall d; end if;
192 end forall;
193 $ (note that no special handling of intt's head is required.)
194
195 $ except for the outermost interval, compute f([intt, v]),
196 $ where v is a successor of some node in intt.
197 if intt /= outint then
198 $ f([intt, v]) is trivially calculated in this case; we
199 $ also remove the dummy aux_f([v, v]) entries.
200 (forall v in cesors)
201 f([intt, v]) :=
202 f([intt, head]) .comp aux_f([head, v]);
203 aux_f([v, v]) := om;
204 end forall;
205 end if;
206 end forall;
207
208 f_p(p) := aux_f([head, rexit(p)]); $ head = rentry(p)
209
210 $ if p contains a stop block, calculate propogation effect to that
211 $ block and combine it with 'normal' flow effect.
212 if rstop(p) /= om then
213 fzero := aux_f([head, rstop(p)]) .of zero;
214 f_p(p) := f_p(p) .meetjoin [fzero, fzero];
215 $ note that a constant function c is represented by [c, c]
216
217 end if;
218
219 $ remove artificial edges added earlier
220 vedges{outint} := {};
221
222 return false; $ to indicate no convergence
223
224 end procedure intraproc_back_eliminate;
225
226
1 .=member axe13w
2
3
4 procedure intra_aux_eliminate(p, f, aux_f, rw fexit);
5$
6$ this procedure performs an additional intraprocedural elimination,
7$ during which we compute, for each node n in p, a map fexit(n) repre-
8$ senting the effect of flow from the start of n up to an exit of p.
9$
10 repr
11 $ data structures for formal parameters
12 p: routine;
13 f: remote smap(df_edge) df_map;
14 aux_f: remote smap(df_edge) df_map;
15 fexit: remote smap(df_node) df_map;
16
17 $ data structures for local variables
18 p_ints: tuple(df_node);
19 outint: df_node;
20 ep: df_node;
21 sp: df_node;
22 outnodes: tuple(df_node);
23 nd: df_node;
24 i: integer;
25 fzero: df_elmt;
26 ftemp: df_map;
27 j: integer;
28 intt: df_node;
29 cesors: sparse set(df_node);
30 nodes: tuple(df_node);
31 k: integer;
32 v: df_node;
33 end repr;
34
35 p_ints := ints(p);
36 outint := p_ints(#p_ints);
37 ep := rexit(p);
38 sp := rstop(p);
39$
40$ first process nodes of outint
41$
42 outnodes := int_nodes(outint);
43
44 (forall nd = outnodes(i))
45
46 fexit(nd) := aux_f([nd, ep]); $ get the effect of flow to ep
47
48 if sp /= om then $ if there is also a stop block
49
50 fzero := aux_f([nd, sp]) .of zero;
51 ftemp := if fzero = xom then fom else [ fzero, fzero ] end;
52 fexit(nd) := fexit(nd) .meetjoin ftemp;
53
54 end if;
55 end forall nd;
56$
57$ next process all remaining intervals in outer-to-inner order
58$
59 (forall j in [ #p_ints-1, #p_ints-2..1 ])
60
61 intt := p_ints(j);
62 cesors := vedges{intt};
63
64 nodes := int_nodes(intt);
65 (forall nd = nodes(k))
66 ftemp := fom;
67 (forall v in cesors)
68 ftemp .meetjoin:= (aux_f([nd,v]) .comp fexit(v));
69 end forall;
70 fexit(nd) := ftemp;
71 end forall nd;
72 end forall j;
73
74
75 end procedure intra_aux_eliminate;
76
77
1 .=member xnf13x
2
3
4 procedure exit_info(f, aux_f, fexit);
5$
6$ this function calculates and returns a mapping which sends
7$ each procedure p into the flow information available at exit
8$ from p. it is called (only in the interprocedural case) just
9$ before we begin the final outer-to-inner propagation phase.
10$
11 repr
12 $ data structures for formal parameters
13 f: remote smap(df_edge) df_map;
14 aux_f: remote smap(df_edge) df_map;
15 fexit: remote smap(df_node) df_map;
16
17 $ data structures for local variables
18 cgf: smap( tuple(routine, routine) ) df_map;
19 p, q: routine;
20 c, c1: df_node;
21 ex_inf: remote smap(routine) df_elmt;
22 cgrinv: mmap(routine) routine;
23 i: integer;
24 scc: routine;
25 scc_procs: tuple(routine);
26 n: integer;
27 convrgd: boolean;
28 k: integer;
29 temp: df_elmt;
30 end repr;
31$
32$ first we construct a map 'cgf' assigning, to each edge (p, q) of the
33$ call graph, a data-propagation map describing the propagation effect
34$ as control returns from the exit of q to p after any call in p to q,
35$ and then advances to the exit of p.
36$
37 cgf := {};
38 (forall [ p, q ] in cgraph) cgf([p,q]) := fom; end forall;
39
40 (forall q = callproc(c)) $ for all calls within all procedures
41 p := routof(c); $ [p, q] is an edge of the call graph
42 c1 := cessor(c); $ c1 is the block following c
43 cgf([p, q]) := cgf([p, q]) .meetjoin fexit(c1);
44
45 $ note that since we are dealing with a backward analysis, we
46 $ want to propagate data from the exit of the calling procedure
47 $ p to the exit of the called procedure q. this direction of
48 $ propagation, however, makes our problem a forward problem for
49 $ the call graph.
50
51 end forall;
52$
53$ next we iterate through the call graph in 'invocation order', i.e.
54$ process the strongly connected components in reverse postorder and the
55$ set of procedures within each strongly connected components in reverse
56$ postorder also.
57$
58 ex_inf := { [ p, xom ] : p in routs }; $ initialize solution
59 ex_inf(sym_main) := zero;
60 cgrinv := { [ p, q ] : [ q, p ] in cgraph };
61
62 $ pick strongly-connected components in reverse postorder
63 (forall i in [ 2..#cg_sccs ])
64
65 $ note that we assume here that the main program is non-recur-
66 $ sive, so that the first strongly-connected component of the
67 $ call graph consists of the main program only. thus we need
68 $ not process it, for the exit value of the main program is
69 $ already assumed known.
70
71 scc := cg_sccs(i);
72 scc_procs := scc_nodes(scc); $ procs in scc in rev. postorder
73
74 (forall n in [ 1..scc_d(scc)+1 ] )
75 convrgd := true;
76 (forall p = scc_procs(k))
77 temp := xom;
78 (forall q in cgrinv{p})
79 temp .mjv:= (cgf([q,p]) .of ex_inf(q));
80 end forall;
81
82 $ test for convergence
83 convrgd and:= (temp = ex_inf(p));
84 ex_inf(p) := temp;
85
86 end forall p;
87
88 if convrgd then quit forall n; end if;
89 end forall n;
90 end forall i;
91
92 return ex_inf;
93
94 end procedure exit_info;
95
96
1 .=member bpi13y
2
3
4 procedure back_propagate_in(p, fexit, rw soln, ex_val);
5$
6$ this procedure performs outer-to-inner back propagation for
7$ a routine p, using the 'fexit' information. ex_val is the flow
8$ information assumed (or known) at the procedure return block,
9$ where 'zero' is always assumed at the stop block of p (but this
10$ assumption has already been used in calculating the fexit maps).
11$
12 repr
13 $ data structures for formal parameters
14 p: routine;
15 fexit: remote smap(df_node) df_map;
16 soln: remote smap(df_node) df_elmt;
17 ex_val: df_elmt;
18
19 $ data structures for local variables
20 intt: df_node;
21 u: df_node;
22 end repr;
23
24 (forall intt in ints(p), u in int_nodes(intt))
25 soln(u) := fexit(u) .of ex_val;
26 end forall;
27
28 end procedure back_propagate_in;
29
30
31
32
33 procedure intraproc_back_analysis(p, rw f, wr soln,
34 id_prm, zero_prm, meet_flag_prm);
35$
36$ this is the master routine to perform a specific backward data flow
37$ analysis intraprocedurally for a routine p whose local variables are
38$ to be analyzed. for more details, comments, and description of para-
39$ meters see the corresponding interprocedural analyser.
40$
41 repr
42 $ data structures for formal parameters
43 p: routine;
44 f: remote smap(df_edge) df_map;
45 soln: remote smap(df_node) df_elmt;
46 id_prm: df_map;
47 zero_prm: df_elmt;
48 meet_flag_prm: boolean;
49
50 $ data structures for local variables
51 aux_f: remote smap(df_edge) df_map;
52 f_p: remote smap(routine) df_map;
54 fexit: remote smap(df_node) df_map;
55 end repr;
56
57 id := id_prm;
58 zero := zero_prm;
59 meet_flag := meet_flag_prm;
60
61 aux_f := {}; f_p := {};
62
63 intraproc_back_eliminate(p, aux_f, f, f_p, 'intra');
65
66 fexit := {};
67 intra_aux_eliminate(p, f, aux_f, fexit);
68
69 soln := {};
70 back_propagate_in(p, fexit, soln, zero);
71$
72$ note that in the intraprocedural case the last two procedures
73$ can be combined to form a single procedure almost identical
74$ with 'intra_aux_eliminate', except that this procedure computes the
75$ 'soln' map directly instead of the 'fexit' maps.
76$
77 end procedure intraproc_back_analysis;
78
79
80
81$
82$ here are the operators which manipulate the data propagation maps
83$ and data states.
84$
85 op .comp(g, f); $ functional composition g of f
86
87 if f = fom or g = fom then
88 return fom;
89 else
90 return [ f(1) * g(1) + g(2), f(2) * g(1) + g(2) ];
91 end if;
92
93 end op .comp;
94
95
96 op .meetjoin(g, f); $ functional meet or join
97
98 if f = fom then return g;
99 elseif g = fom then return f;
100 elseif meet_flag then return [ f(1) * g(1), f(2) * g(2) ];
101 else return [ f(1) + g(1), f(2) + g(2) ];
102 end if;
103
104 end op .meetjoin;
105
106
107 op .mjv(x, y); $ meet or join of lattice elements
108
109 if x = xom then return y;
110 elseif y = xom then return x;
111 elseif meet_flag then return x * y;
112 else return x + y;
113 end if;
114
115 end op .mjv;
116
117
118 operator .of(f, x); $ functional application
119 return if x = xom or f = fom then xom
120 else f(1)*x + f(2)
121 end;
122 end operator .of;
123
124
125 drop
126 .comp,
127 interproc_fwd_analysis,
128 intraproc_fwd_analysis,
129 interproc_back_analysis,
130 intraproc_back_analysis,
131 fom,
132 xom;
133
134
135 end module setl_optimizer - dataflow_solver_ocrs;
136
137
1 .=member tfnd14
2$
3$ this module determines the 'type' of every occurrence in the program.
4$ its output is a map called 'typ' which sends each occurrence into a
5$ tuple with the following fields:
6$
7$ 1. grosstyp
8$
9$ a set of strings indicating all possible 'real types' an
10$ object might take on over different program paths.
11$
12$ the 'real type' of an occurrence is a string such as 'int'
13$ or 'real' which we might get by applying the setl 'type'
14$ operator to the occurence. the possible real types are:
15$ 'int', 'real', 'string', 'atom', 'tuple', and 'set'.
16$
17$ 2. comptyp
18$
19$ this field contains recursive information on the component
20$ types of sets and tuples. it is interpreted in one of two
21$ ways depending on the value of 'is_knt' (see below).
22$
23$ is_knt = true: comptyp is a tuple whose i-th component is a
24$ type descriptor for the i-th component type.
25$
26$ is_knt = false: comptyp is a type descriptor for the component
27$ type of the set or tuple.
28$
29$ 3. is_knt
30$
31$ a boolean predicate which is true for known-length tuples.
32$
33$ 4. is_om
34$
35$ this is a three valued field, indicating whether the object
36$ is definitely omega, definitely not omega, or possibly omega.
37$ the values of this field are given by the constants yes, no,
38$ and maybe.
39$
40$ is_om is used as follows:
41$
42$ a. a set or tuple is considered to be null iff its component
43$ type is definitely omega.
44$
45$ b. a tuple is considered to be a pair iff its first 2 components
46$ are definitely not omega and its remaining components
47$ definitely are.
48$
49$ c. a set can be stored as a map iff its elements are definitely
50$ pairs.
51$
52$ the type finder exports three predicates for making the above
53$ tests. these predicates are called is_null, is_pair, and
54$ is_map. like the is_om field they have values of yes, no, and
55$ maybe.
56$
57$ at the end of the algorithm the type of each ovariable is defined by
58$ the instruction which defines it, while the type of each ivariable
59$ is a function of its use and the definitions and uses of all
60$ occurrences it is linked to.
61$
62$ we may wind up with two occurrences 'o' and 'i' which are linked by
63$ bfrom but have different types. this means that the code generator
64$ must insert a conversion along the path from 'o' to 'i'. the type
65$ fider checks whether such a conversion would be legal, and gives an
66$ error message if it would not.
67$
1 .=member tla14a
2
3
4$ the type lattice
5$ -----------------
6
7$ the best way to understand the type finder is to think about
8$ a simplified version in which type descriptors are pairs
9$ [ grosstyp, comptyp ]. these simple type descriptors form a lattice
10$ of information states, in which 'vagueness' increases towards the
11$ top.
12$
13$ before studying the actual algorithm we will review a few things
14$ about the lattice:
15$
16$ 1. the basic points on the lattice correspond to the standard types
17$ such as int, real, and string. the set of type descriptors with a
18$ given grosstyp form a sublattice. the lattice is essentially
19$ infinite. however, we can make the lattice finite by enforcing a
20$ nesting limit on type descriptors, and by treating all known-length
21$ tuples beyond a certain length as unknown length tuples.
23$
24$ 2. the basic types such as int and real are somewhere near the bottom
25$ of the lattice. 'union' types are somewhere near the top.
27$
28$ 3. the lattice has a maximal type, called 'type_gen'. this point
29$ corresponds to the union of all types. types belonging to this
30$ grosstyp are always represented by a set containing all other
31$ basic types.
32$
33$ 4. the lattice also has a minimal type, called 'type_zero'.
34$ the significance of type_zero is different in different
35$ parts of the algorithm.
36$
37$ at the end of the first or 'forward' pass an occurrence with
38$ type_zero corresponds to a use of an uninitialized variable.
39$ at the end of the second or 'backward' pass an occurrence
40$ with type_zero corresponds to the result of an instruction
41$ whose input types are incompatible.
42$
43$ note that type_zero does not correspond to omega.
44$
45$ 5. the 'conjunction'('and', 'intersection') of two lattice elements
46$ is always a point lower in the lattice. the 'disjunction'('or',
47$ 'union') is always a point higher on the lattice.
48$
49$ problems with the simplified type finder
50$ ----------------------------------------
51$
52$ the type descriptors discussed above give relatively crude information
53$ about the type of an occurrence. there are several additional
54$ attributes which one might consider part of a 'type'. these include:
56$
57$ 1. whether an occurrence is definitely om, possibly om, or definitely
58$ not om. this information is useful since it allows us to distin-
59$ guish between pairs and non-pairs, and thus between sets and maps.
61$
62$ 2. the range of values for integers.
63$
64$ (1) is extremely important: we cannot do automatic data structure
65$ selection without it. (2) is less important, and is currently
66$ ignored.
67$
68$ the extra attributes can be saved separately, i.e. as separate fields
69$ of a type descriptor, or can be added as new points on the lattice.
70$ at first the latter solution seemed to make the lattice too complex
71$ to understand, but eventually was chosen because it is more elegant
72$ and also simplifies the the algorithm.
73$
74$
75$ basic algorithm
76$ ---------------
77$
78$ the type finder consists of three passes, called the forward,
79$ backward, and final passes. the forward and backward passes do the
80$ actual type determination using standard workpile propagation
81$ algorithms. the final phase does cleanup and error detection.
82$
83$ the forward pass starts by initializing the types of all ivariables
84$ whose values are known. it then calculates the type of every
85$ ovariable as a function of its ivariables and the operation which
86$ creates them. it calculates the type of ivariables i as the
87$ disjunction of the types of all oi in bfrom{i}.
88$
89$ the second or backwards pass refines the information gathered by the
90$ forward pass. for example, if we have:
94$
95$ (1) x := i + j;
96$ (2) t := [1, 2];
97$ (3) print(t(i));
98$
99$ then the forward pass will give us:
100$
101$ typ(x1) = typ(i1) = typ(j1) = int, real, string, tuple, or set.
102$ typ(t2) = tuple
103$ typ(t3) = tuple
104$ typ(i3) = int, real, string, tuple, or set.
105$
106$ backwards analysis will tell us that if the program is correct then
107$ typ(i3) and therefore typ(i1) must be integer. furthermore, typ(x1)
108$ and typ(j1) must be integer as well.
109$
110$ as another example,
111$
112$ (4) read(a);
113$ (5) b := a + '1';
114$
115$ here forward analysis will tell us that typ(b5) is string, and
116$ backward analysis will tell us that typ(a5) and therefore typ(a4) must
117$ also be string. clearly we must check the type of a somewhere between
118$ between the time it is read and the time it is used. the mechanism
119$ for inserting this type test is as follows:
121$
122$ in the final version of the "types" map returned by the type finder,
123$ the type of an ivariable will be its backward type, whereas the type
124$ of an ovariable will be the type determined only by its forward
125$ propagation of the final types of its ivariables. (thus, e.g., read
126$ ovariables will still have type general.) thus a4 will receive a
127$ type of general, and a5 will receive a type of string. when name
128$ splitting is performed, we will see that it is necessary to split a
129$ into two separate variables, "a" with type general, and "a.1" with
130$ type string. we will then insert an assignment "a.1 := a" at some
131$ optimal point between (4) and (5).
133$
1 .=member tmn14b
2
3
4 module setl_optimizer - typfind;
5
6
7 var vtyp, $ maps variables to their given type
smff 1 work, $ work pile for forward and backward propagation
smff 3 maxtype_sargs, $ maps system routine arguments to their
smff 4 $ upper bounds.
8 stck, $ stack of occurrences in depth-first search
9 npre, $ preorder index in depth first search
10 preorder, $ preorder map in depth first search
11 nstck, $ length of stack
12 place, $ virtual place in stack of component roots
13 nlev, $ level number for ocuurrences in search
14 occ_sccs, $ tuple of strongly-connected comps
15 occ_graph, $ flow graph of occurrences
16 oscc_nodes; $ maps each s.c.c. to a tuple of its nodes
17 $ in reverse postorder
18
19 const $ various gross types
20 grstup = { t_tuple },
21 grsset = { t_set },
22 grsmap = { t_map };
23
24
25 repr
26 vtyp: sparse smap(symbol) elmt types;
smff 2 work: set(tuple(string, general));
smff 5 maxtype_sargs: sparse smap(symbol) tuple(elmt types);
27 stck: tuple(occurrence);
28 npre: integer;
29 preorder: remote smap(occurrence) integer;
30 nstck: integer;
31 place: remote smap(occurrence) integer;
32 nlev: remote smap(occurrence) integer;
33 occ_sccs: tuple(occurrence);
34 occ_graph: remote mmap(occurrence) occurrence;
35 oscc_nodes: smap(occurrence) tuple(occurrence);
36 grstup, grsset, grsmap: gross_type;
37
38 .con: operator(elmt types, elmt types)
39 elmt types;
40 .dis: operator(elmt types, elmt types)
41 elmt types;
42 .sub: operator(elmt types, elmt types)
43 elmt types;
44
45 type_forward: procedure;
46 type_backward: procedure;
47 type_final: procedure;
48
49 forward: procedure(occurrence) elmt types;
50 backward: procedure(elmt insts)
51 tuple(elmt types);
52 type_constant: procedure(elmt insts) string;
smfe 28
smfe 29 string_length: procedure(elmt types) integer;
smfd 3 constant_equality: procedure(elmt types, elmt types)
smfd 4 boolean;
53
54 given_type: procedure(elmt forms) elmt types;
55 dfs: procedure(occurrence);
56 const_typ: procedure(general) elmt types;
57 ntyp: procedure(
58 gross_type,
59 elmt types )
60 elmt types;
61 knt_type: procedure( tuple(elmt types) )
62 elmt types;
64 pair_type: procedure(elmt types, elmt types)
65 elmt types;
66 trim: procedure(elmt types, integer)
67 elmt types;
68 norm: procedure(elmt types);
69 ads_type: procedure(elmt types) elmt types;
70 end repr;
71
72
73 procedure type_find;
74$
75$ this is the main routine of the type finder. it initializes various
76$ tables then calls the individual passes of the type finder.
78$
79 repr
smfg 86 r: routine;
smfg 87 b: elmt blocks;
smfg 88 i1, i2: elmt insts;
smfg 89 oi, vox, voy: occurrence;
smfg 90 tp: elmt types;
83 end repr;
84
85 title('cims.setl.' + prog_level + ' - type finder');
86 printa(term_file, ' - type finder');
87
90 $ initialize output object
91 typ := {};
92
93 $ initialize maps global to the module
smff 6 vtyp := {}; work := {}; maxtype_sargs := {};
95
96 type_forward; $ forward analysis
97$$++
smfc 607 if 't' in dump_string and 'z' in dump_string then
99 print;
100 print('variable occurrence forward type');
101 print('--------------------------------------');
102 prints('',
103 [ [ rpad(oi_name(oi),12) + ' ' + rpad(oi_str(oi),12),
104 format_type(tp) ] : tp = typ(oi) ] );
105 end if;
106$$--
107 type_backward; $ backward analysis
108$$++
smfc 608 if 't' in dump_string and 'z' in dump_string then
110 print;
111 print('variable occurrence backward/forward type');
112 print('-----------------------------------------------');
113 prints('',
114 [ [ rpad(oi_name(oi),12) + ' ' + rpad(oi_str(oi),12),
115 format_type(tp) ] : tp = typ(oi) ] );
116 end if;
117$$--
118 type_final; $ check for type errors and finalize
119 $ the type of all o-variables.
120$$++
smfc 609 if 't' in dump_string and 'z' in dump_string then
122 print;
123 print('variable occurrence final type');
124 print('------------------------------------');
125 prints('',
126 [ [ rpad(oi_name(oi),12) + ' ' + rpad(oi_str(oi),12),
127 format_type(tp) ] : tp = typ(oi) ] );
128 end if;
129$$--
smfg 91
smfg 92 (forall r in routs)
smfg 93 (for_block(b, r))
smfg 94 i1 := om;
smfg 95 (for_inst(i2, b))
smfg 96 if opcode(i2) = q1_isom or opcode(i2) = q1_notom then
smfg 97 vox := get_oi(i2, 1);
smfg 98 (forall voy in bfrom{vox})
smfg 99 ffrom less:= [ voy, vox ];
smfg 100 (forall oi in ffrom{vox})
smfg 101 bfrom less:= [ oi, vox ];
smfg 102 bfrom with:= [ oi, voy ]; ffrom with:= [ voy, oi ];
smfg 103 end forall;
smfg 104 if vox in bfrom_dead then bfrom_dead with:= voy; end if;
smfg 105 end forall;
smfg 106 bfrom lessf:= vox; ffrom lessf:= vox; bfrom_dead less:= vox;
smfg 107 typ lessf:= vox;
smfg 108 del_inst(i2, i1, b);
smfg 109 end if;
smfg 110 i1 := i2;
smfg 111 end; $ end for_inst;
smfg 112 end; $ end for_block;
smfg 113 end forall;
130
131 (forall tp = typ(oi))
132 typ(oi) := ads_type(tp);
133 end forall;
134
135
136 $ delete the static variables global to the module
smff 7 vtyp := om; work := om; maxtype_sargs := om;
138
139 if 't' in dump_string then
142 print;
143 print('variable occurrence type');
144 print('------------------------------');
145 prints('',
146 [ [ rpad(oi_name(oi),12) + ' ' + rpad(oi_str(oi),12),
147 format_type(tp) ] : tp = typ(oi) ] );
152 end if;
153
154 statistics with:= time; $ save time for final statistics
159
160
161 end procedure type_find;
162
163
1 .=member tyf14c
2
3
4 procedure type_forward;
5$
6$ this is the first, or forward propagation phase of the type finder.
7$ it consists of two sections. the first section initializes the work
8$ pile, and the second propagates types forward through the program
9$ until the work pile is empty.
10$
11$ work pile initialization
12$ ------------------------
13$
14$ the work pile is a set of pairs [ act, oi ] where oi is an occurrence
15$ whose type is to be calculated, and act is the method of calculating
16$ oi's type.
17$
18$ 1. 'fwd':
19$
20$ here oi is an ovariable, and we calculate its type as a function
21$ of the type of the inputs to the instruction which defines it.
23$
24$ 2. 'bfrm'
25$
26$ here oi is an ivariable, and we calculate its type as the
27$ disjunction of all i in bfrom{oi}.
28$
29$
30$ we initialize the workpile by iterating over all occurrences looking
31$ for three cases:
32$
33$ 1. constant ivariables. here we simply set the type of the ivariable.
34$
35$ 2. ovariables whose type is uniquely determined by its opcode. for
36$ example, if we have 't := # s' then t must be an integer. in this
37$ case we set the type of t and make workpile entries of the form
38$ ['bfrm', i], i in ffrom{t}.
39$
40$ 3. ovariables which have at least one constant ivariable. here we add
41$ ['fwd', o] to the workpile.
42$
43$ the type finder can also take into account user-supplied reprs. they
44$ are used as upper bounds for actual computed types. therefore only
45$ this forward typefinding phase (in which computed types 'grow' in
46$ their lattice) and the final type propagation phase need manipulate
47$ these given types; the backward propagation phase ignores these
48$ types, as it only tries to make types smaller in their lattice.
50$
51$ we prepare for the handling of these types by computing a map 'vtyp',
52$ mapping each progam variable to its given type. this type is computed
53$ from the form of the variable by the recursive function 'given_type',
54$ in which some data-form details may be lost.
56$
smfe 30 init
smfe 31 back_count := 0,$ counts the number of times backward is called.
smfe 32 maxtype := {}; $ maps opcodes to the upper bound for its
smfe 33 $ operand types.
57 repr
58 sc: elmt base_scopes;
59 v: symbol;
60 occ_roots: sparse set(occurrence);
61 r: routine;
62 b: elmt blocks;
63 i: elmt insts;
64 opc: elmt base_opcodes;
65 iva1: integer;
66 var_ivars: set(occurrence);
67 j: integer;
68 fm: elmt forms;
69 voj, vo1: occurrence;
70 nam: symbol;
71 t: elmt types;
72 e, oscc: occurrence;
73 fwd_count: integer;
74 bfrm_count: integer;
smfe 34 back_count: integer;
75 x: occurrence;
76 onodes: tuple(occurrence);
77 newoccs: remote set(occurrence);
78 convrgd: boolean;
79 vo, oi: occurrence;
80 newtype, tp: elmt types;
smfe 35 maxtype: remote smap(elmt base_opcodes)
smfe 36 tuple(elmt types);
smfe 37 newtypes: tuple(elmt types);
smfe 38 k: integer;
81 end repr;
82
83 (forall sc in scopes)
84 (for_sym(v, sc))
85 vtyp(v) := given_type(form(v));
86 end;
87 end forall;
smff 8 (forall v in system_routs)
smff 9 $ redefine the return value type for system routines that cannot
smff 10 $ return omega.
smff 11 vtyp(rretn(v)) :=
smff 12 case name(v) of
smff 13 ('open'): type_boolean,
smff 14 ('eof'): type_boolean,
smff 15 ('getipp'): type_int,
smff 16 ('getspp'): type_string,
smff 17 ('lpad'): type_string,
smff 18 ('rpad'): type_string
smff 19 else vtyp(rretn(v))
smff 20 end;
smff 21 $ redefine the argument types for system routines that cannot be
smff 22 $ omega.
smff 23 maxtype_sargs(v) :=
smff 24 case name(v) of
smff 25 ('read'): [ type_gen ],
smff 26 ('print'): [ type_gen ],
smff 27 ('reada'): [ type_string, type_gen ],
smff 28 ('printa'): [ type_string, type_gen ],
smff 29 ('get'): [ type_string, type_gen ],
smff 30 ('getb'): [ type_string, type_gen ],
smff 31 ('putb'): [ type_string, type_gen ],
smff 32 ('getk'): [ type_string, type_gen ],
smff 33 ('putk'): [ type_string, type_gen ]
smff 34 else [ type_notom : j in [ 1..rnargs(v) ] ]
smff 35 end;
smff 36 end forall;
88$
89$ initialize the work pile and build the occurrence flow graph
90$
91 if 'e' in dump_string then
92 print('forward propagation');
93 end if;
94
95 occ_graph := ffrom;
96 occ_roots := {};
97 (forall r in routs)
98 (for_block(b, r))
99 (for_inst(i, b))
100 opc := opcode(i);
101 iva1 := first_ivar(opc);
smfe 39 if opc in ops_typeback and opc /= q1_sargin then
smfe 40 if opc = q1_set or opc = q1_tup then
smfe 41 if maxtype(opc) = om or #maxtype(opc) < #args(i)-1 then
smfe 42 maxtype(opc) :=
smfe 43 [ type_notom : j in [ iva1..#args(i) ] ];
smfe 44 end if;
smfe 45 elseif maxtype(opc) = om then
smfe 46 (forall j in [ 1..#args(i) ])
smfe 47 typ(get_oi(i, j)) := type_gen;
smfe 48 end forall;
smfe 49 maxtype(opc) := backward(i); back_count +:= 1;
smfe 50 end if;
smfe 51 end if;
102 var_ivars := {};
103 (forall j in [ iva1..#args(i) ])
104 voj := get_oi(i, j);
105 nam := oi_sym(voj);
106 if nam notin variables then
107 if ft_type(form(nam)) /= f_proc and
108 ft_type(form(nam)) /= f_lab then
109 typ(voj) := const_typ(value(nam));
110 else
111 typ(voj) := type_zero;
112 end if;
113 else
114 typ(voj) := type_zero;
115 var_ivars with:= voj;
116 end if;
117 end forall;
118 if opc in ops_ovar then
119 vo1 := get_oi(i, 1); $ the o-variable
120 if (t := fixed_typ(opc)) /= om then
121 typ(vo1) := t .con vtyp(oi_sym(vo1));
122 occ_roots with:= vo1;
123 elseif var_ivars = {} then
124 typ(vo1) := forward(vo1) .con vtyp(oi_sym(vo1));
125 occ_roots with:= vo1;
126 else
127 typ(vo1) := type_zero;
128 occ_graph +:= { [ voj, vo1 ] : voj in var_ivars };
129 end if;
130 end if;
131 end;
132 end;
133 end forall;
134$
135$ build depth-first spanning tree for the occurrence flow graph
136$
137 occ_sccs := []; $ strongly connected comp's of occurrence graph
138 oscc_nodes := {}; $ nodes of each strongly connected component
139 $ initialize auxiliary variables
140 stck := []; nstck := 0; place := {};
141 preorder := {}; npre := 0; nlev := {};
142
143 (forall e in occ_roots) dfs(e); end forall;
144
145 $ release storage for garbage collection
146 stck := om; place := om;
147 nlev := om; preorder := om;
148$
149$ actual forward propagation
150$
151 fwd_count := bfrm_count := 0;
152 newoccs := {} +/[ occ_graph{x} : x in occ_roots ];
153 (forall j in [ #occ_sccs, #occ_sccs-1..1 ])
154 oscc := occ_sccs(j);
155 onodes := oscc_nodes(oscc);
156 (until convrgd)
157 convrgd := true; $ flag indicating convergence in oscc
158 (forall vo in onodes | vo in newoccs)
159 convrgd := false;
160 newoccs less:= vo;
161 if is_ovar(vo) then
162 fwd_count +:= 1;
163 newtype := forward(vo) .con vtyp(oi_sym(vo));
164 elseif is_ivar(vo) then
165 bfrm_count +:= 1;
166 newtype := type_zero .dis/
smfe 52 [ typ(vo1) : vo1 in bfrom{vo} ];
smfe 53 if maxtype(oi_op(vo)) /= om then
smfe 54 k := argno(vo) - first_ivar(oi_op(vo)) + 1;
smff 5 tp := newtype .con maxtype(oi_op(vo))(k);
smff 6 if tp /= newtype then
smff 7 $ record ffrom propagation for next phase.
smff 8 $ note that the required bfrom propagation
smff 9 $ will be done during this phase in the
smff 10 $ workpile implicit in the o.s.c.c. graph.
smff 11 work +:= { [ 'ffrm', oi ] :
smff 12 oi in bfrom{vo} |
smff 13 oi notin bfrom_dead };
smff 14 end if;
smff 15 newtype := tp;
smfe 56 end if;
168 else
169 continue forall;
170 end if;
171 if newtype /= typ(vo) then
172 typ(vo) := newtype;
173 newoccs +:= occ_graph{vo};
174 end if;
175 end forall;
176 end until;
177 end forall;
178
179 $ release storage for garbage collection
180 occ_sccs := om; occ_graph := om; oscc_nodes := om;
smfe 57
smfe 58 if 't' in dump_string and 'z' in dump_string then
smfe 59 (forall newtypes = maxtype(opc))
smfe 60 print(opc);
smfe 61 (forall tp in newtypes) print(' ', format_type(tp)); end;
smfe 62 end forall;
smfe 63 end if;
181
182 if 'e' in dump_string then
183 print(fwd_count, 'forward propagations');
smfe 64 print(back_count, 'backward propagations');
184 print(bfrm_count, 'bfrom propagations');
185 end if;
186
187
188 end procedure type_forward;
189
190
191
192
193 procedure given_type(fm);
194$
195$ compute a type (lattice point) from a given form. see section
196$ 'forms' above for description of data forms.
197$
198 repr
199 fm: elmt forms;
200 ftp: elmt base_ft_types;
201 fsimtp: string;
202 tp, ctp: elmt types;
203 fm1: elmt forms;
204 end repr;
205
206 ftp := ft_type(fm);
207 fsimtp := simple_type(ftp);
208
209 case fsimtp of
210
211 ('gen'): tp := type_gen;
212 ('int'): tp := type_int;
213 ('real'): tp := type_real;
214 ('string'): tp := type_string;
215 ('atom'): tp := type_atom;
216 ('elmt'): tp := given_type(ft_elmt(ft_base(fm)));
217 ('set'): tp := ntyp(grsset, given_type(ft_elmt(fm)));
218
219 ('map'): ctp := given_type(ft_elmt(fm)) .con type_pair;
220 tp := ntyp(grsset, ctp .dis type_om);
221
222 ('tuple'):
223 if ftp = f_mtuple then
224 tp := knt_type([ given_type(fm1) : fm1 in ft_elmt(fm) ]);
225 else
226 tp := ntyp(grstup, given_type(ft_elmt(fm)));
227 end if;
228
229 else
230 tp := type_zero;
231 end case;
232
233 return tp .dis type_om;
234
235
236 end procedure given_type;
237
238
239
240
241 procedure dfs(x);
242
243
244 repr
245 x, y, z: occurrence;
246 i: integer;
247 end repr;
248
249
250 preorder(x) := nlev(x) := (npre +:= 1);
251 place(x) := nstck;
252 (forall y in occ_graph{x})
253 if nlev(y) = om then
254 dfs(y);
255 if nlev(y) /= -1 then
256 nstck +:= 1;
257 stck(nstck) := y;
258 end if;
259 end if;
260 if nlev(y) /= -1 then
261 nlev(x) := nlev(x) min nlev(y);
262 end if;
263 end forall;
264 if nlev(x) = preorder(x) then $ root of a strongly connected comp
265 occ_sccs with:= x;
266 oscc_nodes(x) := [ x ];
267 (forall i in [ nstck, nstck-1..place(x)+1 ])
268 z := stck(i);
269 oscc_nodes(x) with:= z;
270 nlev(z) := -1;
271 end forall;
272 nstck := place(x);
273 nlev(x) := -1;
274 end if;
275
276 end procedure dfs;
277
278
1 .=member tyb14d
2
3
4 procedure type_backward;
5$
6$ this is the second, or backwards phase of the type finder. it
7$ propagates the type of each ivariable backwards towards its
8$ definition.
9$
10$ as usual, the routine has two sections. the first initializes the
11$ work pile, and the second iterates until it is empty.
12$
13 repr
15 r: routine;
16 b: elmt blocks;
17 inst: elmt insts;
18 opc: elmt base_opcodes;
19 fwd_count: integer;
20 back_count: integer;
21 bfrm_count: integer;
22 ffrm_count: integer;
23 key: string;
24 targ: general;
25 oi: occurrence;
26 newtype: elmt types;
27 i: occurrence;
28 newtypes: tuple(elmt types);
29 j, j1: integer;
30 tp: elmt types;
31 end repr;
32$
33$ work pile initialisation
34$ ---- ---- --------------
35$
36$ the work pile once again consists of pairs [ key, targ ]. we
37$ initialize the work pile to force backwards propagation of all
38$ relevant ivariables.
39$
40 if 'e' in dump_string then
41 print;
42 print('backward propagation');
43 end if;
44
46 (forall r in routs) (for_block(b, r)) (for_inst(inst, b))
47 if opcode(inst) in ops_typeback then
48 work with:= [ 'back', inst ];
49 end if;
50 end; end; end;
51$
52$ propagation
53$ -----------
54$
55$ in this phase we propagate types in four directions:
56$
57$ 1. 'fwd':
58$
59$ here we determine the type of an ovariable from those of its
60$ ivariables. this uses the same method as employed in type_forward.
62$
63$ 2. 'back':
64$
65$ this calculates the types of the ivariables of an instruction
66$ as a function of the types of the other arguments in the same
67$ instruction.
68$
69$ 3. 'bfrm':
70$
71$ this corresponds to the 'bfrm' action in type_forward.
72$
73$ 4. 'ffrm':
74$
75$ this calculates the type of an occurrence oi as the conjunction of
smfh 21$ the types of all i in ffrom, provided, however, that no program
77$ exit can be reached from oi along a path clear of other occurrences
78$ of the variable of oi.
79$
80 fwd_count := back_count := 0;
81 bfrm_count := ffrm_count := 0;
82
83 (while work /= {})
84 [ key, targ ] from work;
85
86 case key of
87
88 ('fwd'): $ forward propagation
89 fwd_count +:= 1;
90 oi := targ;
91 newtype := forward(oi) .con typ(oi);
92 if newtype = typ(oi) then continue; end if;
93 work +:= { [ 'bfrm', i ]: i in ffrom{oi} };
94
95 $ if this was not a unary operation, propagate back
96 $ to the remaining i-variables
97 if (opc := oi_op(oi)) notin ops_un and
98 opc in ops_typeback and
99 opc notin {q1_asn, q1_argin, q1_argout} then
100 work with:= [ 'back', instno(oi) ];
101 end if;
102
103 typ(oi) := newtype;
104
105 ('bfrm'): $ propagate along bfrom
106 bfrm_count +:= 1;
107 oi := targ;
108 newtype := (type_zero .dis/[ typ(i) : i in bfrom{oi} ])
109 .con typ(oi);
110 if newtype = typ(oi) then continue; end if;
111
112 work +:= { [ 'bfrm', i ] : i in ffrom{oi} };
113 if oi_op(oi) in ops_ovar then
114 work with:= [ 'fwd', get_ovar(oi) ];
115 end if;
116
117 typ(oi) := newtype;
118
119 ('ffrm'): $ propagate along ffrom
120 ffrm_count +:= 1;
121 oi := targ;
122 newtype := (type_zero .dis/[ typ(i) : i in ffrom{oi} ])
123 .con typ(oi);
124 if newtype = typ(oi) then continue; end if;
125
126 if is_ovar(oi) then
127 if oi_op(oi) in ops_typeback then
128 work with:= [ 'back', instno(oi) ];
129 end if;
130 else
131 work +:= { [ 'ffrm', i ] :
132 i in bfrom{oi} | i notin bfrom_dead };
133 if oi_op(oi) in ops_ovar then
134 work with:= [ 'fwd', get_ovar(oi) ];
135 end if;
136 end if;
137
138 typ(oi) := newtype;
139
140 ('back'): $ analogous to the 'fwd' case
141 back_count +:= 1;
142 inst := targ;
143 newtypes := backward(inst);
144
145 j1 := first_ivar(opcode(inst));
146 (forall j in [ j1..#args(inst) ])
147 oi := get_oi(inst, j);
148 newtype := newtypes(j-j1+1) .con typ(oi);
149 if newtype = typ(oi) then continue forall; end if;
150
151 work +:= { [ 'bfrm', i ] : i in ffrom{oi} };
152 work +:= { [ 'ffrm', i ] : i in bfrom{oi} |
153 i notin bfrom_dead };
154
155 typ(oi) := newtype;
156 end forall;
157
158
159 end case;
160
161 end while;
162
163 if 'e' in dump_string then
164 print(fwd_count, 'forward propagations');
165 print(back_count, 'backward propagations');
166 print(bfrm_count, 'bfrom propagations');
167 print(ffrm_count, 'ffrom propagations');
168 end if;
169
170
171 end procedure type_backward;
172
173
1 .=member tfn14e
2
3
4 procedure type_final;
5$
6$ this is the final phase of the type finder. here we re-compute the
7$ type of each ovariable, from the types of its ivariables, so that we
8$ can detect precisely when a type check is necessary and when it is
9$ redundant, as explained above.
10$
11$ we also check for type errors. they can be one of the following:
12$
13$ 1. an occurence having a type type_zero. in this case, for every
14$ possible execution of the program, this occurence will have an
15$ error value (or the program will abort). this is therefore an
16$ error.
17$
18$ 2. two occurences, linked by the bfrom map and having incompatible
19$ types, though none of them has the type type_zero. this means
20$ that there might be an execution flow, along which one of the
21$ occurences will get an error value, but this need not be the case
22$ for every execution. consider the following example:
23$
24$ (1) a := [ 1, 2 ];
25$ (2) if cond1 then a := 1; end if;
26$ (3) if cond2 then x := a(1); end if;
27$
28$ here, after re-computation of the type of ovariables, a2 will have
29$ type integer, while a3 will have type tuple. it may indeed be the
30$ case that cond1 and cond2 can never be true simultaneously, in
31$ which case the program will never abort. if, however, the link
32$ a2 to a3 is ever materialized, we shall have an error. thus, in
33$ this case, the optimizer should issue a warning, but non-fatal
34$ message.
35$
36$ begin by re-computing the types of all ovariables.
37$ note, however, that in operations like 's := {};' or 't := [];'
38$ we still want to retain the backward type of s to some extent.
39$ for example:
40$ (1) s := {};
41$ ...
42$ (2) s with:= int;
43$ in this case we prefer to have typ(s at 1) = set(int) rather than
44$ set(general), which will force an unnecessary conversion/check
45$ between (1) and (2).
46$
smfi 71 init
smfk 45 errvars := {}, $ variables with type_zero message.
smfk 46 newstmt := false, newblk := false;
47 repr
smfi 75 r: routine;
smfi 76 b: elmt blocks;
smfi 77 i: elmt insts;
smfi 78 v: symbol;
smfi 81 errvars: set(symbol);
smfk 47 newstmt, newblk: boolean;
smfi 82 k: integer 0..65536;
smfi 83
smfi 84 o, oi: occurrence;
50 newtype: elmt types;
smfe 65 tp, t1, t2: elmt types;
56
57 workoccs, seenoccs: set(occurrence);
smfk 48 precoccs, reloccs: set(occurrence);
smfk 49 tp_stmts: mmap{elmt types} set(string);
smfi 85 relstmts: set(string);
61 vox, voy, vo1, vo2: occurrence;
62 ivs: tuple(occurrence);
66 message: tuple(string);
smfi 86 text, tail: string;
68 j: integer 0..65536;
69 l: string;
70 end repr;
71
smfi 87 (forall r in routs) (for_block(b, r)) (for_inst(i, b))
smfi 88 if opcode(i) notin ops_ovar then continue; end if;
smfi 89 o := get_oi(i, 1); $ get the output occurrence
smfi 90 if opcode(i) = q1_asn or opcode(i) = q1_argin then
smfi 91 v := args(i)(2);
smfi 92 if is_const(v) = 1 and value(v) = {} then
77 newtype :=
smfi 93 (type_zero .dis/[ typ(oi) : oi in ffrom{o} ])
79 .con type_set;
80 if newtype /= type_zero then typ(o) := newtype; end if;
smfi 94 continue;
82
smfi 95 elseif is_const(v) = 1 and value(v) = [] then
84 newtype :=
smfi 96 (type_zero .dis/[ typ(oi) : oi in ffrom{o} ])
86 .con type_tuple;
87 if newtype /= type_zero then typ(o) := newtype; end if;
smfi 97 continue;
89
smfi 98 elseif v = sym_om then
smfi 99 newtype := type_om .dis/[ typ(oi) : oi in ffrom{o} ];
92 typ(o) := newtype;
smfi 100 continue;
94 end if;
95 end if;
smfi 101 typ(o) := (fixed_typ(opcode(i)) ? forward(o))
smfi 102 .con vtyp(args(i)(1));
smfi 103 end; end; end forall;
99
100 if not debug_flag then return; end if;
101
smfi 104 (forall r in routs)
smfk 50 (for_block(b, r)) newblk := true;
smfk 51 (for_inst(i, b)) if opcode(i) = q1_stmt then newstmt := true; end;
smfk 52 (forall k in [ 1..#args(i) ])
smfi 108 if (v := args(i)(k)) notin variables then continue forall; end;
smfk 53 if newstmt and newblk then
smfk 54 errvars := {}; newstmt := false; newblk := false;
smfk 55 end if;
smfi 109 vox := get_oi(i, k);
103
104 if typ(vox) = type_zero then
105
106 $ some serious problem: the type finder could not deduce any
107 $ type for this occurrence.
108
smfk 56 if opcode(i) = q1_isom or opcode(i) = q1_notom then
smfk 57 $ the occurrence will either have been added to errvars
smfk 58 $ in the preceding q1_if, ..., or this block consists
smfk 59 $ exactly this instruction. in either case we do not
smfk 60 $ want to generate an additional message.
smfk 61 continue forall;
smfk 62 end if;
smfk 63
smfk 64 if opcode(i) = q1_free then
smfk 65 $ either the corresponding q1_argin occurrence has
smfk 66 $ type_zero as well, or the invoked routine cannot
smfk 67 $ be completed. in either case, we prefer to
smfk 68 $ suppress the error message.
smfk 69 errvars with:= oi_sym(vox);
111 continue forall;
112 end if;
113
114 if is_ovar(vox) then
smfi 120 ivs := [ vo1 in occs(i)(2..) |
smfk 70 typ(vo1) = type_zero
smfk 71 and oi_sym(vo1) notin routs
smfk 72 or typ(vo1) = type_om ];
smfi 123 if ivs = [] then ivs := occs(i)(2..); end if;
118 else
119 ivs := [ vox ];
120 end if;
121
122 if exists vo1 in ivs |
smfi 124 typ(vo1) = type_zero
smfl 5 and OI_SYM(VO1) in ERRVARS then
smfi 128 (forall vo1 in ivs) errvars with:= oi_sym(vo1); end;
smfi 129 errvars with:= oi_sym(vox);
127 continue forall;
128 end if;
smfk 76
smfk 77 if opcode(i) in ops_iter then
smfk 78 if is_ivar(vox) and
smfk 79 opcode(i) = q1_inext or opcode(i) = q1_inextd
smfk 80 then
smfk 81 t1 := type_zero
smfk 82 .dis/[ typ(vo1) : vo1 in bfrom{vox} ];
smfk 83 messages{stmtof(i)}{'e'} with:=
smfk 84 [ 'illegal iteration: "' + name(v) + '" '
smfk 85 + case t1 of
smfk 86 (type_zero): 'cannot be evaluated.',
smfk 87 (type_om): 'is undefined.'
smfk 88 else 'is ' + format_type(t1) + '.'
smfk 89 end
smfk 90 ];
smfk 91 end if;
smfk 93 errvars with:= oi_sym(vox);
smfk 94 continue forall;
smfk 95 end if;
129
130 message := [ if is_ovar(vox) then
131 'the evaluation of '
smfi 130 '"' + format_inst(i, om) + '"'
133 else
smfi 131 'the use of "' + name(v) + '"'
135 end +
136 ' will always cause an execution error:' ];
137
138 (forall voy = ivs(j))
139
140 if typ(voy) = type_zero then
141
142 $ either none of the definitions preceding this
143 $ occurrence could be evaluated, or this occurrence
144 $ is part of a set of occurrences which, taken
145 $ together, form a set of inconsistent uses.
146
147 workoccs := { voy };$ workpile of prec. occurrences
148 seenoccs := {}; $ occurrences already seen
149 reloccs := { voy };$ relevant occurrences
smfk 96 precoccs := {}; $ prec. non-error occurrences
150
151 (while workoccs /= {})
152 vo1 from workoccs; seenoccs with:= vo1;
smfk 97 (forall vo2 in bfrom{vo1})
smfk 98 if typ(vo2) = type_zero
smfk 99 or typ(vo2) = type_om then
smfk 100 reloccs with:= vo2;
smfk 101 if vo2 notin seenoccs then
smfk 102 workoccs with:= vo2;
smfk 103 end if;
smfk 104 else
smfk 105 precoccs with:= vo2;
smfk 106 end if;
smfk 107 end forall;
161 end while;
162
smfi 134 workoccs := { vo1 in reloccs | is_ovar(vo1)
smfi 135 and typ(vo1) = type_zero };
smfi 136 relstmts := { oi_stmt(vo1) : vo1 in workoccs };
smfi 137
smfi 138 if #relstmts = 0 then
smfi 139 text := om;
smfi 140 else
smfi 141 text := '"' + oi_name(voy) + '"'
smfi 142 ' cannot be evaluated at ';
smfi 143 tail from relstmts;
smfi 144
smfi 145 if #relstmts = 0 then
smfi 146 text +:= tail;
smfi 147 elseif #relstmts = 1 then
smfi 148 text +:= arb relstmts + ' and ' + tail;
smfi 149 else
smfi 150 text := text +/[ l + ', ' : l in relstmts ];
smfi 151 text +:= 'and ' + tail;
smfi 152 end if;
smfi 153 end if;
smfi 154
smfi 155 (while workoccs /= {})
smfi 156 $ remove all occurrences reachable from these
smfi 157 $ definitions.
smfi 158 vo1 from workoccs; reloccs less:= vo1;
smfi 159 (forall vo2 in ffrom{vo1} | vo2 in reloccs)
smfi 160 reloccs less:= vo2; workoccs with:= vo2;
smfi 161 end forall;
smfi 162 end while;
smfi 163
smfi 164 $ next we find all occurrences which will cause
smfi 165 $ type conflicts at this instruction.
smfi 166
smfi 167 workoccs := { vo1 in reloccs | typ(vo1) = type_om };
smfi 168$$-- problem with statement numbers: if statements are numbered
smfi 169$$-- linearly, then any reference to the (implicit) term block will
smfi 170$$-- receive the statement number of the loop header; if statements
smfi 171$$-- are numbered according to their block order, then any explicit
smfi 172$$-- statement in an step/until/term block will cause the statement
smfi 173$$-- numbering for the entire loop body to be off since these blocks
smfi 174$$-- appear to the parser at the loop header, and are moved behind the
smfi 175$$-- loop body.
smfi 176$$-- the only know place where this causes problems is the use of an
smfi 177$$-- exhausted loop index.
smfi 178$$-- relstmts := { oi_stmt(vo1) : vo1 in workoccs };
smfi 179
smfi 180 if #workoccs /= 0 then
smfi 181 if text = om then
smfi 182 text := '"' + oi_name(voy) + '"'
smfi 183 ' is om';
smfi 184$$-- ' is undefined at ';
smfi 185 else
smfi 186 text +:= ', and is om along some path';
smfi 187$$-- text +:= ', and is undefined at ';
smfi 188 end if;
smfi 189
smfi 190$$-- tail from relstmts;
smfi 191
smfi 192$$-- if #relstmts = 0 then
smfi 193$$-- text +:= tail;
smfi 194$$-- elseif #relstmts = 1 then
smfi 195$$-- text +:= arb relstmts + ' and ' + tail;
smfi 196$$-- else
smfi 197$$-- text := text +/[ l + ', ' : l in relstmts ];
smfi 198$$-- text +:= 'and ' + tail;
smfi 199$$-- end if;
smfi 200 end if;
smfi 201
smfi 202 (while workoccs /= {})
smfi 203 $ remove all occurrences reachable from these
smfi 204 $ occurrences.
smfi 205 vo1 from workoccs; reloccs less:= vo1;
smfi 206 (forall vo2 in ffrom{vo1} | vo2 in reloccs)
smfi 207 reloccs less:= vo2; workoccs with:= vo2;
smfi 208 end forall;
smfi 209 end while;
smfi 210
smfi 211 $ next we find all occurrences linked to the
smfi 212 $ remaining occurrences in the forward direction.
smfi 213
smfi 214 workoccs := reloccs;
smfi 215
smfi 216 (while workoccs /= {})
smfi 217 vo1 from workoccs; seenoccs with:= vo1;
smfi 218 (forall vo2 in ffrom{vo1} |
smfi 219 typ(vo2) = type_zero)
smfi 220 reloccs with:= vo2;
smfi 221 if vo2 notin seenoccs then
smfi 222 workoccs with:= vo2;
smfi 223 end if;
smfi 224 end forall;
smfi 225 end while;
smfi 226
smfi 227 relstmts := { oi_stmt(vo1) : vo1 in reloccs };
smfi 228
smfi 229 if #relstmts /= 0 then
smfi 230 if text = om then
smfi 231 text := '"' + oi_name(voy) + '" ';
smfi 232 else
smfi 233 text := text + ', and ';
smfi 234 end if;
smfi 235
smfi 236 if oi_stmt(voy) in relstmts then
smfi 237 relstmts less:= oi_stmt(voy);
smfi 238 tail := 'here';
smfi 239 else
smfi 240 tail from relstmts;
smfi 241 end if;
smfi 242
smfi 243 if #reloccs = 1 then
smfk 108 text +:= 'cannot be evaluated';
smfi 245 elseif #relstmts = 0 then
smfi 246 text +:= 'is used inconsistently here';
smfi 247 elseif #relstmts = 1 then
smfi 248 text +:= 'is used inconsistently between '
smfi 249 + arb relstmts + ' and ' + tail;
smfi 250 else
smfi 251 text +:= 'is used inconsistently between ';
smfi 252 text := text +/[ l + ', ' : l in relstmts ];
smfi 253 text +:= 'and ' + tail;
smfi 254 end if;
smfi 255 end if;
smfk 109
smfk 110 tp_stmts := { [ typ(vo1), oi_stmt(vo1) ] :
smfk 111 vo1 in precoccs };
smfk 112 if #tp_stmts /= 0 then
smfk 113 if text = om then
smfk 114 text := 'the type of "' + oi_name(voy) + '"'
smfk 115 ' is ';
smfk 116 else
smfk 117 text +:= ', and its type is ';
smfk 118 end if;
smfk 119 (forall relstmts = tp_stmts{t1})
smfk 120 if text(#text) /= ' ' then
smfk 121 text +:= ', ';
smfk 122 end if;
smfk 123 tail from relstmts;
smfk 124 text +:= format_type(t1) + ' at ' +
smfk 125 case #relstmts of
smfk 126 (0): '',
smfk 127 (1): arb relstmts + ' and '
smfk 128 else
smfk 129 '' +/[ l + ', ' : l in relstmts ] +
smfk 130 'and '
smfk 131 end + tail;
smfk 132 end forall;
smfk 133 end if;
188
189 elseif typ(voy) = type_om then
190 text := '"' + oi_name(voy) + '" is undefined';
191 else
192 text :=
193 if j = 1 then 'the ' else 'the ' end +
194 'type of "' + oi_name(voy) + '"'
195 ' is ' + format_type(typ(voy));
196 end if;
197
198 text +:= if j = #ivs then '.' else ', ' end;
smfc 618 if j > 1 and #message(#message) + #text < 64 then
200 message(#message) +:= text;
201 else
202 message with:= text;
203 end if;
260
261 end forall;
smfi 256 messages{stmtof(i)}{'e'} with:= message;
smfi 258 (forall vo1 in ivs) errvars with:= oi_sym(vo1); end;
smfi 259 errvars with:= oi_sym(vox);
263
264
265 elseif is_ivar(vox) and
smfi 260 opcode(i) /= q1_isom and opcode(i) /= q1_notom and
266 exists voy in bfrom{vox} |
267 typ(voy) .con typ(vox) /= typ(voy) then
268
269 $ an input occurrence with some kind of execution problem:
270 $ we find all preceding occurrences which can assume values
271 $ which can cause some execution problem.
272
273 workoccs := { vox };$ workpile of preceding occurrences
274 seenoccs := {}; $ occurrences already seen
smfg 115 reloccs := {}; $ preceding occurrences
277
278 (while workoccs /= {})
279
smfg 116 vo1 from workoccs; seenoccs with:= vo1;
282
283 (forall vo2 in bfrom{vo1} |
284 typ(vo2) .con typ(vox) /= typ(vo2))
285
smfg 117 if is_ovar(vo2) then reloccs with:= vo2; end if;
289
290 if vo2 notin seenoccs then
291 workoccs with:= vo2;
292 end if;
293
294 end forall;
295
298 end while;
299
smfg 118 (forall o in reloccs)
301
smfe 66 t1 := typ(o) .con typ(vox);
smfe 67 t2 := typ(o) .sub typ(vox);
304
smfe 68 if t1 = type_zero then
306 l := 'e';
307
308 elseif ( oi_op(o) = q1_asn or oi_op(o) = q1_argin ) and
309 arg2(instno(o)) = sym_om and
310 is_notom(typ(vox)) then
311 l := 'e';
312
smfe 69 elseif t2 = type_om and getipp('full=0/1') = 0 and
314 ( (oi_op(o) = q1_sargout and
315 name(arg2(instno(o))) in
316 { 'read', 'reada',
317 'get', 'getb', 'getf' } ) or
318 oi_op(o) = q1_of or
319 oi_op(o) = q1_arb ) then
320 continue forall;
321
smfe 70 elseif t2 = ntyp(grsset, type_om) and
323 getipp('full=0/1') = 0 and
324 oi_op(o) = q1_ofa then
325 continue forall;
326
327 else
328 l := 'w';
329 end if;
330
smfe 71 text := 'error if "' + oi_name(o) + '" is ';
smfe 72 if t1 = type_zero then
smfe 73 text +:= format_type(t2);
smfe 74 elseif t2 = type_gen then
smfe 75 text +:= 'not ' + format_type(t1);
smfe 76 elseif string_length(t1) < string_length(t2) then
smfe 77 text +:= 'not ' + format_type(t1);
smfe 78 else
smfe 79 text +:= format_type(t2);
smfe 80 end if;
smfe 81 message := [ text + '.' ];
smfi 261 messages{stmtof(i)}{l} with:= message;
351 end forall;
352
353
smfe 82 elseif is_ovar(vox) and
smfi 262 (text := type_constant(i)) /= om then
smfe 84 message :=
smfi 263 [ 'expression "' + format_inst(i, om) + '"'
smfe 86 ' is constant: ' ];
smfe 87 text +:= '.';
smfe 88 if #message(1) + #text < 72 then
smfe 89 message(1) +:= text;
smfe 90 else
smfe 91 message with:= text;
smfe 92 end if;
smfi 264 messages{stmtof(i)}{'w'} with:= message;
smfe 94
smfe 95
smfi 265 elseif v notin itervars and
smfi 266 opcode(i) notin ops_typepred and
smfh 22 #grosstyp( (typ(vox) .con type_notom) ) > 1 and
smfh 23 ( ( is_ivar(vox) and notexists voy in bfrom{vox} |
smfh 24 #grosstyp( (typ(voy) .con type_notom) ) > 1 ) or
smfh 25 ( is_ovar(vox) and ffrom{vox} /= {} and
smfi 267 notexists voy in occs(i)(2..) |
smfh 29 #grosstyp( (typ(voy) .con type_notom) ) > 1)
smfh 30 ) then
smfe 100 $ we only include o-variables in this test that reach a use.
smfe 101 $ we ignore the internal iteration variable of iterators,
smfe 102 $ which always will have type general.
smfi 268 messages{stmtof(i)}{'i'} with:=
smfi 269 [ '"' + name(v) + '" has an ambiguous type.' ];
361 end if;
smfi 270 end forall;
smfi 271 end; end; end forall;
363
364
365 end procedure type_final;
366
367
1 .=member fwd14f
2
3
4 procedure forward(o);
5$
6$ this routine calculates the type of an ovariable 'o' from the types of
7$ its inputs.
8$
9 repr
10 o: occurrence;
11 opc: elmt base_opcodes;
12 ivs: tuple(occurrence);
13 tps: tuple(elmt types);
14 i: occurrence;
15 grtps: tuple(gross_type);
smff 37 i1, i2, i3, i4: occurrence;
17 t1, t2, t3, t4: elmt types;
18 g1, g2, g3, g4: gross_type;
19 g, gx: gross_type;
20 tp, tpx: elmt types;
smff 38 v, v1, v2, v3: integer;
22 ct1: tuple(elmt types);
23 j: integer;
24 ctp: elmt types;
25 ctp1, ctp2: elmt types;
26 tx, ty, tz: elmt types;
27 r: symbol;
28 end repr;
29
30 opc := oi_op(o);
31 ivs := [ get_oi(instno(o), j) :
32 j in [ first_ivar(opc)..#args(instno(o)) ] ];
33 tps := [ typ(i) : i in ivs ];
34 grtps := [ grosstyp(typ(i)) : i in ivs ];
35
36 [ i1, i2 ] := ivs;
37 [ t1, t2 ] := tps;
38 [ g1, g2 ] := grtps;
39
40 tp := type_zero; $ set to default
41
42 case opc of
44$
45$ binary operators
46$
47 (q1_in, q1_notin):
48 $ if t2 is a set or tuple the result is boolean.
49 if g2 * str_tup_set /= {} then
50 tp := type_boolean;
51 end if;
52
53 (q1_incs):
54 $ if both inputs are sets the result is boolean
55 if t_set in g1*g2 then
56 tp := type_boolean;
57 end if;
58
59 (q1_eq, q1_ne):
60 $ relational operators always return a boolean.
61 tp := type_boolean;
62
smfh 31 (q1_ge, q1_lt, q1_pos):
64 $ if the operands are valid, then the result is boolean
65 if int_real_str * g1 * g2 /= {} then
66 tp := type_boolean;
67 end if;
68
69 (q1_with):
70 $ if t1 is a set or unknown-length tuple, then its type is:
71 $ grosstyp: set, tuple, or both, depending on the type of t1
72 $ comptyp: disjunction of t2 and the component type of t1
73 $ nb. with is not defined on known-length tuples.
74 if t_set in g1 then
75 ctp := comptyp(t1) .con type_notom;
76 t2 := t2 .con type_notom;
77 if ctp /= type_zero or t2 /= type_zero then
78 tp := ntyp( grsset, ctp .dis t2 );
79 else
80 tp := ntyp( grsset, type_om );
81 end if;
82 end if;
83 if t_tuple in g1 then
84 if is_knt(t1) then norm(t1); end if;
85 tp .dis:= ntyp( grstup, comptyp(t1) .dis t2 );
86 end if;
87
88 (q1_less):
89 $ if t1 is a set, then the result has the same type as t1
90 if t_set in g1 then
91 tp := ntyp( grsset, comptyp(t1) .dis type_om );
92 end if;
93
94 (q1_lessb, q1_lesse):
95 $ these opcodes are part of the simulation for q1_fromb
96 $ and frome, resp.
97 $ nb. fromb and frome are not defined for known-length tuples.
98 if t_tuple in g1 then
99 if is_knt(t1) then norm(t1); end if;
100 tp := ntyp( grstup, comptyp(t1) .dis type_om );
101 end if;
102
103 (q1_lessf):
104 $ if t1 is a set, it must be a map or a set of pairs
105 if t_set in g1 then
106 ctp := comptyp(t1);
107 if ctp = type_om then
108 tp := ntyp( grsset, type_om );
109 elseif (ctp .con:= type_pair) /= type_zero then
110 tp := ntyp( grsset, ctp .dis type_om );
111 end if;
112 end if;
113
114 (q1_npow):
115 $ one input is a set, the other an integer;
116 $ the result is set(set_type).
117 if t_set in g1 and t_int in g2 then
118 tp := ntyp( grsset, t1 .dis type_om );
119 end if;
120 if t_int in g1 and t_set in g2 then
121 tp .dis:= ntyp( grsset, t2 .dis type_om );
122 end if;
123
124 (q1_max, q1_min):
125 tp := t1 .con t2 .con type_int_real_str;
126
127 (q1_add):
128 gx := g1 * g2;
129 tp := t1 .con t2 .con type_int_real_str;
130 if t_tuple in gx and is_knt(t1) and is_knt(t2) then
131 tp .dis:= knt_type(comptyp(t1) + comptyp(t2));
132 elseif not is_prim(gx) then
133 if is_knt(t1) then norm(t1); end if;
134 if is_knt(t2) then norm(t2); end if;
135 ctp1 := comptyp(t1);
136 ctp2 := comptyp(t2);
137 ctp := ctp1 .dis ctp2;
138 if is_notom(ctp1) or is_notom(ctp2) then
139 ctp .con:= type_notom;
140 end if;
141 tp .dis:= ntyp( gx*set_tup, ctp );
142 end if;
143
144 (q1_sub):
145 tp := t1 .con t2 .con type_int_real;
146 if t_set in g1 and t_set in g2 then
147 tp .dis:= ntyp( grsset, comptyp(t1) .dis type_om );
148 end if;
149
150 (q1_mult):
151 tpx := t1 .con t2;
152 tp := tpx .con type_int_real;
153 if t_set in g1 and t_set in g2 then
154 tp .dis:= ntyp( grsset, comptyp(tpx) .dis type_om );
155 end if;
156 if t_int in g1 then
157 if t_string in g2 then
158 tp .dis:= type_string;
159 end if;
160 if t_tuple in g2 then
161 if is_knt(t2) then norm(t2); end if;
162 tp .dis:= (t2 .con type_tuple);
163 end if;
164 end if;
165 if t_int in g2 then
166 if t_string in g1 then
167 tp .dis:= type_string;
168 end if;
169 if t_tuple in g1 then
170 if is_knt(t1) then norm(t1); end if;
171 tp .dis:= (t1 .con type_tuple);
172 end if;
173 end if;
174
175 (q1_div):
176 tp := t1 .con t2 .con type_int;
177
178 (q1_slash):
179 if type_int_real .con t1 .con t2 /= type_zero then
180 tp := type_real;
181 end if;
182
183 (q1_mod):
184 if t_set in g1 and t_set in g2 then
185 ctp := comptyp(t1) .dis comptyp(t2) .dis type_om;
186 tp := ntyp( grsset, ctp );
187 end if;
188 if t_int in g1 and t_int in g2 then
189 tp .dis:= type_int;
190 end if;
191
192 (q1_exp):
193 tp := type_int_real .con t1 .con t2;
194 if t_real in g1 and t_int in g2 then
195 tp .dis:= type_real;
196 end if;
197
smff 39 (q1_atan2):
smff 40 tp := t1 .con t2 .con type_real;
198$
199$ unary operators
200$
201 (q1_not):
202 if t_atom in g1 then
203 tp := type_boolean;
204 end if;
205
206 (q1_even, q1_odd):
207 if t_int in g1 then
208 tp := type_boolean;
209 end if;
210
211 (q1_isint, q1_isreal, q1_isstr, q1_isbool,
212 q1_isatom, q1_istup, q1_isset, q1_ismap):
213 tp := type_boolean;
214
215 (q1_arb):
216 $ if t1 is a set, then the result type is the component type.
217 if t_set in g1 then
218 tp := comptyp(t1);
219 end if;
220
221 (q1_arbb, q1_arbe):
222 $ these opcodes are part of the simulation for q1_fromb
223 $ and q1_frome, resp.
224 if t_tuple in g1 then
225 if is_knt(t1) then norm(t1); end if;
226 tp := comptyp(t1);
227 end if;
228
229 (q1_dom, q1_range):
230 $ if the input is a set, the result is its domain or image
231 $ type.
232 j := if opc = q1_dom then 1 else 2 end;
233 if t_set in g1 then
234 ctp := comptyp(t1);
235 if ctp = type_om then
236 $ no pair type yet: pass null set along
237 tp := ntyp( grsset, type_om );
238 elseif (ctp .con:= type_pair) /= type_zero then
239 ct1 := comptyp(ctp);
240 tp := ntyp( grsset, ct1(j) .dis type_om );
241 end if;
242 end if;
243
244 (q1_pow):
245 $ if t1 is a set, then the result is set(t1).
246 if t_set in g1 then
247 tp := ntyp( grsset, t1 .con type_set );
248 end if;
249
250 (q1_nelt):
251 $ for valid input types, the result type is int.
252 if g1 * str_tup_set /= {} then
253 tp := type_int;
254 end if;
255
smff 41 (q1_abs):
257 $ the result type is int or real, depending on the input type
smff 42 $ the result type is int if the input is a string (of length 1).
258 tp := t1 .con type_int_real;
smff 43 if t_string in g1 then tp .dis:= type_int; end if;
259
260 (q1_char):
261 tp := type_string;
262
263 (q1_ceil, q1_floor, q1_fix):
264 if t_real in g1 then
265 tp := type_int;
266 end if;
267
268 (q1_float):
269 if t_int in g1 then
270 tp := type_real;
271 end if;
272
273 (q1_sin, q1_cos, q1_tan,
274 q1_arcsin, q1_arccos, q1_arctan,
275 q1_tanh,
276 q1_expf, q1_log,
277 q1_sqrt ):
278 if t_real in g1 then
279 tp := type_real;
280 end if;
281
282 (q1_rand):
283 $ if t1 is a known length tuple, then the result type is the
284 $ disjunction of the component types. if t1 is a set or
285 $ unknown length tuple, then the result type is the component
286 $ type.
287 tp := t1 .con type_int_real_str;
288 if not is_prim(g1) then
289 if is_knt(t1) then norm(t1); end if;
290 tp .dis:= comptyp(t1);
291 end if;
292
293 (q1_sign):
294 if int_real * g1 /= {} then
295 tp := type_int;
296 end if;
297
298 (q1_type, q1_str):
299 tp := type_string;
300
301 (q1_val):
302 $ this operation converts a string representing any setl
303 $ value to its value, so the result type is general.
304 if t_string in g1 then
305 tp := type_gen;
306 end if;
307
smff 44 (q1_umin):
smff 45 $ the result type is int or real, depending on the input type.
smff 46 tp := t1 .con type_int_real;
308$
309$ slicing operations
310$
311$ nb. these operations are only defined for strings and tuples.
315$
316 (q1_subst):
317 $ t2 and t3 must be integers.
smff 47 [ -, -, i3 ] := ivs;
smff 48 [ -, -, t3 ] := tps;
smff 49 [ -, -, g3 ] := grtps;
smff 50 if t_int in g2 and t_int in g3 then
323 if t_tuple in g1 then
smff 51 if is_knt(t1) and
smff 52 is_const_int(i2) and is_const_int(i3) then
smff 53 ct1 := comptyp(t1);
smff 54 v2 := oi_val(i2);
smff 55 v3 := oi_val(i3);
smff 56 if 1 <= v2 and v2 <= v3+1 and v3 <= #ct1 then
smff 57 tp := knt_type(ct1(v2..v3));
smff 58 else
smff 59 tp := type_zero;
smff 60 end if;
smff 61 else
smff 62 if is_knt(t1) then norm(t1); end if;
smff 63 tp := ntyp( grstup, comptyp(t1) .dis type_om );
smff 64 end if;
326 end if;
smff 65
smff 66 if t_string in g1 then
smff 67 tp .dis:= type_string;
smff 68 end if;
327 end if;
328
329 (q1_end):
330 $ t2 must be an integer.
331 if t_int in g2 then
336 if t_tuple in g1 then
smff 69 if is_knt(t1) and is_const_int(i2) then
smff 70 ct1 := comptyp(t1); v2 := oi_val(i2);
smff 71 if 1 <= v2 and v2 <= #ct1 then
smff 72 tp := knt_type(ct1(v2..));
smff 73 else
smff 74 tp := type_zero;
smff 75 end if;
smff 76 else
smff 77 if is_knt(t1) then norm(t1); end if;
smff 78 tp := ntyp( grstup, comptyp(t1) .dis type_om );
smff 79 end if;
339 end if;
smff 80
smff 81 if t_string in g1 then
smff 82 tp .dis:= type_string;
smff 83 end if;
340 end if;
341
342 (q1_ssubst):
343 $ t1 and t2 must be integer,
344 $ t3 is the right-hand side,
345 $ t4 is the i-occurrence of the output
346 [ -, -, t3, t4 ] := tps;
347 [ -, -, g3, g4 ] := grtps;
348 if t_int in g1 and t_int in g2 then
352 if t_tuple in g3*g4 then
smff 84 if is_knt(t3) and is_knt(t4) and
smff 85 is_const_int(i1) and is_const_int(i2) then
smff 86 ct1 := comptyp(t4);
smff 87 v1 := oi_val(i1);
smff 88 v2 := oi_val(i2);
smff 89 if 1 <= v1 and v1 <= v2+1 and v2 <= #ct1 then
smff 90 tp := knt_type( ct1(1..v1-1)
smff 91 + comptyp(t3)
smff 92 + ct1(v2+1..) );
smff 93 else
smff 94 tp := type_zero;
smff 95 end if;
smff 96 else
smff 97 if is_knt(t3) then norm(t3); end if;
smff 98 if is_knt(t4) then norm(t4); end if;
smff 99 tp := t3 .dis t4;
smff 100 end if;
356 end if;
smff 101
smff 102 if t_string in g3 and t_string in g4 then
smff 103 tp .dis:= type_string;
smff 104 end if;
357 end if;
358
359 (q1_send):
360 $ t1 must be an integer.
smff 105 [ -, -, t3 ] := tps;
smff 106 [ -, -, g3 ] := grtps;
362 if t_int in g1 then
366 if t_tuple in g2*g3 then
smff 107 if is_const_int(i1) and is_knt(t2) and is_knt(t3) then
smff 108 ct1 := comptyp(t3); v1 := oi_val(i1);
smff 109 if 1 <= v1 and v1-1 <= #ct1 then
smff 110 tp := knt_type( ct1(1..v1-1) + comptyp(t2) );
smff 111 else
smff 112 tp := type_zero;
smff 113 end if;
smff 114 else
smff 115 if is_knt(t2) then norm(t2); end if;
smff 116 if is_knt(t3) then norm(t3); end if;
smff 117 tp := t2 .dis t3;
smff 118 end if;
370 end if;
smff 119
smff 120 if t_string in g2 and t_string in g3 then
smff 121 tp .dis:= type_string;
smff 122 end if;
371 end if;
372
373$
374$ assigning operators
375$
376 (q1_asn, q1_argin):
377 tp := t1;
378
379 (q1_argout):
380 tp := tps(3);
381
382 (q1_sargout):
383 $ i1 is the routine name
384 $ i2 is the actual parameter number
385 r := oi_sym(i1); j := oi_val(i2);
386 if rvary(r)=1 and rnargs(r) < j then
387 $ the routine has a variable number of arguments, and the
388 $ current argument has the form of the last formal argument
389 j := rnargs(r);
390 end if;
391 tp := given_type(ft_elmt(form(r))(j));
smff 123 if maxtype_sargs(r) /= om then
smff 124 tp .con:= maxtype_sargs(r)(j);
smff 125 end if;
392
393 (q1_def):
394 $ most general definition for external procedure simulation
395 tp := type_gen;
396$
397$ map operations
398$
399 (q1_of):
smfb 405 $ the first input can be a string, a tuple, or a set. we handle
smfb 406 $ each case separately.
402
403 if t_string in g1 and t_int in g2 then
404 tp := type_string;
405 end if;
406
407 $ next we handle f(x) where f is a known length tuple and x is
408 $ an integer constant. there are three possibilities:
409 $ a. x <= 0: error.
410 $ b. 1 <= x <= # f: set result to proper component type.
411 $ c. # f < x: set result to omega type.
412
413 if t_tuple in g1 and t_int in g2 then
414 if is_knt(t1) and is_const_int(i2) then
415 v := oi_val(i2);
416
417 if 1 <= v and v <= # comptyp(t1) then
418 tp .dis:= ctypn(t1, v);
419 elseif # comptyp(t1) < v then
420 tp .dis:= type_om;
421 end if;
422
423 else
424 $ handle remaining tuple cases by or-ing in component
425 $ type
426 $ nb. the result may be omega.
427 if is_knt(t1) then norm(t1); end if;
smfd 15 tp .dis:= comptyp(t1) .dis type_om;
430 end if;
431 end if;
432
433 $ finally handle sets by 'or'ing in image type. once again,
434 $ the result may be omega.
435
436 if t_set in g1 then
437 ctp := comptyp(t1);
438 if ctp = type_om then
439 $ no pair type yet: keep type small
440 tp .dis:= type_om;
441 elseif (ctp .con:= type_pair) /= type_zero then
442 ct1 := comptyp(ctp);
443 tx := ct1(1) .con t2;
444 if tx /= type_zero then
smfd 16 tp .dis:= ct1(2) .dis type_om;
smfi 272 elseif t2 /= type_zero then
447 $ index not in map domain: result is omega
448 tp .dis:= type_om;
449 end if;
450 end if;
451 end if;
452
453 (q1_ofa):
454 $ the result is set(image type of f)
455 if t_set in g1 then
456 ctp := comptyp(t1);
457 if ctp = type_om then
458 $ no pair type yet: pass null set along
459 tp := ntyp( grsset, type_om );
460 elseif (ctp .con:= type_pair) /= type_zero then
461 ct1 := comptyp(ctp);
462 tx := ct1(1) .con t2;
463 if tx /= type_zero then
smfd 17 tp := ntyp( grsset, ct1(2) .dis type_om );
smfi 273 elseif t2 /= type_zero then
466 $ index not in map domain: result is null set
467 tp := ntyp( grsset, type_om );
468 end if;
469 end if;
470 end if;
471
472 (q1_sof):
473 t3 := tps(3); g3 := grtps(3);
474
475 $ first we handle the case where f is a known-length tuple
476 $ and x is an integer constant. there are three cases:
477 $ a. x <= 0: error.
478 $ b. 1 <= x <= # f: set x-th component type of result to x-th
479 $ component type of f .dis y
480 $ c. x > # f: set result to mixed tuple whose first #f
481 $ components have the component types of f
482 $ and whose x-th component has the type of
483 $ y.
484
485 if t_tuple in g3 and t_int in g1 then
486 if is_knt(t3) and is_const_int(i1) then
487 v := oi_val(i1);
488 ct1 := comptyp(t3);
489
490 if 1 <= v and v <= #ct1 then
491 tp := t3;
492 ctypn(tp, v) := t2;
493 elseif #ct1 < v then
494 tp := t3;
495 ctypn(tp, v) := t2;
496 (forall j in [ #ct1+1..v-1 ])
497 ctypn(tp, j) := type_om;
498 end forall;
499 end if;
500
501 else
502 $ otherwise if f is a tuple then the result is a tuple
503 $ whose component type is the disjunction of the com-
504 $ ponent type(s) of f and the type of y.
505 if is_knt(t3) then norm(t3); end if;
506 tp := ntyp( grstup, comptyp(t3) .dis t2 );
507 end if;
508 end if;
509
510 $ if f can be a set then we 'or' in the type for [x, y].
511 $ there are two special cases:
512 $ 1. either x or y are definitely omega. in this case we
513 $ shall never insert the pair into f, so we treat the
514 $ instruction as a noop.
515 $ 2. either x or y might be omega. in this case we shall
516 $ perform a run-time test and insert the pair only if
517 $ neither element is omega. before building the type
518 $ descriptor for the pair we set both is_om flags to no.
519
520 if t_set in g3 then
521 $ ctp1 is the map element type derived from x and y
522 ctp1 := pair_type(t1, t2);
523 if is_notom(t1) and is_om(t2) then
524 $ cannot say whether a pair is actually inserted
525 ctp1 .dis:= type_om;
526 end if;
527 $ ctp2 is the map element type from the i-occurrence of f
528 ctp2 := (type_pair .dis type_om) .con comptyp(t3);
529 $ ctp is the new map element type
530 ctp := ctp1 .dis ctp2;
531 if is_notom(ctp1) or is_notom(ctp2) then
532 ctp .con:= type_notom;
533 end if;
534 tp .dis:= ntyp( grsset, ctp );
535 end if;
536
537 if t_int in g1 and t_string in g2 and t_string in g3 then
538 tp .dis:= type_string;
539 end if;
540
541 (q1_sofa):
542 $ the output f will always be a map
543 t3 := tps(3); g3 := grtps(3);
544 if t_set in g3 and t_set in g2 then
545 tz := t2 .con type_set; $ range set type
546 ty := comptyp(tz); $ range element type
547 $ ctp1 is the map element type derived from x and y
548 ctp1 := pair_type(t1, ty);
549 if is_notom(t1) and is_om(ty) then
550 $ cannot say whether a pair is actually inserted
551 ctp1 .dis:= type_om;
552 end if;
553 $ ctp2 is the map element type from the i-occurrence of f
554 ctp2 := (type_pair .dis type_om) .con comptyp(t3);
555 $ ctp is the new map element type
556 ctp := ctp1 .dis ctp2;
557 if is_notom(ctp1) or is_notom(ctp2) then
558 ctp .con:= type_notom;
559 end if;
560 tp .dis:= ntyp( grsset, ctp );
561 end if;
562
563$
564$ iterators
565$
566 (q1_next, q1_inext):
smfb 407 $ the second input, i.e. the object being iterated over, can be
smfb 408 $ a string, a tuple, or a set.
571
572 if opc = q1_next then
573 tp := tps(3);
574 end if;
575
576 if t_string in g2 then
577 tp .dis:= type_string;
578 end if;
579
580 if not is_prim(g2) then
581 if is_knt(t2) then norm(t2); end if;
582 tp .dis:= comptyp(t2);
smfe 105 if t_tuple notin g2 then tp .con:= type_notom; end if;
583 end if;
585
586 (q1_nextd, q1_inextd):
587 $ here we compute the type for 'x' in 'for y = f(x)'.
588 $ t2 is the type of f.
589 $ if t2 is a tuple or string, then x is an integer;
590 $ if t2 is a set, it must be a map, and consequently the
591 $ type of x is the type of the first component of the
592 $ component type of t2.
593 if str_tup * g2 /= {} then
594 tp := type_int;
595 end if;
596 if t_set in g2 then
597 ctp := comptyp(t2) .con type_pair;
598 if ctp /= type_zero then
599 ct1 := comptyp(ctp);
600 tp .dis:= ct1(1);
601 end if;
602 end if;
603
604 (q1_set):
605 $ enumerative set former - { x1, x2, x3, ..., xn }
606 $ the result is set(disjunction of individual elements)
607 ctp := type_zero .dis/ tps;
608 tp := ntyp( grsset, ctp .con type_notom );
609
610 (q1_set1):
611 $ iterative set former - { : x in s | c(x) }
612 $ the first input argument gives the (see comment above)
613 $ type of . the result type is set(t1).
614 tp := ntyp( grsset, t1 .dis type_om );
615
616 (q1_tup):
617 $ enumerative tuple former - [ x1, x2, x3, ..., xn ]
618 $ the result is a known-length tuple.
619 (forall ctp = tps(j))
620 tps(j) := ctp .con type_notom;
621 end forall;
622 if #tps = 1 then
623 tp := ntyp( grstup, tps(1) );
624 else
625 tp := knt_type(tps);
626 end if;
627
628 (q1_tup1):
629 $ iterative tuple former - [ : x in s | c(x) ]
630 $ the result type is tuple(t1); see above comment on first
631 $ argument of iterative set and tuple formers.
632 tp := ntyp( grstup, t1 .dis type_om );
633
634 else
635 print('*** missing opcode in forward *** ', o, opc);
636
637 end case;
638
639 return tp;
640
641
642 end procedure forward;
643
644
1 .=member bak14g
2
3
4 procedure backward(inst);
5$
6$ this routine computes the type of the ivariables of inst based on how
7$ they are used.
8$
9$ certain operations such as addition are only legal if the inputs are
10$ not omega. when we process:
11$
12$ (1) read(x);
13$ (2) print(x+1);
14$
15$ we have:
16$
17$ is_om(x1) = maybe by forward analysis
18$ is_om(x2) = no by backward analysis
19$
20$ this means that x1 and x2 have different types, and a conversion
21$ must be inserted between lines 1 and 2. this conversion amounts
22$ to checking that x is not omega.
23$
24 repr
25 inst: elmt insts;
26 opc: elmt base_opcodes;
27 ivs: tuple(occurrence);
28 j: integer;
29 tps: tuple(elmt types);
30 i: occurrence;
31 otyp: elmt types;
32 gotyp: gross_type;
33 i1, i2: occurrence;
34 t1, t2: elmt types;
35 outps: tuple(elmt types);
36 tp, tpa, tpb, tpx: elmt types;
37 tp1, tp2: elmt types;
38 ctp: elmt types;
39 ct1: tuple(elmt types);
40 tx, ty: elmt types;
41 c: general;
42 v: integer;
43 r: symbol;
44 end repr;
45$
46$ begin by getting the type of the ovariable, etc.
47$
48 opc := opcode(inst);
49 ivs := [ get_oi(inst, j) : j in [ first_ivar(opc)..#args(inst) ] ];
50 tps := [ typ(i) : i in ivs ];
51 otyp := typ(get_oi(inst, 1));
52 gotyp := grosstyp(otyp);
53
54 [ t1, t2 ] := tps;
55 outps := tps;
56
57 macro change1; outps(1) := tp endm;
58 macro change2; outps(2) := tp endm;
59 macro change3; outps(3) := tp endm;
60
smfc 620$ check whether otyp is type_zero. this indicates that the instruction
smfc 621$ contains an error. in this situation we replace otyp by type_general
smfc 622$ to return the mildest constraint on this instruction. note that the
smfc 623$ results of this routine are always conjuncted with the previous
smfc 624$ results; hence this upper bound will not cause divergence.
smfc 625
smfc 626 if otyp = type_zero then
smfc 627 otyp := type_gen; gotyp := grosstyp(otyp);
smfc 628 end if;
66
67 case opc of
68$
69$ binary operators
70$
71
72 (q1_in, q1_notin):
73 $ we are looking at s in x in s. s must be a set,
74 $ string, or tuple.
75 tp := type_str_tup_set;
76 change2;
77
78 (q1_incs):
79 tp := type_set;
80 change1; change2;
81
smfh 32 (q1_ge, q1_lt, q1_pos):
83 $ the inputs are integers, reals, or strings.
smfi 274 tp := type_int_real_str;
smfi 275 if t1 /= type_zero then tp .con:= t1; end if;
smfi 276 if t2 /= type_zero then tp .con:= t2; end if;
85 change1; change2;
86
87 (q1_with):
88 $ s.in has the same type as s.out
89 $ x.in has the element type of s.out
90 $ s can not be omega; x can be omega iff s is a tuple
91 $ with is not defined for known-length tuples
92 if t_tuple in gotyp and is_knt(otyp) then norm(otyp); end if;
93 if not is_prim(gotyp) then
94 ctp := comptyp(otyp) .dis type_om;
95 tp := ntyp( gotyp * set_tup, ctp );
96 else
97 tp := type_zero;
98 end if;
99 change1;
100
101 tp := comptyp(tp);
102 if t_tuple notin gotyp then tp .con:= type_notom; end if;
103 change2;
104
105 (q1_less):
106 $ s.in must be a set
107 $ s.in can not be omega
108 tp := if t_set in gotyp then type_set else type_zero end;
109 change1;
110
111 (q1_lesse, q1_lessb):
112 $ these opcodes are part of the simulation for q1_fromb and
113 $ q1_frome.
114 $ t.in must be a tuple
115 $ t.in can not be omega
116 tp := if t_tuple in gotyp then type_tuple else type_zero end;
117 change1;
118
119 (q1_lessf):
120 $ arg2 is a map, arg3 can be anything
121 if t_set in gotyp then
122 tp := ntyp( grsset, type_pair .dis type_om );
123 end if;
124 change1;
125
126 (q1_npow):
127 tp := (comptyp(otyp) .con type_set) .dis type_int;
128 change1; change2;
129
130 (q1_add):
131 tp := otyp .con type_int_real_str;
132 if not is_prim(gotyp) then
133 if is_knt(otyp) then norm(otyp); end if;
134 ctp := comptyp(otyp) .dis type_om;
135 tp .dis:= ntyp( gotyp*set_tup, ctp );
136 end if;
137 change1; change2;
138
139 (q1_mult):
140 tp := otyp .con type_int_real;
141
142 if t_set in gotyp then
143 tp .dis:= type_set;
144 end if;
145
146 tpx := otyp .con type_str_tup;
147 tpa := tpb := tp;
148 if tpx /= type_zero then
149 if (tp1 := tpx .con t1) /= type_zero and
smfi 277 t_int in grosstyp(t2) or t1 = type_zero then
151 tpa .dis:= tp1;
152 tpb .dis:= type_int;
153 end if;
154 if (tp2 := tpx .con t2) /= type_zero and
smfi 278 t_int in grosstyp(t1) or t2 = type_zero then
156 tpa .dis:= type_int;
157 tpb .dis:= tp2;
158 end if;
159 end if;
160 tp := tpa; change1;
161 tp := tpb; change2;
162
163 (q1_mod, q1_sub):
164 tp := otyp .con type_int_real;
165 if t_set in gotyp then
166 tp .dis:= type_set;
167 end if;
168 change1; change2;
169
170 (q1_exp):
171 tp := otyp .con type_int_real;
172 change1;
173
174 if t_real in gotyp then
175 tp .dis:= type_int;
176 end if;
177 change2;
178
179 (q1_max, q1_min):
180 tp := type_int_real_str;
181 change1; change2;
182
183 (q1_slash):
184 tp := type_int_real;
185 change1; change2;
186
187 (q1_div):
188 tp := type_int;
189 change1; change2;
190
smff 126 (q1_atan2):
smff 127 tp := type_real;
smff 128 change1; change2;
191$
192$ unary operators
193$
194 (q1_not, q1_asrt):
195 tp := type_boolean;
196 change1;
197
198 (q1_even, q1_odd):
199 tp := type_int;
200 change1;
201
202 (q1_isint, q1_isreal, q1_isstr, q1_isbool,
smfe 106 q1_isatom, q1_istup, q1_isset, q1_ismap):
204 tp := type_notom;
205 change1;
206
207 (q1_arb):
208 $ q1_arb is only defined for sets and maps.
209 $ the input must be set(output type)
210 tp := ntyp( grsset, otyp .dis type_om );
211 change1;
212
213 (q1_arbb, q1_arbe):
214 $ these opcode are part of the simulation of q1_fromb, q1_frome
215 $ t.in must be a tuple; t.in can not be omega
216 tp := ntyp( grstup, otyp .dis type_om );
217 change1;
218
219 (q1_dom):
220 $ the input is a map with domain type 'otyp' and
221 $ image type general.
222 ctp := pair_type(comptyp(otyp), type_gen) .dis type_om;
223 tp := ntyp( grsset, ctp );
224 change1;
225
226 (q1_range):
227 $ the input is a map with domain type general and
228 $ image type 'otyp'.
229 ctp := pair_type(type_gen, comptyp(otyp)) .dis type_om;
230 tp := ntyp( grsset, ctp );
231 change1;
232
233 (q1_pow):
234 $ the output will be a set of sets, by forward propagation
235 tp := comptyp(otyp) .con type_set;
236 change1;
237
238 (q1_nelt):
239 $ q1_nelt is defined for strings, tuples, and sets.
240 tp := type_str_tup_set;
241 change1;
242
smff 129 (q1_abs):
smff 130 tp := otyp .con type_int_real;
smff 131 if t_int in gotyp then tp .dis:= type_string; end if;
245 change1;
smff 132
smff 133 (q1_char):
smff 134 tp := type_int;
smff 135 change1;
246
247 (q1_ceil, q1_floor, q1_fix):
248 $ the input must be real.
249 tp := type_real;
250 change1;
251
252 (q1_float):
253 $ the input must be integer.
254 tp := type_int;
255 change1;
256
257 (q1_sin, q1_cos, q1_tan,
258 q1_arcsin, q1_arccos, q1_arctan,
259 q1_tanh,
260 q1_expf, q1_log,
261 q1_sqrt ):
262 $ the input must be real.
263 tp := type_real;
264 change1;
265
266 (q1_rand):
267
268 tp := (otyp .dis ntyp( set_tup, otyp )) .con type_notom;
273 change1;
274
275 (q1_sign):
276 tp := type_int_real;
277 change1;
smfe 107
smfe 108 (q1_type, q1_str):
smfe 109 tp := type_notom;
smfe 110 change1;
278
279 (q1_val):
280 tp := type_string;
281 change1;
smff 136
smff 137 (q1_umin):
smff 138 tp := otyp .con type_int_real;
smff 139 change1;
282
smfg 119 (q1_if, q1_ifnot, q1_bif, q1_bifnot):
284 $ the input is boolean
285 tp := type_boolean;
286 change1;
287
288 (q1_next, q1_inext):
smfk 134 $ input is set(otyp), tuple(otyp), or string
290 tp := ntyp( str_tup_set, otyp .dis type_om );
291 change2;
292
293 (q1_nextd, q1_inextd):
294 $ the first argument is the domain element of the iteration.
295 ctp := pair_type(otyp, type_gen);
296 tp := ntyp( grsset, ctp .dis type_om );
297 if t_int in gotyp then $ could be string or tuple iterator
298 tp .dis:= type_str_tup;
299 end if;
300 change2;
301
302 (q1_set):
303 tp := comptyp(otyp) .con type_notom;
304 outps := [ tp : j in [ 1..#ivs ] ];
305
306 (q1_set1):
307 tp := comptyp(otyp) .con type_notom;
309 change1;
310
311 tp := type_int;
312 change2;
313
314 (q1_tup):
315 if is_knt(otyp) then
316 ct1 := comptyp(otyp);
317 (forall j in [ 1..#ivs ])
320 outps(j) := ct1(j) .con type_notom;
321 end forall;
322 else
323 tp := comptyp(otyp) .con type_notom;
325 outps := [ tp : j in [ 1..#ivs ] ];
326 end if;
327
328 (q1_tup1):
329 $ the input type is the element type of the final tuple.
330 $ if there are several element types (i.e. for known-length
331 $ tuples) we take their disjunction.
332 if is_knt(otyp) then
333 tp := type_zero .dis/ comptyp(otyp);
334 else
335 tp := comptyp(otyp);
336 end if;
337 tp .con:= type_notom;
338 change1;
339
340 tp := type_int;
341 change2;
342
343$
344$ slicing operations
345$
346 (q1_end, q1_subst):
347 if t_string in gotyp then
348 tp := type_string;
349 else
350 tp := type_zero;
351 end if;
352 if t_tuple in gotyp then
353 tp .dis:= type_tuple;
354 end if;
356 change1;
357
358 tp := type_int;
359 change2;
360 if opc = q1_subst then change3; end if;
361
362 (q1_ssubst, q1_send):
363 if t_tuple in gotyp then
364 if is_knt(otyp) then norm(otyp); end if;
365 tp := otyp .con type_notom;
366 else
367 tp := type_zero;
368 end if;
369 if t_string in gotyp then
370 tp .dis:= type_string;
371 end if;
373 j := if opc = q1_ssubst then 4 else 3 end;
smff 140 outps(j) := tp;
smff 141 outps(j-1) := tp;
376
377 tp := type_int;
378 change1;
379 if opc = q1_ssubst then change2; end if;
380$
381$ map operations
382$
383 (q1_of):
384 ctp := pair_type(type_gen, otyp);
smfc 629 if ctp = type_zero then ctp := type_pair; end if;
385 tp := ntyp( grsset, ctp .dis type_om );
386 if t_int in grosstyp(t2) then
387 if t_string in gotyp then
388 tp .dis:= type_string;
389 end if;
390 if t_tuple in grosstyp(t1) then
391 i2 := ivs(2);
392 if is_const_int(i2) and is_knt(t1) then
393 v := oi_val(i2);
394 c := comptyp(t1);
395 c(v) := otyp;
396 tp .dis:= knt_type(c);
397 else
398 tp .dis:= type_tuple;
399 end if;
400 end if;
smfi 279 elseif t2 = type_zero then
smfi 280 tp .dis:= type_str_tup;
401 end if;
403 change1;
404
smfi 281 if t_set in grosstyp(t1) or t1 = type_zero then
406 tp := type_notom;
407 else
408 tp := type_int;
409 end if;
410 change2;
411
412 (q1_ofa):
413 if t_set in gotyp then
414 ctp := pair_type(type_gen, comptyp(otyp));
smfc 630 if ctp = type_zero then ctp := type_pair; end if;
415 else
416 ctp := type_pair;
417 end if;
418 tp := ntyp( grsset, ctp .dis type_om );
419 change1;
smfe 111 tp := type_notom;
smfe 112 change2;
420
421 (q1_sof):
422 if t_set in gotyp then
423 ctp := comptyp(otyp) .con type_pair;
424 if ctp /= type_zero then
425 [ tx, ty ] := comptyp(ctp);
426 else
427 tx := type_notom; ty := type_gen;
428 end if;
429 tp := tx .con type_notom;
430 else
431 tp := type_zero;
432 end if;
433 if str_tup * gotyp /= {} then
434 tp .dis:= type_int;
435 end if;
437 change1;
438
439 if t_string in gotyp then
440 tp := type_string;
441 else
442 tp := type_zero;
443 end if;
444 if t_set in gotyp then
446 tp .dis:= ty .dis type_om;
447 end if;
448 if t_tuple in gotyp then
449 if is_knt(otyp) then
450 i1 := ivs(1);
451 ct1 := comptyp(otyp);
452 if is_const_int(i1) then
453 v := oi_val(i1);
454 tp .dis:= ct1(v) .dis type_om;
455 else
456 tp .dis:= (type_om .dis/ ct1);
457 end if;
458 else
459 tp .dis:= comptyp(otyp) .dis type_om;
460 end if;
461 end if;
462 change2;
463
464 if t_string in gotyp then
465 tp := type_string;
466 else
467 tp := type_zero;
468 end if;
469 if t_tuple in gotyp then
470 if is_knt(otyp) then
471 ct1 := comptyp(otyp);
472 (forall ctp = ct1(j))
473 ct1(j) := ctp .dis type_om;
474 end forall;
475 tp .dis:= knt_type(ct1);
476 else
477 ctp := comptyp(otyp);
478 tp .dis:= ntyp( grstup, ctp .dis type_om );
479 end if;
480 end if;
481 if t_set in gotyp then
482 tp .dis:= ntyp( grsset, pair_type(tx, ty) .dis type_om );
483 end if;
484 change3;
485
486 (q1_sofa):
487 $ the output must be a map, by forward propagation.
488 ctp := comptyp(otyp) .con type_pair;
489 if ctp /= type_zero then
490 [ tx, ty ] := comptyp(ctp);
491 else
492 tx := type_notom; ty := type_gen;
493 end if;
494
495 tp := tx .con type_notom;
496 change1;
497
498 tp := ntyp( grsset, ty .dis type_om );
499 change2;
500
501 tp := ntyp( grsset, pair_type(tx, ty) .dis type_om );
502 change3;
503
504 (q1_asn, q1_argin):
505 tp := otyp;
506 change1;
507
508 (q1_argout):
509 tp := otyp;
510 change3;
511
512 (q1_sargin):
513 r := args(inst)(2);
514 j := value(args(inst)(3));
515 if rvary(r)=1 and rnargs(r) < j then
516 $ the routine has a variable number of arguments, and the
517 $ current argument has the form of the last formal argument
518 j := rnargs(r);
519 end if;
520 tp := given_type(ft_elmt(form(r))(j));
smff 142 if maxtype_sargs(r) /= om then
smff 143 tp .con:= maxtype_sargs(r)(j);
smff 144 end if;
521 change1;
smfg 120
smfg 121 (q1_isom):
smfg 122 tp := type_om;
smfg 123 change1;
smfg 124
smfg 125 (q1_notom):
smfg 126 tp := type_notom;
smfg 127 change1;
522
523 else
524 print('*** missing opcode in back', opc, inst);
525 end case;
526
527
528 return outps;
529
530
531 end procedure backward;
532
533
1 .=member tcn14h
2
3
4 procedure type_constant(inst);
5$
6$ this procedure checks whether the result of the instruction inst is
7$ determined by the types of its inputs.
8$
9 repr
10 inst: elmt insts;
11 opc: elmt base_opcodes;
12 occsi: tuple(occurrence);
13 tps: tuple(elmt types);
14 grtps: tuple(gross_type);
15 i: occurrence;
16 t1, t2, t3: elmt types;
17 g1, g2, g3: gross_type;
18 tx, ty, tp: elmt types;
19 ct1: tuple(elmt types);
20 ctp: elmt types;
21 j: integer;
22 end repr;
23
24
25 opc := opcode(inst);
26 occsi := [ get_oi(inst, j) : j in [ 1..#args(inst) ] ];
27 tps := [ typ(i) : i in occsi ];
28 grtps := [ grosstyp(tp) : tp in tps ];
smfk 135
smfk 136 if exists tp in tps | tp = type_zero then return; end if;
29
30 [ t1, t2, t3 ] := tps;
31 [ g1, g2, g3 ] := grtps;
32
33 case opc of
34
35 (q1_eq, q1_ne):
36 $ type a2 = type a3
37 if t2 = type_om or t3 = type_om then
38 if t2 = t3 then
39 return 'both operands are omega';
40 elseif is_notom(t2) then
smff 145 return 'the left operand cannot be omega, '
smff 146 'the right operand is omega';
43 elseif is_notom(t3) then
smff 147 return 'the left operand is omega, '
smff 148 'the right operand cannot be omega';
46 end if;
smfd 22 elseif constant_equality(t2, t3) then $ do recursive test
smfd 23 return 'the operands have different types';
49 end if;
50
51 (q1_in, q1_notin):
52 $ in: a1 := exists x in a3 | x = a2
53 $ notin: a1 := forall x in a3 | x /= a2
54 $ type a2 = type arb a3
55 if t_string in g3 then
56 if t2 .con t3 .con type_string = type_zero then
57 return 'both operands should be strings';
58 end if;
59 end if;
60 if t_tuple in g3 and t2 /= type_om then
61 if is_knt(t3) then
62 ct1 := comptyp(t3);
63 if forall tx in ct1 |
smfd 24 constant_equality(t2, tx) then
65 return 'the left operand cannot be '
66 'an element of the right operand';
67 end if;
68 else
69 tx := comptyp(t3);
smfd 25 if constant_equality(t2, tx) then
71 return 'the left operand cannot be '
72 'an element of the right operand';
73 end if;
74 end if;
75 end if;
76 if t_set in g3 then
77 tx := comptyp(t3);
smfd 26 if constant_equality(t2, tx) then
79 return 'the left operand cannot be '
80 'an element of the right operand';
81 end if;
82 end if;
83
84 (q1_incs, q1_sub, q1_mult, q1_mod):
85 $ incs: a1 := forall x in a3 | x in a2
86 $ sub: a1 := { x in a2 | x notin a3 }
87 $ mult: a1 := { x in a2 | x in a3 }
88 $ mod: a1 := ( a2 - a3 ) + ( a3 - a2 )
89 $ type arb a2 = type arb a3
90 if t_set in g2 then
91 tx := comptyp(t2);
92 ty := comptyp(t3);
smfd 27 if constant_equality(tx, ty) then
smfd 28 return
smfd 29 case opc of
smfd 30 (q1_incs): 'the right operand cannot include '
smfd 31 'the left operand',
smfd 32 (q1_sub): 'the result will be the left operand',
smfd 33 (q1_mult): 'the result will be a null set',
smfd 34 (q1_mod): 'the result will be '
smfd 35 'the union of the operands'
smfd 36 else '*** error in type_constant ***'
smfd 37 end;
95 end if;
96 end if;
97
98 (q1_less):
99 $ a1 := { x in a2 | x /= a3 }
100 $ type arb a2 = type a3
101 if t_set in g2 then
102 tx := comptyp(t2);
smfd 38 if tx = type_om then
smfd 39 return 'the left operand is a null set';
smfd 40 end if;
smfd 41 if constant_equality(tx, t3) then
104 return 'the right operand cannot be '
105 'an element of the left operand';
106 end if;
107 end if;
108
109 (q1_lessf):
110 $ a1 := { [ x, y ] in a2 | x /= a3 }
111 $ type arb domain a2 = type a3
112 if (t2 .con:= type_map) /= type_zero then
113 ctp := comptyp(t2);
114 if ctp = type_om then
smfd 42 return 'the left operand is a null map';
116 end if;
117 ct1 := comptyp(ctp);
118 tx := ct1(1); $ domain element of map
smfd 43 if constant_equality(tx, t3) then
120 return 'the right operand cannot be '
121 'an element of the left operand''s domain';
122 end if;
123 end if;
124
125 (q1_type, q1_isint, q1_isreal, q1_isstr,
126 q1_isbool, q1_isatom, q1_istup, q1_isset):
127 $ a2 should have an ambiguous type
128 if #g2 = 1 then
smfk 137 return 'operand has a unique type';
130 end if;
131
132 (q1_ismap):
133 $ a1 := is_set a2 and forall x in a2 |
134 $ is_tuple x and #x = 2 and x(1) /= om
135 if g2 = grsset then
136 if .is_pair(comptyp(t2)) then
137 return 'operand is always a map';
138 end if;
139 elseif #g2 = 1 then
140 return 'operand cannot be a map';
141 end if;
142
143 (q1_of):
144 $ type arb domain a2 = type a3
145 if t_string in g2 or t_tuple in g2 then
146 if t3 .con type_int = type_zero then
147 return 'string or tuple index is not an integer';
148 end if;
149 end if;
150 if t_set in g2 then
151 if (t2 .con:= type_map) /= type_zero then
152 ctp := comptyp(t2);
153 if ctp = type_om then
smfd 44 return 'a retrieval from a null map always yields '
smfd 45 'omega';
155 end if;
156 ct1 := comptyp(ctp);
157 tx := ct1(1); $ domain element of map
smfd 46 if constant_equality(tx, t3) then
smfd 47 return 'the index is not in the map''s domain';
160 end if;
161 end if;
162 end if;
163
164 (q1_ofa):
165 $ a1 := { y : [ x, y ] in a2 | x = a3 }
166 $ type arb domain a2 = type a3
167 if (t2 .con:= type_map) /= type_zero then
168 ctp := comptyp(t2);
169 if ctp = type_om then
smfd 48 return 'a retrieval from a null map always yields '
smfd 49 'a null set';
171 end if;
172 ct1 := comptyp(ctp);
173 tx := ct1(1); $ domain element of map
smfd 50 if constant_equality(tx, t3) then
smfd 51 return 'the index is not in the map''s domain';
176 end if;
177 end if;
178
179 (q1_case):
180 $ type arb domain a1 = type a2
181 if (t1 .con:= type_map) /= type_zero then
182 ctp := comptyp(t1);
183 if ctp = type_om then
184 return 'trivial case statement';
185 end if;
186 ct1 := comptyp(ctp);
187 tx := ct1(1); $ domain element of map
smfd 52 if constant_equality(tx, t3) then
189 return 'expression cannot match any case tag value';
190 end if;
191 end if;
192
193 end case;
194
195
196 end procedure type_constant;
197
198
smfd 53
smfd 54
smfd 55 procedure constant_equality(t1, t2);
smfd 56$
smfd 57$ this routine performs the recursive test whether the values described
smfd 58$ by t1 and t2 are always equal (not equal) due to their types.
smfd 59$
smfd 60 repr
smfd 61 t1, t2: elmt types;
smfd 62 g1, g2: gross_type;
smfd 63 c1, c2: elmt types;
smfd 64 ct1, ct2: tuple(elmt types);
smfd 65 i: integer;
smfd 66 end repr;
smfd 67
smfd 68
smfd 69 g1 := grosstyp(t1); if t_om in g1 then g1 less:= t_om; end if;
smfd 70 g2 := grosstyp(t2); if t_om in g2 then g2 less:= t_om; end if;
smfd 71
smfd 72 if g1 * g2 = {} then
smfd 73 $ no common gross type: this will always evaluate to false.
smfd 74 return true;
smfd 75
smfd 76 elseif #g1 > 1 or #g2 > 1 then
smfd 77 $ ambiguous gross types: we cannot know which combination of
smfd 78 $ values will be tested.
smfd 79 return false;
smfd 80
smfd 81 elseif is_prim(g1) then
smfd 82 $ here the gross types must be equal: if they are primitive, no
smfd 83 $ no component type needs to be tested.
smfd 84 return false;
smfd 85
smfd 86 elseif is_knt(t1) and is_knt(t2) then
smfd 87 $ two known-length tuples
smfd 88 $ note that known-length tuples cannot be just null tuples.
smfd 89 ct1 := comptyp(t1); ct2 := comptyp(t2);
smfd 90 if #ct1 /= #ct2 then
smfd 91 return false;
smfd 92 else
smfd 93 return forall i in [ 1..#ct1 ] |
smfd 94 constant_equality(ct1(i), ct2(i));
smfd 95 end if;
smfd 96
smfd 97 else
smfd 98 $ two non-primitive types
smfd 99 if is_knt(t1) then norm(t1); end if;
smfd 100 if is_knt(t2) then norm(t2); end if;
smfd 101
smfd 102 c1 := comptyp(t1); c2 := comptyp(t2);
smfd 103
smfd 104 $ see if one operand is a null set or null tuple: the test is
smfd 105 $ constant if the other operand cannot be a null set or tuple.
smfd 106 if c1 = type_om then return not is_om(c2); end if;
smfd 107 if c2 = type_om then return not is_om(c1); end if;
smfd 108
smfd 109 return constant_equality(c1, c2);
smfd 110 end if;
smfd 111
smfd 112
smfd 113 end procedure constant_equality;
smfd 114
smfd 115
1 .=member knt14i
2
3
4 procedure ntyp(g, comp);
5$
6$ this routine builds a new type descriptor for any type except
7$ 'known length tuple'. its arguments are:
8$
9$ g: the grosstype of the result
10$ comp: the component type of the result
11$
12$ this routine always returns a type which is definitely not om,
13$ so that is_om must be separately set if this assumption is false
14$
15 repr
16 g: gross_type;
17 comp: elmt types;
18 end repr;
19$
20$ we begin by building the tuple for the type descriptor, then
21$ check that it is not nested to a depth greater than max_depth.
22$
23 if g = {} then return type_zero; end if;
24
25 if not is_prim(g) and comp = type_zero then
smfe 113 return [ g * int_real_str_atom ];
27 else
28 return [ g less t_om, trim(comp, 2), false ];
29 end if;
30
31
32 end procedure ntyp;
33
34
35
36
37 procedure knt_type(tps);
38$
39$ this routine builds the type descriptor for a known length tuple.
40$ 'tps' is a tuple containing the types of the components.
41$
42$ in order to make sure that the type lattice is finite, we restrict
43$ known length tuples to a maximum length. if #tps exceeds this length,
44$ we return a type descriptor for a homogeneous tuple.
48$
49 repr
50 tps: tuple(elmt types);
51 tp: elmt types;
52 i, ii: integer;
53 end repr;
54
55
56 if exists tp in tps | tp = type_zero then
57 return type_zero;
58
59 elseif #tps > max_len then
60 return ntyp(grstup, type_zero .dis/ tps);
61
62 elseif exists ii in [ #tps, #tps-1..1 ] | tps(ii) /= type_om then
63 return
64 [ grstup,
65 [ trim(tps(i), 2) : i in [ 1..ii ] ],
66 true ];
67
68 else
69 return [ grstup, type_om, false ];
70 end if;
71
72
73 end procedure knt_type;
74
75
1 .=member par14j
29
30
31 procedure pair_type(t1, t2);
32
33$ this routine builds the type descriptor for a pair whose component
34$ types are t1 and t2.
35$
36 repr
smfe 114 t1, t2: elmt types;
39 end repr;
40
smfe 115 return knt_type( [ t1 .con type_notom, t2 .con type_notom ] );
42
43 end procedure pair_type;
44
45
1 .=member trm14k
2
3
4 procedure trim(tp, n);
5$
6$ this routine walks recursively through the component type of tp. if
7$ tp is too deeply nested, it replaces the inner most component type
8$ with type_gen. n is the nesting level of the recursive walk.
10$
11 repr
12 t: elmt types;
13 tp: elmt types;
14 g: gross_type;
15 c: general;
16 n: integer;
17 end repr;
18
smfe 116 if tp = type_zero then return type_zero; end if;
smfe 117 if tp = type_gen then return type_gen; end if;
smfe 118
smfe 119 if n > max_depth then return type_gen; end if;
smfe 120
smfe 121 [ g, c ] := tp;
27
smfe 122 if is_prim(g) then
29 return tp;
30
31 elseif is_knt(tp) then
32 return [ g, [ trim(t, n+1) : t in c ], true ];
33
34 else
35 return [ g, trim(c, n+1), false ];
36 end if;
37
38 end procedure trim;
39
40
41
42
43 procedure norm(rw tp);
44$
45$ convert mixed tuple type to tuple.
46$
47 repr
48 tp: elmt types;
49 end repr;
50
51
52 tp := ntyp(grosstyp(tp), type_zero .dis/ comptyp(tp));
53
54 end procedure norm;
55
56
1 .=member con14l
2
3
4 operator .con(t1, t2);
5$
smfd 116$ this routine computes the meet (conjunction, 'and') of two types.
8$
9 repr
10 t1, t2, tp: elmt types;
11 g1, g2, g: gross_type;
12 c1, c2, c: general;
smfe 123 ct1: tuple(elmt types);
14 i: integer;
15 can_be_om: boolean;
16 end repr;
17
18 if t1 = type_zero then return type_zero; end if;
19 if t2 = type_zero then return type_zero; end if;
smfd 117
smfd 118 if t1 = type_gen then return t2; end if;
smfd 119 if t2 = type_gen then return t1; end if;
smfd 120
smfd 121 if t1 = t2 then return t1; end if;
20
21 [ g1, c1 ] := t1;
22 [ g2, c2 ] := t2;
23
24 can_be_om := is_om(t1) and is_om(t2);
25
smfd 122 if is_prim(g1) or is_prim(g2) then $ one is primitive
36 tp := [ g1 * g2 ];
37
smfd 123 elseif is_knt(t1) and is_knt(t2) then $ both known length
smfe 124 ct1 := [ ];
40
41 (forall i in [ 1..(#c1 min #c2) ])
smfe 125 ct1(i) := c1(i) .con c2(i);
43
smfe 126 if ct1(i) = type_zero then
45 return if can_be_om then type_om else type_zero end;
46 end if;
47 end forall;
48
smfe 127 tp := [ g1*g2, ct1, true ];
50
smfd 124 else $ both sets or tuples
52 g := g1 * g2;
53 if g = {} then return type_zero; end if;
54
55 if is_knt(t1) or is_knt(t2) then
56 $ one known-length, one unknown-length tuple
smfe 128 if is_knt(t2) then c := c2; c2 := c1; c1 := c; end if;
58 $ c1 is known-length tuple
smfe 129 ct1 := [ ];
60 (forall i in [ 1..#c1 ])
smfe 130 ct1(i) := c1(i) .con c2;
smfe 131 if ct1(i) = type_zero then
63 return if can_be_om then type_om else type_zero end;
64 end if;
65 end forall;
66
smfe 132 tp := [ g, ct1, true ];
68
69 else
70 c := c1 .con c2;
71 if c = type_zero then
72 if t_set notin g then return type_zero; end if;
73 c := type_om;
74 end if;
75 tp := [ g, c, false ];
76 end if;
77 end if;
78
smfd 125 assert can_be_om = is_om(tp);
smfd 126 assert can_be_om impl tp /= type_zero;
smfd 127 return tp;
83
84
85 end operator .con;
86
87
1 .=member dis14m
2
3
4 operator .dis(t1, t2);
5$
smfd 128$ this routine computes the join (disjunction, 'or') of two types.
smfd 129$
smfe 133$ assert t_set in bsctyps;
smfe 134$ assert t_set in grosstyp(tp) impl not is_knt(tp);
smfd 130$ assert is_prim(grosstyp(type_om));
8$
9 repr
10 t1, t2, tp: elmt types;
smfe 135 g1, g2, g: gross_type;
smfe 136 c1, c2, c: general;
smfe 137 ct1: tuple(elmt types);
13 i: integer;
15 end repr;
16
17 if t1 = type_zero then return t2; end if;
18 if t2 = type_zero then return t1; end if;
smfd 131
smfd 132 if t1 = type_gen then return type_gen; end if;
smfd 133 if t2 = type_gen then return type_gen; end if;
smfd 134
smfd 135 if t1 = t2 then return t1; end if;
19
20 [ g1, c1 ] := t1;
21 [ g2, c2 ] := t2;
22
smfd 136 if is_prim(g1) and is_prim(g2) then $ both are primitive
38 tp := [ g1 + g2 ];
39
smfd 137 elseif is_prim(g1) then $ t1 primitive
smfd 138 tp := [ g1+g2, c2, is_knt(t2) ];
43
smfd 139 elseif is_prim(g2) then $ t2 primitive
smfd 140 tp := [ g1+g2, c1, is_knt(t1) ];
47
smfd 141 elseif is_knt(t1) and is_knt(t2) then $ both known length
49 $ for the following note that if the length of the two
50 $ tuples differ, we can view the shorter on to have an
51 $ arbitrary number of type_om components at the end.
smfe 138 ct1 := if #c1 >= #c2 then c1 else c2 end;
56 (forall i in [ 1..(#c1 min #c2) ])
smfe 139 ct1(i) := c1(i) .dis c2(i);
58 end forall;
smfe 140 (forall i in [ (#c1 min #c2)+1..#ct1 ])
smfe 141 ct1(i) .dis:= type_om;
61 end forall;
62
smfe 142 tp := [ g1+g2, ct1, true ];
64
smfd 142 else $ both sets or tuples
66 if is_knt(t1) then c1 := type_zero .dis/ c1; end if;
67 if is_knt(t2) then c2 := type_zero .dis/ c2; end if;
68
69 tp := [ g1+g2, c1 .dis c2, false ];
70 end if;
smfe 143
smfe 144 loop $ normalise type_gen
smfe 145 doing [ g, c ] := tp;
smfe 146 while g = bsctyps and grosstyp(c) = bsctyps
smfe 147 do
smfe 148 tp := c;
smfe 149 end loop;
71
smfd 143 assert (is_om(t1) or is_om(t2)) = is_om(tp);
74 return tp;
75
76 end operator .dis;
77
78
1 .=member sub14n
2
3
4 operator .sub(t1, t2);
5$
6$ this operator computes the difference between the types t1 and t2.
7$ the difference between two types is defined to mean the type which t1
8$ can assume but t2 cannot.
9$
10 repr
11 t1, t2, c1, c2: elmt types;
12 tp1, tp2: elmt types;
13 g, gprim, g1, g2: gross_type;
smfd 144 ct1, ct2, c: tuple(elmt types);
smfd 145 i: integer;
14 end repr;
15
16 g1 := grosstyp(t1);
17 g2 := grosstyp(t2);
18
19 if t2 = type_gen then
20 return type_zero;
21
22 elseif t1 = type_om and is_notom(t2) then
23 return type_om;
24
25 elseif is_prim(g1) then
26 return [ g1 - g2 ];
27
28 elseif is_prim(g2) then
29 return [ g1 - g2, comptyp(t1), is_knt(t1) ];
30
31 else
32 gprim := g1 - g2 - tup_set_map;
33
smfd 146 if is_knt(t1) and is_knt(t2) then $ two know-length tuples
smfd 147 ct1 := comptyp(t1); ct2 := comptyp(t2); c := ct1;
smfd 148 (forall i in [ 1..(#ct1 min #ct2) ])
smfd 149 c(i) := ct1(i) .sub ct2(i);
smfd 150 end forall;
smfd 151
smfd 152 return
smfd 153 if forall c1 in c | c1 = type_zero then
smfd 154 $ this tuple does not describe any value: don't
smfd 155 $ include it into the result.
smfd 156 [ gprim ]
smfd 157 else
smfd 158 $ recall that the type descriptor for a known-length
smfd 159 $ tuple cannot describe a set type.
smfd 160 [ gprim with t_tuple, c, true ]
smfd 161 end;
smfd 162 end if;
smfd 163
34 if t_tuple in g1 and is_knt(t1) then norm(t1); end if;
35 if t_tuple in g2 and is_knt(t2) then norm(t2); end if;
36
37 c1 := comptyp(t1);
38 c2 := comptyp(t2);
39
40 if (g := g1-g2) * tup_set_map /= {} then
41
42 $ t1 contains a composite type which t2 does not contain:
43 $ tp1 describes this type.
44
smfd 164 tp1 := [ g, c1, false ];
46
47 else
48 tp1 := type_zero;
49 end if;
50
51 if (g := g1 * g2 * tup_set_map) /= {} then
52
53 $ t1 and t2 have a common composite type: tp2 will descibe
54 $ its difference type.
55
56 if c1 .con c2 = type_zero then tp2 := t1;
57 elseif c1 .con c2 = c1 then tp2 := type_zero;
58 else
59 tp2 := [ g, c1 .sub c2, false ];
60 end if;
61
62 else
63 tp2 := type_zero;
64 end if;
65
66 return [ gprim ] .dis tp1 .dis tp2;
67
68 end if;
69
70
71 end operator .sub;
72
73
1 .=member cnt14o
2
3
4 procedure const_typ(v);
5$
6$ this routine returns a type descriptor for a constant value.
7$
8 repr
9 x, v: general;
10 g: gross_type;
11 end repr;
12
13 g := { if is_integer v then t_int
14 elseif is_real v then t_real
15 elseif is_string v then t_string
16 elseif is_boolean v then t_atom
17 elseif is_tuple v then t_tuple
18 elseif is_set v then t_set
19 else t_om
20 end };
21
22 return
23 if g = grsset then
24 if v = {} then
25 [ grsset, type_om, false ]
26 else
27 ntyp( grsset, type_zero .dis/[ const_typ(x) : x in v ] )
28 end
29
30 elseif g = grstup then
31 knt_type( [ const_typ(x) : x in v ] )
32
33 else
34 [ g ]
35 end;
36
37 end procedure const_typ;
38
39
smfe 150
smfe 151
smfe 152 procedure string_length(tp);
smfe 153$
smfe 154$ this routine does a recursive tree walk of the type descriptor tp to
smfe 155$ compute a measure for the length of the string formatted by
smfe 156$ format_type.
smfe 157$
smfe 158 repr
smfe 159 tp, tx: elmt types;
smfe 160 g: gross_type;
smfe 161 c: general;
smfe 162 end repr;
smfe 163
smfe 164
smfe 165 if tp = type_zero then return 1; end if;
smfe 166 if tp = type_gen then return 1; end if;
smfe 167
smfe 168 if tp = type_notom then return 1; end if;
smfe 169
smfe 170 [ g, c ] := tp;
smfe 171
smfe 172 if c = type_om then
smfe 173 if g = grstup then return 1; end if;
smfe 174 if g = grsset then return 1; end if;
smfe 175 if g = grsmap then return 1; end if;
smfe 176 end if;
smfe 177
smfe 178 return
smfe 179 if is_om(tp) then 1 else 0 end $ omega
smfe 180 + #(g * int_real_str_atom) $ primitive types
smfe 181 + if t_tuple in g and is_knt(tp) then $ known-length tuple
smfe 182 0 +/[ string_length(tx) : tx in c ]
smfe 183 elseif g * tup_set_map /= {} then $ set or tuple
smfe 184 #(g * tup_set_map) * string_length(c)
smfe 185 else
smfe 186 0
smfe 187 end;
smfe 188
smfe 189
smfe 190 end procedure string_length;
smfe 191
smfe 192
40
41
42 operator .is_pair(tp);
43$
44$ this operator returns yes or no depending on whether tp is a type
45$ descriptor for a pair of non-omega values.
46$
47 repr
48 tp: elmt types;
49 c: tuple(elmt types);
50 end repr;
51
52 return
53 if grosstyp(tp) less t_om = grstup
54 and is_knt(tp)
55 and #(c := comptyp(tp)) = 2
56 and is_notom(c(1))
57 and is_notom(c(2))
58 then true
59 else false
60 end;
61
62 end operator .is_pair;
63
64
65
66
67 operator .is_map(tp);
68$
69$ this operator returns yes, no, or maybe depending on whether tp is
70$ a type descriptor for a map.
71$
72 repr
73 tp: elmt types;
74 end repr;
75
76 if grosstyp(tp) less t_om = grsset then
77 return .is_pair(comptyp(tp));
78 else
79 return false;
80 end if;
81
82
83 end operator .is_map;
84
85
1 .=member adt14p
2
3
4 procedure ads_type(tp);
5$
6$ this procedure (recursively) transforms types into the form desired
7$ by the automatic data-structure selection module. the transformations
8$ are the following:
9$
10$ 1. transform the type set(tuple(x,y)) into the type map(tuple(x,y))
11$ 2. transform the type [ bsctyps [ type_gen ] ] into type_gen
12$ 3. drop the is_om flag
13$
14 repr
15 tp: elmt types;
16 g: gross_type;
17 ctp: elmt types;
18 end repr;
19
20
21 g := grosstyp(tp) less t_om;
22
23 if tp = type_om then
24 return type_om;
25
26 elseif tp = type_gen then
27 return type_notom;
28
29 elseif is_prim(g) then
30 return [ g ];
31
32 elseif g = bsctyps less t_om and
33 grosstyp(tp(2)) with t_om = bsctyps then
34 $ 'normalise' type_gen: since we are about to throw away the
35 $ t_om value, this test does what it should.
36 return ads_type(tp(2));
37
38 elseif g = grsset then
39 return [ if .is_pair(comptyp(tp)) then grsmap else grsset end,
40 ads_type(tp(2)) ];
41
42 elseif is_knt(tp) then
43 return [ g, [ ads_type(ctp) : ctp in comptyp(tp) ], true ];
44
45 else
46 return [ g, ads_type(comptyp(tp)), false ];
47 end if;
48
49
50 end procedure ads_type;
51
52
53 end module setl_optimizer - typfind;
54
55
1 .=member admn15
2
3
4 module setl_optimizer - auto_dstruct;
smfd 165$
smfd 166$ the following automatic data structure selection algorithm uses an
smfd 167$ approach to this problem differing from that described in
smfd 168$ and . although the approach suggested there has a rather
smfd 169$ simple structure, it suffers from several deficiencies which have led
smfd 170$ us to an alternative approach. the new approach, to be described
smfd 171$ below, is closer to ed schonberg's algorithm and seems to be
smfd 172$ faster than the earlier approach. in spite of the differences between
smfd 173$ these two methods, they have a similar overall logic which is simpler
smfd 174$ than that of previously suggested algorithms. among these
smfd 175$ simplifications are: use of the bfrom and ffrom maps instead of
smfd 176$ value-flow maps; and elimination of a phase which inserts 'locate'
smfd 177$ instructions into the code.
smfd 178$
smfd 179$ we first describe the new automatic data structure selection algorithm
smfd 180$ heuristically:
smfd 181$
smfd 182$ (1) initially, all instructions i in the code to be processed are
smfd 183$ analysed separately. in this analysis we proceed in a manner
smfd 184$ depending on the opcode of i and the types of its arguments, and
smfd 185$ generate bases b1, b2, ..., bn, such that all of the occurrences in i
smfd 186$ can be given a data structure representation such that each of the
smfd 187$ above bases appear in at least one such declaration, and such that if
smfd 188$ these representations are used, the execution time of i will either
smfd 189$ remain substantially the same, or else become faster.
smfd 190$
smfd 191$ a base bi is generated only if at least one occurrence in i accesses
smfd 192$ its elements, and if introduction of this base does not slow i down.
smfd 193$ i could slow down if hashing of a value into bi is required at i (e.g.
smfd 194$ if a new value of an element of bi may have been created in executing
smfd 195$ i), or if base conversions at i may be required (e.g. if different
smfd 196$ bases are assigned to the arguments in a set union instruction).
smfd 197$
smfd 198$ a second property that we require the generated bases to possess is
smfd 199$ that even after the introduction of repred arguments, the instruction
smfd 200$ i should be equivalent to i with its arguments having their original
smfd 201$ types (and forms). thus, in an instruction 'c := a + b;', if a is a
smfd 202$ set of integers, b is a set of characters and c is (necessarily) a set
smfd 203$ of general elements, no bases are generated, for in order for the
smfd 204$ instruction not to slow down, all three arguments must be based on the
smfd 205$ same base, whose elements must therefore be of general type. thus, a
smfd 206$ and b become sets of general elements, overestimating their previous
smfd 207$ types.
smfd 208$
smfd 209$ this restriction reflects one of the underlying principles of our
smfd 210$ approach, namely: the types of variable occurrences, as produced by
smfd 211$ the type finder, should not be modified during automatic data
smfd 212$ structure selection. such modifications are possible in two cases:
smfd 213$
smfd 214$ (i) during the initial basing pass, if types are converted into based
smfd 215$ reprs which are not equivalent to the original types (as in the above
smfd 216$ set union example).
smfd 217$
smfd 218$ (ii) by merging based reprs of two occurrences having different types.
smfd 219$ such a merge may cause equivalencing of two bases b1 and b2 whose
smfd 220$ element-modes are not equal, so that the new base will not be really
smfd 221$ equivalent either to b1 nor to b2, and consequently the types of reprs
smfd 222$ based on b1 or b2 will have changed.
smfd 223$
smfd 224$ in both cases, types become more general, and never more restricted.
smfd 225$ hence, the new types will over-estimate the actual types, so that the
smfd 226$ code will still be safe. however, because types may become less
smfd 227$ specific, we are apt to generate less efficient code, in the sense
smfd 228$ that some q2 instructions may become more general (and therefore more
smfd 229$ time consuming), and extra type checks and conversions may be
smfd 230$ required.
smfd 231$
smfd 232$ for these reasons, we prefer to make sure that cases (i) and (ii) will
smfd 233$ not occur in our algorithm, and so keep the types of occurrences
smfd 234$ unchanged (see also remark (1) below).
smfd 235$
smfd 236$ not all generated bases actually speed up the program execution.
smfd 237$ those that do not are useless, and, unless we can later merge them
smfd 238$ with more useful bases, will be suppressed (see (4) below). however,
smfd 239$ we find it useful to introduce these extra bases since doing so makes
smfd 240$ it easier to propagate basings across instructions (see (3) below).
smfd 241$
smfd 242$ generated bases whose introduction speeds up the execution of the
smfd 243$ instruction in connection with which they are introduced will be
smfd 244$ called 'effective bases', and all other generated bases will be called
smfd 245$ 'neutral bases'.
smfd 246$
smfd 247$ examples:
smfd 248$
smfd 249$ (a) t := s with x;
smfd 250$
smfd 251$ if t and s are sets with elements of the same type, which is also
smfd 252$ equal to the type of x, we generate one effective base b, repr s and t
smfd 253$ as set(elmt b), and repr x as elmt b. if, in addition, we know that s
smfd 254$ is a set(tuple(tx, ty)), and that x is a tuple(tx, ty), we annotate
smfd 255$ the repr for t to mark that t is a potentially multi-valued map. if s
smfd 256$ and t are homogeneous tuples having the same element type, which is
smfd 257$ also equal to the type of x, we generate one neutral base b, with
smfd 258$ reprs analogous to the above.
smfd 259$
smfd 260$ (b) y := f(x);
smfd 261$
smfd 262$ if f is a map, with a domain type equal to the type of x, and a range
smfd 263$ type equal to the type of y, we generate one effective base b1 and one
smfd 264$ neutral base b2, and generate the following representations:
smfd 265$
smfd 266$ f: smap(elmt b1) elmt b2; x: elmt b1; y: elmt b2;
smfd 267$
smfd 268$ we also annotate the repr for f to indicate that f is involved in an
smfd 269$ operation which requires single-valuedness, for which local basing
smfd 270$ would be most appropriate.
smfd 271$
smfd 272$ if the type of y is not equal to the range type of f, we do not
smfd 273$ generate b2, and if the type of x is not equal to the domain type of
smfd 274$ f, we do not generate b1.
smfd 275$
smfd 276$ if f is a homogeneous tuple, and the type of y is equal to the
smfd 277$ component type of f, we generate one neutral base b and repr f as
smfd 278$ tuple(elmt b) and y as elmt b.
smfd 279$
smfd 280$ if f is a string or of an ambiguous type, no bases are generated.
smfd 281$
smfd 282$ (c) y := x;
smfd 283$
smfd 284$ unless the types of x and y are unequal, we generate one neutral base
smfd 285$ b, and repr x and y as elmt b.
smfd 286$
smfd 287$ note that many of the restrictions imposed in the above examples will
smfd 288$ be satisfied automatically in view of the action of the final phase of
smfd 289$ the type finder, which assigns to each o-variable the 'forward' type
smfd 290$ of its i-variable. for example, in (a) above, if s is a set and the
smfd 291$ type of its elements is equal to the type of x, then the type of t
smfd 292$ will always be equal to that of s; similarly, in (c) above, the type
smfd 293$ of y will always be equal to the type of x. however, we have stated
smfd 294$ the above restrictions in order to make our data structure selection
smfd 295$ algorithm as independent of the type finder as possible.
smfd 296$
smfd 297$
smfd 298$ (2) after the initial base generation phase, most variable occurrences
smfd 299$ will have been based either on effective bases or on neutral bases.
smfd 300$ our algorithm now assumes that effective bases, as well as bases that
smfd 301$ can be merged with effective bases, are advantageous. moreover, base
smfd 302$ merging is performed by passing basing information between
smfd 303$ instructions according to the following heuristics:
smfd 304$
smfd 305$ let vo1, vo2 be two occurrences of the same variable which are linked
smfd 306$ by the bfrom map, and suppose that we want to merge the base
smfd 307$ information of vo1 with that of vo2. let repr1, repr2 be the
smfd 308$ generated reprs of vo1, vo2, respectively. in order to merge these
smfd 309$ reprs, vo1 and vo2 must have the same type. if this is the case, then
smfd 310$ repr1 and repr2 describe objects having the same type, and by
smfd 311$ comparing their structures we can either equivalence or find other
smfd 312$ relations between the bases which these objects involve. a more
smfd 313$ detailed description of this procedure is given in phase 2 of our
smfd 314$ algorithm below.
smfd 315$
smfd 316$
smfd 317$ (3) the base generation pre-pass described above enables us to avoid
smfd 318$ propagation of base information between arguments of the same
smfd 319$ instruction, a task which would call for some messy routines,
smfd 320$ resembling the 'forward' and 'backward' routines of the type finder,
smfd 321$ and would also increase the time consumed by our algorithm
smfd 322$ (see ). however, base propagation across instructions is
smfd 323$ already performed implicitly within the initial base generation phase.
smfd 324$ subsequent base merging only needs to consider bfrom links. to
smfd 325$ convince ourselves that this is indeed the case, we consider several
smfd 326$ examples.
smfd 327$
smfd 328$ example a.
smfd 329$
smfd 330$ (i1) s with:= x; $ s is a set.
smfd 331$ (i2) v(i) := x; $ v is a tuple.
smfd 332$ (i3) y := v(j);
smfd 333$ (i4) z := f(y); $ f is a map.
smfd 334$
smfd 335$ assume that v is a homogeneous tuple. then the initial basing pass we
smfd 336$ will produce the following basings (where only b1, b4 are effective):
smfd 337$
smfd 338$ s1: set(elmt b1); x1: elmt b1;
smfd 339$ v2: tuple(elmt b2); x2: elmt b2;
smfd 340$ y3: elmt b3; v3: tuple(elmt b3);
smfd 341$ y4: elmt b41; z4: elmt b42;
smfd 342$ f4: map(elmt b41) elmt b42;
smfd 343$
smfd 344$ then, when bases are merged along bfrom links, b1 and b2 will be
smfd 345$ merged (using the x-link from i1 to i2); b2 and b3 will be merged
smfd 346$ (via the v-link); b3 and b41 will be merged (via the y-link). if we
smfd 347$ did not introduce neutral bases for i2 and i3, we would have to
smfd 348$ propagate basings across i2 and i3 in order to deduce that b1 and b41
smfd 349$ should be merged.
smfd 350$
smfd 351$ note also that in the steps just described b42 has not been merged
smfd 352$ with an effective base. if this condition persists, b42 will be
smfd 353$ dropped during the base adjustment phase.
smfd 354$
smfd 355$ example b. (s, u and t are assumed to be sets)
smfd 356$
smfd 357$ (i1) s with:= x;
smfd 358$ (i2) u with:= s;
smfd 359$ (i3) t from u;
smfd 360$ (i4) y from t;
smfd 361$
smfd 362$ here, after the pre-pass, we would have:
smfd 363$
smfd 364$ s1: set(elmt b1); x1: elmt b1;
smfd 365$ u2: set(elmt b2); s2: elmt b2;
smfd 366$ t3: elmt b3; u3: set(elmt b3);
smfd 367$ y4: elmt b4; t4: set(elmt b4);
smfd 368$
smfd 369$ using the bfrom links which apply to this fragment of code, we would
smfd 370$ first merge the two reprs elmt b2 and set(elmt b1) of the s
smfd 371$ occurrences; this will give us information about the element mode of
smfd 372$ b2, i.e. elmt b2 = set(elmt b1). then we equivalence b2 and b3 via
smfd 373$ the bfrom link for u. finally, using the bfrom link for t, we deduce
smfd 374$ that elmt b3 = set(elmt b4). this example shows that repr merging has
smfd 375$ to be done transitively, so that b1 and b4 ought to be equivalenced
smfd 376$ once b2 and b3 are equivalenced, since the merging of b2 and b3 calls
smfd 377$ for the merging of the reprs set(elmt b1) and set(elmt b4). this
smfd 378$ additional merge must also be taken care of during the base adjustment
smfd 379$ phase of our algorithm.
smfd 380$
smfd 381$
smfd 382$ (4) if, after merging, all the effective bases in some equivalence
smfd 383$ class of bases support occurrences of only one composite object, all
smfd 384$ the bases in this class should be suppressed. this remark applies
smfd 385$ also to the case in which the class contains no effective bases.
smfd 386$
smfd 387$
smfd 388$ (5) a delicate issue arising in previous automatic data-structure
smfd 389$ selection algorithms was the insertion of 'locate' operations into the
smfd 390$ code being processed. these operations compute base pointers for
smfd 391$ elements of a base, inserting them into the base when necessary. this
smfd 392$ problem is still delicate, but we have shifted it to the (subsequent)
smfd 393$ conversion optimisation phase of the optimiser, where it is treated as
smfd 394$ a special case of a general conversion insertion algorithm. we can
smfd 395$ therefore ignore this problem completely in the present algorithm,
smfd 396$ simplifying the algorithm considerably.
smfd 397$
smfd 398$
smfd 399$ (6) in our original design of this algorithm we determined refined
smfd 400$ representations (such as local, remote, and sparse) during a final
smfd 401$ phase of our algorithm. our experience, however, has shown that the
smfd 402$ selection of set-types (i.e. local, remote, and sparse) as well as the
smfd 403$ selection of map-types (i.e. single-valued map v. multi-valued map)
smfd 404$ can be done naturally during the pre-pass and the subsequent merge
smfd 405$ phase. our algorithm now selects during the pre-pass appropriate set-
smfd 406$ and map-types (where applicable), and our merge phase merges these
smfd 407$ attributes while it merges the base element modes.
smfd 408$
smfd 409
smfd 410$ global variables and abstract data structures of the algorithm
smfd 411$ ------ --------- --- -------- ---- ---------- -- --- ---------
smfd 412
smfd 413$ the above remarks suggest a rather simple automatic data-structure
smfd 414$ selection algorithm. the detailed algorithm is given below.
smfd 415$
smfd 416$ the input to this algorithm consists of the data flow maps bfrom and
smfd 417$ ffrom, and the type map typ, which gives the computed type of each
smfd 418$ variable occurrence.
smfd 419$
smfd 420$ the output of the algorithm is another map on occurrences, called
smfd 421$ oi_repr, mapping each occurrence to a suggested repr. note that the
smfd 422$ actual form of repred variables is not modified until the subsequent
smfd 423$ name-splitting phase.
smfd 424$
smfd 425$ during automatic data-structure selection, reprs are treated as
smfd 426$ extended type descriptors. more precisely, each repr is (at least) a
smfd 427$ four component tuple having the form
smfd 428$
smfd 429$ rpr := [ grosstyp(rpr): set(elmt basic_types, including t_elmt),
smfd 430$ comptyp(rpr): repr,
smfd 431$ is_knt: boolean,
smfd 432$ is_based: boolean ]
smfd 433$
smfd 434$ set types (i.e. sets and maps) have a fifth component indicating the
smfd 435$ basing type (i.e. local, remote, or sparse) that should be used if
smfd 436$ this set type becomes a based type. map types in addition have a
smfd 437$ sixth component indicating whether this map is definitively single-
smfd 438$ valued (e.g. f in f(x) which is only defined for single-valued maps),
smfd 439$ definitively multi-valued (e.g. f in f{x}), or whether we don't know
smfd 440$ so far.
smfd 441$
smfd 442$ note that a repr is represented in much the same way as a type, but
smfd 443$ may involve the additional gross type element_of_base (denoted by
smfd 444$ t_elmt) whose component type is the base name. (see the type finder
smfd 445$ for additional information concerning the representation of types).
291$
292 const $ auxiliary repr mnemonics
293 based = 1, unbased = om;
294
295 macro base_of(rpr); rpr(2) endm;
296
297
298$ the following global variables are used in this phase:
299
300 var
301 bases, $ set of all generated bases
302 repbase, $ maps each base to its representative base
303 nbases, $ maps each representative base to number of
304 $ bases in its eqivalence class
305 is_effective, $ maps each base to an effectiveness indicator
306 basedoccs, $ set of all (tentatively) based occurrences
307 aux_repr; $ maps each occurrence to its (tentative) repr
308
309$ additional various global variables, constants and macros are:
310
311 const $ various tuples of argument indices
312 tup1 = [ 1 ],
313 tup2 = [ 2 ],
314 tup3 = [ 3 ],
315 tup12 = [ 1, 2 ],
316 tup13 = [ 1, 3 ],
317 tup14 = [ 1, 4 ],
318 tup23 = [ 2, 3 ],
319 tup123 = [ 1, 2, 3 ],
320 tup124 = [ 1, 2, 4 ],
321 tup134 = [ 1, 3, 4 ];
322
323 const $ various gross types
324 grsset = { t_set },
325 grsmap = { t_map },
326 grstup = { t_tuple },
327 grselmt = { t_elmt };
328
329 macro based_pair(ebx, eby);
330 [ grstup, [ ebx, eby ], true, based ]
331 endm;
332
smfl 6 macro BASED_TUP(EB);
smfl 7 [ GRSTUP, EB, false, BASED ]
smfl 8 endm;
smfl 9
smfl 10 macro BASED_KNT(C);
smfl 11 [ GRSTUP, C, true, BASED ]
smfl 12 endm;
340
smfl 13 macro BASED_SET(EB, STP);
smfl 14 GENABASE(
smfl 15 [ GRSSET, EB, om, BASED, STP ],
smfl 16 [],
smfl 17 [] )
smfl 18 endm;
smfl 19
smfl 20 macro BASED_MAP(EBX, EBY, STP, MTP);
smfl 21 GENABASE(
smfl 22 [ GRSMAP, BASED_PAIR(EBX, EBY), om, BASED, STP, MTP ],
smfl 23 [],
smfl 24 [] )
smfl 25 endm;
352
353 var
354 workpile, $ used for repr merging
355 ins, $ current instruction during base generation
356 argsi, $ args of current instruction
357 droppables, $ set of all non-effective bases
358 seendrops; $ set of all non-effective bases which had all
359 $ non-effective bases in their element mode
360 $ (recursively) replaced by the respective
361 $ element mode of the non-effective base.
362
363
364 repr
365 bases: remote set(tent_base);
366 droppables: remote set(tent_base);
367 seendrops: remote set(tent_base);
368 repbase: remote smap(tent_base) tent_base;
369 nbases: remote smap(tent_base) integer;
370 is_effective: remote smap(tent_base) general;
371 basedoccs: remote set(occurrence);
372 aux_repr: remote smap(occurrence) elmt types;
373 ins: elmt insts;
374 argsi: tuple(symbol);
375 workpile: set(tuple(elmt types, elmt types));
376 grselmt: gross_type;
377 grstup: gross_type;
378 grsset, grsmap: gross_type;
379 tup1, tup2, tup3: tuple(integer);
380 tup12, tup13, tup14: tuple(integer);
381 tup23: tuple(integer);
382 tup123, tup124, tup134: tuple(integer);
383 basegen: procedure;
384 genbases: procedure;
385 genabase: procedure(
386 elmt types,
387 tuple(integer),
388 tuple(integer) )
389 elmt types;
390 maxscope: procedure(tuple(elmt base_scopes))
391 elmt base_scopes;
392 basemerge: procedure;
393 equibase: procedure(tent_base, tent_base);
394 .lim: operator(tent_base) tent_base;
395 baseadjust: procedure;
396 fancy_output: procedure;
397 real_repr: procedure(elmt types) elmt types;
398 end repr;
399
400
401
402 procedure auto_data;
403$
404$ this is the main driving routine of our algorithm. it consists
405$ of calls to the various phases of the algorithm.
406$
411 title('cims.setl.' + prog_level + ' - data structure choice');
412 printa(term_file, ' - data structure selection');
413
416 basegen; $ the base generation pre-pass.
417 basemerge; $ the base merging phase.
418 baseadjust; $ the base and repr adjustment phase.
419
420 $ delete the static variables global to the module
421 bases := om; repbase := om; nbases := om;
422 is_effective := om; basedoccs := om; aux_repr := om;
423 workpile := om; ins := om; argsi := om;
424 seendrops := om; droppables := om;
425
426 statistics with:= time; $ save time for final statistics
431
432
433 end procedure auto_data;
434
435
1 .=member bgn15a
2
3
smfd 446
smfd 447$ 1. the base generation pre-pass
smfd 448$ -- --- ---- ---------- --------
smfd 449
smfd 450$ during this phase we iterate through the code, generating bases
smfd 451$ whenever appropriate. these bases are linked across instructions,
smfd 452$ subject to constraints determined by the types of the i-variables and
smfd 453$ the instruction. the output of this phase is the map aux_repr, which
smfd 454$ maps occurrences into (based) reprs.
smfd 455$
smfd 456$ for each instruction ins generate bases as described in (1) above.
smfd 457$ this is done in a manner depending on the opcode of the instruction
smfd 458$ ins and on the type of its arguments. for each base generated, we
smfd 459$ compute the form of its elements from the types of the arguments of
smfd 460$ ins, modify the aux_repr map of the based arguments of ins to show the
smfd 461$ appropriate based representations, and classify each generated base as
smfd 462$ effective or neutral.
smfd 463$
smfd 464$ the following instructions are relevant:
smfd 465$
smfd 466$ q1_in, q1_notin, q1_incs, q1_eq, q1_ne,
smfd 467$ q1_add, q1_sub, q1_mult, q1_mod,
smfd 468$ q1_with, q1_less, q1_lessb, q1_lesse, q1_lessf,
smfd 469$ q1_arb, q1_arbb, q1_arbe, q1_dom, q1_range,
smfd 470$ q1_set, q1_set1, q1_tup, q1_tup1,
smfd 471$ q1_inext, q1_next, q1_inextd, q1_nextd,
smfd 472$ q1_of, q1_ofa, q1_subst, q1_end,
smfd 473$ q1_sof, q1_sofa, q1_ssubst, q1_send,
smfd 474$ q1_asn, q1_argin, q1_argout
smfd 475$
smfd 476$ these opcodes generate bases linked across the instruction if their
smfd 477$ argument types satisfy specific constraints. otherwise, they use the
smfd 478$ same heuristic the remaining opcodes use, namely that for each
smfd 479$ occurrence voi we generate a neutral base which supports only voi. we
smfd 480$ do this so that basing informations are propagated across a program as
smfd 481$ much as possible, reducing the risk of repeated conversions which
smfd 482$ might be needed otherwise, as the following example shows:
smfd 483$
smfd 484$ (1) s := {}; $ s1: set(elmt b1)
smfd 485$ (while ...)
smfd 486$ read(x);
smfd 487$ (2) if x in s then $ s2: elmt b2
smfd 488$ (3) s with:= 2*x; $ s3: set(elmt b3)
smfd 489$ end if;
smfd 490$ end while;
smfd 491$
smfd 492$ in this case, basing s2 as shown will finally base all three
smfd 493$ occurrences of s as set(elmt b), for some base b, but will not add
smfd 494$ input values of x to b, which will force hashing in instruction (2).
smfd 495$
smfd 496$ this will keep b as small as possible. the other alternative, namely
smfd 497$ to leave s2 unbased, is much worse, as it forces a repeated conversion
smfd 498$ between the based and unbased forms of s. (note that in instruction
smfd 499$ (2) x has the type general, while s has the type set(integer). in
smfd 500$ this case, our heuristic principle for the q1_in instruction forbids
smfd 501$ common basing of x and s in this instruction).
smfd 502$
6
7 procedure basegen;
8$
9$ this procedure iterates through the code, generating bases whenever
10$ appropriate. it builds up initial versions of various maps on bases
11$ and occurences.
12$
13 repr
14 vo: occurrence;
15 tp: elmt types;
16 r: routine;
17 b: elmt blocks;
18 end repr;
19
20
21 aux_repr := typ; $ maps occurrences to tentively based types:
22 $ start with the known (unbased) types of
23 $ variable occurences, the result of the
24 $ type finder.
25 bases := {}; $ set of all bases
26 elmt_mode := {}; $ a map from bases to their element-mode.
27 bscope := {}; $ a map from bases to their scope.
28 userbase := {}; $ a map which sends each base to an
29 $ equivalent user-supplied base (if any).
30 is_effective := {}; $ an effectiveness indicator for bases, which
31 $ can have three kinds of values:
32 $ (i) 'neutral', if the base is neutral.
33 $ (ii) a variable name v, if the base is
34 $ effective, but the only composite object
35 $ (set or map) it supports is v.
36 $ (iii) 'effective', if at least two composite
37 $ objects are effectively supported by
38 $ the base.
39 basedoccs := {}; $ set of all based occurences
40 $ (see section 'scopes of bases' above)
41
42$$$ ???? for efficiency, may want to do a.d.s. for each procedure
43$$$ ???? separately. this will, however, complicate the logic of the
44$$$ ???? following algorithm, and so this possibility is ignored in the
45$$$ ???? current code
46
47 if 'y' in dump_string then
48 print(' - base generation phase');
49 end if;
50
51 (forall r in routs)
52 (for_block(b, r))
53 (for_inst(ins, b))
54 genbases;
55
56$ for each instruction ins generate bases as described in (1) above.
57$ this is done in a manner depending on the opcode of the instruction
58$ ins and on the type of its arguments. for each base generated, we
59$ compute the form of its elements from the types of the arguments of
60$ ins, modify the aux_repr map of the based arguments of ins to show
61$ the appropriate based representations, and classify each generated
62$ as effective or neutral.
63
64 end; $ end for_inst;
65 end; $ end for_block;
66 end forall;
67
68 end procedure basegen;
69
70
1 .=member gnb15b
2
3
4 procedure genbases;
5$
6$ this routine analyzes an instruction ins, generates initial bases for
7$ ins, and sets up appropriate basings for the occurences in ins. this
8$ is done using a case statement involving the opcode of ins and the
9$ types of its arguments.
10$
11$ this routine uses an auxiliary routine genabase to generate a new base
12$ (i.e. a new atom) and to update various maps related to all tentative
13$ bases (e.g. the set of all bases, bases, and the set of all based
14$ occurrences, basedoccs). it takes as arguments the element mode of
15$ the base to be generated, plus a tuple of integers indicating which
16$ arguments of the current instruction ins are to be supported by this
17$ base, plus a tuple of integers indicating which arguments are
18$ supported effectively (i.e. composite objects such as sets or maps for
19$ which the introduction of the base would eliminate a hashing
20$ operation).
21$
22 macro locspr_of(b); set_type(elmt_mode(base_of(b))) endm;
23 macro maptyp_of(b); map_type(elmt_mode(base_of(b))) endm;
24
25
26 repr
27 j: integer 0..65536;
28 v: symbol;
29 ivs: tuple(occurrence);
30 tps: tuple(elmt types);
31 grtps: tuple(gross_type);
32 vo1, vo2, vo3, vo4: occurrence;
33 i: occurrence;
34 typ1, typ2, typ3, typ4: elmt types;
35 g1, g2, g3, g4: gross_type;
36 opc: elmt base_opcodes;
37 jbig, jsml, k, q: integer;
38 comps2, comps3, bcomps2, bcomps3,
39 comps: tuple(elmt types);
40 ind: integer;
41 tp, tpc, tpx: elmt types;
42 voj: occurrence;
43 typj: elmt types;
44 tupj: tuple(integer);
45 ebx, eby, ebz,
46 eb, eb1, eb2, eb3: elmt types;
47 end repr;
48
49 opc := opcode(ins);
50 argsi := args(ins);
51 ivs := [ get_oi(ins, j) :
52 j in [ 1..#argsi ] | get_oi(ins, j) in all_oi ];
smfl 26 TPS := [ TYP(I) ? TYPE_ZERO : I in IVS ];
54 grtps := [ grosstyp(tp) : tp in tps ];
55
56 [ vo1, vo2, vo3 ] := ivs;
57 [ typ1, typ2, typ3 ] := tps;
58 [ g1, g2, g3 ] := grtps;
59
100 case opc of
101
102 (q1_with, q1_less):
103
104 case g1 of
105
106 (grsmap):
107
108$ it follows from the logic of the type finder that in this case
109$ both vo1 and vo2 are maps and vo3 is a pair.
110$ in this case we generate two bases for ins; one for the domain
111$ and one for the image of these maps.
112$ i.e. if 'ins' is 'f := g with p' then we interpret it as something
113$ like 'f := g; f{p(1)} with:= p(2);'. this means that ins would
114$ ordinarily be executed using two hashing operations. nevertheless,
115$ only the domain base is assumed to be effective, as we suspect
116$ that the range of these maps will tend to be sparse over its
117$ would-be base.
118 if typ1 = typ2 and typ3 = comptyp(typ1) then
119
120 $ nb. only the first two arguments are effectively
121 $ supported by the domain base ebx.
122 ebx := genabase(domtyp(typ1), tup123, tup12);
123 eby := genabase(rangetyp(typ1), tup123, [] );
124
137 $ if ov = iv1, then local basing is advantageous,
138 $ and we link the two (neutral) bases to reduce the
139 $ chance that a conversion might be required.
140 $ otherwise, a value transfer between ov and iv1 takes
141 $ place, and local basing would require a full conver-
142 $ sion. hence remote basing is more advantageous.
smfl 27
smfl 28 if OPC = Q1_WITH then
smfl 29
smfl 30 $ EBZ is the range set type for the multi-valued map
smfl 31 EBZ := BASED_SET(EBY, SPRSE);
smfl 32
smfl 33 if ARGSI(1) = ARGSI(2) then
smfl 34 EB1 := BASED_MAP(EBX, EBZ, LOCL, FT_MMAP);
smfl 35 EB2 := EB1;
smfl 36 else
smfl 37 EB1 := BASED_MAP(EBX, EBZ, REMT, FT_MMAP);
smfl 38 EB2 := BASED_MAP(EBX, EBY, REMT, FT_MAP );
smfl 39 end if;
smfl 40
smfl 41 else $ OPC = Q1_LESS
smfl 42
smfl 43 if ARGSI(1) = ARGSI(2) then
smfl 44 EB1 := BASED_MAP(EBX, EBY, LOCL, FT_MAP );
smfl 45 EB2 := EB1;
smfl 46 else
smfl 47 EB1 := BASED_MAP(EBX, EBY, REMT, FT_MAP );
smfl 48 EB2 := BASED_MAP(EBX, EBY, REMT, FT_MAP );
smfl 49 end if;
smfl 50
smfl 51 end if;
155
156 aux_repr(vo1) := eb1;
157 aux_repr(vo2) := eb2;
158 aux_repr(vo3) := based_pair(ebx, eby);
159 end if;
160
161 (grsset):
162
163 if typ1 = typ2 and comptyp(typ1) = typ3 then
164
165 ebx := genabase(typ3, tup123, tup12);
166
167 if argsi(1) = argsi(2) then
smfl 52 EB1 := BASED_SET(EBX, LOCL);
171 eb2 := eb1;
173 else
smfl 53 EB1 := BASED_SET(EBX, REMT);
smfl 54 EB2 := BASED_SET(EBX, REMT);
179 end if;
180
181 aux_repr(vo1) := eb1;
182 aux_repr(vo2) := eb2;
183 aux_repr(vo3) := ebx;
184 end if;
185
186 (grstup):
187
188$ generate a neutral base (several bases for known length tuples) and
189$ make the involved tuples into tuples of elements of this base(s)
190 if is_knt(typ1) then
191
192$ find the index of the larger tuple (jbig) and that of the smaller one
193 jbig := if opc = q1_with then 1 else 2 end;
194 jsml := 3 - jbig; $ 1 for less, 2 for with
195 comps := comptyp(typ(get_oi(ins, jbig)));
196
197 if comps(#comps) = typ3 then
198
199 (forall k in [ 1..#comps-1 ])
200 comps(k) := genabase(comps(k), tup12, []);
201 end forall;
202
203 comps(#comps) := aux_repr(vo3) :=
204 genabase(comps(#comps), [ jbig, 3 ], []);
smfl 55 AUX_REPR(GET_OI(INS, JBIG)) := BASED_KNT(COMPS);
207 aux_repr(get_oi(ins, jsml)) :=
smfl 56 BASED_KNT(COMPS(1..#COMPS-1));
212
213 end if;
214
215 else $ homogeneous tuple
216
217 if typ1 = typ2 and typ3 = comptyp(typ1) then
218
219 ebx := genabase(typ3, tup123, []);
220
smfl 57 AUX_REPR(VO1) := BASED_TUP(EBX);
smfl 58 AUX_REPR(VO2) := BASED_TUP(EBX);
223 aux_repr(vo3) := ebx;
224
225 end if;
226 end if;
227 end case;
228
229
230 (q1_lessb, q1_lesse): $ a1 := a2 less a3; a2 must be a tuple
231
smfl 59 if G2 = GRSTUP then
233 if is_knt(typ2) then
234 comps2 := comptyp(typ2);
235 if forall tpc in comps2 | tpc = typ3 then
236 ebx := genabase(typ3, tup123, []);
237
smfl 60 EB1 := BASED_KNT([ EBX : J in [ 1..#COMPS-1 ] ]);
smfl 61 EB2 := BASED_KNT([ EBX : J in [ 1..#COMPS ] ]);
246
247 aux_repr(vo1) := eb1;
248 aux_repr(vo2) := eb2;
249 aux_repr(vo3) := ebx;
250 end if;
251 else
252 ebx := genabase(typ3, tup123, []);
smfl 62 EB1 := BASED_TUP(EBX);
254
255 aux_repr(vo1) := eb1;
256 aux_repr(vo2) := eb1;
257 aux_repr(vo3) := ebx;
258 end if;
259 end if;
260
261
262 (q1_lessf):
263
smfl 63 if G1 = GRSMAP and TYP1 = TYP2 and DOMTYP(TYP1) = TYP3 then
266
267 ebx := genabase(domtyp(typ1), tup123, tup12);
268 eby := genabase(rangetyp(typ1), tup12, [] );
269
270 if argsi(1) = argsi(2) then
smfl 64 EB1 := BASED_MAP(EBX, EBY, LOCL, FT_MAP);
275 eb2 := eb1;
277 else
smfl 65 EB1 := BASED_MAP(EBX, EBY, REMT, FT_MAP);
smfl 66 EB2 := BASED_MAP(EBX, EBY, REMT, FT_MAP);
285 end if;
286
287 aux_repr(vo1) := eb1;
288 aux_repr(vo2) := eb2;
289 aux_repr(vo3) := ebx;
290 end if;
291
292 (q1_of): $ a1 := a2(a3)
293
294$ here a2 is a map or tuple (or char. string, which case we ignore
295$ since it has no consequences for basing)
296
297 case g2 of
298
299 (grsmap):
300
301 if domtyp(typ2) = typ3 and rangetyp(typ2) = typ1 then
302
303 ebx := genabase(domtyp(typ2), tup23, tup2);
304 eby := genabase(rangetyp(typ2), tup12, [] );
305
smfl 67 EB2 := BASED_MAP(EBX, EBY, LOCL, FT_SMAP);
309
310 aux_repr(vo1) := eby;
311 aux_repr(vo2) := eb2;
312 aux_repr(vo3) := ebx;
313 end if;
314
315 (grstup) :
316 if is_knt(typ2) then
317
318 comps := comptyp(typ2);
319
320 if is_const(arg3(ins))=1 then
321
322 ind := value(arg3(ins));
323
324 if 1 <= ind and ind <= #comps then
325
326 if typ1 = comps(ind) then
327
328$ here a2 is a known length tuple and a3 is an integer constant
329$ falling within range of a2. we generate one base for each
330$ component of a2, and construct the appropriate basings. the base
331$ for the component being retrieved is used also to base a1.
332 aux_repr(vo1) := comps(ind) :=
333 genabase(typ1, tup12, []);
334
335 (forall j in [ 1..#comps ] | j /= ind)
336 comps(j) :=
337 genabase(comps(j), tup2, []);
338 end forall;
339
smfl 68 AUX_REPR(VO2) := BASED_KNT(COMPS);
342
343 end if;
344
345 end if;
346
347 else
348
349$ mixed tuple with non-constant index; meaningful basings can
350$ still be generated, provided that all components of a2 have
351$ the same type.
352 if (forall tpc = comps(j) | tpc = typ1) then
353 ebx := genabase(typ1, tup12, []);
354 aux_repr(vo1) := ebx;
355 aux_repr(vo2) :=
smfl 69 BASED_KNT( [ EBX : Q in [ 1..#COMPS ] ] );
357 end if;
358 end if;
359 else $ homogeneous tuple
360
361 if typ1 = comptyp(typ2) then
362
363 ebx := genabase(typ1, tup12, []);
364 aux_repr(vo1) := ebx;
smfl 70 AUX_REPR(VO2) := BASED_TUP(EBX);
366
367 end if;
368
369 end if;
370
371 end case;
372
373 (q1_sof): $ f(a2) := a3; a4 is f before this operation
374 $ and a1 is f afterwards.
375
376$ here a1,a4 are maps or tuples (or char. strings, which case we ignore
377$ since it has no consequences for basing)
378
379 vo4 := ivs(4); typ4 := tps(4);
380
381 case g1 of
382
383 (grsmap):
384
385 if domtyp(typ1) = typ2 and
386 rangetyp(typ1) = typ3 and
387 typ1 = typ4 then
388
389 ebx := genabase(domtyp(typ1), tup124, tup14);
390 eby := genabase(rangetyp(typ1), tup134, [] );
391
smfl 71 EB1 := BASED_MAP(EBX, EBY, LOCL, FT_SMAP);
395
396 aux_repr(vo1) := aux_repr(vo4) := eb1;
397 aux_repr(vo2) := ebx;
398 aux_repr(vo3) := eby;
399
400 else
401 $ there is no conversion possible between a1 and a4:
402 $ make sure that this does not happen by linking their
403 $ neutral bases.
404 ebx := genabase(domtyp(typ1), tup14, tup14);
405 eby := genabase(rangetyp(typ1), tup14, [] );
406
smfl 72 EB1 := BASED_MAP(EBX, EBY, LOCL, FT_SMAP);
410
411 aux_repr(vo1) := eb1;
412 aux_repr(vo4) := eb1;
413
414 end if;
415
416 (grstup):
417
418 if is_knt(typ1) and typ1 = typ4 then
419
420 comps := comptyp(typ1);
421
422 if is_const(arg2(ins))=1 then
423
424 $ mixed tuple with constant index: meaningful
425 $ basings can be generated if the index is in range.
426
427 ind := value(arg2(ins));
428
429 if 1 <= ind and ind <= #comps and
430 typ3 = comps(ind) then
431
432 (forall j in [ 1..#comps ] | j /= ind)
433 comps(j) := genabase(comps(j), tup14, []);
434 end forall;
435
436 ebx := genabase(typ3, tup134, []);
437 comps(ind) := ebx;
438
smfl 73 EB1 := BASED_KNT(COMPS);
440
441 aux_repr(vo1) := eb1;
442 aux_repr(vo3) := ebx;
443 aux_repr(vo4) := eb1;
444 end if;
445
446 else
447 $ mixed tuple with non-constant index: meaningful
448 $ basings can still be generated, provided that all
449 $ components of a1 have the same type.
450
451 if (forall tpc = comps(j) | tpc = typ3) then
452 ebx := genabase(typ3, tup134, []);
smfl 74 EB1 := BASED_KNT([ EBX : Q in [ 1..#COMPS ] ]);
456 aux_repr(vo1) := eb1;
457 aux_repr(vo3) := ebx;
458 aux_repr(vo4) := eb1;
459 end if;
460 end if;
461
462 elseif typ1 = typ4 then $ homogeneous tuple
463
464 if typ3 = comptyp(typ1) then
465 ebx := genabase(typ3, tup134, []);
smfl 75 EB1 := BASED_TUP(EBX);
467
468 aux_repr(vo1) := eb1;
469 aux_repr(vo3) := ebx;
470 aux_repr(vo4) := eb1;
471 end if;
472
473 end if;
474
475 end case;
476
477 (q1_ofa): $ a1 := a2{a3}; a2 must be a map
478
smfl 76 if G2 = GRSMAP and
480 domtyp(typ2) = typ3 and
481 rangetyp(typ2) = comptyp(typ1) then
482
483 ebx := genabase(domtyp(typ2), tup23, tup23);
484 eby := genabase(rangetyp(typ2), tup12, [] );
485
486 $ ebz is the range set type of the multi-valued map.
smfl 77 EBZ := BASED_SET(EBY, SPRSE);
489
smfl 78 EB2 := BASED_MAP(EBX, EBZ, LOCL, FT_MMAP);
493
494 aux_repr(vo1) := ebz;
495 aux_repr(vo2) := eb2;
496 aux_repr(vo3) := ebx;
497 end if;
498
499
500 (q1_sofa): $ a1{a2} := a3; a4 is the input a1
501
502 typ4 := tps(4); vo4 := ivs(4);
503
smfl 79 if G1 = GRSMAP then
smfd 504 if typ1 = typ4 and domtyp(typ1) = typ2 and
smfd 505 rangetyp(typ1) = comptyp(typ3) then
smfd 506
smfd 507 ebx := genabase(domtyp(typ1), tup124, tup14);
smfd 508 eby := genabase(rangetyp(typ1), tup134, [] );
smfd 509
smfd 510 $ ebz is the range set type of the multi-valued map.
smfl 80 EBZ := BASED_SET(EBY, SPRSE);
smfd 513
smfl 81 EB1 := BASED_MAP(EBX, EBZ, LOCL, FT_MMAP);
smfd 517
smfd 518 aux_repr(vo1) := aux_repr(vo4) := eb1;
smfd 519 aux_repr(vo2) := ebx;
smfd 520 aux_repr(vo3) := ebz;
smfd 521
smfd 522 else
smfd 523 $ there is no conversion possible between a1 and a4:
smfd 524 $ make sure that this does not happen by linking their
smfd 525 $ neutral bases.
smfd 526 ebx := genabase(domtyp(typ1), tup14, tup14);
smfd 527 eby := genabase(rangetyp(typ1), tup14, [] );
smfd 528
smfl 82 $ EBZ is the range set type of the multi-valued map.
smfl 83 EBZ := BASED_SET(EBY, SPRSE);
smfl 84
smfl 85 EB1 := BASED_MAP(EBX, EBZ, LOCL, FT_MMAP);
smfd 532
smfd 533 aux_repr(vo1) := aux_repr(vo4) := eb1;
smfd 534 end if;
smfd 535
smfd 536 else
smfd 537 $ there is some error here, but no conversion is possible
smfd 538 $ between a1 and a4: make sure that this does not happen by
smfd 539 $ linking their neutral bases.
smfd 540 eb1 := genabase(typ1, tup14, []);
smfd 541 aux_repr(vo1) := aux_repr(vo4) := eb1;
smfd 542 end if;
537
538
539 (q1_in, q1_notin): $ a1 := (a2 in a3); (or notin)
540
541 case g3 of
542
543 (grsset) :
544
545 if typ2 = comptyp(typ3) then
546 ebx := genabase(typ2, tup23, tup3);
547
smfl 86 EB3 := BASED_SET(EBX, LOCL);
550
551 else
552 ebx := genabase(typ2, tup2, []);
553
554 eb3 := genabase(typ3, tup3, []);
555 locspr_of(eb3) := locl;
556 end if;
557
558 aux_repr(vo2) := ebx;
559 aux_repr(vo3) := eb3;
560
561 (grsmap):
562$ the test 'a2 in a3' is in this case a test of 'pair in map'
563$ which suggests introduction of two bases, an effective base
564$ b and a neutral base b1, and repr a2 as tuple(elmt b, elmt b1)
565$ and a3 as a map (elmt b) elmt b1.
566 if typ2 = comptyp(typ3) then
567
568 ebx := genabase(domtyp(typ3), tup23, tup3);
569 eby := genabase(rangetyp(typ3), tup23, [] );
570
smfl 87 EB2 := BASED_PAIR(EBX, EBY);
smfl 88 EB3 := BASED_MAP(EBX, EBY, LOCL, FT_MAP);
576
577 aux_repr(vo2) := eb2;
578 aux_repr(vo3) := eb3;
579
580 end if;
581
582 end case;
583
584
585 (q1_asn, q1_argin): $ a1 := a2;
586 $ formal parameter := actual parameter;
587 if typ1 = typ2 then $ link the bases
588 eb1 := genabase(typ1, tup12, []);
589 eb2 := eb1;
590 else $ still check for nullset/nullmap assignments
591 eb1 := genabase(typ1, tup1, []);
592 eb2 := om;
593 end if;
594
595 if is_const(v := oi_sym(vo2))=1 and value(v) = {} then
596 $ nullset or nullmap
597 locspr_of(eb1) := if opc=q1_asn then neutrl else sprse end;
smfl 89 if G1 = GRSMAP then
599 maptyp_of(eb1) := ft_smap;
600 end if;
601
602 else
smfl 90 if G1 = GRSSET then
604 locspr_of(eb1) := sprse;
605 end if;
smfl 91 if G1 = GRSMAP then
607 locspr_of(eb1) := sprse;
608 maptyp_of(eb1) := ft_map;
609 end if;
610 end if;
611
612 aux_repr(vo1) := eb1;
613 aux_repr(vo2) := eb2;
614
615 (q1_argout): $ actual parameter := formal parameter
616
617 if typ1 = tps(4) then
618 eb1 := genabase(typ1, tup14, []);
619 aux_repr(vo1) := eb1;
620 aux_repr(ivs(4)) := eb1;
621 end if;
622
623 (q1_add, q1_sub, q1_mod, q1_mult): $ a1 := a2 op a3;
624
625 case g1 of
626
627 (grsset):
628
629 if typ1 = typ2 and typ2 = typ3 then
630
631 ebx := genabase(comptyp(typ1), tup123, tup123);
632
smfl 92 EB1 := BASED_SET(EBX, REMT);
smfl 93 EB2 := BASED_SET(EBX, REMT);
smfl 94 EB3 := BASED_SET(EBX, REMT);
641
642 aux_repr(vo1) := eb1;
643 aux_repr(vo2) := eb2;
644 aux_repr(vo3) := eb3;
645 end if;
646
647
648 (grsmap):
649
650 if typ1 = typ2 and typ2 = typ3 then
651
652 ebx := genabase(domtyp(typ1), tup123, tup123);
653 eby := genabase(rangetyp(typ1), tup123, [] );
654
655 $ ebz is the range set type of the multi-valued map
smfl 95 EBZ := BASED_SET(EBY, SPRSE);
smfl 96
smfl 97 EB1 := BASED_MAP(EBX, EBZ, REMT, FT_MMAP);
smfl 98 EB2 := BASED_MAP(EBX, EBY, REMT, FT_MAP );
smfl 99 EB3 := BASED_MAP(EBX, EBY, REMT, FT_MAP );
670
671 aux_repr(vo1) := eb1;
672 aux_repr(vo2) := eb2;
673 aux_repr(vo3) := eb3;
674 end if;
675
676
677 (grstup):
678 if opc = q1_add then
679 if is_knt(typ2) then
680 comps2 := comptyp(typ2);
681 if is_knt(typ3) then
682 comps3 := comptyp(typ3);
683 bcomps2 := [];
684 bcomps3 := [];
685 (forall tpc = comps2(j))
686 bcomps2 with:= genabase(tpc, tup12,[]);
687 end forall;
690 (forall tpc = comps3(j))
691 bcomps3 with:= genabase(tpc, tup13, []);
692 end forall;
smfl 100 AUX_REPR(VO1) := BASED_KNT(BCOMPS2 + BCOMPS3);
smfl 101 AUX_REPR(VO2) := BASED_KNT(BCOMPS2);
smfl 102 AUX_REPR(VO3) := BASED_KNT(BCOMPS3);
698 else
699 if (forall tpc = comps2(j) |
700 tpc = comptyp(typ3)) then
701 eb := genabase(comptyp(typ3), tup123, []);
smfl 103 EB1 := BASED_TUP(EB);
smfl 104 EB2 :=
smfl 105 BASED_KNT([ EB : Q in [ 1..#COMPS2 ] ]);
smfl 106
smfl 107 AUX_REPR(VO1) := EB1;
smfl 108 AUX_REPR(VO2) := EB2;
smfl 109 AUX_REPR(VO3) := EB1;
708 end if;
709 end if;
710 else
711 if is_knt(typ3) then
712 comps3 := comptyp(typ3);
713 if (forall tpc = comps3(j) |
714 tpc = comptyp(typ2) ) then
715 eb := genabase(comptyp(typ2),tup123,[]);
smfl 110 EB1 := BASED_TUP(EB);
smfl 111 EB3 :=
smfl 112 BASED_KNT([ EB : Q in [ 1..#COMPS3 ] ]);
smfl 113
smfl 114 AUX_REPR(VO1) := EB1;
smfl 115 AUX_REPR(VO2) := EB1;
smfl 116 AUX_REPR(VO3) := EB3;
722 end if;
723 else
724 if (tpc := comptyp(typ2)) = comptyp(typ3) then
725 eb := genabase(tpc, tup123, []);
smfl 117 EB1 := BASED_TUP(EB);
smfl 118
smfl 119 AUX_REPR(VO1) := EB1;
smfl 120 AUX_REPR(VO2) := EB1;
smfl 121 AUX_REPR(VO3) := EB1;
729 end if;
730 end if;
731 end if;
732 end if;
733
734 end case;
735
736 (q1_nextd, q1_inextd):
737
738$ iteration over a tuple or a map (or a string, which case we ignore)
739$ this is not a pro-basing instruction in either case, but neutral
740$ bases are introduced here to facilitate later basing propagation
741$ (see the base merging phase for details)
742
743 case g3 of
744
745 (grsmap):
746
747 ebx := genabase(domtyp(typ3), tup13, []);
748 eby := genabase(rangetyp(typ3), tup3, []);
749
smfl 122 EB3 := BASED_MAP(EBX, EBY, SPRSE, FT_MAP);
753
754 aux_repr(vo1) := ebx;
755 aux_repr(vo3) := eb3;
756
757 (grstup):
758
759 if is_knt(typ3) then
760 comps := comptyp(typ3);
761 if (forall tpc = comps(j) | tpc = comps(1)) then
762 ebx := genabase(comps(1), tup3, []);
763
smfl 123 EB3 := BASED_KNT( [ EBX : Q in [ 1..#COMPS ] ] );
768
769 aux_repr(vo3) := eb3;
770 end if;
771 else
772 ebx := genabase(comptyp(typ3), tup3, []);
smfl 124 AUX_REPR(VO3) := BASED_TUP(EBX);
774 end if;
775
776 end case;
777
778 (q1_next, q1_inext):
779
780 case g3 of
781
782 (grsset):
783
784 ebx := genabase(comptyp(typ3), tup13, []);
785
smfl 125 EB3 := BASED_SET(EBX, SPRSE);
788
789 aux_repr(vo1) := ebx;
790 aux_repr(vo3) := eb3;
791
792 (grsmap):
793
794 ebx := genabase(domtyp(typ3), tup13, []);
795 eby := genabase(rangetyp(typ3), tup13, []);
796
smfl 126 EB3 := BASED_MAP(EBX, EBY, SPRSE, FT_MAP);
800
801 aux_repr(vo1) := based_pair(ebx, eby);
802 aux_repr(vo3) := eb3;
803
804 (grstup):
805
806 if is_knt(typ3) then $ probably rather unlikely
807 comps := comptyp(typ3);
808 if (forall tpc = comps(j) | tpc = typ1) then
809 ebx := genabase(typ1, tup13, []);
810
smfl 127 EB3 := BASED_KNT( [ EBX : Q in [ 1..#COMPS ] ] );
815
816 aux_repr(vo1) := ebx;
817 aux_repr(vo3) := eb3;
818 end if;
819 else
820 ebx := genabase(comptyp(typ3), tup13, []);
821 aux_repr(vo1) := ebx;
smfl 128 AUX_REPR(VO3) := BASED_TUP(EBX);
823 end if;
824
825 end case;
826
827 if opc = q1_next and vo1 in basedoccs then
828 basedoccs with:= (vo4 := ivs(4));
829 aux_repr(vo4) := aux_repr(vo1);
830 end if;
831
832 (q1_set1): $ iterative set former
833
834 case g1 of
835
836 (grsset):
837
838 ebx := genabase(typ2, tup12, tup1);
839
smfl 129 EB1 := BASED_SET(EBX, NEUTRL);
842
843 aux_repr(vo1) := eb1;
844 aux_repr(vo2) := ebx;
845
846 (grsmap):
847
848 ebx := genabase(domtyp(typ1), tup12, tup1);
849 eby := genabase(rangetyp(typ1), tup12, [] );
850
851 $ ebz is the range set type for the multi-valued map.
smfl 130 EBZ := BASED_SET(EBY, SPRSE);
854
smfl 131 EB1 := BASED_MAP(EBX, EBZ, NEUTRL, FT_MMAP);
858
859 aux_repr(vo1) := eb1;
860 aux_repr(vo2) := based_pair(ebx, eby);
861
862 end case;
863
864
865 (q1_tup1): $ iterative tuple former
866
867 ebx := genabase(typ2, tup12, []);
smfl 132 AUX_REPR(VO1) := BASED_TUP(EBX);
869 aux_repr(vo2) := ebx;
870
871
872 (q1_dom): $ a1 := domain a2
873
smfl 133 if G2 = GRSMAP then
875 ebx := genabase(domtyp(typ2), tup12, tup1);
876 eby := genabase(rangetyp(typ2), tup12, [] );
877
smfl 134 EB1 := BASED_SET(EBX, NEUTRL);
smfl 135 EB2 := BASED_MAP(EBX, EBY, SPRSE, FT_MAP);
884
885 aux_repr(vo1) := eb1;
886 aux_repr(vo2) := eb2;
887 end if;
888
889 (q1_range): $ a1 := range a2
890
smfl 136 if G2 = GRSMAP then
892 ebx := genabase(domtyp(typ2), tup12, [] );
893 eby := genabase(rangetyp(typ2), tup12, tup1);
894
smfl 137 EB1 := BASED_SET(EBY, NEUTRL);
smfl 138 EB2 := BASED_MAP(EBX, EBY, SPRSE, FT_MAP);
901
902 aux_repr(vo1) := eb1;
903 aux_repr(vo2) := eb2;
904 end if;
905
906 (q1_incs):
907
908 if typ2 = typ3 then
909 case g2 of
910
911 (grsset):
912
913 ebx := genabase(comptyp(typ2), tup23, tup23);
914
smfl 139 EB2 := BASED_SET(EBX, SPRSE);
smfl 140 EB3 := BASED_SET(EBX, LOCL);
920
921 aux_repr(vo2) := eb2;
922 aux_repr(vo3) := eb3;
923
924 (grsmap):
925
926 ebx := genabase(domtyp(typ2), tup23, tup23);
927 eby := genabase(rangetyp(typ2), tup23, [] );
928
smfl 141 EB2 := BASED_MAP(EBX, EBY, SPRSE, FT_MAP);
smfl 142 EB3 := BASED_MAP(EBX, EBY, LOCL, FT_MAP);
936
937 aux_repr(vo2) := eb2;
938 aux_repr(vo3) := eb3;
939
940 end case;
941 end if;
942
943 (q1_arb):
944
945 case g2 of
946
947 (grsset):
948
949 ebx := genabase(typ1, tup12, []);
950
smfl 143 EB2 := BASED_SET(EBX, SPRSE);
953
954 aux_repr(vo1) := ebx;
955 aux_repr(vo2) := eb2;
956
957 (grsmap):
958
959 ebx := genabase(domtyp(typ2), tup12, []);
960 eby := genabase(rangetyp(typ2), tup12, []);
961
smfl 144 EB1 := BASED_PAIR(EBX, EBY);
smfl 145 EB2 := BASED_MAP(EBX, EBY, SPRSE, FT_MAP);
967
968 aux_repr(vo1) := eb1;
969 aux_repr(vo2) := eb2;
970
971 end case;
972
973
974 (q1_arbb, q1_arbe): $ a1 := arb a2; a2 must be a tuple
975
smfl 146 if G2 = GRSTUP then
977
978 if is_knt(typ2) then
979
980 comps2 := comptyp(typ2);
981
982 if forall tpc in comps2 | tpc = typ1 then
983 ebx := genabase(typ1, tup12, []);
984
smfl 147 EB2 := BASED_KNT( [ EBX : J in [ 1..#COMPS2 ] ] );
989
990 aux_repr(vo1) := ebx;
991 aux_repr(vo2) := eb2;
992 end if;
993
994 elseif typ1 = comptyp(typ2) then
995
996 ebx := genabase(typ1, tup12, []);
997 aux_repr(vo1) := ebx;
smfl 148 AUX_REPR(VO2) := BASED_TUP(EBX);
999
1000 end if;
1001 end if;
1002
1003
1004 (q1_eq, q1_ne):
1005
1006 if typ2 = typ3 then
1007 eb := genabase(typ2, tup23, []);
1008 aux_repr(vo2) := eb;
1009 aux_repr(vo3) := eb;
1010 end if;
1011
1012
1013 (q1_tup): $ enumerative tuple former
1014
smfl 149 if G1 = GRSTUP then
1016 if #ivs = 2 then $ treat as homogeneous tuple
1017
1018 ebx := genabase(typ2, tup12, []);
smfl 150 AUX_REPR(VO1) := BASED_TUP(EBX);
1020 aux_repr(vo2) := ebx;
1021
1022 else $ must be known-length tuple
1023
1024 comps := [];
1025 (forall j in [ 2..#ivs ])
1026 voj := ivs(j);
1027
1028 ebx := genabase(tps(j), [ 1, j ], []);
1029 comps with:= ebx;
1030 aux_repr(voj) := ebx;
1031 end forall;
1032
smfl 151 AUX_REPR(VO1) := BASED_KNT(COMPS);
1034 end if;
1035 end if;
1036
1037
1038 (q1_set): $ enumerative set former
1039
1040 case g1 of
1041
1042 (grsset):
1043
1044 if (forall j in [ 2..#ivs ] |
1045 tps(j) = comptyp(typ1)) then
1046 ebx := genabase(comptyp(typ1), [ 1..#ivs ], []);
1047
smfl 152 EB1 := BASED_SET(EBX, NEUTRL);
1050
1051 aux_repr(vo1) := eb1;
1052
1053 (forall j in [ 2..#ivs ])
1054 aux_repr(ivs(j)) := ebx;
1055 end forall;
1056 end if;
1057
1058 (grsmap):
1059 if (forall j in [ 2..#ivs ] |
1060 tps(j) = comptyp(typ1)) then
1061 ebx := genabase(domtyp(typ1), [ 1..#ivs ], []);
1062 eby := genabase(rangetyp(typ1), [ 1..#ivs ], []);
1063
1064 if #ivs > 2 then
1065 $ potentially multi-valued result
smfl 153 EBZ := BASED_SET(EBY, SPRSE);
1068
smfl 154 EB1 := BASED_MAP(EBX, EBZ, NEUTRL, FT_MMAP);
1072
1073 else
smfl 155 EB1 := BASED_MAP(EBX, EBY, NEUTRL, FT_SMAP);
1077 end if;
1078
1079 aux_repr(vo1) := eb1;
1080
smfl 156 EB2 := BASED_PAIR(EBX, EBY);
1082
1083 (forall j in [ 2..#ivs ])
1084 aux_repr(ivs(j)) := eb2;
1085 end forall;
1086 end if;
1087
1088 end case;
1089
1090 (q1_subst, q1_end, q1_ssubst, q1_send):
1091 [ voj, typj, tupj ] :=
1092 if opc = q1_subst or opc = q1_end then
1093 [ vo2, typ2, tup12 ]
1094 elseif opc = q1_send then
1095 [ vo3, typ3, tup13 ]
1096 else
1097 [ ivs(4), tps(4), tup14 ]
1098 end;
1099
1100 if grosstyp(typj) = grstup then
smfl 157 if IS_KNT(TYPJ) then
smfl 158 if IS_KNT(TYP1) then
smfl 159 pass; $ ABORT('Missing code: genbases.subst.');
smfl 160 else
smfl 161 COMPS := COMPTYP(TYPJ);
smfl 162 if forall TPC = COMPS(J) | TPC = COMPTYP(TYP1) then
smfl 163 EBX := GENABASE(COMPTYP(TYP1), TUPJ, []);
smfl 164
smfl 165 EB1 := BASED_TUP(EBX);
smfl 166 EB2 := BASED_KNT( [ EBX : Q in [ 1..#COMPS ] ]);
smfl 167
smfl 168 AUX_REPR(VO1) := EB1;
smfl 169 AUX_REPR(VOJ) := EB2;
smfl 170 end if;
smfl 171 end if;
1112 else
1113 ebx := genabase(comptyp(typj), tupj, []);
1114
smfl 172 EB1 := BASED_TUP(EBX);
smfl 173
smfl 174 AUX_REPR(VO1) := EB1;
smfl 175 AUX_REPR(VOJ) := EB1;
1117 end if;
1118 end if;
1119
1120
1121 (q1_case): $ t := a1(a2); if t /= om then go to t;
1122
smfl 176 if G1 = GRSMAP and DOMTYP(TYP1) = TYP2 then
1124 ebx := genabase(typ2, tup12, tup1);
1125 eby := genabase(type_gen, tup1, [] );
1126
smfl 177 EB1 := BASED_MAP(EBX, EBY, REMT, FT_SMAP);
1130
1131 aux_repr(vo1) := eb1;
1132 aux_repr(vo2) := ebx;
1133 end if;
1134
1135
1136 end case;
1137
1138$ if no bases have been introduced, we assign a neutral base
1139$ for each occurrence in the instruction.
1140
1141 (forall voj = ivs(j) |
1142 is_ivar(voj) and
1143 voj notin basedoccs and is_const(argsi(j)) = om )
1144
1145 eb := genabase((typj := tps(j)), [ j ], []);
1146
1147 if t_set in grosstyp(typj) then
1148 locspr_of(eb) := neutrl;
1149 end if;
1150
1151 if t_map in grosstyp(typj) then
1152 locspr_of(eb) := neutrl;
1153 maptyp_of(eb) := ft_map;
1154 end if;
1155
1156 aux_repr(voj) := eb;
1157 end forall;
1158
1159 end procedure genbases;
1160
1161
1 .=member gab15c
2
3
4 procedure genabase(tp, boccs, effoccs);
5$
6$ this routine generates a temporary base (= blank atom), with
7$ 'tp' as its element-mode. 'boccs' is a tuple of indices of
8$ arguments of the current instruction which are to be based on
9$ this base, and 'effoccs' is a tuple of indices of arguments
10$ which are to be effectively based on this base (i.e. composite
11$ objects for which this base eliminates a hash operation).
12$
13 repr
14 tp: elmt types;
15 boccs, effoccs: tuple(integer);
16
17 b: tent_base;
18 effvars: sparse set(symbol);
19 j: integer;
20 end repr;
21
22 b := newat;
23 bases with:= b;
24 elmt_mode(b) := tp;
25
26$ note that at this phase all base element modes are unbased (so
27$ that the fifth component of 'tp' (= om) need not be changed.
28
29$ note additional based occurrences
30 basedoccs +:= { get_oi(ins, j) : j in boccs};
31$ note that the current instruction, here called 'ins', is passed
32$ globally.
33
34 bscope(b) := maxscope([scope(argsi(j)) : j in boccs]);
35 $ (see explanatory section on 'scopes of bases' at the start of
36 $ this module for more details.)
37
38 effvars := {argsi(j) : j in effoccs};
39 is_effective(b) :=
40 if effvars = {} then 'neutral'
41 elseif #effvars = 1 then arb effvars $ see preceeding comment
42 else 'effective' end; $ on the desired map value in this case
43
44 return [ grselmt, b, om, based ];
45
46 end procedure genabase;
47
48
49
50
51 procedure maxscope(tup_scps);
52$
53$ this routine computes the maximal scope in a tuple 'tup_scps'
54$ of scopes which are contained within each other.
55$ the following types of scopes can appear together:
56$ 1. 'sc_proc', 'sc_mod', 'sc_dir'
57$ 2. 'sc_proc', 'sc_prog', 'sc_dir'
58$ 3. 'sc_proc', 'sc_lib'
59$
60$ see comment 'scopes of bases' above.
61$
62 repr
63 tup_scps: tuple(elmt base_scopes);
64
65 scp: elmt base_scopes;
66 maxscp: elmt base_scopes;
67 end repr;
68
69$ maxscp is the largest containing scope found so far
70 maxscp := om;
71
72 (forall scp in tup_scps | scp /= om)
73 if maxscp = om then maxscp := scp; end if;
74 if maxscp = scp then continue forall; end if;
75
76 case sc_type(scp) of
77
78 (sc_sys, sc_lib): return sym_sys;
79
80 (sc_dir, sc_prog, sc_mod):
81 case sc_type(maxscp) of
82 (sc_sys, sc_lib): return sym_sys;
83 (sc_dir, sc_prog, sc_mod): maxscp := sym_dir;
84 (sc_proc):
85 $ account for the fact that the main program is part of
86 $ the system scope
87 if maxscp = sym_main then
88 maxscp := maxscope( [ sym_prog, scp ] );
89 else
90 maxscp := maxscope( [ scope(maxscp), scp ] );
91 end if;
92 end case;
93
94 (sc_proc):
95 $ account for the fact that the main program is part of the
96 $ system scope
97 if scp = sym_main then
98 maxscp := maxscope( [ sym_prog, maxscp ] );
99 else
100 maxscp := maxscope( [ scope(scp), maxscp ] );
101 end if;
102
103 end case;
104 end forall;
105
106 return maxscp;
107
108 end procedure maxscope;
109
110
1 .=member bsm15d
2
3
smfd 543
smfd 544$ 2. base merging and adjustment
smfd 545$ -- ---- ------- --- ----------
smfd 546
smfd 547$ in this phase we merge based reprs of all pairs of occurrences linked
smfd 548$ by a bfrom link. this merging operation proceeds approximately as
smfd 549$ follows:
smfd 550$
smfd 551$ let vo and vo1 be two occurrences which have the same type and which
smfd 552$ are linked by bfrom. it follows from the mechanism of the base
smfd 553$ generation pre-pass that any repr rpr generated at this phase can only
smfd 554$ have one of the following three forms:
smfd 555$
smfd 556$ (i) rpr can be unbased.
smfd 557$
smfd 558$ (ii) rpr can have the form 'elmt b'.
smfd 559$
smfd 560$ (iii) rpr can have the form
smfd 561$ composite(elmt b)
smfd 562$ (for sets and homogeneous tuples), or the form
smfd 563$ composite(elmt b1, elmt b2, ..., elmt bn)
smfd 564$ (for maps (then n = 2) and mixed tuples).
smfd 565$
smfd 566$ these initial reprs will not be modified during the base merging and
smfd 567$ adjustment phase. consequently, only the following cases can arise
smfd 568$ when merging the reprs of vo and vo1:
smfd 569$
smfd 570$ 1. if one of these reprs is unbased, do nothing.
smfd 571$
smfd 572$ 2. if both reprs are of the second category, the merge simply
smfd 573$ equivalences the corresponding bases. this equivalencing action
smfd 574$ calls for the merging of the element-modes of the bases, thus repr
smfd 575$ merging is a recursive (or transitive) process. for more details,
smfd 576$ see below.
smfd 577$
smfd 578$ 3. if both reprs are of the third category, then their structures
smfd 579$ must be identical, but may possibly involve different bases. in
smfd 580$ this case the merge equivalences all pairs of corresponding bases
smfd 581$ in these reprs, as is done in (2)).
smfd 582$
smfd 583$ 4. if one repr is elmt b, and the other is of the third category,
smfd 584$ then if elmt_mode(b) is unbased we replace elmt_mode(b) by the
smfd 585$ second repr, and if elmt_mode(b) is based, we merge it with the
smfd 586$ second repr (this is another source of transitive closure in the
smfd 587$ merging process).
smfd 588$
smfd 589$ we use the following implementation: the set 'bases' of all generated
smfd 590$ bases is represented as a forest in which each equivalence class of
smfd 591$ bases is a tree whose root is the representing base for that class.
smfd 592$ we can then use a highly-efficient compressed balanced tree
smfd 593$ representation to manipulate this forest. for this purpose let
smfd 594$ 'repbase' denote the father mapping in this forest, and let
smfd 595$ repbase .lim b denote the root mapping (see ). in addition to
smfd 596$ repbase we also maintain an auxiliary map 'nbases' which maps each
smfd 597$ root of the forest to its number of descendents, and the map
smfd 598$ 'elmt_mode', which has to be kept only for the roots of the forest.
smfd 599$ since elmt_mode(b) has to be kept iff repbase(b) is undefined, these
smfd 600$ two maps can be merged into one, to obtain a compact data-structure.
smfd 601$
smfd 602$ for the suppression of useless bases we also need to maintain an
smfd 603$ 'is_effective' map at the roots of the forest, combining its values at
smfd 604$ the roots of two trees which are to be merged in order to determine
smfd 605$ the effectivity of the merged tree. this map can only have the three
smfd 606$ kinds of values outlined above, and according to our heuristic
smfd 607$ principle (4), all classes for which is_effective of their root is not
smfd 608$ true will be suppressed in a subsequent phase of our algorithm.
smfd 609$
smfd 610$ essentially, only two operations need to be performed on this forest:
smfd 611$
smfd 612$ 1. root determination: to compute the root of a given base, we apply
smfd 613$ the lim operator. this is explained in , except that here
smfd 614$ the 'virtual forest' mentioned in can be identical with
smfd 615$ the actual one, so that path compression can be applied directly
smfd 616$ to repbase. note, however, that or treatment of map types
smfd 617$ requires that whenever we merge two map types where one designates
smfd 618$ a multi-valued map and the other does not, the root of the new
smfd 619$ tree must be the multi-valued map type. this is due to the fact
smfd 620$ that a multi-valued map type carries information about the range
smfd 621$ set type (which also contains information about the range element
smfd 622$ type), while the other map types contain information only about
smfd 623$ the range element type.
smfd 624$
smfd 625$ 2. base equivalencing: this is accomplished by a balanced linking of
smfd 626$ two trees into one, but with the following additional operations:
smfd 627$ (a) the set types of elmt_mode's are merged, according to the
smfd 628$ heuristic outlined below; (b) the map types of map reprs are
smfd 629$ merged; and (c) the elmt_mode's of the roots of the linked trees
smfd 630$ are merged. to perform this latter operation we may have to
smfd 631$ update the elmt_mode of the new root. this is required when
smfd 632$ elmt_mode(root of larger tree) is unbased, and elmt_mode(root of
smfd 633$ smaller tree) is based. in this case we replace the unbased mode
smfd 634$ by the based one. note that this can induce additional base
smfd 635$ equivalences.
smfd 636$
smfd 637$
smfd 638$ user-declared basings are partly reflected in the typ map, available
smfd 639$ at the start of the automatic data structure selection algorithm.
smfd 640$ however, they raise several problems concerning which the current
smfd 641$ implementation has made somewhat arbitrary decisions. for example, it
smfd 642$ is not clear whether we ever want to merge two user-supplied bases, or
smfd 643$ always keep them distinct. an argument for not merging them is that
smfd 644$ by doing so we may cause some based objects to become sparse over the
smfd 645$ merged base, which may well have been the reason why the user supplied
smfd 646$ two distinct bases instead of one. thus we have chosen not to merge
smfd 647$ user-supplied bases, though in other cases it might be better to do
smfd 648$ so.
smfd 649$
smfd 650$ to avoid such merging, we maintain a map at the roots of our forest,
smfd 651$ called 'userbase', indicating which user-supplied base, if any, is a
smfd 652$ member of the corresponding class. in this way, we can avoid linking
smfd 653$ two classes together if they contain different user-supplied bases.
smfd 654$
smfd 655$ note that currently the userbase map is not initialised during the
smfd 656$ base generation pre-pass. this calls for some modifications of the
smfd 657$ pre-pass. consequently the comment just made can be ignored. note
smfd 658$ that the equibase routine given below will not equivalence bases for
smfd 659$ which different user bases have been declared.
smfd 660$
smfd 661$ let us emphasise again that our algorithm merges basings only when it
smfd 662$ encounters occurrences of the same type. this is a restriction which
smfd 663$ simplifies the logic of the algorithm, avoiding several troublesome
smfd 664$ issues that would arise otherwise. see also remark (1) at the end of
smfd 665$ the present module.
smfd 666$
smfd 667$ however, we may want to consider some relaxations, e.g. tuple vs.
smfd 668$ known-length tuple.
smfd 669$
127 procedure basemerge;
128
129
130 repr
131 vo, vo1: occurrence;
132 rpr, rpr1, rpr2: elmt types;
133 grstyp1, grstyp2: basic_type;
134 i: integer;
135 mptp1, mptp2: elmt base_ft_mapcs;
136 temp1, temp2: elmt types;
137 b, rb1, rb2: tent_base;
138 sc: elmt base_scopes;
139 end repr;
140
141
142$ initially,
143
144 repbase := {};
145 nbases := { [ b, 1 ] : b in bases};
146
147 if 'y' in dump_string then
148 print(' - base merging phase');
149 end if;
150 if 'x' in dump_string then
151 prints('aux_repr =',
152 [ [ rpad(oi_name(vo), 20) + rpad(oi_str(vo), 10), rpr ] :
153 rpr = aux_repr(vo) ] );
154 prints('elmt_mode =', [ [ str b, rpr ] : rpr = elmt_mode(b) ] );
155 prints('bscope', [ [ str b, sc ] : sc = bscope(b) ] );
156 end if;
157
158 (forall vo in basedoccs, vo1 in bfrom{vo} |
159 vo1 in basedoccs and typ(vo) = typ(vo1) )
160
161$ let us emphasize again that our algorithm merges basings only when it
162$ encounters occurences of the same type. this is a restriction which
163$ simplifies the logic of the algorithm, avoiding several troublesome
164$ issues that would arise otherwise. see also remark (1) at the end of
165$ the present module.
166$$$ ???? may want however to consider some relaxations, e.g. tuple
167$$$ ???? vs. known-length tuple
168$
169 workpile := { [ aux_repr(vo), aux_repr(vo1) ] };
170
171 (while workpile /= {})
172 [ rpr1, rpr2 ] from workpile;
173 if 'x' in dump_string then
174 print;
175 print('merge representation', rpr1);
176 print(' with', rpr2);
177 end if;
178
179 if not is_based(rpr1) then continue; end if;
180 if not is_based(rpr2) then continue; end if;
181
182$ otherwise both reprs are based, so that their conjunction may yield
183$ additional merging actions.
184
185 grstyp1 := arb grosstyp(rpr1);
186 grstyp2 := arb grosstyp(rpr2);
187$ note that based occurrences will have only one basic type in their
188$ 'grosstyp' field. this is because the base generation prepass would
189$ not have generated bases for occurrences having ambiguous types.
190
191 if grstyp1 = grstyp2 then
192
193 if grstyp1 = 'elmt' then
194
195$ both reprs are element-of-base. equivalence their bases, which are
196$ the component-types of these reprs. this equivalencing may trigger
197$ the merging of the element-modes of these bases.
199
200 equibase(base_of(rpr1), base_of(rpr2));
201
202 elseif grstyp1 = 'map' then
203
204$ if a map is repred as a based map, its domain type and range type are
205$ both element-of-base types, and we have to equivalence these bases.
207
208 equibase(base_of(domtyp(rpr1)),
209 base_of(domtyp(rpr2)));
210
211 mptp1 := map_type(rpr1);
212 mptp2 := map_type(rpr2);
213
214 if mptp1 = ft_mmap and mptp2 /= ft_mmap then
215 rb1 := .lim base_of(rangetyp(rpr1));
216 temp1 := comptyp(elmt_mode(rb1));
217 $ nb. it follows from the logic of the pre-pass
218 $ that the element mode of rb1 is based.
219
220 equibase(base_of(temp1),
221 base_of(rangetyp(rpr2)) );
222
223 $ nb. it follows from the logic of the
224 $ pre-pass and the equibase routine that rpr2
225 $ is updated correctly.
226 $ rangetyp(rpr2) :=
227 $ [ { t_elmt }, rb1, om, based ];
228 $ map_type(rpr2) := ft_mmap;
229
230 elseif mptp1 /= ft_mmap and mptp2 = ft_mmap then
231 rb2 := .lim base_of(rangetyp(rpr2));
232 temp2 := comptyp(elmt_mode(rb2));
233 $ nb. it follows from the logic of the pre-pass
234 $ that the element mode of rb2 is based.
235
236 equibase(base_of(rangetyp(rpr1)),
237 base_of(temp2) );
238
239 $ nb. it follows from the logic of the
240 $ pre-pass and the equibase routine that rpr1
241 $ is updated correctly.
242 $ rangetyp(rpr1) :=
243 $ [ { t_elmt }, rb2, om, based ];
244 $ map_type(rpr1) := ft_mmap;
245
246 else
247 equibase(base_of(rangetyp(rpr1)),
248 base_of(rangetyp(rpr2)) );
249 end if;
250
251 elseif grstyp1 = t_tuple and is_knt(rpr1) then
252 $ equivalence all the components of these
253 $ mixed tuples
254 (forall i in [ 1..#comptyp(rpr1) ])
255 equibase(base_of(ctypn(rpr1, i)),
256 base_of(ctypn(rpr2, i)));
257 end forall;
258
259 else
260 $ for sets and homogeneous tuples, only one
261 $ base equivalencing need be performed
262
263 temp1 := comptyp(rpr1);
264 temp2 := comptyp(rpr2);
265 equibase(base_of(temp1), base_of(temp2));
266 end if;
267
268 elseif grstyp1 = t_elmt then
269$ here we merge 'elmt b' with a composite repr. this calls for merging
270$ the element-mode of b with the other repr. however, if as yet the
271$ element mode of b is not based, we simply change it to the second
272$ (necessarily based) repr.
273
274 rb1 := .lim base_of(rpr1);
275
276 if not is_based(elmt_mode(rb1)) then
277$$-- here bscope is not updated correctly: if the scope of rpr1 is
278$$-- greater than the scope of rpr2, then this information is lost.
279$$-- for as long as we allocate all bases in the system scope, this
280$$-- does not matter.
281 elmt_mode(rb1) := rpr2;
282 else
283 workpile with:= [ elmt_mode(rb1), rpr2 ];
284 end if;
285
286 elseif grstyp2 = t_elmt then
287
288 rb2 := .lim base_of(rpr2);
289
290 if not is_based(elmt_mode(rb2)) then
291$$-- here bscope is not updated correctly: if the scope of rpr2 is
292$$-- greater than the scope of rpr1, then this information is lost.
293$$-- for as long as we allocate all bases in the system scope, this
294$$-- does not matter.
295 elmt_mode(rb2) := rpr1;
296 else
297 workpile with:= [ elmt_mode(rb2), rpr1 ];
298 end if;
299 end if;
300
301 end while;
302 end forall;
303
304 typ := om; $ free for garbage collection
305
306 end procedure basemerge;
307
308
1 .=member eqb15e
2
3
4 procedure equibase(b1, b2);
5$
6$ this is our base equivalencing routine. most of its code performs
7$ standard tree-balancing, but "elmt_mode", "is_effective", "bscope",
8$ and "userbase" also need to be adjusted appropiately.
9$
10$ the 'workpile' variable is global.
11$
12 repr
13 b1, b2: tent_base;
14
15 rb1, rb2, root, desc: tent_base;
16 ubase: symbol;
17 eff, eff1, eff2: general;
18 lcsp, lcsp1, lcsp2: elmt base_based_modes;
19 mptp, mptp1, mptp2: elmt base_ft_mapcs;
20 bscp: elmt base_scopes;
21 end repr;
22
23 rb1 := .lim b1;
24 rb2 := .lim b2;
25
26 if rb1 = rb2 then return; end if;
27
28$
29$ first determine the user-declared base of the equivalence class,
30$ if there exists such a base.
31$
32 if (ubase := userbase(rb1)) = om then
33 ubase := userbase(rb2);
34 elseif userbase(rb2) /= om and userbase(rb2) /= ubase then
35 return; $ do not merge classes with different user bases
36 end if;
37$
38$ next compute the effectivity of the new class
39$
40 eff1 := is_effective(rb1);
41 eff2 := is_effective(rb2);
42
43 eff := case eff1 of
44 ('neutral'): eff2,
45 ('effective'): 'effective'
46 else $ eff1 is now a variable name
47 case eff2 of
48 ('neutral'): eff1,
49 ('effective'): 'effective'
50 else $ both are variable names
51 if eff1 = eff2 then eff1 else 'effective' end
52 end
53 end;
54$
55$ next compute the maptyp and locspr entries for the new class
56$
57 lcsp1 := set_type(elmt_mode(rb1));
58 lcsp2 := set_type(elmt_mode(rb2));
59
60 if lcsp1 = lcsp2 then
61 lcsp := lcsp1;
62 else
63 if lcsp1 = om then lcsp1 := sprse; end;
64 if lcsp2 = om then lcsp2 := sprse; end;
65 lcsp := if lcsp1 = neutrl then lcsp2
66 elseif lcsp2 = neutrl then lcsp1
67 elseif lcsp1 = lcsp2 then sprse
68 else remt end;
69 end if;
70
71 mptp1 := map_type(elmt_mode(rb1));
72 mptp2 := map_type(elmt_mode(rb2));
73
74 if mptp1 /= mptp2 and mptp1 /= ft_mmap and mptp2 /= ft_mmap then
75 mptp := if mptp1 = ft_smap then ft_smap
76 elseif mptp2 = ft_smap then ft_smap
77 else ft_map
78 end;
79 else
80 mptp := om;
81 end if;
82
83 bscp := maxscope([bscope(rb1), bscope(rb2)]);
84$
85$ determine the new root, balancing the resulting tree whenever
86$ possible
87$
88 if mptp1 = ft_mmap and mptp2 /= ft_mmap then
89 root := rb1; desc := rb2;
90
91 elseif mptp1 /= ft_mmap and mptp2 = ft_mmap then
92 root := rb2; desc := rb1;
93
94 elseif nbases(rb1) > nbases(rb2) then
95 root := rb1; desc := rb2;
96 else
97 root := rb2; desc := rb1;
98 end if;
99
100 repbase(desc) := root;
101
102 nbases(root) +:= nbases(desc);
103 is_effective(root) := eff;
104 userbase(root) := ubase;
105 bscope(root) := bscp;
106
107 set_type(elmt_mode(root)) := lcsp;
108 set_type(elmt_mode(desc)) := lcsp;
109
110 if mptp /= om then
111 map_type(elmt_mode(root)) := mptp;
112 map_type(elmt_mode(desc)) := mptp;
113 end if;
114
115 if is_based(elmt_mode(desc)) then
116 if not is_based(elmt_mode(root)) then
117$$-- here bscope is not updated correctly: if the scope of root is
118$$-- greater than the scope of desc, then this information is lost.
119$$-- for as long as we allocate all bases in the system scope, this
120$$-- does not matter.
121 elmt_mode(root) := elmt_mode(desc);
122 else
123 $ both are based, so additional equivalencing is needed
124 workpile with:= [ elmt_mode(root), elmt_mode(desc) ];
125 end if;
126 end if;
127
128 if 'x' in dump_string then
smfl 178 print(' New root', ROOT,
smfl 179 'with element mode', ELMT_MODE(ROOT));
smfl 180 print(' has', NBASES(ROOT), 'descendents'
smfl 181 ' and effectiveness', EFF);
135 end if;
136
137
138 end procedure equibase;
139
140
1 .=member rpb15f
2
3
4 op .lim(b);
5$
6$ this routine computes the root of b in our forest, and applies
7$ "path compression".
8$
9 repr
10 b: tent_base;
11
12 rb1, rb2, rbx: tent_base;
13 s1: remote set(tent_base);
14 end repr;
15
16 rb1 := repbase(b);
17
18 if rb1 = om then
19 return b;
20
21 elseif (rb2 := repbase(rb1)) = om then
22 return rb1;
23
24 else
25 s1 := {b};
26
27 (while (rbx := repbase(rb2)) /= om)
28 s1 with:= rb1;
29 rb1 := rb2;
30 rb2 := rbx;
31 end while;
32
33 (forall rb1 in s1)
34 repbase(rb1) := rb2;
35 end forall;
36
37 return rb2;
38 end if;
39
40 end op .lim;
41
42
43
1 .=member baj15g
2
3
smfd 670$ 3. base and repr adjustment phase
smfd 671$ -- ---- --- ---- ---------- -----
smfd 672
smfd 673$ this phase is a 'clean-up' phase which suppresses useless bases, and
smfd 674$ computes the oi_repr map for all occurrences. thus it consists of the
smfd 675$ following two subphases:
smfd 676$
smfd 677$ (a) we first suppress (equivalence classes of) bases that have not
smfd 678$ turned out to be useful, according to the heuristic principle (4)
smfd 679$ above. each droppable equivalence class is flagged as such, and any
smfd 680$ other repr containing a base b1 in such a class should be modified so
smfd 681$ that each elmt b1 appearance in it is replaced by
smfd 682$ elmt_mode(repbase .lim b1). the output of this phase is a set
smfd 683$ droppables containing all droppable bases.
smfd 684$
smfd 685$ (b) next, we iterate over all occurrences, computing the oi_repr map.
smfd 686$ for each occurrence vo, oi_repr(vo) is an actual repr which is
smfd 687$ obtained from aux_repr(vo) by replacing bases by their
smfd 688$ representatives, or dropping them as described in (a) above. during
smfd 689$ this step we also enforce certain compile restriction, such as that
smfd 690$ the result of a value creating operation is a value; if such a value
smfd 691$ is wanted in a based form, it must be converted to such a
smfd 692$ representation explicitly. again note that at this point we compute
smfd 693$ repr on an occurrence bases, so if we have 's := s1 + s2' and require
smfd 694$ s to have the form elmt b, then the above restriction would give s the
smfd 695$ repr elmt_mode(b), and the subsequent conversion analysis phase would
smfd 696$ insert a locate instruction at some appropriate point to ensure that s
smfd 697$ would be in the elmt b format.
smfd 698$
smfd 699$ (c) finally we dertermine the set of surviving representative bases,
smfd 700$ which is passed to the next phase, the conversion analsysis phase.
6
7 procedure baseadjust;
8
9$ this phase is a "clean-up" phase which suppresses useless bases,
10$ computes the oi_repr map for all occurences, and enters the
11$ surviving bases into the symbol table. thus it consists of
12$ the following three subphases:
13
22 repr
23 rb: tent_base;
24 rpr: elmt types;
25 vo: occurrence;
26 opc: elmt base_opcodes;
27 bmode: elmt types;
28 repbases: remote set(tent_base);
29 vorpr: elmt types;
30 end repr;
31
32 if 'y' in dump_string then
33 print(' - base adjustment phase');
34 end if;
35
36 repbases := { rb in bases | repbase(rb) = om };
37 droppables :=
38 { rb in repbases | is_effective(rb) /= 'effective'};
39
47 oi_repr := {};
48 seendrops := {}; $ 'seendrops' is the set of all droppable bases
49 $ b for which the real elmt_mode(b) has already
50 $ been computed.
51
52 (forall rpr = aux_repr(vo))
53 if vo in basedoccs then
54 rpr := real_repr(rpr);
55 if grosstyp(rpr) = grselmt then
smfd 701 opc := oi_op(vo);
57 if (is_ovar(vo) and
58 opc in ops_ovar and opc notin ops_iter and
59 (opc = q1_ofa or opc notin ops_nonewval))
60 or
61 $ nb. opc in ops_sin and argno(vo) = 1 is part
62 $ of preceding "is_ovar(vo) and ..." test
63 (opc in ops_sin and argno(vo) = 4)
64 or
65 (opc in ops_iter and argno(vo) = 3)
66$$-- nb. we also need to check that if opc in { q1_nextd, q1_inextd }
67$$-- and argno(vo) = 3 and grosstyp(rpr) = grsset then error: conversion
68$$-- will be attempted at q1_inextd, a3 will be changed
69 then
70 rpr := real_repr(elmt_mode(base_of(rpr)));
71 end if;
72 end if;
73 end if;
74 oi_repr(vo) := rpr;
75 end forall;
76
77 if 'y' in dump_string then
78 prints('oi_repr =',
79 [ [ rpad(oi_name(vo), 20) + rpad(oi_str(vo), 10), vorpr ] :
80 vorpr = oi_repr(vo) ] );
81 end if;
82
83 aux_repr := om; $ free space for garbage collection
84
92 actual_bases := repbases - droppables;
93$$$ ???? for garbage collection, it may be advantageous to
94$$$ ???? delete all map entries on all bases other than those
95$$$ ???? in actual_bases.
96 if 'y' in dump_string then
97 print;
98 print('actual bases and their element forms are');
99 end if;
100
101 (forall rb in actual_bases)
102 if is_based(elmt_mode(rb)) then
103 elmt_mode(rb) := real_repr(elmt_mode(rb));
104 end if;
105 if 'y' in dump_string then
106 print(rb, elmt_mode(rb));
107 end if;
108 end forall;
109
110 if 'd' in dump_string then fancy_output; end if;
111
112 end procedure baseadjust;
113
114
1 .=member fpr15h
2
3
4 procedure fancy_output;
5$
6$ this routine prints the repr information collected in this phase in a
7$ format resembling that of the data-representation sublanguage, only
8$ that a variable may be assigned several different reprs in different
9$ occurrences of it. we print each repr of each variable togoether with
10$ the list of all occurrences of that variable having that repr.
11$
12 repr
13 v: symbol;
14 vo: occurrence;
15 rpr: elmt types;
16 b: tent_base;
17 vreprs: sparse mmap{symbol}
18 sparse mmap{elmt types}
19 sparse set(occurrence);
20 r_occs: sparse mmap{elmt types}
21 sparse set(occurrence);
22 v_occs: sparse set(occurrence);
23 end repr;
24
25
26 vreprs := {};
27 (forall rpr = oi_repr(vo) |
28 (v := oi_sym(vo)) in variables and is_internal(v) = om)
29 vreprs{v}{rpr} with:= vo;
30 end forall;
31
32 print; print;
33 print('suggested data structures:');
34 print; print;
35
36 (forall b in actual_bases)
37 print(rpad('base ads' + str b + ':', 24),
38 format_repr(elmt_mode(b)) + ';' );
39 end forall;
40
41 print;
42
43 (forall r_occs = vreprs{v}, v_occs = r_occs{rpr} |
44 ( exists vo in v_occs | ffrom{vo} /= {}) )
45 print(rpad(name(v) + ': ', 24), format_repr(rpr) + ';' );
46 print(' $ at occurences '
47 +/[ ' ' + oi_str(vo) : vo in v_occs ] );
48 end forall;
49
50
51 end procedure fancy_output;
52
53
1 .=member rrp15i
2
3
4 procedure real_repr(rpr);
5$
6$ this routine transforms a based repr rpr into a new repr in the
7$ following way:
8$ each appearance of a droppable base b in this repr is replaced
9$ (recursively) by its element mode;
10$ each appearance of an effective base b in this repr is replaced
11$ by the actual base representing b.
12$
13 repr
14 rpr: elmt types;
15 grs: basic_type;
16 temp5: tuple(elmt types);
17 rb: tent_base;
18 rprx: elmt types;
19 i: integer;
20 end repr;
21
22
23 $ it follows from the logic of the base generation pass that
24 $ ambiguous types can not have based reprs. consequently we
25 $ take an immediate exit.
26 if # grosstyp(rpr) /= 1 then return rpr; end if;
27
28 grs := arb grosstyp(rpr);
29
30 case grs of
31
32 (t_elmt):
33$ get representing base and check whether it is droppable
34 rb := .lim base_of(rpr);
35 if rb in droppables then
36$ if droppable, but already processed, return its element mode
37$ (in which all required replacements have already taken place)
38 if rb in seendrops then
39 return elmt_mode(rb);
40 else
41$ otherwise note this base as processed, get its element mode
42$ and transform it recursively if based.
43 seendrops with:= rb;
44 rprx := elmt_mode(rb);
45 if not is_based(rprx) then
46 return elmt_mode(rb) := rprx;
47 else
48 return elmt_mode(rb) := real_repr(rprx);
49 end if;
50 end if;
51 else
52$ if not droppable, return 'elmt of representing base'
53 return [ grselmt, rb ];
54 end if;
55
56 (t_tuple):
57$ return a tuple repr, with transformed component reprs
58 if is_knt(rpr) then
59 temp5:=comptyp(rpr);
60 return
61 [ grstup,
62 [ real_repr(temp5(i)) : i in [ 1..#temp5 ] ],
63 true ];
64 else
65 return [ grstup, real_repr(comptyp(rpr)), false ];
66 end if;
67
68 (t_map):
69$ return a map repr, with transformed element repr
70 return
71 [ grsmap,
72 [ grstup,
73 [ real_repr(domtyp(rpr)), real_repr(rangetyp(rpr)) ],
74 true ],
75 om,
76 om,
77 set_type(rpr),
78 map_type(rpr) ];
79
80 (t_set):
81$ return a set repr, with transformed element repr
82 return
83 [ grsset,
84 real_repr(comptyp(rpr)),
85 om,
86 om,
87 set_type(rpr) ];
88
89 else
90 return rpr;
91
92 end case;
93
94 end procedure real_repr;
95
96
97
smfd 702
smfd 703$ remarks
smfd 704$ -------
smfd 705
smfd 706$ (1) the transitive closure of base equivalences carried out during the
smfd 707$ merging procedure always relates 'more composite' bases to 'more
smfd 708$ primitive' ones. equivalencing two bases whose element-modes are
smfd 709$ composite can cause bases appearing in these modes to be equivalenced
smfd 710$ too, as in example b above. however, equivalencing is not induced in
smfd 711$ the opposite direction. for example:
smfd 712$
smfd 713$ example c
smfd 714$
smfd 715$ s with:= x; $ s: set(elmt b1); x: elmt b1;
smfd 716$ u with:= s; $ u: set(elmt b2); s: elmt b2;
smfd 717$ t with:= x; $ t: set(elmt b3); x: elmt b3;
smfd 718$ v with:= t; $ v: set(elmt b4); t: elmt b4;
smfd 719$
smfd 720$ in this example, b1 and b3 are equivalenced in view of the x-link, but
smfd 721$ b2 and b4 are not merged. this approach is probably desirable, since
smfd 722$ such a merging would not improve the execution of the above code
smfd 723$ fragment, but might make u and v sparse over the merged base (of
smfd 724$ course, further information may make us merge b2 and b4, e.g. an
smfd 725$ instruction such as 'if s in v then ...').
smfd 726$
smfd 727$ (2) as with any recursive or transitive-closure mechanism, we must
smfd 728$ guarantee convergence of the merging process. since the number of
smfd 729$ generated bases is finite, divergence could occur only if there exist
smfd 730$ cyclic dependencies between bases, the simplest of which could be:
smfd 731$ base b1: set(elmt b1). if such a configuration occurred and b1 were
smfd 732$ equivalenced with base b2: set(elmt b2), then the merging process
smfd 733$ would repeat equivalencing operations involving b1 and b2 infinitely
smfd 734$ many times. also, during the base-dropping phase, if b1 were
smfd 735$ droppable then we might attempt to replace each elmt b1 appearance in
smfd 736$ a repr by set(elmt b1), which would obviously lead to endless looping.
smfd 737$
smfd 738$ we claim, however, that such situations will never occur, indeed, a
smfd 739$ cyclic dependency could only be derived by base merging along a cyclic
smfd 740$ execution path, and only if there is a cyclic type dependency along
smfd 741$ this path, as in the loop
smfd 742$
smfd 743$ (forall ...) x with:= x; end forall;
smfd 744$
smfd 745$ but in this situation the type finder will produce different types for
smfd 746$ the o-variable and the i-variable of the statement in the loop, e.g.
smfd 747$ set(general) and general, respectively (recall that o-variables are
smfd 748$ assigned the forward type of their i-variables in the final phase of
smfd 749$ the type finder). hence, no base merging will take place along such
smfd 750$ loops.
smfd 751$
smfd 752$ it can also be noted that if the base generated for this statement
smfd 753$ (call it b1) is not dropped, then the conversion analysis phase will
smfd 754$ split the variable x into two variable x.1 and x.2, and will transform
smfd 755$ the above loop into
smfd 756$
smfd 757$ (forall ...) x.2 := x.1; x.1 with:= x.2; end forall;
smfd 758$
smfd 759$ where we have:
smfd 760$
smfd 761$ b1: base(general); x.2: elmt b1; x.1: set(elmt b1);
smfd 762$
smfd 763$ and the assignment x.2 := x.1; is a locate of the value of x.1 in b1.
smfd 764$
smfd 765$ it should also be noted that in order to ensure proper operation of
smfd 766$ the type finder, its above-mentioned final phase should compute
smfd 767$ o-variable types without applying the standard artificial limit on the
smfd 768$ complexity of generated types, so as to avoid any accidental type
smfd 769$ identification.
smfd 770$
smfd 771$ note in this connection that if we process the loop
smfd 772$
smfd 773$ (forall ...) x := { x }; end forall;
smfd 774$
smfd 775$ both x occurrences would get the type set(set(...set(general)...))
smfd 776$ with a maximal nesting level, unless, in the final phase, we increase
smfd 777$ the nesting level of the o-variable by 1.
smfd 778$
smfd 779$ (3) return for the moment to example c above, where there are two
smfd 780$ linked occurrences of s, one of which is repred set(elmt b1) and the
smfd 781$ other elmt b2. at a first glance it seems that we ought to produce a
smfd 782$ common repr for these occurrences, but a better choice is to leave
smfd 783$ these reprs as they are. then, after base merging and name-splitting,
smfd 784$ the code will be transformed into:
smfd 785$
smfd 786$ sa with:= x; $ sa: set(elmt b1); x: elmt b1;
smfd 787$ (a1) sb := sa;
smfd 788$ u with:= sb; $ u: set(elmt b2); sb: elmt b2;
smfd 789$ tb from u; $ u: set(elmt b2); tb: elmt b2;
smfd 790$ (a2) ta := tb;
smfd 791$ y from ta; $ ta: set(elmt b1); y: elmt b1;
smfd 792$
smfd 793$ where a1 is a base locate of the value of sa in b2 and a2 is
smfd 794$ essentially a dereferencing of the value of tb, originally a pointer
smfd 795$ to an element of b2, but after dereferencing a pointer to the set
smfd 796$ value of ta (note that here type checking is necessary unless the
smfd 797$ element mode of b2 is set(elmt b1)).
smfd 798$
smfd 799$ this approach again reflects the basic philosophy of the final phases
smfd 800$ of the optimiser, namely: reprs and types should be assigned to
smfd 801$ occurrences in such a way that each instruction will be executed in
smfd 802$ the most efficient manner, and any type or repr checks and conversions
smfd 803$ which must precede an instruction should be moved and inserted into
smfd 804$ the code in an appropriate place preceding that instruction.
smfd 805$
smfd 806$ final remarks
smfd 807$ ----- -------
smfd 808$
smfd 809$ (1) our algorithm merges reprs only if they have the same type, and
smfd 810$ consequently equivalences bases only if they have the same
smfd 811$ element-type. for example, set(integers) and set(general) are
smfd 812$ considered as distinct types. hence, even if there is a link between
smfd 813$ two occurrences having such types, their bases will not be merged, and
smfd 814$ eventually we shall have to convert from one base to the other. it is
smfd 815$ not clear whether this approach is to be preferred, and there may be a
smfd 816$ point in merging bases of this kind, even though this can lead to
smfd 817$ creation of additional type checks and conversions which would not
smfd 818$ have been otherwise needed. at any rate, our approach is simple and
smfd 819$ should be quite acceptable in most cases.
smfd 820$
smfd 821$ (2) we expect the present data structure algorithm to be more
smfd 822$ efficient than the variant algorithm described in . in the
smfd 823$ present algorithm, base propagation is accomplished by a single pass
smfd 824$ through the bfrom links between based occurrences, with very efficient
smfd 825$ processing of each such link. however, a time consuming part of the
smfd 826$ present algorithm is the manipulation of completely useless and thus
smfd 827$ droppable bases, and corresponding based occurrences. it is not clear
smfd 828$ how to estimate this additional time usage, which depends heavily on
smfd 829$ the nature of the program being analysed.
smfd 830$
smfd 831$ since it generates these additional bases, the present algorithm will
smfd 832$ require more space than the previous one. this space usage could be
smfd 833$ reduced by somewhat more intricate programming (e.g. by folding the
smfd 834$ pre-pass into the base merging phase), but then the algorithm would
smfd 835$ lose some of its clarity.
smfd 836$
smfd 837$ note, however, that the space required by the older automatic
smfd 838$ data-structure selection algorithms (of schonberg, schwartz and liu)
smfd 839$ which use value-flow, is at least the cardinality of the value-flow
smfd 840$ maps, in comparison with which the space requirement of the present
smfd 841$ algorithm is rather modest.
245
246
247 end module setl_optimizer - auto_dstruct;
248
249
1 .=member cnv15j
2
3 module setl_optimizer - conversion_analysis;
4$
5$ this module performs data-structure conversion analysis. this is a
6$ necessary supplementary phase to be performed after the preceding
7$ type analysis and automatic data-structure selection phases have com-
8$ puted data types and representations for the variable occurrences in
9$ the program being analyzed.
10$
11$ this phase performs the following tasks:
12$
13$ (a) name-splitting:
14$
15$ each variable v whose occurrences do not get all the same repre-
16$ sentation, is 'split' into several variables, one for each pos-
17$ sible data representation computed for occurrences of v. each
18$ occurrence of v is then replaced by an occurrence of the corres-
19$ ponding split-variable. all the split variables of v are entered
20$ into the symbol table as storage-sharing variables. the problem
21$ with this transformation is that conversions between different
22$ variables split from the same variable still have to be inserted
23$ into the code, to avoid situations in which one such variable is
24$ defined and then another split variable is used. this is taken
25$ care of by the following conversion analysis subphase.
26$
27$ (b) conversion analysis:
28$
29$ in this phase we perform three bit-vectoring data flow analyses
30$ to determine where and when to insert conversions from one split
31$ variable to another. the rationale of these analyses is
32$ discussed in section 9 of the tech. report, and is mentioned here
33$ with only little detail.
34$
35$ the first analysis being performed is a 'backward-union' safety
36$ analysis whose purpose is to determine which conversions can oc-
37$ cur at a given program point (to be mainly an interval preheader,
38$ into which we try to move such conversions).
39$
40$ the second analysis is a 'forward-intersection' availability ana-
41$ lysis, which, using the safety information available from the
42$ previous analysis, moves conversions out of loops if possible,
43$ and determines whether a conversion is required prior to any
44$ given use of a split variable. the actual conversion insertion
45$ takes place later on in this module.
46$
47$ the third analysis is a 'forward-union' reachability analysis, in
48$ which we determine, for each basic block n, the set mayreach(n)
49$ of all split variables which can reach the start of n. this will
50$ enable us to emit appropriate conversions as follows: if we want
51$ to insert at a certain point a conversion to a split variable vx,
52$ we compute the set of all variables vy split from the same origi-
53$ nal variable as vx, which can reach the conversion. if this set
54$ consists of exactly one variable vy, then we emit a conversion of
55$ vy to vx; if there is more than one such variable vy, then we
56$ emit a conversion from a type-general variable sharing storage
57$ with vx to vx.
58$
59 macro .comp; .comp_syms endm;
60 macro df_base; df_base_syms endm;
61 macro interproc_fwd_analysis; interproc_fwd_analysis_syms endm;
62 macro intraproc_fwd_analysis; intraproc_fwd_analysis_syms endm;
63 macro interproc_back_analysis; interproc_back_analysis_syms endm;
64 macro intraproc_back_analysis; intraproc_back_analysis_syms endm;
65 macro fom; fom_syms endm;
66 macro xom; xom_syms endm;
67
68 var
69 all_splits, $ set of all split variables
70 split_vars, $ maps each variable v to all of its split
71 $ variables
72 split_from, $ maps each split variable to original variable
73 forminv, $ maps each tuple of form attributes and a
74 $ scope to a form in this scope having those
75 $ attributes
76 can_convert; $ a relation containing [ fm1, fm2 ] iff any
77 $ value having form fm1 can be converted to
78 $ form fm2
79
80
81 macro base_of(rpr); userbase(rpr(2)) endm;
82
83$ the following macro constructs a tuple of form attributes from a form
84
85 macro form_maps(f);
86 [ ft_type(f),
87 ft_mapc(f),
88 ft_elmt(f),
89 ft_dom(f),
90 ft_im(f),
91 ft_base(f),
92 ft_lim(f),
93 ft_tup(f),
94 ft_hashok(f),
95 ft_neltok(f),
96 ft_pos(f),
97 ft_num(f) ]
98 endm;
99
100 macro ft_type_; nfm_maps(1) endm;
101 macro ft_mapc_; nfm_maps(2) endm;
102 macro ft_elmt_; nfm_maps(3) endm;
103 macro ft_dom_; nfm_maps(4) endm;
104 macro ft_im_; nfm_maps(5) endm;
105 macro ft_base_; nfm_maps(6) endm;
106 macro ft_lim_; nfm_maps(7) endm;
107 macro ft_tup_; nfm_maps(8) endm;
108 macro ft_hashok_; nfm_maps(9) endm;
109 macro ft_neltok_; nfm_maps(10) endm;
110 macro ft_pos_; nfm_maps(11) endm;
111 macro ft_num_; nfm_maps(12) endm;
112
113 const null_ft_num =
114 { [ f_lset, 0 ],
115 [ f_lmap, 0 ],
116 [ f_limap, 0 ],
117 [ f_lpmap, 0 ],
118 [ f_lrmap, 0 ] };
119
120 const $ various gross types
121 grselt = { t_elmt },
122 grstup = { t_tuple },
123 grsset = { t_set },
124 grsmap = { t_map };
125
126
127 repr
128 mode df_elmt: df_elmt_syms;
129 mode df_map: df_map_syms;
130
131 base splitvars: symbol;
132 mode splitvar: elmt splitvars;
133
134 all_splits: remote set(splitvar);
135 split_vars: remote mmap{splitvar}
136 sparse set(splitvar);
137 split_from: remote smap(splitvar) splitvar;
138
139 forminv: mmap{elmt base_scopes}
140 smap(tuple(general)(12))
141 elmt forms;
142 can_convert: mmap{elmt forms} set(elmt forms);
143 grselt: gross_type;
144 grstup: gross_type;
145 grsset, grsmap: gross_type;
146
147 .meet: operator(df_map, df_map) df_map;
148 .join: operator(df_map, df_map) df_map;
149 compute_splits: procedure;
150 place_conversions: procedure;
151 conv_blockmaps: procedure(routine, df_elmt)
152 tuple(
153 remote smap(df_edge) df_map,
154 remote smap(df_edge) df_map,
155 remote smap(df_edge) df_map,
156 remote mmap{df_node} df_elmt
157 );
158 insert_convs: procedure(
159 routine,
160 remote smap(df_node) df_elmt,
161 remote mmap{df_node} df_elmt,
162 remote smap(df_node) df_elmt,
163 df_elmt
164 );
165 sharp_form: procedure(
166 elmt forms,
167 elmt types,
168 elmt base_scopes )
169 elmt forms;
170 newform: procedure(
171 tuple(general)(12),
172 elmt base_scopes )
173 elmt forms;
174 elmt_type: procedure(elmt types) elmt types;
175 insert_base: procedure(tent_base, elmt base_scopes);
176 add_conv: procedure(
177 splitvar,
178 elmt insts,
179 df_elmt
180 );
181 add_split: procedure(splitvar) splitvar;
182 end repr;
183
184
185 procedure conv_optimize;
186$
187$ this is the main driver routine for conversion analysis. it consists
188$ of the following phases:
189$
190$ 1. base insertion: during this phase, we actually insert the effec-
191$ tive bases into the symbol table.
192$
193$ 2. computation of split variables: for each variable occurrence, we
194$ find (a possibly new) variable with the form for the variable at
195$ the occurrence, and substitute the original variable by the newly
196$ variable.
197$
198$ 3. conversion insertion: during this phase, we solve the data flow
199$ problems metioned above, and insert the conversions required bet-
200$ ween variables within each equivalence class.
201$
202 repr
203 entry_time: integer;
204 end repr;
205
206 title('cims.setl.' + prog_level + ' - conversion analysis');
207 printa(term_file, ' - conversion analysis');
208
209 entry_time := time;
210
211 all_splits := {}; $ set of all variables being split
212 split_vars := {}; $ maps each variable v to all of its split
213 $ variables
214 split_from := {}; $ maps each split variable to original variable
215
216
217 compute_splits; $ generate the needed split variables
218 place_conversions; $ find low-frequency places for conversions
219
220
221 $ delete the static variables global to this module
222 all_splits := om; split_vars := om; split_from := om;
223 forminv := om; can_convert := om;
224
225 statistics with:= time; $ save time for final statistics
226
227 if 'e' in dump_string then
228 print;
229 print(time - entry_time, 'msecs spent in conversion analysis');
230 end if;
231
232
233 end procedure conv_optimize;
234
235
236 procedure compute_splits;
237$
238$ this routine does the actual insertion of the effective bases into
239$ the symbol table.
240$
241$
242$ this routine computes the equivalence classes for each variable in
243$ the program.
244$
245 init
246 memo_form := {};
247 init
248 argin_inst := {}, argout_inst := {},
249 argin_form := {}, argout_form := {};
250
251 repr
252 sc: elmt base_scopes;
253 b: tent_base;
254 fm, nfm: elmt forms;
255 fm1, fm2: elmt forms;
256 v: symbol;
257 vx, vy: splitvar;
258 vo: occurrence;
259 rpr: elmt types;
260 vforms: sparse set(elmt forms);
smfc 631 nfm_maps: tuple(general)(12);
262 memo_form: smap(
263 tuple(elmt forms, elmt types, symbol)
264 ) elmt forms;
smfk 138 new_occsof: sparse mmap{symbol}
smfk 139 sparse set(occurrence);
smfk 140 voccs: sparse set(occurrence);
265
266 r: routine;
267 inst: elmt insts;
268 argins: sparse set(elmt insts);
269 argin_inst: sparse mmap(symbol) elmt insts;
270 argout_inst: sparse mmap(symbol) elmt insts;
271 argin_form: sparse mmap(symbol) elmt forms;
272 argout_form: sparse mmap(symbol) elmt forms;
273 split_time: integer;
274 end repr;
275
276
277 split_time := time;
278
279 forminv := {};
280 (forall sc in scopes)
281
282 $ build forminv, which sends each scope and vector of form
283 $ attributes to its form table entry.
284
285$$-- we do not compute the scope of tentative bases correctly at the
286$$-- moment: consequently we move all forms into the system scope
287$$-- here. if the scoping was done correctly, the following (disabled
288$$-- i.e. commented-out) code would suffice. the corrective code has
289$$-- has been marked as such.
290
291$$-- (for_form(fm, sc))
292$$-- if not is_fbase(fm) then
293$$-- forminv{sc}(form_maps(fm)) := fm;
294$$-- end if;
295$$-- end;
296
297$$-- start of corrective code
298 (for_form(fm, sc))
299 if is_fbase(fm) then
300 if sc_type(sc) /= sc_sys then
301 ermsg('cannot yet handle user-defined bases');
302 end if;
303 else
304 if forminv{sc}(form_maps(fm)) = om then
305 if sc_type(sc) /= sc_sys then
306 last_form(sym_sys) :=
307 next_form(last_form(sym_sys)) := fm;
308 end if;
309 forminv{sym_sys}(form_maps(fm)) := fm;
310 end if;
311 end if;
312 end; $ end for_form;
313
314 if sc_type(sc) /= sc_sys then
315 first_form lessf:= sc; last_form lessf:= sc;
316 end if;
317 next_form lessf:= last_form(sym_sys);
318 end forall;
319
320 (forall sc in scopes)
321$$-- end of corrective code
322
323 $ insert the actual bases of this scope into the symbol table.
324
325$$-- (forall b in actual_bases |
326$$-- bscope(b) = sc and userbase(b) = om)
327 (forall b in actual_bases | userbase(b) = om)
328 insert_base(b, sym_sys);
329
330$$-- note that we allocate all bases in the system scope
331
332$$-- if userbase(b) is not om, or not in this scope, we must assure
333$$-- that maxscope([ scope(userbase(b)), bscope(b) ]) =
334$$-- scope(userbase(b)), i.e. that the userbase is in a larger scope
335$$-- than b, and furthermore that the ft_elmt(form(userbase(b))) is
336$$-- consistent with the elmt_mode(b). this is currently not done.
337
338 end forall;
339
340 $ finally compute all forms for this scope
smfk 141
smfk 142 new_occsof := {}; $ occurrences of new split variables.
341
342 (for_sym(v, sc))
343 if v notin variables then continue; end if;
344
smfk 143 $ assert domain occsof = variables; except as follows:
smfk 144 $ 1. there exist variables which are not in domain(occsof):
smfk 145 $ these are dead variables, generated e.g. by available
smfk 146 $ expression analysis when merging redundant assignments.
smfk 147 $ 2. there are some constants added to occsof when instruc-
smfk 148 $ tions are added.
346
347 (forall vo in occsof{v})
348 rpr := oi_repr(vo) ? type_zero;
349 if rpr = type_zero then continue; end if;
350 if is_repr(v) = 1 then
351 fm := form(v);
352 else
353 fm := std_form(f_gen);
354 end if;
355$
356$ now 'merge' the given form 'fm' of v and the suggested repr 'rpr'
357$ at the occurrence vo, to obtain a new form 'nfm' which is
358$ more specific than fm and is compatible with rpr. this new form
359$ is also inserted into the form table of the appropriate scope
360$ if not there already. all these is carried out by the routine
361$ 'sharp_form'
362$
363 if (nfm := memo_form( [ fm, rpr, v ] )) = om then
364 nfm := sharp_form(fm, rpr, sym_sys);
365$$-- note that we allocate all forms in the system scope
366 memo_form( [ fm, rpr, v ] ) := nfm;
367 end if;
368
369 if form(v) = nfm then
370 vx := v;
371 split_vars{vx} with:= vx;
372 split_from(vx) := vx;
373
374 elseif exists vx in split_vars{v} |
375 form(vx) = nfm then
376 pass;
377
378 elseif split_from(v) = om and not is_repr(v)=1 then
379 form(v) := nfm;
380
381 vx := v;
382 split_vars{vx} with:= vx;
383 split_from(vx) := vx;
384
385 elseif exists r in routs | v = rretn(r) then
386 $ this could be handles somewhat more efficient...
387 form(v) := std_form(f_gen);
388
389 vx := v;
390 split_vars{vx} with:= vx;
391 split_from(vx) := vx;
392
393 elseif oi_op(vo) = q1_argin and is_ovar(vo) and
394 name( rptyps(args(instno(vo))(3))
395 (value(args(instno(vo))(4))) ) = 'wr'
396 then
397 $ recall that the third operand of a q1_argin gives
398 $ the routine name, and the fourth operand gives the
399 $ argument number in the call: if this is a wr
400 $ parameter, ignore it as far as generation of split
401 $ variables is concerned.
402
403 $ assert args(instno(vo))(2) = sym_om;
404
405 vx := v;
406 else
407 vx := add_split(v);
408 form(vx) := nfm;
409 end if;
410
smfk 149 if v /= vx then
smfk 150 args(instno(vo))(argno(vo)) := vx;
smfk 151 occsof{v} less:= vo; new_occsof{vx} with:= vo;
smfk 152 end if;
412
413 if oi_op(vo) = q1_argin and is_ovar(vo) then
414 argin_inst{v} with:= instno(vo);
415 argin_form{v} with:= form(vx);
416
417 elseif oi_op(vo) = q1_argout and is_ivar(vo) then
418 argout_inst{v} with:= instno(vo);
419 argout_form{v} with:= form(vx);
420 end if;
421 end forall vo;
422 end; $ end for_sym;
smfk 153
smfk 154 (forall voccs = new_occsof{v}) occsof{v} +:= voccs; end;
smfk 155 new_occsof := om; $ free storage.
smfk 156
423 end forall sc;
424
430
431$ formal parameters of procedures must be handled differently during
432$ the generation of split variables, for the following two reasons:
433$
434$ (1) if a write-parameter (ie. a parameter with a rw or wr declaration)
435$ requires a conversion, our general algorithm would insert the conver-
436$ sion before the instruction which requires the conversion, i.e. the
437$ q1_argout instruction. this is the wrong place, because at this point
438$ the actual parameter is still on the stack, and consequently a conver-
439$ sion of the symbol table entry's value would produce the wrong result.
440$ note that the proper place for this conversion is in the called
441$ procedures exit block.
442$
443$ (2) the code generator uses the form of the procedure to determine the
444$ conversions required between actual and formal parameters, plus the
445$ conversion which might be required for the procedure's return value.
446$ to compute the proper procedure form we need to know which of the
447$ possibly existing split variables was actually used in the q1_argin
448$ and q1_argout instructions, to then use their forms to build the
449$ procedure form. (note that since setl does not provide generic
450$ procedures, the form of an ambigous formal parameter becomes general)
451$
452$ we then handle formal parameters as follows: whenever we generate a
453$ split variable for the formal parameter of a q1_argin or q1_argout
454$ instruction, we update two maps: the first maps each formal
455$ parameter to all the forms it assumes in a q1_argin or q1_argout
456$ instruction; the second maps each formal parameter to all q1_argin
457$ or q1_argout instructions in which it appears. if, after generating
458$ all split variables, we find that some formal parameter is found with
459$ more than one form, we generate an additional split variable of form
460$ general, and use the second map to modify all q1_argin and q1_argout
461$ instructions to use this variable (note that such a split might
462$ already exist). we then update the routine parameter list, rparams,
463$ to reflect any change. finally, we generate the new procedure form.
464$ (nb. we really keep separate maps for the q1_argin and q1_argout cases
465$ to simplify the update process.)
466
467 $ at this point, we are done with the ads_maps: delete them
468 actual_bases := om; userbase := om; bscope := om;
469 oi_repr := om; elmt_mode := om;
470
471 (forall argins = argin_inst{v})
472 if # (argin_form{v} + argout_form{v}) > 1 then
473
474 if ft_type(form(v)) = f_gen then
475 vx := v;
476 split_vars{vx} with:= vx;
477 split_from(vx) := vx;
478
479 elseif exists vx in split_vars{v} |
480 ft_type(form(vx)) = f_gen then
481 is_param(vx) := 1;
482
483 else
484 vx := add_split(v);
485 form(vx) := std_form(f_gen);
486 end if;
487
488 (forall inst in argins)
489 args(inst)(1) := vx;
smfk 157 if v /= vx then
smfk 158 vo := get_oi(inst, 1);
smfk 159 occsof{v} less:= vo; occsof{vx} with:= vo;
smfk 160 end if;
490 end forall;
491
492 (forall inst in argout_inst{v})
493 args(inst)(4) := vx;
smfk 161 if v /= vx then
smfk 162 vo := get_oi(inst, 4);
smfk 163 occsof{v} less:= vo; occsof{vx} with:= vo;
smfk 164 end if;
494 end forall;
495
496 elseif args(arb argins)(1) = v then
497 continue forall;
498
499 else
500 vx := args(arb argins)(1);
501 end if;
502
503 inst := arb argins;
504 rparams(args(inst)(3))(value(args(inst)(4))) := vx;
505 end forall;
506
507 (forall r in routs)
508 nfm_maps := [];
509 ft_type_ := f_proc;
510 ft_elmt_ := [ form(v) : v in rparams(r) ] with form(rretn(r));
511 ft_lim_ := #rparams(r) + 1;
512
513 if forall fm in ft_elmt_ | ft_type(fm) = f_gen then
514 form(r) := std_form(f_proc);
515 else
516$$--cf. above comment relating to the scope of forms
517 form(r) := newform(nfm_maps, sym_sys);
518 end if;
519 end forall;
520
521 all_splits := { vx : vx = split_from(vy) | #split_vars{vx} > 1 };
522
523 argin_inst := om; argout_inst := om;
524 argin_form := om; argout_form := om;
525$
526$ compute the relation can_convert
527$
528 can_convert := {};
529 (forall vx in all_splits)
530 vforms := { form(vy) : vy in split_vars{vx} };
531 (forall fm1 in vforms, fm2 in vforms | can_conv(fm1, fm2))
532 can_convert with:= [ fm1, fm2 ];
533 end forall;
534 end forall;
535
536 if 'e' in dump_string then
537 print(time - split_time, 'msecs to compute split variables');
538 end if;
539
540 end procedure compute_splits;
541
542
543
544
545 procedure place_conversions;
546$
547$ this routine solves the data flow problems and computes the maps to
548$ insert the required conversions.
549$
550$ note that in the data structures selected below we reflected that we
551$ use the results of an analysis as soon as it becomes available. this
552$ led us to use the data flow base for most of our work, as this base
553$ should be smaller than the set of all split variables.
554$
555 repr
556 globsplits, locsplits: df_elmt;
557
558 zero: df_elmt;
559 id: df_map;
560
561 maysafe: remote smap(df_node) df_elmt;
562 avail: remote smap(df_node) df_elmt;
563 exposed: remote mmap{df_node} df_elmt;
564 insert: remote mmap{df_node} df_elmt;
565 safe: remote mmap{df_node} df_elmt;
566 mayreach: remote smap(df_node) df_elmt;
567 dum1, dum2, dum3: remote mmap{df_node} df_elmt;
568
569 ffwd, ffwdj, fbak: remote smap(df_edge) df_map;
570
571 r: routine;
572 intt, hd: elmt blocks;
573 v, vy: splitvar;
574 vx: elmt df_base;
575 ksplits, gsplits: df_elmt;
576 fnewcnvs: df_map;
577 usym1, usym2: symbol;
578 df_time: integer;
579 end repr;
580
581
582 df_time := time;
583$
584$ construct the undefined flow values for the dataflow_solver routines.
585$
586 xom := { usym1 := newat };
587 fom := [ { usym1 := newat }, { usym2 := newat } ];
588
589$ conversion analysis for global variables (and formal parameters)
590
591 globsplits := {};
592 (forall v in globalvars | v in all_splits)
593 globsplits +:= split_vars{v};
594 end forall;
595 (forall r in routs, v in rparams(r) |
596 split_from(v) in all_splits )
597 globsplits +:= split_vars{split_from(v)};
598 end forall;
599
600 if globsplits = {} then
601 pass;
602
603 else
604 zero := globsplits; $ analysis data state at exits
605 id := [ zero, {} ]; $ identity map for analysis
606
607 $ get the data_flow maps for both analyses and the 'exposed' map
608 [ffwd, ffwdj, fbak, exposed] := conv_blockmaps(om, globsplits);
609
610 $ invoke the interprocedural analyzers
611 interproc_back_analysis(fbak, maysafe, id, zero, false);
612 fbak := om; $ free storage
613
614$ before calling the forward analyzer, convert the 'maysafe' map
615$ produced by the backward analyzer to the form required by the
616$ forward analyzer. (see section 9 of the tech. report.)
617
618 safe := {};
619 (forall r in routs, intt in ints(r) |
620 (hd := int_nodes(intt)(1)) /= intt)
621 safe{intt} :=
622 { vx in globsplits |
623 (forall vy in split_vars{split_from(vx)} |
624 vy in maysafe(hd) and
625 form(vx) in can_convert{form(vy)} ) };
626 end forall;
627 maysafe := om; $ free storage
628
629 zero := {}; $ forward analysis data state at entries
630 interproc_fwd_analysis(ffwd, avail, id, zero, true,
631 true, exposed, insert, safe);
632 ffwd := om; $ free storage
633
634$ next update the flow maps 'ffwdj' of the third analysis to take
635$ into account conversions moved out of loops
636 (forall r in routs, intt in ints(r) |
637 (hd := int_nodes(intt)(1)) /= intt)
638 fnewcnvs := id;
639 (forall vx in insert{intt})
640 ksplits := split_vars{split_from(vx)} less vx;
641 gsplits := { vx };
642 fnewcnvs := [ id(1) - ksplits, gsplits ] .comp fnewcnvs;
643 end forall;
644 ffwdj([intt, hd]) := fnewcnvs .comp ffwdj([intt, hd]);
645 end forall;
646
647 interproc_fwd_analysis(ffwdj, mayreach, id, zero, false,
648 false, dum1, dum2, dum3);
649 ffwdj := om; $ free storage
650
651$ finally, perform the actual conversion insertion
652 insert_convs(om, avail, insert, mayreach, globsplits);
653
654 $ free storage
655 avail := om; insert := om; mayreach := om;
656 globsplits := om;
657
658 end if;
659
660$ repeat the above procedure for the local variables of each
661$ procedure r
662
663 (forall r in routs)
664
665 locsplits := {};
666 (forall v in localvars{r} |
667 v in all_splits and
668 forall vy in split_vars{v} | vy notin rparams(r) )
669 locsplits +:= split_vars{v};
670 end forall;
671
672 if locsplits = {} then continue forall; end if;
673
674 zero := locsplits; $ analysis data state at exits
675 id := [ zero, {} ]; $ identity map for analysis
676
677 [ ffwd, ffwdj, fbak, exposed ] :=
678 conv_blockmaps(r, locsplits);
679
680 intraproc_back_analysis(r, fbak, maysafe, id, zero, false);
681 fbak := om; $ free storage
682
683 safe := {};
684 (forall intt in ints(r) | (hd := int_nodes(intt)(1)) /= intt)
685 safe{intt} :=
686 { vx in locsplits |
687 (forall vy in split_vars{split_from(vx)} |
688 vy in maysafe(hd) and
689 form(vx) in can_convert{form(vy)} ) };
690 end forall;
691 maysafe := om; $ free storage
692
693 zero := {};
694
695 intraproc_fwd_analysis(r, ffwd, avail, id, zero, true,
696 true, exposed, insert, safe);
697 ffwd := om; $ free storage
698
699$ next update the flow maps 'ffwdj' of the third analysis to take
700$ into account conversions moved out of loops
701 (forall intt in ints(r) |
702 (hd := int_nodes(intt)(1)) /= intt)
703 fnewcnvs := id;
704 (forall vx in insert{intt})
705 ksplits := split_vars{split_from(vx)} less vx;
706 gsplits := { vx };
707 fnewcnvs := [ id(1)-ksplits, gsplits ] .comp fnewcnvs;
708 end forall;
709 ffwdj([intt, hd]) := fnewcnvs .comp ffwdj([intt, hd]);
710 end forall;
711
712 intraproc_fwd_analysis(r, ffwdj, mayreach, id, zero, false,
713 false, dum1, dum2, dum3);
714 ffwdj := om; $ free storage
715
716 insert_convs(r, avail, insert, mayreach, locsplits);
717
718 $ free storage
719 avail := om; insert := om; mayreach := om;
720 locsplits := om;
721 end forall;
722
723 if 'e' in dump_string then
724 print(time - df_time, 'msecs to solve dataflow problem');
725 end if;
726
727
728 end procedure place_conversions;
729
730
1 .=member cbm15k
2
3
4 procedure conv_blockmaps(p, splits);
5$
6$ this procedure computes data flow maps and exposed representations for
7$ the backward and forward analyses required in conversion optimisation.
8$ the first parameter 'p' is either a routine to be scanned, or, if p is
9$ omega, then all routines have to be scanned. the second parameter,
10$ 'splits', is the set of all split variables relevant for the analysis.
11$
12 repr
13 $ data structures for parameters
14 p: routine;
15 splits: df_elmt;
16
17 $ data structures for return values
18 ffwd, ffwdj, fbak: remote smap(df_edge) df_map;
19 exposed: remote mmap{df_node} df_elmt;
20
21 $ data structures for local variables
22 todo: sparse set(routine);
23 r: routine;
24 b: df_node;
25 i: elmt insts;
26 opc: elmt base_opcodes;
27 argsi: tuple(symbol);
28
29 v: splitvar;
30 vx: symbol;
31 vx1: splitvar;
32 vx2: elmt df_base;
33 vy: elmt df_base;
34 fmx: elmt forms;
35 iva1: integer;
36 k: integer;
37
38 fblkfwd, fblkbak: df_map;
39 inpvars: df_elmt;
40 killed: df_elmt;
41 fwdgen, bakgen: df_elmt;
42 can_expose: df_elmt;
43 vsplits: df_elmt;
44
45 sblks: sparse set(df_node);
46 lb: symbol;
47 b1: df_node;
48 end repr;
49
50 if p = om then todo := routs; else todo := { p }; end if;
51
52 ffwd := {}; ffwdj := {}; fbak := {};
53 exposed := {};
54
55 (forall r in todo)
56 (for_block(b, r))
57 fblkfwd := fblkbak := [splits, {}];
58
59 (for_inst(i, b))
60 opc := opcode(i);
61 argsi := args(i);
62 iva1 := first_ivar(opc);
63$$$ ???? need to worry about two input arguments of i being different
64$$$ ???? split variables of the same original variable.
65$$$ ???? this case should never happen, and we assume here that it
66$$$ ???? indeed does not occur
67 inpvars := {}; $ set of all input arguments of i
68
69 killed := fwdgen := bakgen := {};
70$ these sets are defined as follows:
71$ killed - the set of all split variables whose original variable has
72$ appeared so far in i
73$ fwdgen - the set of all split variables occurring in i (where the
74$ output occurrence in i suppresses any input occurrences in i
75$ of the same original variable from appearing in this set.
77$ bakgen - set of all split variables vx split from some v such that
78$ either v originally occurred in i as an input argument,
79$ actually being represented by another split variable vx1
80$ such that one can always convert from vx to vx1, or, if this
81$ is not the case, v occurs in i as its output argument.
82
83 can_expose := fblkfwd(1) - fblkfwd(2);
84 (forall k in [ #argsi, #argsi-1..iva1 ] |
85 (vx2 := vx := argsi(k)) in splits)
86 v := split_from(vx);
87 inpvars with:= v;
88 vsplits := split_vars{v};
89 fmx := form(vx);
90
91 if vx2 in can_expose then
92 exposed{b} with:= vx2;
93 end if;
94
95 killed +:= vsplits;
96 fwdgen with:= vx2;
97 bakgen +:= { vy in vsplits |
98 fmx in can_convert{form(vy)} };
99
100 end forall;
101
102 if opc in ops_ovar and
103 (vx2 := vx := argsi(1)) in splits then
104 v := split_from(vx);
105 vsplits := split_vars{v};
106 killed +:= vsplits;
107 fwdgen := fwdgen - vsplits + { vx2 };
108 if v notin inpvars then bakgen +:= vsplits; end;
109 end if;
110
111 fblkfwd :=
112 [ splits-killed+fwdgen, fwdgen ] .comp fblkfwd;
113
114 fblkbak :=
115 fblkbak .comp [ splits-killed+bakgen, bakgen ];
116
117 if opc in ops_goto then
118 if opc = q1_case then
119 sblks := { blockof(value(lb)) :
120 lb in range value(argsi(1)) };
121 else
122 sblks := { blockof(value(argsi(#argsi))) };
123 end if;
124 (forall b1 in sblks)
125 ffwd([b,b1]) := fblkfwd .meet ffwd([b,b1]);
126 ffwdj([b,b1]) := fblkfwd .join ffwd([b,b1]);
127 fbak([b,b1]) := fblkbak .join fbak([b,b1]);
128 end forall;
129 end if;
130 end; $ end for_inst
131 end; $ end for_block
132 end forall;
133
134 return [ ffwd, ffwdj, fbak, exposed ];
135
136 end procedure conv_blockmaps;
137
138
139
140
141 operator .meet(f, g);
142$
143$ this is a general routine, used here with the following data
144$ structures:
145$
146 repr
147 f, g: df_map;
148 end repr;
149
150 if g = om then
151 return f;
152 else
153 return [ f(1) * g(1), f(2) * g(2) ];
154 end if;
155
156 end operator .meet;
157
158
159 operator .join(f, g);
160$
161$ this is a general routine, used here with the following data
162$ structures:
163$
164 repr
165 f, g: df_map;
166 end repr;
167
168 if g = om then
169 return f;
170 else
171 return [ f(1) + g(1), f(2) + g(2) ];
172 end if;
173
174 end operator .join;
175
176
1 .=member inc15l
2
3
4 procedure insert_convs(p, avail, insert, mayreach, splits);
5$
6$ this procedure scans each basic block and determines whether conver-
7$ sions between split variables are required, based on the global avail
8$ information. it also inserts conversions into interval preheaders.
9$
10$ the logic of this routine is quite similar to the preceding
11$ conv_blockmaps routine, and more extensive comments can be found there
12$
13 repr
14 $ data structures for parameters
15 p: routine;
16 avail: remote smap(df_node) df_elmt;
17 insert: remote mmap{df_node} df_elmt;
18 mayreach: remote smap(df_node) df_elmt;
19 splits: df_elmt;
20
21 $ data structures for local variables
22 todo: sparse set(routine);
23 r: routine;
24 b: df_node;
25 i, iprev: elmt insts;
26 opc: elmt base_opcodes;
27 argsi: tuple(symbol);
28 v: splitvar;
29 vx: symbol;
30 vx1: splitvar;
31 vx2: elmt df_base;
32 iva1: integer;
33 k: integer;
34 availb, mayreachb: df_elmt;
35 insertb: df_elmt;
36 killed, gen: df_elmt;
37 vsplits, vreach: df_elmt;
38 end repr;
39
40
41 if p = om then todo := routs; else todo := { p }; end if;
42
43 (forall r in todo)
44 (for_block(b, r))
45 availb := avail(b);
46 if availb = om then continue; end if;
47 mayreachb := mayreach(b);
48 iprev := om;
49
50 (for_inst(i, b))
51 opc := opcode(i);
52 argsi := args(i);
53 iva1 := first_ivar(opc);
54
55 killed := gen := {}; $ only for forward propagation
56 (forall k in [ #argsi, #argsi-1..iva1 ] |
57 (vx2 := vx := argsi(k)) in splits)
58
59 if vx2 notin availb then
60 killed +:= split_vars{split_from(vx1 := vx)};
61 if opc /= q1_argout then
62 $ nb. conversions for formal paramters are
63 $ inserted in the called routine's exit
64 $ block (below), and consequently excluded
65 $ here.
66 add_conv(vx1, iprev, mayreachb);
67 end if;
68 gen with:= vx2;
69 end if;
70 end forall;
71
72 if opc in ops_ovar and
73 (vx2 := vx := argsi(1)) in splits then
74 v := split_from(vx);
75 vsplits := split_vars{v};
76 killed +:= vsplits;
77 gen := gen - vsplits +{vx2};
78 end if;
79
80 availb := availb - killed + gen;
81 mayreachb := mayreachb - killed + gen;
82
83 $ is this the last instruction in a preheader ?
84 if i = last_inst(b) and
85 (insertb := insert{b}) /= {} then
86
87 $ see comment above relating to formal parameters
88 $ assert opc /= q1_argout;
89 (forall vx in insertb)
90 add_conv(vx, iprev, mayreachb);
91 end forall;
92 end if;
93
94 if opc = q1_exit then
95 (forall vx in rparams(r) | (vx2 := vx) in splits
96 and is_write(vx) = 1)
97 if vx2 notin availb then
98 add_conv(vx, iprev, mayreachb);
99 end if;
100 end forall;
101 end if;
102
103 iprev := i;
104 end; $ end for_inst
105 end; $ end for_block
106 end forall;
107
108 end procedure insert_convs;
109
110
111
112
113 procedure add_conv(vx, rw iprev, mayreachb);
114
115 repr
116 vx: splitvar;
117 iprev: elmt insts;
118 mayreachb: df_elmt;
119 v, vy, vz: splitvar;
120 vsplits, vreach: set(splitvar);
121 str1, str2, str3: string;
122 end repr;
123
124 v := split_from(vx);
125 vsplits := split_vars{v};
126 vreach := { vy in vsplits | vy in mayreachb };
127
128 if #vreach = 1 then
129 vy := arb vreach;
130
131 elseif ft_type(form(v)) = f_gen then
132 vy := v;
133
134 elseif exists vy in vsplits | ft_type(form(vy)) = f_gen then
135 pass;
136
137 else
138 vy := add_split(v);
139 form(vy) := std_form(f_gen);
140 end if;
141
142 if vx = vy then return; end if;
143
144 if is_temp(vx) = 1 then
145 (forall vz in split_vars{v}) is_temp(vz) := om; end forall;
146 end if;
147
148 insert_ins(iprev, q1_asn, vx, vy);
149
150 str1 := 'convert "' + name(v) + '"';
151 str2 := ' from "' + format_form(form(vy)) + '"';
152 str3 := ' to "' + format_form(form(vx)) + '".';
153
154 if #str1 + #str2 + #str3 < 72 then
smfc 632 messages{stmtof(iprev)}{'s'} with:= [ str1 + str2 + str3 ];
156 elseif #str1 + # str2 < 72 then
smfc 633 messages{stmtof(iprev)}{'s'} with:= [ str1 + str2, str3 ];
159 else
smfc 634 messages{stmtof(iprev)}{'s'} with:= [ str1, str2, str3 ];
162 end if;
163
164
165 end procedure add_conv;
166
167
168
169
170 procedure add_split(v2);
171$
172$ this routine adds a new split variable vy to the scope of v.
173$ nb. form(vy) is undefined on exit of this routine.
174$
175 repr
176 v1, vy1: symbol;
177 v2, vy2: splitvar;
178 end repr;
179
180
181 vy1 := add_var(scope(v1 := v2));
182
183 name(vy1) := name(v1) + '.' + str # split_vars{v2};
184 value(vy1) := value(v1);
185
186 alias(vy1) := v1;
187 is_store(vy1) := om;
188
189 is_read(vy1) := is_read(v1);
190 is_write(vy1) := is_write(v1);
191 is_param(vy1) := is_param(v1);
192 is_stk(vy1) := is_stk(v1);
193 is_temp(vy1) := is_temp(v1);
194 is_internal(vy1) := is_internal(v1);
195 is_const(vy1) := is_const(v1);
196
197 split_vars{v2} with:= (vy2 := vy1);
198 split_from(vy2) := v2;
199
200 if v1 in variables then variables with:= vy1; end if;
201 if v1 in uservars then uservars with:= vy1; end if;
202
203 return vy2;
204
205
206 end procedure add_split;
207
208
209
210
211 procedure can_conv(fm1, fm2);
212$
213$ this routine computes a flag indicating whether a value with form fm1
214$ can be converted to the form fm2.
215$
216 repr
217 fm1, fm2: elmt forms;
218 tp1, tp2: elmt base_ft_types;
219 simtp1, simtp2: string;
220 comps1, comps2: tuple(elmt forms);
221 cfm1: elmt forms;
222 j: integer;
223 end repr;
224
225 tp1 := ft_type(fm1); $ get the basic types of the forms
226 tp2 := ft_type(fm2);
227
228 simtp1 := simple_type(tp1);
229 simtp2 := simple_type(tp2);
230
231 if simtp2 = 'gen' then $ fm2 is a type general
232 return true;
233
234 elseif simtp2 = 'elmt' then
235 return can_conv(fm1, ft_elmt(ft_base(fm2)));
236
237 elseif simtp1 = 'elmt' then
238 return can_conv(ft_elmt(ft_base(fm1)), fm2);
239
240 elseif simtp1 = 'gen' then
241 return false;
242
243$ at this point, both fm1 and fm2 should have the same basic type,
244$ if conversion is to succeed, except for the types 'map' and 'set'.
245 elseif simtp1 /= simtp2 then
246 if { simtp1, simtp2 } /= { 'map', 'set' } then
247 return false;
248 end if;
249 end if;
250
251 case simtp1 of
252
253 ('set', 'map'):
254 $ nb. a conversion from a multi-valued map to a single-valued
255 $ map is not save, and consequently we assume here that is is
256 $ not possible.
257 if ft_mapc(fm2) = ft_smap and ft_mapc(fm1) /= ft_smap then
258 return false;
259 end if;
260
261 $ note that the conversion from set to map is possible iff
262 $ the conversion between their elements is possible
263 return can_conv(ft_elmt(fm1), ft_elmt(fm2));
264
265 ('tuple'):
266 if tp1 = f_mtuple then
267 if tp2 = f_mtuple then
268 if #(comps1 := ft_elmt(fm1)) <=
269 #(comps2 := ft_elmt(fm2)) then
270$$$ ???? note that we assume that it is possible to convert e.g.
271$$$ ???? [ int ] to [ int, int ]
272 return (forall cfm1 = comps1(j) |
273 can_conv(cfm1, comps2(j)));
274 else
275 return false;
276 end if;
277 else
278 return (forall cfm1 in ft_elmt(fm1) |
279 can_conv(cfm1, ft_elmt(fm2)));
280 end if;
281
282 elseif tp2 = f_mtuple then
283 return false;
284 else
285 return can_conv(ft_elmt(fm1), ft_elmt(fm2));
286 end if;
287
288$$$ ???? for simplicity we assume below that any primitive type
289$$$ ???? can be converted to any other such type having the same
290$$$ ???? 'simple type'. this assumption is not true in general
291$$$ ???? and should be modified later.
292 else
293 return true;
294
295 end case;
296
297 end procedure can_conv;
298
299
1 .=member sfm15m
2
3
4 procedure sharp_form(fm, rpr, sc);
5$
6$ this recursive procedure gets as input a form fm, a computed repr rpr,
7$ and a scope sc. it computes a new form nfm such that:
8$
9$ 1. nfm is more specific than, or equivalent to fm
10$ 2. nfm is compatible with rpr, that is converting nfm into a repr (in
11$ the format used in our automatic data structure selection algo-
12$ rithm) would yield rpr.
13$ 3. nfm belongs to the form table of sc, or the form table of a contai-
14$ ning scope.
15$
16$ note that nfm may point to other (component) forms. if these forms do
17$ not already exist, they are also generated, and placed into the appro-
18$ priate form table in a place preceding that of nfm. (this is compa-
19$ tible with the original structure of the form tables.)
20$
21$ the code below is rather complex. moreover, it may not be completely
22$ accurate due to the following reasons:
23$
24$ --- some important design decisions have so far been left out. these
25$ decisions concern the way in which we want to incorporate user-
26$ supplied information, and whether such information has always
27$ higher precedence over the reprs computed by the optimiser. a few
28$ issues of this sort are mentioned below, but the choices made
29$ below are rather arbitrary, and should be carefully reviewed.
30$
31$ since user-supplied information is already incorporated in our type
32$ analysis phase, where it serves as an upper bound on computed types,
33$ we can assume here that rpr is always more specific than, or
34$ equivalent to fm, but only in the attributes considered in our
35$ data-type and structure computations. other attributes, currently
36$ ignored in those analyses, such as range of integers, short vs. long
37$ primitive types, etc. which are currently missing in rpr have to be
38$ taken from fm.
39$
40 repr
41 fm: elmt forms;
42 rpr: elmt types;
43 sc: elmt base_scopes;
44
45 tp: elmt base_ft_types;
46 simtp: string;
47 grs: gross_type;
48 lcsp: elmt base_based_modes;
49 mptp: elmt base_ft_mapcs;
50 g: basic_type;
51 fmt: elmt forms;
52 ftp: elmt base_ft_types;
53 fm1, fm2, fm3: elmt forms;
54 comps: tuple(elmt types);
55 crpr: elmt types;
56 j: integer;
57 fmx: elmt forms;
58 b: tent_base;
59 bx: symbol;
60 bfm, dfm, ifm: elmt forms;
61 rstp, rtp: elmt types;
62 nfm_maps, nfmx_maps: tuple(general)(12);
63 nfm, nfmx: elmt forms;
64 end repr;
65
66
67
68 tp := ft_type(fm);
69 simtp := simple_type(tp);
70 grs := grosstyp(rpr);
71 lcsp := set_type(rpr);
72 mptp := map_type(rpr);
73$ if gross type is ambiguous, or is null (designating 'om'), return
74$ the original form.
75 if #grs /= 1 then return fm; end if;
76
77 g := arb grs; $ otherwise get the gross type
78
79$ first, if fm is a general form, we create 'nfm' only from 'rpr'
80 if simtp = 'gen' then
81
82 case g of
83
84 (t_int): return std_form(f_int);
85
86 (t_real): return std_form(f_real);
87
88 (t_string): return std_form(f_string);
89
90 (t_atom): return std_form(f_atom);
91
92 (t_set):
93$ first get the component form. then create a tuple 'nfm_maps'
94$ consisting of all relevant form attributes of nfm (see the macro
95$ 'form_maps' above). this tuple will then be used to construct
96$ nfm and insert it into the properform table.
97 fm1 := sharp_form(fm, comptyp(rpr), sc);
98 nfm_maps := [];
99 ftp := f_uset;
100 if lcsp /= om and ft_type(fm1) = f_elmt and
101 (bfm := ft_base(fm1)) /= om then
102 if lcsp = locl then
103 ftp := localtp(ftp);
104 ft_pos_ := (ft_num(bfm)(ftp) +:= 1);
105 ft_base_ := bfm;
106 elseif lcsp = remt then
107 ftp := remotetp(ftp);
108 ft_base_ := bfm;
109 end if;
110 end if;
111 ft_type_ := ftp;
112 ft_elmt_ := fm1;
113
114 (t_map):
115
116 fm1 := sharp_form(fm, domtyp(rpr), sc);
117
118 if mptp = ft_smap then
119 fm2 := sharp_form(fm, rangetyp(rpr), sc);
120 fm3 := sharp_form(fm, comptyp(rpr), sc);
121
122 elseif mptp = ft_mmap then
123 rstp := rangetyp(rpr); $ the range set type
124 if grosstyp(rstp) = grselt then
125 $ nb. the range set type of an mmap can not
126 $ have the form 'elmt b': transform it here
127 $ if it has.
128 rstp := elmt_mode(rstp(2));
129 end if;
130 $ nb. the range set type rstp is a set type, and conse-
131 $ quently could be an mmap-type; in this case, the
132 $ element type of rstp is not necessarily the component
133 $ type of rstp.
134 rtp := elmt_type(rstp);
135 fm2 := sharp_form(fm, rstp, sc);
136 fm3 := sharp_form(
137 fm,
138 [ grstup,
139 [ domtyp(rpr), rtp ],
140 true ],
141 sc );
142
143 else $ map_type(rpr) = ft_map: convert to ft_mmap
144 fm2 := sharp_form(
145 fm,
146 [ grsset,
147 rangetyp(rpr),
148 om,
149 om,
150 sprse ],
151 sc );
152 fm3 := sharp_form(fm, comptyp(rpr), sc);
153 mptp := ft_mmap;
154 end if;
155
156 if lcsp = remt and ft_type(fm1) = f_elmt and
157 (bfm := ft_base(fm1)) /= om then
158$ first generate the embedded tuple form
159 nfm_maps := [];
160 ft_type_ := f_tuple;
161 ft_elmt_ := fm2;
162 fmt := newform(nfm_maps, sc);
163 end if;
164 nfm_maps := [];
165 ftp := f_umap;
166 if lcsp /= om and ft_type(fm1) = f_elmt and
167 (bfm := ft_base(fm1)) /= om then
168 if lcsp = locl then
169 ftp := localtp(ftp);
170 ft_pos_ := (ft_num(bfm)(ftp) +:= 1);
171 ft_base_ := bfm;
172 elseif lcsp = remt then
173 ftp := remotetp(ftp);
174 ft_base_ := bfm;
175 ft_tup_ := fmt;
176 end if;
177 end if;
178 ft_type_ := ftp;
179 ft_mapc_ := mptp;
180 ft_elmt_ := fm3;
181 ft_dom_ := fm1;
182 ft_im_ := fm2;
183
184 (t_tuple):
185 if is_knt(rpr) then
186 comps := comptyp(rpr);
187 nfm_maps := [];
188 ft_type_ := f_mtuple;
smfh 33 ft_elmt_ := [ sharp_form(fm, crpr, sc): crpr in comps ];
190 ft_lim_ := #comps;
194
195 else
197 nfm_maps := [];
198 ft_type_ := f_tuple;
smfh 34 ft_elmt_ := sharp_form(fm, comptyp(rpr), sc);
200 ft_lim_ := 0;
201 end if;
202
203 $ the nelt field of tuples is maintained:
204 ft_neltok_ := 1;
205
206 (t_elmt):
207 if base_of(rpr) = om then insert_base(rpr(2), sc); end if;
208 nfm_maps := [];
209 ft_type_ := f_elmt;
210 ft_base_ := form(base_of(rpr));
211
212 (t_om): return std_form(f_gen);
213
214 end case;
215
216 elseif simtp = 'elmt' and g /= t_elmt then
217 return sharp_form(ft_elmt(ft_base(fm)), rpr, sc);
218
219 else
220$ here fm is a non-general type. we begin by copying into 'nfm_maps'
221$ all attributes of fm. these will then be modified depending on the
222$ information available in 'rpr'.
223 nfm_maps := form_maps(fm);
224
225 case g of
226
227 (t_int, t_real, t_string, t_atom):
228 return fm;
229$$$ ???? what if fm is 'elmt b'? are we to override this user-supplied
230$$$ ???? repr and replace it by the primitive type itself?
231
232 (t_elmt):
233 if base_of(rpr) = om then insert_base(rpr(2), sc); end if;
234 if simtp = 'elmt' then
235 if ft_base_ = form(base_of(rpr)) then
236 return fm;
237 else
238 print('** form and repr have different bases',
239 fm, rpr);
240 end if;
241 else
242 nfm_maps := [];
243 ft_type_ := f_elmt;
244 ft_base_ := form(base_of(rpr));
245 end if;
246
247 (t_set):
248 if simtp = 'map' then
249 $ since we assume rpr to be more specific than fm,
250 $ this case cannot occur.
251 print('form is a map but repr is a set', fm, rpr);
252 else
253 fm1 := sharp_form(ft_elmt_, comptyp(rpr), sc);
254 ftp := f_uset;
255 if ftp = ft_type_ and lcsp /= om and
256 ft_type(fm1) = f_elmt and
257 (bfm := ft_base(fm1)) /= om then
258 if lcsp = locl then
259 ftp := localtp(ftp);
260 ft_pos_ := (ft_num(bfm)(ftp) +:= 1);
261 ft_base_ := bfm;
262 elseif lcsp = remt then
263 ftp := remotetp(ftp);
264 ft_base_ := bfm;
265 end if;
266 end if;
267 ft_type_ := ftp;
268 ft_elmt_ := fm1;
269 end if;
270
271 (t_map):
272
273 if simtp = 'map' then
274 ft_dom_ := sharp_form(ft_dom_, domtyp(rpr), sc);
275 if ft_mapc_ = ft_smap then
276 if mptp = ft_mmap then
277 rstp := rangetyp(rpr); $ the range set type
278 if grosstyp(rstp) = grselt then
279 $ nb. the range set type of an mmap can not
280 $ have the form 'elmt b': transform it here
281 $ if it has.
282 rstp := elmt_mode(rstp(2));
283 end if;
284 $ nb. the range set type rstp is a set type, and
285 $ consequently could be an mmap-type; in this
286 $ case, the element type of rstp is not neces-
287 $ sarily the component type of rstp.
288 rtp := elmt_type(rstp);
289 else
290 rtp := rangetyp(rpr);
291 end if;
292 ft_im_ := sharp_form(ft_im_, rtp, sc);
293 ft_elmt_ := sharp_form(
294 ft_elmt_,
295 [ grstup,
296 [ domtyp(rpr), rtp ],
297 true ],
298 sc );
299 mptp := ft_smap;
300
301 elseif mptp = ft_mmap then
302 assert ft_mapc_ = ft_mmap;
303 rstp := rangetyp(rpr); $ the range set type
304 if grosstyp(rstp) = grselt then
305 $ nb. the range set type of an mmap can not
306 $ have the form 'elmt b': transform it here
307 $ if it has.
308 rstp := elmt_mode(rstp(2));
309 end if;
310 $ nb. the range set type rstp is a set type, and
311 $ consequently could be an mmap-type; in this
312 $ case, the element type of rstp is not neces-
313 $ sarily the component type of rstp.
314 rtp := elmt_type(rstp);
315 ft_im_ := sharp_form(ft_im_, rstp, sc);
316 ft_elmt_ := sharp_form(
317 ft_elmt_,
318 [ grstup,
319 [ domtyp(rpr), rtp ],
320 true ],
321 sc );
322
323 else $ map_type(rpr) = ft_smap or ft_map,
324 assert ft_mapc_ = ft_mmap;
325 $ so convert the map to an mmap.
326 ft_im_ := sharp_form(
327 ft_im_,
328 [ grsset,
329 rangetyp(rpr),
330 om,
331 om,
332 sprse ],
333 sc );
334 ft_elmt_ := sharp_form(ft_elmt_, comptyp(rpr), sc);
335 mptp := ft_mmap;
336 end if;
337
338 else $ simtp = 'set'
339 fm1 := ft_elmt_;
340$ check whether the element form of fm is definitely a pair. if so
341$ we may improve the resulting domain and image forms of the new
342$ map, by taking the component forms of this pair into account.
343 if ft_type(fm1) = f_mtuple and ft_lim(fm1) = 2 then
344 dfm := ft_elmt(fm1)(1);
345 ifm := ft_elmt(fm1)(2);
346 else
347 dfm := ifm := std_form(f_gen);
348 end if;
349
350 ft_dom_ := sharp_form(dfm, domtyp(rpr), sc);
351
352 if mptp = ft_mmap then
353 rstp := rangetyp(rpr); $ the range set type
354 if grosstyp(rstp) = grselt then
355 $ nb. the range set type of an mmap can not
356 $ have the form 'elmt b': transform it here
357 $ if it has.
358 rstp := elmt_mode(rstp(2));
359 end if;
360 $ nb. the range set type rstp is a set type, and
361 $ consequently could be an mmap-type; in this
362 $ case, the element type of rstp is not neces-
363 $ sarily the component type of rstp.
364 rtp := elmt_type(rstp);
365 else
366 rtp := rangetyp(rpr);
367 end if;
368
369 fmx := sharp_form(ifm, rtp, sc); $ range element form
370
371 nfmx_maps := [];
372 nfmx_maps(1) := f_uset; $ ft_type
373 nfmx_maps(3) := fmx; $ ft_elmt
374
375 ft_im_ := newform(nfmx_maps, sc); $ range set form
376 ft_elmt_ := sharp_form(
377 ft_elmt_,
378 [ grstup,
379 [ domtyp(rpr), rtp ],
380 true ],
381 sc );
382 ft_type_ := f_umap;
383 ft_mapc_ := ft_mmap;
384 mptp := ft_mmap;
385 end if;
386 ftp := f_umap;
387 if ftp = ft_type_ then
388 if lcsp = remt and ft_type(ft_dom_) = f_elmt and
389 (bfm := ft_base(ft_dom_)) /= om then
390 $ first generate the embedded tuple form
391 nfmx_maps := [];
392 nfmx_maps(1) := f_tuple;
393 nfmx_maps(3) := ft_im_;
394 fmt := newform(nfmx_maps, sc);
395 end if;
396
397 if lcsp /= om and ft_type(ft_dom_) = f_elmt and
398 (bfm := ft_base(ft_dom_)) /= om then
399 if lcsp = locl then
400 ftp := localtp(ftp);
401 ft_pos_ := (ft_num(bfm)(ftp) +:= 1);
402 ft_base_ := bfm;
403 elseif lcsp = remt then
404 ftp := remotetp(ftp);
405 ft_base_ := bfm;
406 ft_tup_ := fmt;
407 end if;
408 end if;
409 ft_type_ := ftp;
410 ft_mapc_ := if ft_mapc_ = ft_smap then
411 ft_smap
412 elseif mptp = ft_smap then
413 ft_smap
414 else
415 ft_mmap
416 end;
417 end if;
418
419 (t_tuple):
420 if is_knt(rpr) then
421 comps := comptyp(rpr);
422 if tp = f_mtuple then
423 if # ft_elmt_ /= # comps then
424 print('fm and rpr are diff. length mtuples',
425 fm, rpr);
426 else
427 (forall j in [ 1..#ft_elmt_ ])
428 fm1 := ft_elmt_(j);
429 fm2 := sharp_form(fm1, comps(j), sc);
430 ft_elmt_(j) := fm2;
431 end forall;
432 end if;
433 else
434 ft_type_ := f_mtuple;
435 ft_lim_ := # comps;
436 fm1 := ft_elmt_;
437 ft_elmt_ := [];
438 (forall crpr = comps(j))
439 fm2 := sharp_form(fm1, crpr, sc);
440 ft_elmt_ with:= fm2;
441 end forall;
442 end if;
443 elseif tp = f_mtuple then
444 print('fm is a mtuple, rpr is a tuple', fm, rpr);
445 else
446 ft_elmt_ := sharp_form(ft_elmt_, comptyp(rpr), sc);
447 end if;
448
449 $ the nelt field of tuples is maintained:
450 ft_neltok_ := 1;
451
452 (t_om): return fm;
453
454 end case;
455 end if;
456
457$ at this point, the tuple 'nfm_maps' contains the attributes of the
458$ new form. using the map 'forminv', which maps each such tuple and
459$ a scope to a form in this scope having these attributes (if such
460$ a form exists there), we try to locate 'nfm' in 'sc' or in a
461$ containing scope. if unable to find it, we insert nfm into the
462$ form table of sc.
463
smfh 35 return newform(nfm_maps, sc);
467
468 end procedure sharp_form;
469
470
471
472
473 procedure newform(nfm_maps, sc);
474$
475$ this routine checks, given the new form maps, whether such a form
476$ exists already in the scope sc. if it finds such a form, it returns
477$ it; otherwise it returns a new form.
478$
479 repr
480 nfm_maps: tuple(general)(12);
481 sc, scx: elmt base_scopes;
482 nfm, f1: elmt forms;
483 end repr;
484
485
486 if exists scx in cont_scopes(sc) |
487 forminv{scx}(nfm_maps) /= om then
488 return forminv{scx}(nfm_maps);
489 end if;
490
491$ no form has been found
492
493 nfm := add_form(sc);
494 form_maps(nfm) := nfm_maps;
495 forminv{sc}(nfm_maps) := nfm;
496
497 (init f1 := nfm; while ft_type(f1) = f_elmt)
498 if ft_type(ft_base(f1)) = f_pbase then quit; end if;
499 f1 := ft_elmt(ft_base(f1));
500 end init;
501 ft_deref(nfm) := f1;
502
503 return nfm;
504
505
506 end procedure newform;
507
508
509
510
511 procedure elmt_type(rpr);
512$
513$ this procedure recursively builds the element form for a map repr.
514$
515 repr
516 rpr: elmt types;
517 rstp: elmt types;
518 end repr;
519
520
521 if grosstyp(rpr) = grsmap and map_type(rpr) = ft_mmap then
522
523 rstp := rangetyp(rpr); $ the range set type
524
525 if grosstyp(rstp) = grselt then
526 $ nb. the range set type of an mmap can not have the
527 $ form 'elmt b': transform it here if it has.
528 rstp := elmt_mode(rstp(2));
529 end if;
530
531 return [ grstup, [ domtyp(rpr), elmt_type(rstp) ], true ];
532
533 else
534 return comptyp(rpr);
535 end if;
536
537
538 end procedure elmt_type;
539
540
541 procedure insert_base(b, sc);
542$
543 repr
544 b: tent_base;
545 sc: elmt base_scopes;
546 fm, xfm: elmt forms;
547 v: symbol;
548 end repr;
549
550
551 sc := sym_sys;
552$$-- we really ought to use the maxscope of sc and bscope(b) here -
553$$-- at the moment, thoght, this is a little pointless, since we
554$$-- allocate all forms in the system scope
555$$-- should be make this change, recall that maxscope is local to
556$$-- auto_dstruct, hence needs to be exported/imported to get here.
557$$-- sc := maxscope([ sc, bscope(b) ]);
558 xfm := sharp_form(std_form(f_gen), elmt_mode(b), sc);
559
560 fm := add_form(sc);
561 ft_type(fm) := f_base;
562 ft_elmt(fm) := xfm;
563 ft_num(fm) := null_ft_num;
564
565 (while ft_type(xfm) = f_elmt)
566 if ft_type(ft_base(xfm)) = f_pbase then quit; end if;
567 xfm := ft_elmt(ft_base(xfm));
568 end while;
569 ft_deref(fm) := xfm;
570
571 v := add_sym(sc);
smfk 165 name(v) := 'opt#' + str(#basesymb + 1); is_internal(v) := om;
573 form(v) := fm;
574 is_read(v) := 1; is_write(v) := 1;
575 is_repr(v) := 1; is_store(v) := 1;
576 userbase(b) := v; basesymb(fm) := v;
577
578
579 end procedure insert_base;
580
581
582 drop
583 .comp,
584 interproc_fwd_analysis,
585 intraproc_fwd_analysis,
586 interproc_back_analysis,
587 intraproc_back_analysis,
588 fom,
589 xom;
590
591
592 end module setl_optimizer - conversion_analysis;
593
594
1 .=member copy18
2
3
4 module setl_optimizer - copy_optimization;
5$
6$ this module performs copy optimization using an algorithm which
7$ approximates the more complicated value-flow analysis technique
8$ suggested by j. schwartz. it results in a simplified approach
9$ which is likely to be much more efficient than the value-flow
10$ approach, but which is still based on essentially the same value
11$ relationships computed by value-flow. having calculated these
12$ relationships, our algorithm can then determine which potentially
13$ destructive operations can be performed without having to copy by
14$ using live-dead information about the program variable occurrences.
15$
16$ let us first describe briefly our modified approach to value-flow
17$ analysis. the purpose of that analysis is to determine, for each
18$ potentially destructive use vo, the set of all variable occurrences
19$ vo' whose value can contain the value of vo as a member (or be equal
20$ to this value). this set is significant in that the values of
21$ occurrences in it are the only values that can possibly contain
22$ pointers to the value that we wish to destroy at vo. using standard
23$ arguments taken from value-flow analysis as originally described,
24$ we can show that vo' and vo must be related in the following way:
25$ there exists an occurrence vo'' which precedes both vo and vo'
26$ in execution flow, and contains vo as a member. (vo'' may be vo or
27$ vo'). moreover, this membership relationship is realized by a series
28$ of operations which retrieve vo from vo'', and by another series of
29$ operations which, through retrievals, imbeddings and assignments,
30$ create vo' from vo''. in addition, the relationships between vo' and
31$ vo'' and between vo'' and vo' must be such that their composition
32$ still makes vo a member of vo' (or equal to it).
33$
34$ using these facts, we carry out our analysis as follows: start at
35$ each destructive use vo; perform an upward propagation, tracking
36$ membership relationships from vo to other preceding occurrences,
37$ thereby finding all occurrences vo'' mentioned before. then by a
38$ downward propagation step find all occurrences vo' mentioned above by
39$ propagating membership relationships from the vo''s detected earlier,
40$ and ensuring that vo' can still contain vo.
41
42$ the following macros are used to check the memo functions, and invoke
43$ the routine if the function has not yet been evaluated
44
45 macro must_copy(r, fm);
46 (must_copy_memo(r, fm) ? must_copy_rout(r, fm))
47 endm;
48
49 macro rel_comp(r, rx);
50 (rel_comp_memo(r, rx) ? rel_comp_rout(r, rx))
51 endm;
52
53 macro inv(r);
54 (inv_memo(r) ? inv_rout(r))
55 endm;
56
57 macro rel_inst(vo);
58 (rel_inst_memo(vo) ? rel_inst_rout(vo))
59 endm;
60
61$ the following global variables are used in this module:
62
63 var
64 contain, $ maps each pot. destructive use to
65 $ set of containing occurrences
66 all_reldefs, $ definitions that can contain destructively
67 $ used values as their parts
68 globreldefs, $ the subset of all_reldefs which must be
69 $ analysed inter-procedurally
70 psoccsof, $ maps each destructive use to preceding
71 $ occurrences of the same variable,
72 $ which can set the share bit.
73 puoccsof, $ maps each destructive use to preceding
74 $ occurrences of the same variable that
75 $ definitely yields an unshared value for it.
76 destconsts, $ set of constant occurrences appearing in
77 $ value-flow.
78
79 must_copy_memo, $ memo map for must_copy predicate
80 rel_comp_memo, $ memo map for relationship composition
81 inv_memo, $ memo map for relationship inversion
82 rel_inst_memo, $ memo map for output-input relationship
83 $ in an instruction
84
85 livethru, $ maps each potentially destructive use n to the
86 $ set of all definitions which are live at n
87 destuses, $ destructive uses at which copy may be
88 $ required
89 potdestuses, $ set of all potentially destructive uses
90 dstuseini; $ maps each instruction i of potdestuses to a
91 $ potentially destructive use in i.
92
93$ the following constants are used in this module:
94
95$ the first group contains various strings which denote elementary
96$ membership relationships between setl objects (see procedure
97$ value_flow for more details).
98
99 const
100 elt = 'elmt', eltinv = 'elmt-1',
101 cmp = 'comp', cmpinv = 'comp-1',
102 ncmp1 = 'comp1', ncmp1inv = 'comp1-1',
103 ncmp2 = 'comp2', ncmp2inv = 'comp2-1',
104 ncmp3 = 'comp3', ncmp3inv = 'comp3-1',
105 ncmp4 = 'comp4', ncmp4inv = 'comp4-1',
106 ncmp5 = 'comp5', ncmp5inv = 'comp5-1',
107 ncmp6 = 'comp6', ncmp6inv = 'comp6-1',
108 ncmp7 = 'comp7', ncmp7inv = 'comp7-1',
109 ncmp8 = 'comp8', ncmp8inv = 'comp8-1',
110 ncmp9 = 'comp9', ncmp9inv = 'comp9-1',
111 rngmmap = 'mmap_range', rngmmapinv = 'mmap_range-1',
112 anymb = 'anymemb',
113 illeg = 'illegal';
114
115 const
116 elem_memb_rel =
117 { elt, eltinv, cmp, cmpinv,
118 ncmp1, ncmp1inv, ncmp2, ncmp2inv, ncmp3, ncmp3inv,
119 ncmp4, ncmp4inv, ncmp5, ncmp5inv, ncmp6, ncmp6inv,
120 ncmp7, ncmp7inv, ncmp8, ncmp8inv, ncmp9, ncmp9inv,
121 rngmmap, rngmmapinv,
122 anymb, illeg },
123
124 inverses =
125 { eltinv, cmpinv,
126 ncmp1inv, ncmp2inv, ncmp3inv,
127 ncmp4inv, ncmp5inv, ncmp6inv,
128 ncmp7inv, ncmp8inv, ncmp9inv,
129 rngmmapinv },
130
131 ncmpis =
132 { ncmp1, ncmp2, ncmp3,
133 ncmp4, ncmp5, ncmp6,
134 ncmp7, ncmp8, ncmp9 },
135
136 ncmpi_invs =
137 { ncmp1inv, ncmp2inv, ncmp3inv,
138 ncmp4inv, ncmp5inv, ncmp6inv,
139 ncmp7inv, ncmp8inv, ncmp9inv },
140
141 ncmpofi =
142 [ ncmp1, ncmp2, ncmp3,
143 ncmp4, ncmp5, ncmp6,
144 ncmp7, ncmp8, ncmp9 ];
145
146
147 const
148 rid = [], $ encodes the identity relationship
149 anymemb = [ anymb ], $ encodes anymember relationship
150 illegal = [ illeg ], $ encodes illegal relationship
151 nestlim = 10; $ maximal allowed nesting of
152 $ elementary relatonships
153
154 const
155 inverse =
156 { [ elt, eltinv ], [ eltinv, elt ],
157 [ cmp, cmpinv ], [ cmpinv, cmp ],
158 [ ncmp1, ncmp1inv ], [ ncmp1inv, ncmp1 ],
159 [ ncmp2, ncmp2inv ], [ ncmp2inv, ncmp2 ],
160 [ ncmp3, ncmp3inv ], [ ncmp3inv, ncmp3 ],
161 [ ncmp4, ncmp4inv ], [ ncmp4inv, ncmp4 ],
162 [ ncmp5, ncmp5inv ], [ ncmp5inv, ncmp5 ],
163 [ ncmp6, ncmp6inv ], [ ncmp6inv, ncmp6 ],
164 [ ncmp7, ncmp7inv ], [ ncmp7inv, ncmp7 ],
165 [ ncmp8, ncmp8inv ], [ ncmp8inv, ncmp8 ],
166 [ ncmp9, ncmp9inv ], [ ncmp9inv, ncmp9 ],
167 [ rngmmap, rngmmapinv ], [ rngmmapinv, rngmmap ],
168 [ anymb, anymb ], [ illeg, illeg ] };
169
170 const
171 iofncmp =
172 { [ ncmp1, 1 ], [ ncmp2, 2 ], [ ncmp3, 3 ],
173 [ ncmp4, 4 ], [ ncmp5, 5 ], [ ncmp6, 6 ],
174 [ ncmp7, 7 ], [ ncmp8, 8 ], [ ncmp9, 9 ] };
175
176
177 repr
178 base elem_memb_rel: string;
179 mode vf_elem_rel: elmt elem_memb_rel;
180$
181$ for storage savings we keep all value flow relations in a base.
182$
183 base vf_relations: tuple(vf_elem_rel);
184 mode vf_relation: elmt vf_relations;
185
186 elt, eltinv, cmp, cmpinv,
187 ncmp1, ncmp1inv, ncmp2, ncmp2inv, ncmp3, ncmp3inv,
188 ncmp4, ncmp4inv, ncmp5, ncmp5inv, ncmp6, ncmp6inv,
189 ncmp7, ncmp7inv, ncmp8, ncmp8inv, ncmp9, ncmp9inv,
190 rngmmap, rngmmapinv, anymb, illeg:
191 vf_elem_rel;
192
193 nestlim: integer;
194 inverses: local set(vf_elem_rel);
195 ncmpis: local set(vf_elem_rel);
196 ncmpi_invs: local set(vf_elem_rel);
197 ncmpofi: tuple(vf_elem_rel);
198 inverse: local smap(vf_elem_rel) vf_elem_rel;
199 iofncmp: local smap(vf_elem_rel) integer;
200
201 rid, anymemb: vf_relation;
202 illegal: vf_relation;
203
204 mode destuse: occurrence;
205 mode reldef: occurrence;
206 mode relocc: occurrence;
207
208 potdestuses: set(destuse);
209$$-- potdestuses: remote set(destuse);
210 dstuseini: sparse smap(elmt insts) destuse;
211 all_reldefs: set(reldef);
212$$-- all_reldefs: remote set(reldef);
213 globreldefs: sparse set(reldef);
214 puoccsof, psoccsof: mmap{destuse} set(relocc);
215$$-- puoccsof, psoccsof: remote mmap{destuse} set(relocc);
216 destconsts: sparse set(relocc);
217
218 must_copy_memo: smap(vf_relation, elmt forms) boolean;
219 inv_memo: smap(vf_relation)
220 vf_relation;
221 rel_comp_memo: smap(vf_relation, vf_relation)
222 vf_relation;
223 rel_inst_memo: smap(occurrence)
224 mmap{occurrence}
225 set(vf_relation);
226
227 contain: mmap{destuse} sparse set(relocc);
228 livethru: mmap{destuse} sparse set(reldef);
229$$-- contain: remote mmap{destuse}
230$$-- sparse set(relocc);
231$$-- livethru: remote mmap{destuse}
232$$-- sparse set(reldef);
233 destuses: set(destuse);
234$$-- destuses: remote set(destuse);
235
236 value_flow: procedure;
237 rel_comp_rout: procedure(vf_relation, vf_relation)
238 vf_relation;
239 inv_rout: procedure(vf_relation) vf_relation;
240 rel_inst_rout: procedure(relocc)
241 sparse mmap{relocc}
242 set(vf_relation);
243 must_copy_rout: procedure(vf_relation, elmt forms)
244 boolean;
245
246 live_dead_analysis: procedure;
247 .ofx_s: operator(df_map_syms, df_elmt_syms)
248 df_elmt_syms;
249 .ofx_o: operator(df_map_ocrs, df_elmt_ocrs)
250 df_elmt_ocrs;
251 block_flowmaps: procedure(routine, df_elmt_ocrs)
252 tuple(
253 remote smap(df_edge) df_map_ocrs,
254 remote smap(df_edge) df_map_syms,
255 smap(destuse) df_map_ocrs,
256 smap(
257 tuple(destuse, df_node) )
258 df_map_syms
259 );
260 .join_s: operator(df_map_syms, df_map_syms)
261 df_map_syms;
262 .join_o: operator(df_map_ocrs, df_map_ocrs)
263 df_map_ocrs;
264 copy_eliminate: procedure;
265 copy_share_improve: procedure;
266 end repr;
267
268 procedure copy_optimize;
269$
270$ this is the master procedure for copy optimization. it consists of the
271$ following phases:
272$
273$ 1. value relationship computation: for each potentially destructive
274$ use we compute the set of all variable occurrences which may
275$ contain the value being used at this point as a part.
276$
277$ 2. live-dead analysis: we perform live-dead analysis using our
278$ bit-vectoring data flow analysis package. for efficiency, we carry
279$ out this analysis only for occurrences participating in the
280$ relationships built in phase 1 (in typical programs there should be
281$ relatively few such occurrences).
282$
283$ 3. copy elimination: using the results of phases 1 and 2, we determine
284$ which potentially destructive uses definitely do not require
285$ copying. appropriate copy flags are set accordingly.
286$
287$ 4. additional (relatively minor) optimizations can then be carried out
288$ using the bitvectoring approach outlined in cims rep #17. these
289$ include: suppression of share-bit setting, changing conditional
290$ copies to unconditional copies, and motion of copies out of loops.
291$
292$$$ ???? the set potdestuses of potentially destructive uses is computed
293$$$ ???? here, but in practice this should probably be moved to an
294$$$ ???? earlier phase.
295$
smfi 282 init
smfi 283 du_count := 0; $ counts the destructive uses.
296 repr
297 r: routine;
298 b: elmt blocks;
299 i: elmt insts;
300 opc: elmt base_opcodes;
301 dvo: occurrence;
smfi 284 du_count: integer 0..65536;
302 entry_time: integer;
303 end repr;
304
305 title('cims.setl.' + prog_level + ' - copy optimization');
306 printa(term_file, ' - copy optimisation');
307
308 entry_time := time;
309$
310$ compute the set potdestuses of all potentially destructive uses
311$
312 potdestuses := {};
313 dstuseini := {};
314 (forall r in routs)
315 (for_block(b, r))
316 (for_inst(i, b))
317 opc := opcode(i);
318$ determine the argument potentially subject to destructive use
319$ ops_destuse1 (defined in the directory) contains opcodes potentially
320$ destroying their first ivariable (i.e. their second argument);
321$ ops_destuse3 and ops_destuse4 have similar meanings.
322 if opc in ops_destuse1 then
323 dvo := get_oi(i, 2);
324 elseif opc in ops_destuse3 then
325 if opc = q1_next
326 $ only the iteration value of a map is used
327 $ destructively: don't analyse remaining cases
328 and not is_fmap(ft_deref(form(args(i)(3))))
329 and not ft_type(ft_deref(form(args(i)(3)))) = f_gen
330 then
331 continue;
332 end if;
333 dvo := get_oi(i, 4);
334 elseif opc in ops_destuse4 then
335 dvo := get_oi(i, 5);
336 else
337 continue;
338 end if;
339
340$ check the form of dvo to determine whether this is really a
341$ potentially destructive use (addition of integers is certainly not a
342$ destructive use, but addition of sets is).
343$
344$ the test that we use is somewhat coarse, but should serve as a good
345$ approximation to find potentially destructive uses: simply test
346$ whether the form of the variable of dvo is a 'long' object, i.e. is a
347$ set, map or tuple (type general is also considered to be long).
348
smff 149 if not is_fprim(ft_deref(oi_form(dvo))) or
smff 150 ft_type(ft_deref(oi_form(dvo))) = f_string then
smff 151 if ft_type(oi_form(dvo)) = f_elmt or
smff 152 ft_type(oi_form(dvo)) = f_string then
351 copy_flag(i) := copy_yes;
smfi 285 du_count +:= 1;
smff 153 messages{stmtof(i)}{'s'} with:=
353 [ 'an unconditional copy is required for '
354 '"' + oi_name(dvo) + '".' ];
355 else
356 potdestuses with:= dvo; $ use is potentially dest.
357 dstuseini(i) := dvo;
smfi 286 du_count +:= 1;
358 if oi_sym(dvo) in uservars and
359 oi_sym(dvo) in globalvars then
360 globals_du{r} with:= dvo;
361 end if;
362 end if;
363 end if;
364 end; $ end for_inst;
365 end; $ end for_block;
366 end forall;
smfi 287
smfi 288 if 'e' in dump_string then
smfi 289 print('#all_oi =', #all_oi,
smfi 290 ' #all_o =', #all_o,
smfi 291 ' #all_i =', #all_i,
smfi 292 ' #destructive uses =', du_count);
smfi 293 print;
smfi 294 end if;
367
368 value_flow; $ value relationship computation
369 live_dead_analysis; $ live-dead analysis
370 copy_eliminate; $ copy elimination phase
371 copy_share_improve; $ 'bookkeeping' optimisations
372
373 $ delete the static variables global to the module
374 contain := om; all_reldefs := om; psoccsof := om;
375 puoccsof := om; destconsts := om; rel_comp_memo := om;
376 inv_memo := om; rel_inst_memo := om;
377 livethru := om; destuses := om; potdestuses := om;
378 dstuseini := om; globreldefs := om; must_copy_memo := om;
379
380 statistics with:= time; $ save time for final statistics
381
382 if 'e' in dump_string then
383 print(time - entry_time, 'msecs spent in copy optimization');
384 end if;
385
386
387 end procedure copy_optimize;
388
389
1 .=member vfl18a
2
3
4 procedure value_flow;
5$
6$ this routine accomplishes phase 1 of our copy optimization. here, for
7$ each potentially destructive use vo, we compute the set of all
8$ variable occurrences vo' whose value can contain the value of vo as a
9$ part at the point of use. to this end we build up a collection of
10$ nodes having the form [vo1, r1], where vo1 is a variable occurrence
11$ and r is a value-relationship indicating how vo1 is related to some
12$ other value which is a part of vo1.
13$
14$ r is represented as a tuple of elementary relationships, and stands
15$ for their composition. these elementary relationships are:
16$
17$ elt - element of a set
18$
19$ cmp - component of a tuple
20$
21$ ncmpi - the i-th component of a known length tuple
22$ note that only the first 9 components of such a tuple
23$ are handled explicitly; the rest are treated as 'cmp'
24$
25$ we begin our analysis with nodes [vo, []], where vo can be any
26$ potentially destructive use (i.e. belongs to potdestuses). then,
27$ tracing bfrom links and ouput-input links within instructions, we
28$ collect all other nodes which can be linked to such a vo by a series
29$ of forward links. then a forward propagation from these new nodes
30$ will yield all other nodes that can be linked to a potentially
31$ destructive use by a valid membership relationship. (see an
32$ accompanying report for explanation and justification of the facts
33$ used here).
34$
35$ the algorithm is organized so that it does this tracing separately for
36$ each potentially destructive use. this simplifies the algorithm, at
37$ the slight expense of duplicating some value-flow propagations in case
38$ several potentially destructive uses are linked to the same preceding
39$ occurrences.
40$
41$ this routine computes the gobal object contain, which maps each
42$ potentially destructive use to the set of all occurrences which
43$ may contain it as a member (or be equal to it).
44$
smfh 36 init
smfi 295 sr1 := 0.0, $ summation of relationship lengths.
smfi 296 sr2 := 0.0, $ summation of squares of relationship lengths.
smfi 297 sr3 := 0.0; $ number of relationships.
45 repr
46 voxoccs: sparse set(relocc);
47 precsoccs, precuoccs: set(relocc);
48 allpoccs: mmap{destuse} set(relocc);
49$$-- allpoccs: remote mmap{destuse} set(relocc);
50 seenoccs: set(relocc);
51$$-- seenoccs: remote set(relocc);
52 workoccs: sparse set(relocc);
53 all_reloccs: set(relocc);
54$$-- all_reloccs: remote set(relocc);
55 globreloccs: sparse set(relocc);
56
57 relnodes: set( tuple(relocc, vf_relation) );
58 uppile, downpile: set( tuple(relocc, vf_relation) );
59 inst_props: set( tuple(relocc, vf_relation) );
60 node, node1: tuple(relocc, vf_relation);
61
62 opc: elmt base_opcodes;
63 r, r1, rx, rx_inv: vf_relation;
64 v, vv: symbol;
65 vo, vo1: occurrence;
66 vox: destuse;
67 voy, voz: relocc;
68 rin: sparse mmap{relocc} set(vf_relation);
69 x: destuse;
70 y: sparse set(relocc);
smfc 635 z: relocc;
smfi 298 sr1, sr2, sr3: real;
smfi 299 tr1, tr2, tr3: real;
smfi 300 mu, sigma: real;
smfi 301 m1, s1: integer;
71 entry_time: integer;
72 end repr;
73
74 entry_time := time;
75
76$ begin by initializing the various memo maps and propagation related
77$ objects.
78
79
80$ the four following maps are used to store the results computed by
81$ the routines must_copy, rel_comp, rel_inst and inv, respectively,
82$ in order to avoid recomputation.
83$
84$ must_copy examines a form under a value relationship to determine
85$ whether a value under this relationship is an element of a base.
86$ in such a case we must copy unconditionally the value before using
87$ it destructively, as bases are considered live throughout a program.
88$
89$ rel_comp computes the composition of two membership relationships
90$ (in practice, the second one will always be a relationship between
91$ output and input arguments of an instruction);
92
93$ rel_inst computes the membership/containment relationships between
94$ the arguments of a given instruction;
95
96$ inv computes the inverse of a relationship computed by rel_inst.
97
98 must_copy_memo := {};
99 rel_comp_memo := {};
100 rel_inst_memo := {};
101 inv_memo := {};
102
103$ in order to track all occurrences and membership relationships that a
104$ potentially destructive use can be linked to, we can think of the
105$ algorithm as implicitly constructing two (virtual) graphs upgraph and
106$ downgraph, whose nodes are pairs of the form
107$ [ occurrence, relationship ],
108$ and whose edges constitute direct links between these pairs. a direct
109$ link between the pairs [ vo1, r1 ] and [ vo2, r2 ] exists either when
110$ vo1 and vo2 are linked by bfrom (and r1 = r2), or when vo1 and vo2
111$ are an input and an output occurrences within the same instruction.
112$ upgraph would consist of all such links collected during the first
113$ (upward) propagation phase of the algorithm, while downgraph would
114$ consist of links collected during the second, downward propagation
115$ phase.
116
117$ initialize the output map of this analysis, as defined above.
118 contain := {};
119
120 all_reloccs := {}; $ relevant occurrences collected by value flow
121 globreloccs := {}; $ subset of all_reloccs to be analysed globally
122
123 psoccsof := {}; $ maps each destructive use to preceding
124 $ occurrences of the same variable
125 puoccsof := {};
126 allpoccs := {}; $ set of all occurrences preceding some
127 $ destructive use
128$ process each potentially destructive use
129 (forall vox in potdestuses)
130 precsoccs := {}; $ preceding occurrences which can set
131 $ the share bit
132 precuoccs := {}; $ preceding occurrences yielding
133 $ unshared values.
134 workoccs := {vox}; $ workpile of preceding occurrences
135 seenoccs := {}; $ occurrences allready seen
136 (while workoccs /= {})
137 voy from workoccs;
138 seenoccs with:= voy;
139 (forall voz in bfrom{voy} | voz notin seenoccs)
smfd 842 opc := oi_op(voz);
141 if (case argno(voz) of
142 (1): opc in ops_share1,
143 (2): opc in ops_share2,
144 (3): opc in ops_share3,
145 (4): opc in ops_share4
146 else false
147 end)
148 then
149 if opc = q1_asn and
150 argno(voz) = 1 and
151 is_const(vv := arg2(instno(voz))) = 1 and
152 (value(vv) = {} or value(vv) = []) then
153 precuoccs with:= voz;
154 else
155 precsoccs with:= voz;
156 end if;
157
158 elseif is_ovar(voz) and opc notin ops_nonewval then
159 precuoccs with:= voz;
160
161 else
162 workoccs with:= voz;
163 end if;
164 end forall;
165 end while;
166 psoccsof{vox} := precsoccs;
167 puoccsof{vox} := precuoccs;
168 allpoccs{vox} := precsoccs + precuoccs;
169 end forall;
170
171
172 (forall [ voy, vox ] in allpoccs)
smfc 636 if 'p' in dump_string and 'z' in dump_string then
smfc 637 print('start new batch at ', time);
smfc 638 print(' destructive use:', oi_str(voy), '=', oi_name(voy));
smfc 639 print(' prec occurrence:', oi_str(vox), '=', oi_name(vox));
smfc 640 end if;
173
174 $ start the propagation at potentially destructive use vox
175 node := [ vox, rid ];
176 $ initialize relnodes, uppile and downpile.
177 $ relnodes is the set of all nodes encountered so far
178 relnodes := { node };
179$ the elements of uppile are pairs of the form
180$ [ occ, rel ]
181$ indicating a desired propagation from occ and rel to
182$ preceding occurrences. if occ is an ovariable, then rel should
183$ be propagated to ivariables of the instruction containing occ;
184$ if occ is an ivariable then rel should be propagated to previous
185$ occurrences of the same variable linked to occ by bfrom.
186
187 uppile := { node };
188
189$ downpile is a similar workpile for downward propagation; it consists
190$ of pairs like those appearing in uppile. each such pair
191$ [ occ, rel ] indicates a desired propagation from occ in the
192$ direction of execution flow. such a propagation would be
193$ to other occurrences of the same varible linked to occ by ffrom,
194$ and, if occ is an ivariable, also to the ovariable of its
195$ instruction.
196$
197$ in order to avoid that extra propagation in cases where the
198$ reverse propagation (from ovariable to ivariable) has already
199$ taken place during the upward propagation phase, we maintain an
200$ additional set inst_props of all such pairs [ occ, rel ] where
201$ occ is an ivariable and rel is relationship that has been propagated
202$ to occ from its ovariable. see below for the use of that set.
203
204 inst_props := {};
205
206 downpile := { node };
207$
208$ carry out upward propagation
209$
210 (while uppile /= {})
211
smfc 641 node from uppile;
smfc 642 [ vo, r ] := node;
smfc 643
smfc 644 if 'p' in dump_string and 'z' in dump_string then
smfc 645 print(' uppile:', oi_str(vox), r, oi_str(vo), '=',
smfc 646 oi_name(vo));
smfc 647 end if;
213
214 if is_ivar(vo) then
215
216 (forall vo1 in bfrom{vo} | vo1 /= vo)
217 if (node := [ vo1, r ]) notin relnodes then
smfc 648 $ new node for propagation
219 relnodes with:= node;
220
221 uppile with:= node;
222 downpile with:= node;
223 end if;
224 end forall;
smfc 649
225 elseif is_ovar(vo) then
226
smfc 650 $ call a memo routine to obtain the output-input value
smfc 651 $ relationships for the instruction of vo.
229 rin := rel_inst(vo);
230
231 (forall [ vo1, rx ] in rin) $ vo1 is ivar of this inst
smfc 652 $ call another memo routine to compose r with rx.
233 r1 := rel_comp(r, rx);
234
235 if r1 /= illegal then
smfc 653 $ composition yields a valid membership
smfc 654 $ relationship r1.
237 node := [ vo1, r1 ];
smfc 655
smfc 656 $ check if node has not been traced yet.
239 if node notin relnodes then $ new node for pro
240 relnodes with:= node;
241
242$ put node in inst_props to record the fact that propagation from vo
243$ and r to vo1 and r1 has already taken place. note that we assume
244$ here that this propagation is one-to-one, so that in particular it
245$ is fully determined by . this is generally the case, except
246$ for cases involving ambiguous memb relationships (see comments in
247$ rel_comp), or cases where the maximal nesting level has been exceeded.
248$ in this cases backward propagation from vo1 and r1 to vo might result
249$ in a relationship r' which is always an overestimation of r. thus
250$ the use of inst_props can help us in avoiding that overestimation.
251
252 inst_props with:= node;
253
254 uppile with:= node;
255 downpile with:= node;
256 end if;
257
258 end if;
259 end forall;
260
261 end if;
262 end while;
263$
264$ now perform downward propagation
265$
266$ the logic of the downward propagation step is quite similar to that
267$ of the upward propagation step; see that step for more comments.
269$
270 (while downpile /= {})
271 node from downpile;
272 [ vo, r ] := node;
smfc 657
smfc 658 if 'p' in dump_string and 'z' in dump_string then
smfc 659 print(' downpile:', oi_str(vox), r, oi_str(vo), '=',
smfc 660 oi_name(vo));
smfc 661 end if;
273 if is_ivar(vo) and node notin inst_props then
274 opc := oi_op(vo); $ get the opcode
275 if opc in ops_ovar then
276$ vo's instruction has an ovariable. propagate relationship to it
277 vo1 := get_ovar(vo); $ get the o-variable
278 inst_props with:= node;
279 rin := rel_inst(vo1);
280 (forall rx in rin{vo})
281$ compose r with the inverse of rx to get the relation at vo1
282 rx_inv := inv(rx);
283 r1 := rel_comp(r, rx_inv);
284 if r1 /= illegal then
285 node1 := [ vo1, r1 ];
286 if node1 notin relnodes then
287 relnodes with:= node1;
288 downpile with:= node1;
289 end if;
290 end if;
291 end forall;
292 end if;
293 end if;
294
295 $ in any case, propagate forward via ffrom
296 (forall vo1 in ffrom{vo})
297 if (node := [ vo1, r ]) notin relnodes then
298 relnodes with:= node;
299 downpile with:= node;
300 end if;
301 end forall;
302 end while;
303
smfi 302 if 'e' in dump_string then
smfi 303 tr1 := tr2 := tr3 := 0.0;
smfi 304 (forall [ vo, r ] in relnodes)
smfi 305 sr1 +:= float(#r); sr2 +:= float(#r) ** 2; sr3 +:= 1.0;
smfi 306 tr1 +:= float(#r); tr2 +:= float(#r) ** 2; tr3 +:= 1.0;
smfi 307 end forall;
smfi 308 mu := tr1 / tr3;
smfi 309 sigma := sqrt( (tr2 - tr1**2/tr3) / tr3 );
smfi 310 m1 := fix(mu * 1000.0); s1 := fix(sigma * 1000.0);
smfi 311 print('#rels =', fix tr3, '=', #relnodes,
smfi 312 ' min =', min/[ #r : [ -, r ] in relnodes ],
smfi 313 ' max =', max/[ #r : [ -, r ] in relnodes ],
smfi 314 ' mean =', str(m1 div 1000)+'.'+str(m1 mod 1000),
smfi 315 ' sdev =', str(s1 div 1000)+'.'+str(s1 mod 1000),
smfi 316 ' cv =', if mu /= 0.0 then 100.0*sigma/mu else 0 end, '%'
smfi 317 );
smfi 318 end if;
304
smfh 40 if exists [ vo, r ] in relnodes |
smfh 41 must_copy(r, oi_form(vo)) then
306 copy_flag(instno(voy)) := copy_yes;
smfc 662 messages{stmtof(instno(voy))}{'s'} with:=
308 [ 'an unconditional copy is required for '
309 '"' + oi_name(voy) + '".' ];
310 potdestuses less:= voy;
311 dstuseini(instno(voy)) := om;
312 else
313 voxoccs := domain relnodes;
314 contain{vox} := voxoccs;
315 all_reloccs +:= voxoccs;
316 globreloccs +:= { vo in voxoccs |
317 (v := oi_sym(vo)) in globalvars
318 or is_param(v)=1
319 or scope(v) /= scope(oi_sym(vox)) };
320 end if;
321 end forall;
322
323 if 'p' in dump_string then
smfc 663 prints('contain =',
smfc 664 [ [ oi_str(x), { oi_str(z) : z in y } ] : y = contain{x} ]
smfc 665 );
325 end if;
326
327 $ reldefs is the set of relevant definitions collected by this phase
328 all_reldefs := { vo in all_reloccs | is_ovar(vo) };
329
330 $ globreldefs is the subset of reldefs to be analysed globally
331 globreldefs := { vo in all_reldefs | vo in globreloccs };
332
333 $ destconsts is the set of constants involved in the analysis
334 destconsts := { vo in all_reloccs |
335 is_const(v := oi_sym(vo))=1 and
336 value(v) /= {} and value(v) /= [] };
337
338 $ free some space to be garbage collected
339 rel_comp_memo := om;
340 inv_memo := om;
341 rel_inst_memo := om;
342 must_copy_memo := om;
343
344 if 'e' in dump_string then
smfi 319 if sr3 > 0.0 then
smfi 320 print;
smfi 321 mu := sr1 / sr3;
smfi 322 sigma := sqrt( (sr2 - sr1**2/sr3) / sr3 );
smfi 323 m1 := fix(mu * 1000.0); s1 := fix(sigma * 1000.0);
smfi 324 print('#rels =', fix sr3,
smfi 325 ' mean =', str(m1 div 1000)+'.'+str(m1 mod 1000),
smfi 326 ' sdev =', str(s1 div 1000)+'.'+str(s1 mod 1000),
smfi 327 ' cv =', if mu /= 0.0 then 100.0*sigma/mu else 0 end, '%'
smfi 328 );
smfi 329 end if;
smfh 46 print;
345 print(time - entry_time, 'msecs for value flow');
346 end if;
347
348 end procedure value_flow;
349
350
351
352
353 procedure rel_comp_rout(r, rx);
354$
355$ this routine computes the composition of the membership relationship
356$ r, given as a tuple of elementary membership relationships (such as
357$ elt, cmp, ncmpi etc.) with the relationship rx, which designates a
358$ value relationship between output and input arguments of an instruc-
359$ tion. rx is also given as a tuple, but each component of rx can
360$ designate either a membership relationship or its inverse (i.e. a
361$ containment relationship such as eltinv, cmpinv, ncmpiinv, etc.).
363$
364$ to ensure convergence of our algorithm we impose a nesting level
365$ limit nestlim on membership relatioships. any relation r containing
366$ more than nestlim elementary components is crudely represented as the
367$ symbol anymemb, indicating at least nestlim levels of elementary
368$ memberships. anymemb relationships do not change by composition with
369$ any other relationship. this is an overestimation which is safe in
370$ the sense that it cannot cause a possible membership relationship to
371$ disappear (although it can add spurious membership relationships).
373$
374$ in some cases of ambiguous types (e.g. 'a set or a tuple'), rx may
375$ contain ambiguous membership relationships, (e.g. 'an element of a
376$ set or a component of a tuple'). in these cases we keep the set of
377$ all valid membership relationships in a given relationship rx. for
378$ example, in 'y := f(x)' where f can be either a map or a tuple, y can
379$ be either a cmp of f or a ncmp2 of an elt of f. in such cases we
380$ represent the relationship as n consecutive memb's, where n is the
381$ maximal possible number of nested elementary relationships that can
383$ constitute that relationship (2 in the above example).
384$
385$ a problem can arise in the above treatment of ambiguous level of
386$ membership. consider for example a relationship r having the form
387$ elt.cmp; suppose that we compose r with a relationship
388$ rx = memb.memb which indicates either one or two possible levels of
389$ membership. this will produce the relationship elt.cmp.memb.memb;
390$ now suppose that we want to compose it first with the inverse of rx
391$ (a relationship representing either one or two levels of containment)
392$ and then with the inverse of r. to play safe, we must represent the
394$ inverse of rx as memb-1 (using the minimal possible level of
395$ containment, for otherwise we run into the risk of removing too many
396$ levels of membership, which may make us treat certain valid membership
397$ relationships as invalid), so that the first composition, if treated
398$ casually, will yield elt.cmp.memb, and then the second composition of
399$ this relationship with cmp-1.elt-1 will be found to be illegal, due
400$ to a failure to match direct relationships correctly.
402$
403$ the solution that we will use is as follows: whenever a relationship
404$ is composed with memb or memb-1, we first convert it by replacing each
405$ component by memb, and then performing the composition using standard
406$ rules. thus, in the above example the composition of r with rx will
407$ yield memb.memb.memb.memb and the next two compositions can then be
408$ carried out safely resulting in the relationship memb.
410$
411$ to make this routine more efficient, we maintain a 'memo' map which
412$ records all previously computed compositions.
413$
414 repr
415 r, r1, rx: vf_relation;
416 rxi, last: vf_elem_rel;
417 i, ir1: integer;
418 end repr;
419
420 r1 := r;
421 (forall rxi = rx(i))
422 if rxi notin inverses then
423 if # r1 = nestlim then $ convert to anymemb repr
424 r1 := anymemb;
425 elseif r1 = anymemb then
426$ r already has the anymemb representation; leave it unchanged
427 quit forall;
428 else $ normal case
429 r1 with:= rxi; $ append new membership to r1
430 end if;
431 else $ a containment relationship
432 if r1 = [] then
433 r1 := illegal;
434 quit forall;
435 else $ normal case
436$ remove the last elementary subrelationship from r1 and check that it
437$ matches the current subrelationship of rx. (we allow matching of
438$ memb with any relationship, and also matching of cmp with any ncmpi.)
439
440 last frome r1;
441 if inverse(last) /= rxi and
442 (last /= cmp or rxi notin ncmpi_invs) and
443 (rxi /= cmpinv or last notin ncmpis) then
444 r1 := illegal;
445 quit forall;
446 end if;
447 end if;
448 end if;
449 end forall;
450
451 return rel_comp_memo(r, rx) := r1;
452
453 end procedure rel_comp_rout;
454
455
456
457
458 procedure inv_rout(rx);
459$
460$ compute the inverse of rx. this simply reverses the components of rx
461$ and the flag bits which these components may contain.
463$
464 repr
465 rx, ry: vf_relation;
466 i: integer;
467 end repr;
468
469
470 ry := [ inverse(rx(i)) : i in [ #rx, #rx-1..1 ] ];
471
472 return inv_memo(rx) := ry;
473
474 end procedure inv_rout;
475
476
1 .=member rln18b
2
3
4 procedure rel_inst_rout(vo);
5$
6$ this routine computes the output-input relationships for an
7$ instruction whose output occurrence is vo. it returns a map rin
8$ which maps each input occurrence iv in that instruction to the
9$ relationship of the value of vo to the value of iv, given in the form
10$ described in the comments associated with the routine rel_comp.
12$
13$ for efficiency, this routine uses a memo map to record the
14$ relationships computed for previously processed instructions.
15$
16$ the following macros are used in this procedure:
17$
22 macro maybe_tup(fm); (is_ftup(fm) or ft_type(fm) = f_gen) endm;
23 macro maybe_set(fm); (is_fset(fm) or ft_type(fm) = f_gen) endm;
24 macro maybe_map(fm); (is_fmap(fm) or ft_type(fm) = f_gen) endm;
25
26 repr
27 vo, voj: occurrence;
28 rin: mmap{occurrence}
29 set(vf_relation);
30 inst: elmt insts;
31 opc: elmt base_opcodes;
32 argsi: tuple(symbol);
33 ivs: tuple(occurrence);
34 iv1, iv2, iv3, iv4: occurrence;
35 a1, a2, a3, a4: symbol;
36 fm: elmt forms;
37 ncmpi, ncmpj: vf_elem_rel;
38 j: integer;
39 end repr;
40
41
42 rin := {};
43 inst := instno(vo);
44 opc := opcode(inst);
45 argsi := args(inst);
46 [ a1, a2, a3, a4 ] := argsi;
47
48 $ nb. none of the operators of interest in this routine are in
49 $ ops_ivar (ie. operators whose first argument is an i-variable):
50 $ hence the following loop has a lower bound of two.
51 ivs := [ get_oi(inst, j) : j in [ 2..#argsi ] ];
52 [ iv1, iv2, iv3, iv4 ] := ivs;
53
54 case opc of
55
56 (q1_asn, q1_argin): $ vo = iv1
57 rin{iv1} with:= rid;
58
59 (q1_argout): $ vo = iv3
60 rin{iv3} with:= rid;
61
62 (q1_arb, q1_rand):
63 $ vo elt iv1 if iv1 is a set or map;
64 $ vo cmp iv1 if a tuple
65 fm := ft_deref(form(a2));
66 if maybe_set(fm) then
67 rin{iv1} with:= [ elt ];
68 end if;
69
70 if maybe_tup(fm) then
71 rin{iv1} with:= [ cmp ];
72 end if;
73
74 (q1_with):
75 $ vo elt-1.elt iv1 if vo is a set or a map; i.e. vo contain
76 $ elements that are also elements of iv1. also vo elt-1 iv2.
77 $ similar relationships apply for tuples and ambiguous types.
78 fm := ft_deref(form(a1));
79 if maybe_set(fm) then
80 rin{iv1} with:= [ eltinv, elt ];
81 rin{iv2} with:= [ eltinv ];
82 end if;
83
84 if maybe_tup(fm) then
85 rin{iv1} with:= [ cmpinv, cmp ];
86 rin{iv2} with:= [ cmpinv ];
87 end if;
88
89 (q1_of):
90 $ vo cmp iv1, if iv1 is a tuple;
91 $ vo ncmpi iv1, if in addition the value of iv2 = i is known
92 $ and less than 9
93 $ vo ncmp2.elt iv1, if iv1 is a map;
94 fm := ft_deref(form(a2));
95 if maybe_tup(fm) then
96 if ft_type(fm) = f_mtuple and
97 is_const(oi_sym(iv2)) = 1 and
98 ft_type(oi_form(iv2)) = f_sint and
99 (ncmpi := ncmpofi(oi_val(iv2))) /= om then
100 rin{iv1} with:= [ ncmpi ];
101 else
102 rin{iv1} with:= [ cmp ];
103 end if;
104 end if;
105
106 if maybe_set(fm) then
107 rin{iv1} with:= [ ncmp2, elt ];
108 end if;
109
110 (q1_sof):
111 $ vo cmp-1 (or ncmpi-1) iv2, and
112 $ vo cmp-1.cmp iv3, if vo is a tuple;
113 $ vo elt-1.ncmp1-1 iv1,
114 $ vo elt-1.ncmp2-1 iv2, and
115 $ vo elt-1.elt iv3, if vo is a map;
116 fm := ft_deref(form(a1));
117 if maybe_tup(fm) then
118 if ft_type(fm) = f_mtuple and
119 is_const(oi_sym(iv1)) = 1 and
120 ft_type(oi_form(iv1)) = f_sint and
121 (ncmpi := ncmpofi(oi_val(iv1))) /= om then
122 rin{iv2} with:= [ inverse(ncmpi) ];
123 else
124 rin{iv2} with:= [ cmpinv ];
125 end if;
126 rin{iv3} with:= [ cmpinv, cmp ];
127 end if;
128
129 if maybe_set(fm) then
130 rin{iv1} with:= [ eltinv, ncmp1inv ];
131 rin{iv2} with:= [ eltinv, ncmp2inv ];
132 rin{iv3} with:= [ eltinv, elt ];
133 end if;
134
135 (q1_ofa):
136 $ vo elt-1.ncmp2.elt iv1, if iv1 is a map
137 fm := ft_deref(form(a2));
138 if maybe_set(fm) then
139 rin{iv1} := { [ eltinv, ncmp2, elt ], [ rngmmap ] };
140 end if;
141
142 (q1_sofa):
143 $ vo elt-1.ncmp2-1.elt iv2,
144 $ vo elt-1.ncmp1-1 iv1, and
145 $ vo elt-1.elt iv3, if vo is a map;
146 fm := ft_deref(form(a1));
147 if maybe_set(fm) then
148 rin{iv1} with:= [ eltinv, ncmp1inv ];
149 rin{iv2} := { [ eltinv, ncmp2inv, elt ], [ rngmmapinv ] };
150 rin{iv3} with:= [ eltinv, elt ];
151 end if;
152
153 (q1_add):
154 $ vo elt-1.elt iv1 and iv2, if they are sets or maps;
155 $ vo cmp-1.cmp iv1 and iv2, if tuples.
156 fm := ft_deref(form(a1));
157 if maybe_set(fm) then
158 rin{iv1} with:= [ eltinv, elt ];
159 rin{iv2} with:= [ eltinv, elt ];
160 end if;
161
162 if maybe_tup(fm) then
163 rin{iv1} with:= [ cmpinv, cmp ];
164 rin{iv2} with:= [ cmpinv, cmp ];
165 end if;
166
167 (q1_sub):
168 $ same as q1_add for sets and maps
169 fm := ft_deref(form(a1));
170 if maybe_set(fm) then
171 rin{iv1} with:= [ eltinv, elt ];
172 end if;
173
174 (q1_mult):
175 $ vo elt-1.elt iv1 and iv2, if they are sets or maps
176 $ for vo a tuple, interpret as tuple repitition. the
177 $ vo cmp-1.cmp iv can hold for any ivariable iv which can be
178 $ a tuple.
179 fm := ft_deref(form(a1));
180 if maybe_set(fm) then
181 rin{iv1} with:= [ eltinv, elt ];
182 rin{iv2} with:= [ eltinv, elt ];
183 end if;
184
185 if maybe_tup(fm) then
186 if maybe_tup(ft_deref(form(a2))) then
187 rin{iv1} with:= [ cmpinv, cmp ];
188 end if;
189 if maybe_tup(ft_deref(form(a3))) then
190 rin{iv2} with:= [ cmpinv, cmp ];
191 end if;
192 end if;
193
194 (q1_less):
195 $ same as q1_with, but only for iv1 and only for sets/maps.
196 fm := ft_deref(form(a1));
197 if maybe_set(fm) then
198 rin{iv1} with:= [ eltinv, elt ];
199 end if;
200
201 (q1_lesse, q1_lessb):
202 $ same as q1_with, but only for iv1 and only for tuples.
203 rin{iv1} with:= [ cmpinv, cmp ];
204
205 (q1_lessf):
206 $ same as q1_with, but only for iv1 and only for maps.
207 fm := ft_deref(form(a1));
208 if maybe_set(fm) then
209 rin{iv1} with:= [ eltinv, elt ];
210 end if;
211
212 (q1_pow):
213 $ vo elt-1.elt-1.elt iv1
214 rin{iv1} with:= [ eltinv, eltinv, elt ];
215
216 (q1_npow):
217 $ vo elt-1.elt-1.elt iv2
218 rin{iv2} with:= [ eltinv, eltinv, elt ];
219
220 (q1_dom):
221 $ vo elt-1.ncmp1.elt iv1
222 rin{iv1} with:= [ eltinv, ncmp1, elt ];
223
224 (q1_range):
225 $ vo elt-1.ncmp2.elt iv1
226 rin{iv1} with:= [ eltinv, ncmp2, elt ];
227
228 (q1_end, q1_subst):
229 $ vo cmp-1.cmp iv1, if they are tuples.
230 fm := ft_deref(form(a1));
231 if maybe_tup(fm) then
232 rin{iv1} with:= [ cmpinv, cmp ];
233 end if;
234
235 (q1_send):
236 $ vo cmp-1.cmp iv2 and iv3, if tuples
237 fm := ft_deref(form(a1));
238 if maybe_tup(fm) then
239 rin{iv2} with:= [ cmpinv, cmp ];
240 rin{iv3} with:= [ cmpinv, cmp ];
241 end if;
242
243 (q1_ssubst):
244 $ same as in q1_send, for iv3 and iv4
245 fm := ft_deref(form(a1));
246 if maybe_tup(fm) then
247 rin{iv3} with:= [ cmpinv, cmp ];
248 rin{iv4} with:= [ cmpinv, cmp ];
249 end if;
250
251 (q1_set):
252 $ vo elt-1 ivj, for j = 2,...
253 (forall j in [ 2..#argsi ])
254 voj := get_oi(inst, j);
255 rin{voj} with:= [ eltinv ];
256 end forall;
257
258 (q1_tup):
259 $ vo ncmpj-1 (or cmp-1) ivj, for j = 2,...
260 (forall j in [ 2..#argsi ])
261 voj := get_oi(inst, j);
262 if (ncmpj := ncmpofi(j-1)) /= om then
263 rin{voj} with:= [ inverse(ncmpj) ];
264 else
265 rin{voj} with:= [ cmpinv ];
266 end if;
267 end forall;
268
269 (q1_set1):
270 $ vo elt-1 iv1
271 rin{iv1} with:= [ eltinv ];
272
273 (q1_tup1):
274 $ vo cmp-1 iv1
275 rin{iv1} with:= [ cmpinv ];
276
277 (q1_inext, q1_next):
278 $ vo.ncmpj-1.ncmpj.elt.iv2, j = 1,2, if iv2 is a map
279 $ vo.rid.iv3, if iv2 is a map and opc = q1_next (see below)
280 $ vo.elt.iv2, if iv2 is a set
281 $ vo.cmp.iv2, if iv2 is a tuple
282 $ in the current implementation, q1_inext creates a new pair
283 $ for the map elements, and q1_next uses this pair destruc-
284 $ tively in order to create the next map element. iv3 is an
285 $ additional argument introduced by the optimiser, and desi-
286 $ gnates the destructive use of the output variable.
287 fm := ft_deref(form(a3));
288 if maybe_map(fm) then
289 rin{iv2} := { [ ncmp1inv, ncmp1, elt ],
290 [ ncmp2inv, ncmp2, elt ] };
291 if opc = q1_next then
292 rin{iv3} with:= rid;
293 end if;
294 end if;
295
296 if maybe_set(fm) and not is_fmap(fm) then
297 rin{iv2} with:= [ elt ];
298 end if;
299
300 if maybe_tup(fm) then
301 rin{iv2} with:= [ cmp ];
302 end if;
303
304 (q1_inextd, q1_nextd):
305 $ vo ncmp1.elt iv2, if iv2 is a map
306 fm := ft_deref(form(a3));
307 if maybe_set(fm) then
308 rin{iv2} with:= [ ncmp1, elt ];
309 end if;
310
311 (q1_arbb, q1_arbe):
312 $ vo cmp iv1, if iv1 is a tuple
313 rin{iv1} with:= [ cmp ];
314
315 end case;
316
317 return rel_inst_memo(vo) := rin;
318
319
320 end procedure rel_inst_rout;
321
322
323
324
325 procedure must_copy_rout(r, fm);
326$
327$ this procedure examines the form fm under the value relationship r.
328$ an unconditional copy is required if the containment expressed in r
329$ involves a base element. this is a slight overestimate, since bases
330$ are asumed to be always live. it simplifies, however, our algoritm
331$ considerably.
332$
333 repr
334 r: vf_relation;
335 fm: elmt forms;
336
337 r1: vf_relation;
338 xfm: elmt forms;
339 rx: vf_elem_rel;
340 end repr;
341
342
343 if ft_type(fm)= f_elmt and is_fprim(ft_deref(fm)) then
344 return must_copy_memo(r, fm) := false;
345
346 elseif ft_type(fm) = f_elmt then
347 return must_copy_memo(r, fm) := true;
348
349 elseif ft_type(fm) = f_gen then
350 return must_copy_memo(r, fm) := false;
351
352 elseif r = rid then
353 return must_copy_memo(r, fm) := false;
354
355 else
356 r1 := r; rx frome r1;
357
358 return
359 must_copy_memo(r, fm) := case rx of
360
361 (elt): if is_fset(fm) then
362 must_copy(r1, ft_elmt(fm))
363 else
364 false
365 end,
366
367 (cmp): if ft_type(fm) = f_mtuple then
368 if exists xfm in ft_elmt(fm) |
369 must_copy(r1, xfm) then
370 true
371 else
372 false
373 end
374 elseif is_ftup(fm) then
375 must_copy(r1, ft_elmt(fm))
376 else
377 false
378 end,
379
380 (arb ncmpis):
381 if ft_type(fm) = f_mtuple then
382 must_copy(r1, ft_elmt(fm)(iofncmp(rx)))
383 elseif is_ftup(fm) then
384 must_copy(r1, ft_elmt(fm))
385 else
386 false
387 end,
388
389 (rngmmap): if is_fmap(fm) and ft_mapc(fm) = ft_mmap then
390 must_copy(r1, ft_im(fm))
391 else
392 false
393 end,
394
395 (anymb): if ft_type(fm) = f_mtuple then
396 if exists xfm in ft_elmt(fm) |
397 must_copy(r, xfm) then
398 true
399 else
400 false
401 end
402 elseif is_ftup(fm) or is_fset(fm) then
403 must_copy(r, ft_elmt(fm))
404 else
405 false
406 end
407
408 else
409 expr
410 print;
411 print('error in must_copy: r =', r, 'form =', fm);
412 stop;
413 yield false;
414 end
415 end;
416 end if;
417
418 end procedure must_copy_rout;
419
420
1 .=member lva18c
2
3
4 procedure live_dead_analysis;
5$
6$ this routine performs live-dead analysis for all variable occurrences
7$ in reloccs. an occurrence vo of a variable v is said to be live at a
8$ given point n if there exists a path from vo to a use of v which
9$ passes through n and which is free of any modifications of v.
10$
11$ for simplicity we break the analysis into two subphases: first, for
12$ each point n within a potentially destructive use, we compute the set
13$ of all occurrences in reloccs which can reach n (this is done in a way
14$ resembling our method of bfrom computation. for efficiency we
15$ restrict this analysis only to variable definitions belonging to
16$ reloccs. note that it is sufficient to consider only definitions
17$ rather than both definitions and uses in reloccs for the simple reason
18$ that if a use in reloccs can reach a given program point n, then there
19$ must exist a definition of the same variable preceding the use which
20$ also belongs to reloccs and can reach n (assuming no uninitialized
21$ variables)).
22$
23$ then we compute the set of all variables v which have occurrences in
24$ reloccs and which are live at n (in the usual sense of liveness at a
25$ point). combination of the results of these two analyses gives us the
26$ information we need. we caution that a slight overestimation may
27$ occur in the interprocedural case (in the analysis of global
28$ variables), since the existence of two interprocedurally valid
29$ subpaths (from an occurrence vo of a global variable v to a
30$ potentially destructive operation n and then from n to a use of v)
31$ does not necessarily imply that their concatenation is also
32$ interproceduraly valid.
33$
34$ liveness information is returned in a map livethru which maps each
35$ potentially destructive use n to the set of all definitions in reloccs
36$ which are live at n.
37$
38$ it should be noted that our copy optimization algorithm avoids an
39$ important issue that would have arisen if we were to use a simpler
40$ approach based on bitvectoring data-flow analysis, such as in setl
41$ nl. 195. this is the issue of 'globalization' of share-bit setting.
42$ suppose that a variable v which will later be used destructively is
43$ passed as a parameter to some procedure p. this valuetransfer already
44$ causes v to be shared with the corresponding formal parameter, and v
45$ may also be shared with other local variables of p. however, unless
46$ the value of v became part of a global object (or a write parameter)
47$ during the execution of p, the call to p should not be viewed as
48$ sharing the value of v after the call has been completed. this fact,
49$ which is very difficult to pick up by using a bitvectoring scheme, is
50$ handled implicitly by the live analysis used by our algorithm. this
51$ comment has been included here as a reminder and warning if an attempt
52$ is made to replace the value-flow based algorithm by a simpler
53$ bitvectoring scheme. this issue also needs to be considered carefully
54$ in the bitvectoring 'bookkeeping optimization' phase (see procedure
55$ copy_share_improve below).
56$
57 repr
58 freach: remote smap(df_edge) df_map_ocrs;
59 flive: remote smap(df_edge) df_map_syms;
60 frdestuse: smap(destuse) df_map_ocrs;
61 fldestuse: smap( tuple(destuse, df_node) )
62 df_map_syms;
63 zero_o: df_elmt_ocrs;
64 id_o: df_map_ocrs;
65 zero_s: df_elmt_syms;
66 id_s: df_map_syms;
67 dum1, dum2: remote mmap{df_node} df_elmt_ocrs;
68 usym1, usym2: symbol;
69 uocrs1, uocrs2: occurrence;
70
71 reach: remote smap(df_node) df_elmt_ocrs;
72 canreach: mmap{destuse} df_elmt_ocrs;
73 fvo: df_map_ocrs;
74 globrelvars: df_elmt_syms;
75 livat: remote smap(df_node) df_elmt_syms;
76 bvo: elmt blocks;
77 w: df_node;
78 livatvo: df_elmt_syms;
79 vo: destuse;
80 vo1: elmt df_base_ocrs;
81 vo2: occurrence;
82 r: routine;
83 p: symbol;
84 locreldefs: df_elmt_ocrs;
85 locrelvars: df_elmt_syms;
86 x: destuse;
87 y: sparse set(reldef);
smfg 128 z: reldef;
88 entry_time: integer;
89 end repr;
90
91 entry_time := time;
92
93$
94$ initialise a special data flow value and map which denote the effect
95$ of an undefined (unreachable) data state and an undefined (untrace-
96$ able) data flow, respectively.
97$
98 xom_syms := { usym1 := newat };
99 fom_syms := [ { usym1 := newat }, { usym2 := newat } ];
100
101 xom_ocrs := { uocrs1 := newat };
102 fom_ocrs := [ { uocrs1 := newat }, { uocrs2 := newat } ];
103$
104$ initialize the output map livethru
105$
106 livethru := {};
107$
108$ first perform interprocedural analysis
109$
110$ initialize the block mappings required by our standard data-flow
111$ package, and a few auxiliary mappings. for efficiency, one scan
112$ through the code is used to compute the mappings for both forward
113$ (reachability) and backward (liveness) analyses.
114$ see block_flowmaps for details.
115$
smfk 166 if globreldefs /= {} then
smfk 167
116 [ freach, flive, frdestuse, fldestuse ] :=
117 block_flowmaps(om, globreldefs);
118$
119$ reachability analysis
120$
121 zero_o := {};
122 id_o := [ globreldefs, zero_o ];
123
124 interproc_fwd_analysis_ocrs
125 (freach, reach, id_o, zero_o, false, false, dum1, dum2, om);
126 freach := om; $ free storage
127$
128$ next compute the map canreach which maps each potentially
129$ destructive use vo to the set of all relevant definitions
130$ which can reach vo. this is done by propagating reach
131$ through the appropriate portion of the block containing vo.
132$
133 canreach := {};
134 (forall fvo = frdestuse(vo))
135 $ ofx is a variant of the functional application operator
136 canreach{vo} := fvo .ofx_o reach(blockof(instno(vo)));
137 end forall;
138
139 frdestuse := om; reach := om; $ free storage
140$
141$ live analysis
142$
143 globrelvars := { oi_sym(vo2) : vo2 in globreldefs };
144 zero_s := {};
145 id_s := [ globrelvars, zero_s ];
146
147 interproc_back_analysis_syms
148 (flive, livat, id_s, zero_s, false);
149 flive := om; $ free storage
150$
151$ next compute the livethru map, combining reachability and liveness
152$
153 (forall vo in potdestuses)
154 bvo := blockof(instno(vo));
155$ compute livatvo - the set of all variables live at vo
156$ see a description of fldestuse in procedure block_flowmaps.
157 livatvo := zero_s +/[ fldestuse([vo,w]) .ofx_s livat(w) :
158 w in cessor{bvo}];
159$ then livethru(vo) is computed as the set of all definitions
160$ that can reach vo whose variable is in livatvo
161 livethru{vo} :=
162 { vo1 in canreach{vo} | oi_sym(vo1) in livatvo };
163 end forall;
164 $ free storage
165 fldestuse := om; canreach := om;
166 livat := om; livatvo := om;
167
168 if 'q' in dump_string then
169 prints('livethru =', [ [ str x, y ] : y = livethru{x} ] );
170 end if;
smfk 168
smfk 169 end if;
171$
172$ next perform the corresponding intraprocedural analysis
173$ for each procedure
174$
175 (forall r in routs)
176
177 locreldefs := { vo2 in all_reldefs |
178 vo2 notin globreldefs
179 and oi_sym(vo2) in localvars{r} };
smfk 170
smfk 171 if locreldefs = {} then continue forall; end if;
180
181 [ freach, flive, frdestuse, fldestuse ] :=
182 block_flowmaps(r, locreldefs);
183
184 zero_o := {};
185 id_o := [ locreldefs, zero_o ];
186
187 intraproc_fwd_analysis_ocrs(r, freach, reach, id_o, zero_o,
188 false, false, dum1, dum2, om);
189 freach := om; $ free storage
190
191 canreach := {};
192 (forall fvo = frdestuse(vo))
193 canreach{vo} := fvo .ofx_o reach(blockof(instno(vo)));
194 end forall;
195
196 reach := om; frdestuse := om; $ free storage
197
198 locrelvars := { oi_sym(vo2) : vo2 in locreldefs };
199 zero_s := {};
200 id_s := [ locrelvars, zero_s ];
201
202 intraproc_back_analysis_syms
203 (r, flive, livat, id_s, zero_s, false);
204 flive := om; $ free storage
205
206 (forall vo in potdestuses)
207 bvo := blockof(instno(vo));
208 livatvo := zero_s +/[ fldestuse([vo,w]) .ofx_s livat(w) :
209 w in cessor{bvo}];
210 livethru{vo} +:=
211 { vo1 in canreach{vo} | oi_sym(vo1) in livatvo };
212 end forall;
213
214 $ free storage
215 fldestuse := om; canreach := om;
216 livat := om; livatvo := om;
217 end forall;
218
219 if 'p' in dump_string then
smfg 129 prints('livethru =',
smfh 47 [ [ oi_str(x), { oi_str(z): z in y } ] : y = livethru{x} ]
smfg 131 );
221 end if;
222
223 if 'e' in dump_string then
224 print(time - entry_time, 'msecs for live analysis');
225 end if;
226
227 end procedure live_dead_analysis;
228
229
230
231
232 operator .ofx_s(f, x);
233
234 repr
235 f: df_map_syms;
236 x: df_elmt_syms;
237 end repr;
238
239 if f = om then return {}; else return f(1) * x + f(2); end if;
240
241 end operator .ofx_s;
242
243
244 operator .ofx_o(f, x);
245
246 repr
247 f: df_map_ocrs;
248 x: df_elmt_ocrs;
249 end repr;
250
251 if f = om then return {}; else return f(1) * x + f(2); end if;
252
253 end operator .ofx_o;
254
255
256 procedure block_flowmaps(p, rldefs);
257
258$ the rldefs parameter is the set of all definitions of variables
259$ (i.e. ovariables) that are linked to potentially destructive
260$ uses considered in a particular invocation of this routine
261$ (i.e. global variables or local variables of some procedure).
262$
263$ this routine builds up four kinds of data flow maps
264$ by scanning the code, either in all routines (when p = om,
265$ indicating interprocedural analysis), or just in the routine
266$ p. the maps built are:
267$
268$ freach - maps each edge in the flow graph to its
269$ effect on reachability information
270$
271$ flive - maps each edge in the flow graph to its effect
272$ on liveness information.
273$
274$ recall that the data-flow functions needed for our analyses
275$ i.e. the functions which express the data-flow effect of particular
276$ parts of the program flow graph, such as edges, intervals, portions
277$ of basic blocks etc., can be represented as follows:
278$
279$ for reachability:
280$
281$ f = (thru, gen), where thru is the set of all definitions which, if
282$ reaching the start of the flow described by f, can still reach its
283$ end, and where gen is the set of definitions which occur during that
284$ flow and can reach its end.
285$ (this comment applies to the data-flow function frblk used below.)
286$
287$ for liveness:
288$
289$ f = (thru, exp), where thru is the set of all variables which, if live
290$ at the end of the flow described by f, are still live at its start,
291$ and where exp is the set of all variables which have an upward-exposed
292$ use within that flow, and are therefore unconditionally live at the
293$ start of that flow.
294$ (this comment applies to the data-flow functions flblk, flins, flaft,
295$ flbef and fluse used below.)
296$
297$ two additional objects are computed in this routine to eliminate the
298$ need for a second scan of the code after carrying out the data-flow
299$ analyses. without these objects available we would have to scan
300$ basic blocks once more, in order to propagate the information
301$ computed by the data flow analysis, which only gives data at block
302$ entries and exits, to the program points at which this information is
303$ actually needed. since in our case we know these points, namely the
304$ potentially destructive uses, in advance, we can compute the data-flow
305$ effects of the flow between these points and the entry and exits of
306$ the blocks containing them in advance. specifically, the objects
307$ computed are:
308$
309$ frdestuse - maps each potentially destructive use to the data-flow
310$ map representing the effect on reachability of the flow
311$ from the start of the basic block containing that use to
312$ a point logically placed between the input arguments
313$ and the output argument of that use ('midpoint' of that
314$ use).
315$
316$ fldestuse - maps each pair consisting of a potentially destructive
317$ use vo and a successor block sb of the block containing
318$ vo to a data-flow function representing the effect on
319$ liveness of the flow from the 'midpoint' of the use at
320$ vo to the start of sb.
321$
322$ the reason for computing flow effects up to (or from) a 'midpoint'
323$ of a potentially destructive operation are illustrated by the
324$ following example:
325$
326$ v := v with x;
327$
328$ if we considered variable liveness just before that instruction,
329$ we would conclude that v is live there (since it is used
330$ immediately thereafter). likewise, if we considered liveness
331$ just after that instruction, v might be seen as live due to a
332$ subsequent use. the 'right' place for considering liveness is
333$ the midpoint of the instruction, between input and output, where
334$ v will be found to be dead.
335$
336 repr
337 $ data structures for parameters
338 p: routine;
339 rldefs: df_elmt_ocrs;
340
341 $ data structures for returned variables
342 freach: remote smap(df_edge) df_map_ocrs;
343 flive: remote smap(df_edge) df_map_syms;
344 frdestuse: smap(destuse) df_map_ocrs;
345 fldestuse: smap( tuple(destuse, df_node) )
346 df_map_syms;
347
348 $ data structure for local variables
349 todo: sparse set(routine);
350 rlvars: df_elmt_syms;
351 defofvars: mmap{symbol} df_elmt_ocrs;
352 vo: occurrence;
353 v: symbol;
354 id1: df_map_ocrs;
355 id2: df_map_syms;
356 r: routine;
357 b: elmt blocks;
358 i: elmt insts;
359 opc: elmt base_opcodes;
360 argsi: tuple(symbol);
361 frblk: df_map_ocrs;
362 flblk: df_map_syms;
363 dstusesinb: sparse set(occurrence);
364 fluse: smap(occurrence) df_map_syms;
365 used: df_elmt_syms;
366 j: integer;
367 flbef: df_map_syms;
368 ov: occurrence;
369 flaft: df_map_syms;
370 flins: df_map_syms;
371 vo1: occurrence;
372 sblks: sparse set(elmt blocks);
373 lb: symbol;
374 b1: elmt blocks;
375 end repr;
376
377 if p = om then todo := routs; else todo := { p }; end if;
378$
379$ compute rlvars - the set of all variables appearing in rldefs
380$ and defofvars - a map from each such variable to its definitions
381$ in rldefs.
382$
383 rlvars := {}; defofvars := {};
384 (forall vo in rldefs)
385 rlvars with:= (v := oi_sym(vo));
386 defofvars with:= [ v, vo ];
387 end forall;
388
389 id1 := [ rldefs, {} ]; $ identity map for reachability anal.
390 id2 := [ rlvars, {} ]; $ identity map for live analysis
391
392 freach := {}; flive := {};
393 frdestuse := {}; fldestuse := {};
394
395 (forall r in todo)
396 (for_block(b, r))
397$ initialize maps that summarize the data-flow through the block b
398$ so far (frblk for reachability and flblk for liveness).
399 frblk := id1;
400 flblk := id2;
401 dstusesinb := {}; $ set of pot. destructive uses in b
402$ fluse maps each use vo in dstusesinb to the data-flow effect on
403$ liveness of the flow from the midpoint of vo onward within b.
404 fluse := {};
405
406 (for_inst(i, b)) $ iterate over instructions of block
407 opc := opcode(i);
408 argsi := args(i);
409 used := { v : j in [ first_ivar(opc)..#argsi ] |
410 (v := argsi(j)) in rlvars };
411$ flbef represents the effect on liveness of the right-hand side of i
412$ (i.e. of the appearances of the input arguments in i).
413 flbef := [ rlvars, used ];
414
415$ check whether i contains a relevant pot. destructive use vo
416 if (vo := dstuseini(i)) /= om then
417$ record effect on reachability of flow up to that use
418 frdestuse(vo) := frblk;
419$ add to collection of destructive uses in b
420 dstusesinb with:= vo;
421 end if;
422
423$ check whether i has an ovariable
424 if opc in ops_ovar then
425 v := argsi(1);
426$ if v is in rlvars update frblk and flaft by the effects of this
427$ definition.
428 if v in rlvars then
429 ov := get_oi(i, 1);
430$ the effect on reachability: ov can now reach the current point
431$ in the block, whereas all other definitions of v cannot
432
433$ note: the use of the map composition operator .comp (imported
434$ from the data-flow solver package) makes the tracing of flow
435$ through the block very simple to calculate; otherwise
436$ an explicit computation would be required.
437 frblk :=
438 [ rldefs-defofvars{v}+{ov}, {ov} ]
439 .comp_ocrs frblk;
440$ the effect on liveness: v becomes dead, and nothing else
441$ becomes live
442 flaft := [ rlvars - {v}, {} ];
443 end if;
444 else
445$ in this case the left hand side of i has no effect on liveness
446$ of the relevant variables.
447 flaft := id2;
448 end if;
449$ if there is a pot. destructive use vo in i (i.e. if vo as
450$ computed earlier is not om), initialize fluse(vo).
451 if vo /= om then
452 fluse(vo) := flaft;
453 end if;
454$ get the effect of i on liveness
455 flins := flbef .comp_syms flaft;
456$ update the flblk map by the effect of i on liveness
457 flblk := flblk .comp_syms flins;
458
459$ update fluse of previously encountered destructive uses in b
460$ note: an alternative approach might have been to propagate
461$ liveness information backwards through b. while this would
462$ eliminate the need to maintain a separate data-flow function
463$ for each destructive use in b (the fluse map), it would require
464$ maintainance of a separate data-flow function for each
465$ successor of b. moreover, this alternative approach would require
466$ us to process b in two different directions, instead of a single
467$ pass over b, as is done here.
468
469 (forall vo1 in dstusesinb | vo1 /= vo)
470 fluse(vo1) := fluse(vo1) .comp_syms flins;
471 end forall;
472
473$ if i is a branch instruction, use the current frblk, flblk etc.
474$ to update the various edge mappings that we wish to compute
475 if opc in ops_goto then
476$ get blocks that can be reached by this jump
477 if opc = q1_case then
478 sblks := { blockof(value(lb)) :
479 lb in range value(argsi(1)) };
480 else
481 sblks := { blockof(value(argsi(#argsi))) };
482 end if;
483 (forall b1 in sblks)
484
485$ update freach and flive using the current frblk and flblk maps
486$ the values are join'ed together, since both analyses determine
487$ facts that may happen (rather than must happen) as execution
488$ reaches (or leaves) a given program point.
489 freach([b, b1]) :=
490 frblk .join_o:= freach([b, b1]);
491 flive([b, b1]) :=
492 flblk .join_s:= flive([b, b1]);
493
494$ update fldestuse using the current fluse maps
495 (forall vo in dstusesinb)
496 fldestuse([vo,b1]) :=
497 fluse(vo) .join_s fldestuse([vo, b1]);
498 end forall;
499 end forall;
500 end if;
501 end; $ end for_inst
502 end; $ end for_block
503 end forall r;
504
505 return [ freach, flive, frdestuse, fldestuse ];
506
507 end procedure block_flowmaps;
508
509
510
511
512 operator .join_s(f, g);
513
514 repr
515 f, g: df_map_syms;
516 end repr;
517
518 if g = om then
519 return f;
520 else
521 return [ f(1) + g(1), f(2) + g(2) ];
522 end if;
523
524 end operator .join_s;
525
526
527 operator .join_o(f, g);
528
529 repr
530 f, g: df_map_ocrs;
531 end repr;
532
533 if g = om then
534 return f;
535 else
536 return [ f(1) + g(1), f(2) + g(2) ];
537 end if;
538
539 end operator .join_o;
540
541
1 .=member cel18d
2
3 procedure copy_eliminate;
4
5$ in this routine we use the value relationships and the liveness
6$ information computed in the preceding phases to determine
7$ which potentially destructive operations can be performed
8$ without having to copy the object whose value is being destroyed
9
10$ the general rule is as follows:
11
12$ copy elimination rule: let n be the 'midpoint' of
13$ a potentially destructive operation, and let vo denote the
14$ potential destructive use there. let containvo denote the set
15$ of all variable occurrences vo' for which there exists
16$ a membership relationship r such that [vo', r] can be reached
17$ from [vo, rid] by a path through (the virtual) upgraph followed by
18$ a path through (the virtual) downgraph. suppose that each vo'
19$ in containvo is dead at n. (recall that liveness is computed on a
20$ 'per occurrence' basis.) then no copy is required at n.
21
22$ the actual graph traversals have been accomplished in the
23$ preliminary value-flow algorithm (see value_flow). the map
24$ contain produced by that algorithm can be used to obtain
25$ containvo directly.
26$
27$ another application of copy elimination is to optimize
28$ iterations. currently (unless the diter flag is turned on)
29$ if an object s is to be iterated over it is first copied
30$ to another object s', and then iteration is performed
31$ over s'. this is done because if s is modified during iteration
32$ we want to continue iteration over its old value. this however
33$ can be checked by our copy elimination procedure. indeed,
34$ let "s' := s" be the assignment of s to s' before the iteration.
35$ suppose that the occurrence of s' in this statement can
36$ reach some potentially destructive use of this value, and
37$ that s' is live at that use. only in this case the value
38$ of s will have to be copied before or during the iteration
39$ and so direct iteration over s is impossible. on the other
40$ hand, if this case does not arise, then it is safe to
41$ iterate over s directly.
42
43$ this optimization can be accomplished as follows: s' will
44$ always appear at exactly four q1 instructions:
45
46$ (1) q1_asn s' s
47$ (2) q1_inext (or q1_inextd)
48$ (3) q1_next (or q1_nextd)
49$ (4) q1_asn s' om (at the end of iteration).
50
51$ by iterating over all q1_next and q1_nextd appearing in
52$ the code being analyzed, and by tracing bfrom and ffrom
53$ links from it, we can collect all such quadruples. then,
54$ during copy elimination, we check, for each destructive
55$ use iv whether the corresponding contain entries include
56$ any occurrence of an s' in its defining assignment (1).
57$ if so, and if that occurrence is live at iv, then we
58$ tag this quadruple as not being amenable to optimization.
59$ after elimination has been completed, all untagged quadruples
60$ can then be optimized, the optimization simply being the
61$ deletion of statements (1) and (4) and substitution of s
62$ in place of s' in statements (2) and (3).
63$
64$ we use the following data structures:
65$
66$ iter_asns: set of all occurrences of a s' in assignments
67$ of the form (1).
68$
69$ other_insts: maps each such assignment to the three statements
70$ (2) - (4).
71$
72 repr
73 vo: occurrence;
74 containvo: df_elmt_ocrs;
75 liveconts: df_elmt_ocrs;
76 livevo: df_elmt_ocrs;
77 precuoccs: df_elmt_ocrs;
78 vox: occurrence;
79 instx: elmt insts;
80 share_insts: sparse set(elmt insts);
81 copy_cond, copy_fl: boolean;
82 copy_text: string;
83 end repr;
84
85$ copy_iters := {};
86 destuses := {}; $ destructive uses where copy may be required
87
88$ process each potentially destructive use vo.
89 (forall vo in potdestuses)
90 livevo := livethru{vo} + destconsts;
91 copy_fl := false;
92 copy_cond := false;
93 share_insts := {};
94
95 (forall vox in psoccsof{vo})
96$ vo_copy := contain{vox} * livevo;
97 if contain{vox} * livevo /= {} then
98 copy_fl := true; $ vo requires copying
99 share_insts with:= instno(vox);
100$ if (vo_copy_iters := iter_asns * vo_copy) /= {} then
101$ copy_iters +:= vo_copy_iters;
102$ end if;
103 else
104 copy_cond := true;
105 end if;
106 end forall;
107 precuoccs := puoccsof{vo};
108 if precuoccs * livevo /= {} then
109 copy_cond := false;
110 copy_fl := true;
111 elseif precuoccs /= {} then
112 copy_cond := true;
113 end if;
114
115 if not copy_fl then
116 copy_flag(instno(vo)) := copy_no;
117 copy_text := 'no';
118 else
119 destuses with:= vo;
120 if copy_cond then
121 $ a conditional copy; set share bits
122 copy_flag(instno(vo)) := copy_test;
123 copy_text := 'a conditional';
124 (forall instx in share_insts)
125 share_flag(instx) := 1;
126 end forall;
127 else $ unconditional copy; no share bit setting
128 copy_flag(instno(vo)) := copy_yes;
129 copy_text := 'an unconditional';
130 end if;
131 end if;
smfc 666 messages{stmtof(instno(vo))}{'s'} with:=
133 [ copy_text + ' copy is required for '
134 '"' + oi_name(vo) + '".' ];
135 end forall;
136
137$ we now perform the iteration optimization described above.
138$ (forall vox in iter_asns - copy_iters)
139$ (forall [ inxt, nxt, asnom ] in other_insts(vox))
140$ del_insx(i := instno(vox));
141$ del_insx(asnom);
142$ arg3(inxt) := arg3(nxt) := arg2(i);
143$ end forall;
144$ end forall;
145
146 end procedure copy_eliminate;
147
148
1 .=member csi18e
2
3
4 procedure copy_share_improve;
5$
6$ this routine performs (?) various bookkeeping optimizations
7$ related to copying, such as suppression of share-bit settings,
8$ changing conditional copying into unconditional copying, and
9$ moving copy operations out of loops.
10$
11$ for the time being this is an empty procedure.
12
13 pass;
14
15 end procedure copy_share_improve;
16
17
18 end module setl_optimizer - copy_optimization;
19
20
1 .=member util16
2
3
4 module setl_optimizer - util;
5
6$ this library contains various utility routines
7
8
1 .=member sym16a
2
3
4$ utilities for symbol table manipulation
5$ ---------------------------------------
6
7
8 procedure add_sym(sc);
9$
10$ allocate a new symbol and add it to the end of the list of symbols
11$ in scope 'sc'.
12$
13 repr
14 sc: elmt base_scopes;
15 s: symbol;
16 end repr;
17
18 s := newat;
19
20 if first_sym(sc) = om then
21 first_sym(sc) := last_sym(sc) := s;
22 else
23 last_sym(sc) := next_sym(last_sym(sc)) := s;
24 end if;
25
26 name(s) := str s;
27 scope(s) := sc;
28 is_internal(s) := 1;
29
30 return s;
31
32 end procedure add_sym;
33
34
35
36
37 procedure add_var(sc);
38$
39$ add a variable to the scope 'sc'.
40$
41 repr
42 sc: elmt base_scopes;
43 s: symbol;
44 end repr;
45
46 s := add_sym(sc);
47
48 form(s) := std_form(f_gen);
49 is_read(s) := 1;
50 is_write(s) := 1;
51
52 return s;
53
54 end procedure add_var;
55
56
57
58
59 procedure add_int(sc, i);
60$
61$ add an integer constant with value 'i' to scope 'sc'
62$
63 repr
64 sc: elmt base_scopes;
65 i: integer;
66 fm: elmt forms;
67$$-- old: symbol;
68 s: symbol;
69 end repr;
70
71 fm := std_form(f_int);
72$$-- value_inv is undefined here
73$$--old := value_inv(i, sc, fm);
74$$--if old /= om then return old; end;
75
76 s := add_sym(sc);
77
78 name(s) := str i;
79 form(s) := fm;
80 value(s) := i;
81 is_const(s) := 1;
82
83 return s;
84
85 end procedure add_int;
86
87
88
89
90 procedure add_label(sc);
91$
92$ add a label to scope sc.
93$
94 repr
95 sc: elmt base_scopes;
96 l: symbol;
97 end repr;
98
99 l := add_sym(sc);
100
101 form(l) := std_form(f_lab);
102 is_const(l) := 1;
103$$$ ???? art-this needs more comment. also, where is the value
104$$$ ???? of the label defined.
105
106 return l;
107
108 end procedure add_label;
109
110
111
112
113 procedure del_sym(sym, presym, sc);
114$
115$ this routine deletes 'sym' from the symbol table of 'sc',
116$ where 'presym' is the symbol preceding sym in this table.
117$
118 repr
119 sym: symbol;
120 presym: symbol;
121 sc: elmt base_scopes;
122
123 s, nextsym: symbol;
124 end repr;
125
126$ we first update the 'next_sym', 'first_sym' and 'last_sym'
127$ maps, and then remove 'sym' from the domain of all symbol-
128$ table maps.
129
130 if presym = om then
131 (for_sym(s, sc))
132 if s = sym then quit; end if;
smfc 667 presym := s;
134 end; $ end for_sym
135 end if;
136
137 nextsym := next_sym(sym);
138 if presym /= om then
139 if nextsym /= om then
140 next_sym(presym) := nextsym;
141 else
142 next_sym(presym) := om;
143 last_sym(sc) := presym;
144 end if;
145 else
146 if nextsym /= om then
147 first_sym(sc) := nextsym;
148 else $ sym is the only symbol in sc
149 first_sym(sc) := om;
150 last_sym(sc) := om;
151 end if;
152 end if;
153
154 name lessf:= sym;
155 scope lessf:= sym;
156 form lessf:= sym;
157 value lessf:= sym; is_const lessf:= sym;
158 alias lessf:= sym; is_store lessf:= sym;
159 is_temp lessf:= sym; is_internal lessf:= sym;
160 is_read lessf:= sym; is_write lessf:= sym;
161 is_stk lessf:= sym; is_param lessf:= sym;
162 is_repr lessf:= sym; is_init lessf:= sym;
163 is_seen lessf:= sym; is_back lessf:= sym;
164 is_rec lessf:= sym;
165 next_sym lessf:= sym;
166
167 end procedure del_sym;
168
169
1 .=member frm16b
2
3
4 procedure add_form(sc);
5$
6$ this routine adds a new form (plex base member) to the scope 'sc'.
7$
8 repr
9 sc: elmt base_scopes;
10 fm: elmt forms;
11 end repr;
12
13 fm := newat;
14
15 if first_form(sc) = om then
16 first_form(sc) := last_form(sc) := fm;
17 else
18 last_form(sc) := next_form(last_form(sc)) := fm;
19 end if;
20
21 return fm;
22
23 end procedure add_form;
24
25
1 .=member blk16c
2
3
4 procedure add_block(pb, sc, isafter);
5$
6$ allocate a new block and add it to the scope sc either after
7$ the block pb (if isafter = true) or before pb otherwise.
8$
9 repr
10 pb: elmt blocks;
11 sc: elmt base_scopes;
12 isafter: boolean;
13 b, qb, rb: elmt blocks;
14 end repr;
15
16$ if isafter = false, iterate through the blocks of sc to find
17$ the block preceding pb
18
19 if not isafter then
20 qb := om;
21 (for_block(b, sc))
22 if b = pb then quit; end;
23 qb := b;
24 end;
25 else
26 qb := pb;
27 end if;
28
29 b := newat;
30
31 if qb = om then $ insert at end
32 if first_block(sc) = om then
33 first_block(sc) := last_block(sc) := b;
34 else
35 last_block(sc) := next_block(last_block(sc)) := b;
36 end if;
37 else $ insert after qb
38 if (rb := next_block(qb)) = om then $ qb is last
39 last_block(sc) := next_block(qb) := b;
40 else
41 next_block(b) := rb;
42 next_block(qb) := b;
43 end if;
44 end if;
45
46 routof(b) := sc;
47
48 return b;
49
50 end procedure add_block;
51
52
53
54
55 procedure del_block(b, pb, r);
56$
57$ deletes a block b from the scope r. pb is the block preceding
58$ b in this scope.
59$
60 repr
61 b,pb,nb: elmt blocks;
62 i,pi: elmt insts;
63 r: elmt base_scopes;
64 end repr;
65
66 pi := om;
67 (for_inst(i, b))
68 if pi = om then
69 pi := i;
70 else
71 del_inst(i, pi, b);
72 end if;
73 end;
74
75$ delete the label of the block from the symbol table
76 dead_labs with:= arg1(pi);
77
78 del_inst(pi, om, b);
79
80 nb := next_block(b);
81 if nb = om then
82 if pb = om then
83 first_block(r) := om;
84 last_block(r) := om;
85 else
86 next_block(pb) := om;
87 last_block(r) := pb;
88 end if;
89 else
90 if pb = om then
91 first_block(r) := nb;
92 else
93 next_block(pb) := nb;
94 end if;
95 end if;
96
97
98 end procedure del_block;
99
100
1 .=member ins16d
2
3
4 procedure add_inst(b, opc, a(*));
smfi 330$
smfi 331$ add a new instruction at the end of block b.
5$
6$ the final, variable-length group of parameters of this routine are
7$ the arguments of the instruction being added. note that this
8$ instruction may not be a call or label.
smfi 332$ this instruction may not be a call or label because inserting such
smfi 333$ an instruction requires that various maps on blocks are updated.
11$
15 repr
16 b: elmt blocks;
17 opc: elmt base_opcodes;
18 a: tuple(symbol);
19
20 i: elmt insts;
21 v: symbol;
22 oi: occurrence;
23 occsi: tuple(occurrence);
24 iva1, j: integer 0..65536;
25 end repr;
26
27 i := newat;
28
29 if first_inst(b) = om then
smfk 172 stmtof(i) := 65535;
30 first_inst(b) := last_inst(b) := i;
31 else
smfi 335 stmtof(i) := stmtof(last_inst(b));
32 last_inst(b) := next_inst(last_inst(b)) := i;
33 end if;
34
35 blockof(i) := b;
36
37$ update all_o etc.
38 iva1 := first_ivar(opc);
39 occsi := [];
40
41 (forall v = a(j))
42 oi := newat;
43 instno(oi) := i;
44 argno(oi) := j;
45 occsi(j) := oi;
46
47 if j = 1 and opc in ops_ovar then all_o with:= oi; end if;
48 if j >= iva1 then all_i with:= oi; end if;
49
smfk 173 all_oi with:= oi;
smfk 174
smfl 182 if V in VARIABLES then
smfk 176 occsof{v} with:= oi;
smfk 177 end if;
52 end forall;
53
54 opcode(i) := opc;
55 args(i) := a;
56 occs(i) := occsi;
57
58 return i;
59
60 end procedure add_inst;
61
62
63
64
65 procedure insert_ins(rw old, opc, a(*));
66
67 repr
68 old: elmt insts;
69 opc: elmt base_opcodes;
70 a: tuple(symbol);
71 end repr;
72
73 insert_ins1(old, opc, a);
74
75 end procedure insert_ins;
76
77
78
79
80 procedure insert_ins1(rw old, opc, a);
81
82$ add a new instruction after instruction 'i'.
83
84 repr
85 old: elmt insts;
86 opc: elmt base_opcodes;
87 a: tuple(symbol);
88
89 new: elmt insts;
90 b: elmt blocks;
91 v: symbol;
92 oi: occurrence;
93 occsi: tuple(occurrence);
94 iva1, j: integer 0..65536;
95 end repr;
96
97 new := newat;
98
99 next_inst(new) := next_inst(old);
100 next_inst(old) := new;
101
102 b := blockof(old);
103 blockof(new) := b;
104 stmtof(new) := stmtof(old);
105
106 if last_inst(b) = old then last_inst(b) := new; end if;
107
108$ update oi_sets and oi_maps.
109 iva1 := first_ivar(opc);
110 occsi := [];
111
112 (forall v = a(j))
113 oi := newat;
114 instno(oi) := new;
115 argno(oi) := j;
116 occsi(j) := oi;
117
118 if j = 1 and opc in ops_ovar then all_o with:= oi; end if;
119 if j >= iva1 then all_i with:= oi; end if;
120
smfk 178 all_oi with:= oi;
smfk 179
smfl 183 if V in VARIABLES then
smfk 181 occsof{v} with:= oi;
smfk 182 end if;
123 end forall;
124
125 opcode(new) := opc;
126 args(new) := a;
127 occs(new) := occsi;
128
129 old := new;
130
131 end procedure insert_ins1;
132
133
134
135
136 procedure del_inst(rw i, pi, b);
137$
138$ this routine deletes an instruction from the q1 code.
139$ i is the instruction to be deleted and pi is the instruction
140$ preceding i in its basic block b.
141$ it resets i to pi, so that, if we iterate over the block b using
142$ the for_inst macro, we step to the instruction following i.
143$
144$ nb. this routine can not be used to delete the first instruction
145$ of a block while iterating through a block using the for_inst
146$ macro, since the step block of the iteration would look for
147$ next_inst(om), which yields an error.
148$
149
150 repr
151 i: elmt insts;
152 pi: elmt insts;
153 b: elmt blocks;
154
155 inst, ni: elmt insts;
156 opc: elmt base_opcodes;
157 argsi: tuple(symbol);
158 v: symbol;
159 oi: occurrence;
160 iva1, j: integer 0..65536;
161 end repr;
162
163
164 if pi = om then
165 (for_inst(inst, b))
166 if inst = i then quit; end if;
167 pi := inst;
168 end; $ end for_inst
169 end if;
170
171 ni := next_inst(i);
172 if pi /= om then
173 if ni /= om then
174 next_inst(pi) := ni;
175 else
176 next_inst(pi) := om;
177 last_inst(b) := pi;
178 end if;
179 else
180 if ni /= om then
181 first_inst(b) := ni;
182 else
183 first_inst(b) := om;
184 last_inst(b) := om;
185 end if;
186 end if;
187
188 argsi := args(i);
189 opc := opcode(i);
190 iva1 := first_ivar(opc);
191
192 (forall v = argsi(j))
193 oi := get_oi(i, j);
194
195 if j = 1 and opc in ops_ovar then all_o less:= oi; end if;
196 if j >= iva1 then all_i less:= oi; end if;
197
198 all_oi less:= oi;
199 occsof{v} less:= oi;
200 end forall;
201
202 i := pi;
203
204 end procedure del_inst;
205
206
1 .=member pru16e
2
3
4 procedure ermsg(s);
5
6$ print error message 's'
7
8 print('**** error', s, '****');
9
10 end procedure ermsg;
11
12
13
14
15 procedure abort(s);
16
17$ print error message and abort
18
19 ermsg(s);
20 stop;
21
22 end procedure abort;
23
24
25
26
27 procedure prints(hdr, t);
28$
29$ this utility routine prints its second argument sorted. this is a
30$ tuple 't' of pairs [ c, x ], where c is a string and x can be any
31$ object. we first sort t in lexicographical order of the string
32$ components, and then print it one pair per line. we use a simple
33$ version of heapsort to do the sort.
34$
35 repr
36 hdr: string;
37 t: tuple(tuple(string, general));
38 x: tuple(string, general);
39 j, k, l, m, n: integer 0..65536;
40 end repr;
41
42
43 macro before(l, r); $ defines partial order
44 ( t(l)(1) < t(r)(1) )
45 endm;
46
47
48 print;
49 print(hdr);
50
51 if #t = 0 then return t; end if; $ trivial case
52
53 $ sort the pairs lexographically by their first component, using
54 $ heap sort
55 (init n := #t; j := n div 2; while j >= 1 step j -:= 1;)
56 (init k := j; while (l := k+k) <= n)
57 $ which child will be promoted ?
58 m := if l < n and before(l, l+1) then l+1 else l end;
59
60 $ will a child be promoted ?
61 if before(k, m) then
62 x := t(k); t(k) := t(m); t(m) := x; k := m;
63 else
64 quit init k;
65 end if;
66 end init k;
67 end init n;
68
69 (init j := n; while j > 1)
70 x := t(j); t(j) := t(1); t(1) := x; j -:= 1;
71 (init k := 1; while (l := k+k) <= j)
72 $ which child will be promoted ?
73 m := if l < j and before(l, l+1) then l+1 else l end;
74
75 $ will a child be promoted ?
76 if before(k, m) then
77 x := t(k); t(k) := t(m); t(m) := x; k := m;
78 else
79 quit init k;
80 end if;
81 end init k;
82 end init j;
83
84 (forall x in t) print(x(1), x(2)); end forall;
85
86
87 end procedure prints;
88
89
90
91
smfe 193 procedure format_type(tp);
smfe 194$
smfe 195$ this routine returns a string corresponding to the type tp.
smfe 196$
smfe 197$ assert is_string arb grosstyp(tp);
smfe 198$ assert grosstyp(tp) subset bsctyps;
smfe 199$ assert tp = type_zero or #grosstyp >= 1;
smfe 200$
smfe 201 const
smfe 202 grstup = { t_tuple },
smfe 203 grsset = { t_set },
smfe 204 grsmap = { t_map };
smfe 205
smfe 206 repr
smfe 207 tp, tx: elmt types;
smfe 208 g: gross_type;
smfe 209 c: general;
smfe 210 ct1: tuple(elmt types);
smfe 211 x: basic_type;
smfe 212 text: string;
smfe 213 j: integer;
smfe 214 grstup, grsset, grsmap: gross_type;
smfe 215 end repr;
smfe 216
smfe 217
smfe 218 if tp = type_zero then return '-'; end if;
smfe 219 if tp = type_gen then return 'general'; end if;
smfe 220
smfe 221 if tp = type_notom then return 'not-om'; end if;
smfe 222
smfe 223 [ g, c ] := tp;
smfe 224
smfe 225 if c = type_om then
smfe 226 if g = grstup then return 'nulltup'; end if;
smfe 227 if g = grsset then return 'nullset'; end if;
smfe 228 if g = grsmap then return 'nullmap'; end if;
smfe 229 end if;
smfe 230
smfe 231 if g*tup_set_map /= {} and
smfe 232 (t_tuple in g impl not is_knt(tp)) and is_om(c) then
smfe 233 (forall x in g | x in tup_set_map)
smfe 234 if text = om then
smfe 235 text := 'null' + x;
smfe 236 else
smfe 237 text +:= ' | null' + x;
smfe 238 end;
smfe 239 end forall;
smfe 240 if c = type_gen then $ c .con:= type_notom;
smfe 241 c := type_notom;
smfe 242 else
smfe 243 grosstyp(c) less:= t_om;
smfe 244 end if;
smfe 245 if grosstyp(c) = {} then g -:= tup_set_map; end if;
smfe 246 tp := [ g, c, false ];
smfe 247 end if;
smfe 248
smfe 249 (forall x in g)
smfe 250
smfe 251 if text = om then text := x; else text +:= ' | ' + x; end;
smfe 252
smfe 253 case x of
smfe 254
smfe 255 (t_set):
smfe 256 text +:= '(' + format_type(comptyp(tp)) + ')';
smfe 257
smfe 258 (t_map):
smfe 259 text +:= '(' + format_type(domtyp(tp)) + ') '
smfe 260 + format_type(rangetyp(tp));
smfe 261
smfe 262 (t_tuple):
smfe 263 if is_knt(tp) then
smfe 264 ct1 := comptyp(tp);
smfe 265 text +:= '(' +/[ format_type(tx) +
smfe 266 if j = #ct1 then ')' else ', ' end :
smfe 267 tx = ct1(j) ];
smfe 268 else
smfe 269 text +:= '(' + format_type(comptyp(tp)) + ')';
smfe 270 end if;
smfe 271
smfe 272 $ note that the primitive types fall into the else-clause of
smfe 273 $ this case statement.
smfe 274
smfe 275 end case;
smfe 276
smfe 277 end forall;
smfe 278
smfe 279 return if '|' in text then '{ ' + text + ' }' else text end;
smfe 280
smfe 281
smfe 282 end procedure format_type;
140
141
142
143
144 procedure format_repr(rpr);
145$
146$ this routine returns a string containing the description of 'rpr'
147$ in the syntax of the setl data-representation sublanguage.
148$
149 repr
150 g: gross_type;
151 fr: basic_type;
152 comps: tuple(elmt types);
153 j: integer;
154 rpr, crpr: elmt types;
155 brckts: string;
156 end repr;
157
158
159 g := grosstyp(rpr);
160 if #g /= 1 then return 'general'; end if;
161
162 fr := arb g;
163 case fr of
164
165 (t_om): return 'omega';
166 (t_int): return 'integer';
167 (t_real): return 'real';
168 (t_string): return 'string';
169 (t_atom): return 'atom';
170 (t_elmt): return 'elmt ads' + str rpr(2);
171
172 (t_set): return case set_type(rpr) of
173 (locl): 'local set(',
174 (remt): 'remote set(',
175 (sprse): 'sparse set('
176 else 'set('
177 end + format_repr(comptyp(rpr)) + ')';
178
179 (t_map): return
180 case set_type(rpr) of
181 (locl): 'local ',
182 (remt): 'remote ',
183 (sprse): 'sparse '
184 else ''
185 end +
186 case map_type(rpr) of
187 (ft_smap): 'smap(' + format_repr(domtyp(rpr)) + ') ',
188 (ft_mmap): 'mmap{' + format_repr(domtyp(rpr)) + '} '
189 else 'map(' + format_repr(domtyp(rpr)) + ') '
190 end + format_repr(rangetyp(rpr));
191
192 (t_tuple):
193 if is_knt(rpr) then
194 comps := comptyp(rpr);
195 brckts := (+/[ format_repr(crpr) +
196 (if j = #comps then ')' else ', ' end)
197 : crpr = comps(j) ]);
198 return
199 if brckts = om then 'tuple' else 'tuple('+brckts end;
200 else
201 return 'tuple(' + format_repr(comptyp(rpr)) + ')';
202 end if;
203
204 else
205 return ' (error in format_repr) ';
206 end case;
207
208
209 end procedure format_repr;
210
211
212
213
214 procedure format_form(fm);
215$
216$ this routine formats a form table entry into a human-readable string.
217$
218 repr
219 fm: elmt forms;
220 t: tuple(elmt forms);
221 j, n: integer;
222 end repr;
223
224
225 return
226 case ft_type(fm) of
227
228(f_gen): 'general',
229
230(f_sint): 'integer ' + str ft_low(fm) + '..' +
231 if ft_lim(fm) /= om and ft_lim(fm) /= 0 then
232 str ft_lim(fm)
233 else
234 'maxsi'
235 end,
236
237(f_sstring): 'string',
238(f_atom): 'atom',
239(f_latom): 'atom',
240(f_elmt): 'elmt ' + name(basesymb(ft_base(fm))),
241(f_uint): 'untyped integer',
242(f_ureal): 'untyped real',
243(f_int): 'integer',
244(f_string): 'string',
245(f_real): 'real',
246(f_ituple): 'tuple(untyped integer)',
247(f_rtuple): 'tuple(untyped real)',
248(f_ptuple): 'packed tuple(' + format_form(ft_elmt(fm)) + ')',
249
250(f_tuple): 'tuple(' + format_form(ft_elmt(fm)) + ')' +
251 if ft_lim(fm) /= om and ft_lim(fm) /= 0 then
252 '(' + str ft_lim(fm) + ')'
253 else
254 ''
255 end,
256
257(f_mtuple): 'tuple(' +/
258 [ format_form(ft_elmt(fm)(j)) +
259 if j = #ft_elmt(fm) then ')' else ', ' end :
260 j in [ 1..#ft_elmt(fm) ] ],
261
262(f_uset): if ft_type(ft_elmt(fm)) = f_elmt then
263 'sparse '
264 else
265 ''
266 end +
267 'set(' + format_form(ft_elmt(fm)) + ')',
268
269(f_lset): 'local set(' + format_form(ft_elmt(fm)) + ')',
270
271(f_rset): 'remote set(' + format_form(ft_elmt(fm)) + ')',
272
273(f_umap): if ft_type(ft_dom(fm)) = f_elmt then
274 'sparse '
275 else
276 ''
277 end +
278 case ft_mapc(fm) of
279 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
280 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') ',
281 (ft_mmap): 'mmap{' + format_form(ft_dom(fm)) + '} '
282 else om end +
283 format_form(ft_im(fm)),
284
285(f_lmap): 'local ' +
286 case ft_mapc(fm) of
287 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
288 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') ',
289 (ft_mmap): 'mmap{' + format_form(ft_dom(fm)) + '} '
290 else om end +
291 format_form(ft_im(fm)),
292
293(f_rmap): 'remote ' +
294 case ft_mapc(fm) of
295 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
296 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') ',
297 (ft_mmap): 'mmap{' + format_form(ft_dom(fm)) + '} '
298 else om end +
299 format_form(ft_im(fm)),
300
301(f_lpmap): 'packed local ' +
302 case ft_mapc(fm) of
303 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
304 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') '
305 else om end +
306 format_form(ft_im(fm)),
307
308(f_limap, f_lrmap):
309 'local ' +
310 case ft_mapc(fm) of
311 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
312 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') '
313 else om end +
314 format_form(ft_im(fm)),
315
316(f_rpmap): 'packed remote ' +
317 case ft_mapc(fm) of
318 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
319 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') '
320 else om end +
321 format_form(ft_im(fm)),
322
323(f_rimap, f_rrmap):
324 'remote ' +
325 case ft_mapc(fm) of
326 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
327 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') '
328 else om end +
329 format_form(ft_im(fm)),
330
331(f_base): 'base(' + format_form(ft_elmt(fm)) + ')',
332
333(f_pbase): 'plex base',
334
335(f_uimap, f_urmap):
336 if ft_type(ft_dom(fm)) = f_elmt then
337 'sparse '
338 else
339 ''
340 end +
341 case ft_mapc(fm) of
342 (ft_map): 'map(' + format_form(ft_dom(fm)) + ') ',
343 (ft_smap): 'smap(' + format_form(ft_dom(fm)) + ') '
344 else om end +
345 format_form(ft_im(fm)),
346
347(f_error): 'error',
348
349(f_proc): 'procedure' +
350 if (n := #(t := ft_elmt(fm))) /= 0 then
351 '(' +/[ format_form(t(j)) +
352 if j = n-1 then '' else ', ' end :
353 j in [ 1..n-1 ] ] +
354 ') ' + format_form(t(n))
355 else
356 ''
357 end,
358
359(f_memb): 'member',
360
361(f_lab): 'label'
362
363 else
364 ' (error in format_form) '
365 end;
366
367
368 end procedure format_form;
369
370
371
372
373 procedure format_inst(i, aivs);
374$
375$ this routine attempts to re-build the source text corresponding to the
376$ instruction i. aivs, if given, is a tuple with the new arguments for
377$ the instruction.
378$
379 repr
380 i: elmt insts;
381 aivs: tuple(symbol);
382 opc: elmt base_opcodes;
smfc 673 a1, a2, a3: symbol;
smfc 674 name1, name2, name3: string;
smfc 675 pname1, pname2, pname3: string;
386 end repr;
387
388
389 opc := opcode(i);
390 assert opc in ops_ovar;
391 assert first_ivar(opc) = 2;
smfc 676 aivs := aivs ? args(i)(2..); [ a1, a2, a3 ] := aivs;
393
394 name1 := if #name(a1) > 2 and name(a1)(1) = 't' and
395 (name(a1)(2) = '.' or name(a1)(2) = '#') then
396 ''
397 else
398 name(a1)
399 end;
400 pname1 := if is_internal(a1) /= om then
401 '(' + name1 + ')'
402 else
403 name1
404 end;
405
406 if a2 /= om then
407 name2 := if #name(a2) > 2 and name(a2)(1) = 't' and
408 (name(a2)(2) = '.' or name(a2)(2) = '#') then
409 ''
410 else
411 name(a2)
412 end;
413 pname2 := if is_internal(a2) /= om then
414 '(' + name2 + ')'
415 else
416 name2
417 end;
418 else
419 name2 := pname2 := '***';
420 end if;
smfc 681
smfc 682 if a3 /= om then
smfc 683 name3 := if #name(a3) > 2 and name(a3)(1) = 't' and
smfc 684 (name(a3)(2) = '.' or name(a3)(2) = '#') then
smfc 685 ''
smfc 688 else
smfc 689 name(a3)
smfc 690 end;
smfc 691 pname3 := if is_internal(a3) /= om then
smfc 692 '(' + name3 + ')'
smfc 693 else
smfc 694 name3
smfc 695 end;
smfc 696 else
smfc 697 name3 := pname3 := '***';
smfc 698 end if;
421
422 return case opc of
423
424(q1_in): pname1 + ' in ' + pname2,
425(q1_notin): pname1 + ' notin ' + pname2,
426(q1_incs): pname1 + ' incs ' + pname2,
427(q1_eq): pname1 + ' = ' + pname2,
428(q1_ne): pname1 + ' /= ' + pname2,
429(q1_lt): pname1 + ' < ' + pname2,
smfh 48(q1_pos): pname1 + ' > ' + pname2,
430(q1_ge): pname1 + ' >= ' + pname2,
431
432(q1_add): pname1 + ' + ' + pname2,
433(q1_sub): pname1 + ' - ' + pname2,
434(q1_mult): pname1 + ' * ' + pname2,
435(q1_slash): pname1 + ' / ' + pname2,
436(q1_div): pname1 + ' div ' + pname2,
437(q1_mod): pname1 + ' mod ' + pname2,
438(q1_exp): pname1 + ' ** ' + pname2,
439(q1_atan2): pname1 + ' atan2 ' + pname2,
440(q1_max): pname1 + ' max ' + pname2,
441(q1_min): pname1 + ' min ' + pname2,
442(q1_npow): pname1 + ' npow ' + pname2,
443(q1_from): pname1 + ' from ' + pname2,
444(q1_fromb): pname1 + ' fromb ' + pname2,
445(q1_frome): pname1 + ' frome ' + pname2,
446(q1_with): pname1 + ' with ' + pname2,
447(q1_less): pname1 + ' less ' + pname2,
448(q1_lessb): pname2 + ' fromb ' + pname1,
449(q1_lesse): pname2 + ' frome ' + pname1,
450(q1_lessf): pname1 + ' lessf ' + pname2,
451
452(q1_not): 'not ' + pname1,
453(q1_even): 'even ' + pname1,
454(q1_odd): 'odd ' + pname1,
455(q1_isint): 'is_integer ' + pname1,
456(q1_isreal): 'is_real' + pname1,
457(q1_isstr): 'is_string ' + pname1,
458(q1_isbool): 'is_boolean ' + pname1,
459(q1_isatom): 'is_atom ' + pname1,
460(q1_istup): 'is_tuple ' + pname1,
461(q1_isset): 'is_set ' + pname1,
462(q1_ismap): 'is_map ' + pname1,
463
464(q1_arb): 'arb ' + pname1,
465(q1_arbb): ' fromb ' + pname1,
466(q1_arbe): ' frome ' + pname1,
467(q1_dom): 'domain ' + pname1,
468(q1_range): 'range ' + pname1,
469(q1_pow): 'pow ' + pname1,
470(q1_nelt): '# ' + pname1,
471(q1_abs): 'abs ' + pname1,
472(q1_char): 'char ' + pname1,
473(q1_ceil): 'ceil ' + pname1,
474(q1_floor): 'floor ' + pname1,
475(q1_fix): 'fix ' + pname1,
476(q1_float): 'float ' + pname1,
477(q1_sin): 'sin ' + pname1,
478(q1_cos): 'cos ' + pname1,
479(q1_tan): 'tan ' + pname1,
480(q1_arcsin): 'asin ' + pname1,
481(q1_arccos): 'acod ' + pname1,
482(q1_arctan): 'atan ' + pname1,
483(q1_tanh): 'tanh ' + pname1,
484(q1_expf): 'exp ' + pname1,
485(q1_log): 'log ' + pname1,
486(q1_sqrt): 'sqrt ' + pname1,
487(q1_sign): 'sign ' + pname1,
488(q1_type): 'type ' + pname1,
489(q1_str): 'str ' + pname1,
490(q1_val): 'val ' + pname1,
491(q1_umin): '-' + pname1,
492(q1_rand): 'random ' + pname1,
493
494(q1_newat): 'newat',
495(q1_time): 'time',
496(q1_date): 'date',
497(q1_na): 'nargs',
498
499(q1_set): '{ ' +
500 if #aivs >= 1 then name1 else '' end +
501 if #aivs >= 2 then ', ' + name2 else '' end +
502 if #aivs >= 3 then ', ...' else '' end +
503 ' }',
504
505(q1_set1): '{ ' + name1 + ' : }',
506
507(q1_tup): '[ ' +
508 if #aivs >= 1 then name1 else '' end +
509 if #aivs >= 2 then ', ' + name2 else '' end +
510 if #aivs >= 3 then ', ...' else '' end +
511 ' ]',
512
513(q1_tup1): '[ ' + name1 + ' : ]',
514
515(q1_inext, q1_next, q1_inextd, q1_nextd):
516 '',
517
518(q1_of): pname1 + '(' + name2 + ')',
519(q1_ofa): pname1 + '{' + name2 + '}',
smfc 699(q1_subst): pname1 + '(' + name2 + '..' + name3 + ')',
521(q1_end): pname1 + '(' + name2 + '..)',
522
smfc 700(q1_sof): pname3 + '(' + name1 + ')',
smfc 701(q1_sofa): pname3 + '{' + name1 + '}',
smfc 702(q1_ssubst): '(' + name1 + '..' + name2 + ')',
smfc 703(q1_send): pname3 + '(' + name1 + '..)',
527
528(q1_asn): name1,
529(q1_argin): name1
530
531else ''
532
533 end;
534
535
536 end procedure format_inst;
537
538
539
540
541 end module setl_optimizer - util;
542
543
1 .=member dmps17
2
3
4 module setl_optimizer - dumps;
5
6$ this module contains procedures to dump the q1 code and various
7$ graphs.
8
9 var
10 line, $ current line number in segment
11 outint; $ outermost interval of routine being dumped
12
13 var
14 all_bases; $ all bases in scope
15
16 const
17 line_size = 130, $ linesize of output file
18 lines_per_segment = 54; $ lines per segment
19
20 var
smfk 183 act_exposd, $ globals actually used in a scope before they
smfk 184 $ are defined by that member
smfk 185 act_reads, $ globals actually used by a member
25 act_writes, $ globals actually changed by a member
26 act_calls, $ routines actually called by a member
smfk 186 globals, $ maps each member to the globals it defines
smfk 187 routines, $ maps each member to the routines it defines
27 seen; $ member has been processed before
28
29 init
smfk 188 act_exposd := {}, act_reads := {}, act_writes := {},
smfk 189 act_calls := {}, globals := {}, routines := {},
smfk 190 seen := {};
33
34 repr
35 line: integer 0..lines_per_segment;
36 outint: elmt blocks;
37 all_bases: tuple(symbol);
38
39 symdmp: procedure(elmt base_scopes);
40 formdmp: procedure(elmt base_scopes);
41 codedmp: procedure(elmt base_scopes);
42 intdmp: procedure(elmt base_scopes);
43 dmp_int: procedure(elmt blocks, integer);
44
45 base members: elmt base_scopes;
46 mode member: elmt members;
47
48 globals: local mmap(member) symbol;
49 routines: local mmap(member) routine;
50
smfk 191 act_exposd: local mmap(member) symbol;
51 act_reads: local mmap(member) symbol;
52 act_writes: local mmap(member) symbol;
53 act_calls: local mmap(member) routine;
54
55 seen: local set(member);
56
57 print_dir_summary: procedure(elmt base_scopes, string);
58 print_memb_summary: procedure(elmt base_scopes, string);
59 print_member_interface: procedure(member, integer 0..65536);
60 print_proc_summary: procedure(routine);
61 print_decls: procedure(
62 elmt base_scopes,
63 integer 0..65536 );
64 print_reprs: procedure(
65 elmt base_scopes,
66 integer 0..65536 );
67 sort_by_name: procedure(tuple(symbol))
68 tuple(symbol);
69 sort_by_occs: procedure(tuple(occurrence))
70 tuple(occurrence);
71 end repr;
72
73
74 procedure dmp(scp, tables(*));
75$
76$ this is the main dump routine. its arguments are:
77$
78$ scp: name of scope to be dumped. if 'scope' is omega we dump
79$ all scopes.
80$
81$ tables: a tuple of strings giving the tables to be dumped.
82$
83 repr
84 scp: elmt base_scopes;
85 tables: tuple(string);
86 todo: tuple(elmt base_scopes);
87 t: string;
88 sc: elmt base_scopes;
89 end repr;
90
91 if scp = om then todo := scopes; else todo := [ scp ]; end if;
92
93 (forall t in tables)
94
95 case t of
96
97 ('symtab'): (forall sc in todo) symdmp(sc); end;
98 ('formtab'): (forall sc in todo) formdmp(sc); end;
99 ('codetab'): (forall sc in todo) codedmp(sc); end;
100 ('igraph'): (forall sc in todo) intdmp(sc); end;
101 end case;
102 end forall;
103
104 end procedure dmp;
105
106
107
108
109 procedure symdmp(sc);
110$
111$ this routine dumps the symbols of the scope sc.
112$
113$ assert if is_atom x then # str x <= 6 else true end;
114$
115 repr
116 sc: elmt base_scopes;
117 s: symbol;
118 t, undrs: string;
119 end repr;
120
121 title('symbol table dump for ' + name(sc));
122
123 undrs := line_size * '-';
124 line := lines_per_segment;
125
126 (for_sym(s, sc))
127 if line >= lines_per_segment then
128 print('s name form scope alias',
129 'tm in rd wr cn st sk pr rp in sn rc value' );
130 print(undrs);
131 print;
132 line := 3;
133 else
134 line +:= 1;
135 end if;
136
137 print(
138 rpad(str s, 6),
139 if #(t := name(s)) > 9 then t(1..9) else rpad(t, 9) end,
140 rpad(str form(s), 6),
141 rpad(str scope(s), 6),
142 rpad(str alias(s), 6),
143 if is_temp(s) = om then '- ' else '+ ' end,
144 if is_internal(s) = om then '- ' else '+ ' end,
145 if is_read(s) = om then '- ' else '+ ' end,
146 if is_write(s) = om then '- ' else '+ ' end,
147 if is_const(s) = om then '- ' else '+ ' end,
148 if is_store(s) = om then '- ' else '+ ' end,
149 if is_stk(s) = om then '- ' else '+ ' end,
150 if is_param(s) = om then '- ' else '+ ' end,
151 if is_repr(s) = om then '- ' else '+ ' end,
152 if is_init(s) = om then '- ' else '+ ' end,
153 if is_seen(s) = om then '- ' else '+ ' end,
154 if is_rec(s) = om then '- ' else '+ ' end,
155 if #(t:=str value(s)) > 52 then t(1..52) else t end
156 );
157
158 if line >= lines_per_segment then eject; end if;
159 end;
160
161 end procedure symdmp;
162
163
164
165
166 procedure formdmp(sc);
167$
168$ this routine dumps the forms of the scope sc.
169$
170$ assert if is_atom x then # str x <= 6 else true end;
171$ assert is_string ft_type(fm);
172$ assert # ft_type(fm) <= 9;
173$ assert if ft_mapc(fm) /= om then is_string ft_mapc(fm) else true end;
174$ assert if ft_mapc(fm) /= om then # ft_mapc(fm) <= 7 else true end;
175$
176 repr
177 sc: elmt base_scopes;
178 fm: elmt forms;
179 el: general;
180 t, undrs: string;
181 end repr;
182
183
184 title('form table dump for ' + name(sc));
185
186 undrs := line_size * '-';
187 line := lines_per_segment;
188
189 (for_form(fm, sc))
190 if line >= lines_per_segment then
191 print('form type mapc elmt dom im ',
192 'base lim tup hash nelt low pos num/elmt');
193 print(undrs);
194 print;
195 line := 3;
196 else
197 line +:= 1;
198 end if;
199
200 print(
201 rpad(str fm, 6),
202 rpad(ft_type(fm), 9),
203 if (t:=ft_mapc(fm)) = om then ' ' else rpad(t,7) end,
204
205 if is_atom (el:=ft_elmt(fm)) then
206 rpad(str el, 6)
207 else
208 ' '
209 end,
210
211 rpad(str ft_dom(fm), 6),
212 rpad(str ft_im(fm), 6),
213 rpad(str ft_base(fm), 6),
214 if #(t:=str ft_lim(fm)) > 6 then t(1..6) else rpad(t,6) end,
215 rpad(str ft_tup(fm), 6),
216 if ft_hashok(fm) = om then '- ' else '+ ' end,
217 if ft_neltok(fm) = om then '- ' else '+ ' end,
218 if #(t:=str ft_low(fm)) > 4 then t(1..4) else rpad(t,4) end,
219 if #(t:=str ft_pos(fm)) > 4 then t(1..4) else rpad(t,4) end,
220
221 if is_fbase(fm) then
222 if #(t:=str ft_num(fm)) > 42 then t(1..42) else t end
223 elseif not is_atom el then
224 if #(t:=str el) > 42 then t(1..42) else t end
225 else
226 rpad(str ft_deref(fm), 6)
227 end
228 );
229
230 if line >= lines_per_segment then eject; end if;
231 end;
232
233 end procedure formdmp;
234
235
236
237
238 procedure print_summary(todo);
239$
240$ this routine prints the summary for scopes todo. the summary contains
241$ a interface description and the representations chosen for all local
242$ variables. consequently, the information printed by print_symtab is
243$ properly contained in the information printed by print_summary.
244$
245 init
246 header := '';
247
248 repr
249 todo: sparse set(elmt base_scopes);
250 sc: elmt base_scopes;
251 header: string;
252 end repr;
253
254
255 (forall sc in scopes | sc in todo)
256
257 if sc_type(sc) /= sc_proc and header /= '' then
258 print;
259 print('end', header);
260 end if;
261
262 print;
263
264 case sc_type(sc) of
265
266 (sc_sys): $ system scope
267
268 print_reprs(sc, 1);
269
270 (sc_lib): $ library scope
271
272 header := 'library ' + name(sc) + ';';
273 print_memb_summary(sc, header);
274
275 (sc_dir): $ directory scope
276
277 header := 'directory ' + name(sc) + ';';
278 print_dir_summary(sc, header);
279
280 (sc_prog): $ program scope
281
282 header := 'program '+name(sym_dir)+' - '+name(sc)+';';
283 print_memb_summary(sc, header);
284
285 (sc_mod): $ module scope
286
287 header := 'module '+name(sym_dir)+' - '+name(sc)+';';
288 print_memb_summary(sc, header);
289
290 (sc_proc): $ procedure scope
291
292 print_proc_summary(sc);
293
294 end case;
295
296
297 end forall;
298
299 if header /= '' then
300 print;
301 print('end', header);
302 end if;
303
304
305 end procedure print_summary;
306
307
308
309
310 procedure print_dir_summary(sc, header);
311$
312$ this routine prints the summary for the directory d.
313$
314 repr
315 sc: elmt base_scopes;
316 header: string;
317
318 d, m: member;
319 p: routine;
320 v: symbol;
321 end repr;
322
323
324 print;
325 print(header);
326
327 d := sc;
328
329 (forall m in all_modules | m notin seen)
330 globals{m} := { v in globalvars |
331 v in uservars and scope(v) = m };
smfk 192 if m = d then continue forall; end if;
smfk 193
smfk 194 $ recall that value(m)(5) are the exported procedures of m.
smfk 195 routines{m} := { p in routs | membof(p) = m } + value(m)(5);
smfk 196 if sc_type(m) = sc_prog then routines{m} with:= sym_main; end;
333
smfk 197 act_exposd{m} := {}+/[ globals_e{p}: p in routines{m} ];
334 act_reads{m} := {}+/[ globals_r{p}: p in routines{m} ];
335 act_writes{m} := {}+/[ globals_w{p}: p in routines{m} ];
336 act_calls{m} := {}+/[ cgraph{p}: p in routines{m} ];
337
338 seen with:= m;
339 end forall;
340
smfk 198 act_exposd{d} := {} +/[ act_exposd{m} : m in all_modules ];
341 act_reads{d} := {} +/[ act_reads{m} : m in all_modules ];
342 act_writes{d} := {} +/[ act_writes{m} : m in all_modules ];
343 act_calls{d} := {} +/[ act_calls{m} : m in all_modules ];
344
345 seen with:= d;
346
347 print_decls(sc, 1);
348
349 print;
350 print(' program', name(sym_dir), '-', name(sym_prog) + ':');
351 print_member_interface(sym_prog, 2);
352
353 (forall m in scopes | sc_type(m) = sc_mod)
354 print;
355 print(' module', name(sym_dir), '-', name(m) + ':');
356 print_member_interface(m, 2);
357 end forall;
358
359 print_reprs(sc, 1);
360
361
362 end procedure print_dir_summary;
363
364
365
366
367 procedure print_memb_summary(sc, header);
368$
369$ this routine prints the summary for the member m, where m is not a
370$ directory.
371$
372 repr
373 sc: elmt base_scopes;
374 header: string;
375
376 m: member;
377 p: routine;
378 v: symbol;
379 end repr;
380
381
382 print;
383 print(header);
384
385 if (m := sc) notin seen then
386 globals{m} := { v in globalvars |
387 v in uservars and scope(v) = sc };
388 routines{m} := { p in routs | membof(p) = sc };
389
smfk 199 act_exposd{m} := {}+/[ globals_e{p}: p in routines{m} ];
390 act_reads{m} := {}+/[ globals_r{p}: p in routines{m} ];
391 act_writes{m} := {}+/[ globals_w{p}: p in routines{m} ];
392 act_calls{m} := {}+/[ cgraph{p}: p in routines{m} ];
393
394 seen with:= m;
395 end if;
396
smfk 200 if sym_dir notin seen then print_member_interface(m, 1); end if;
smfk 201
398 print_decls(m, 1);
399 print_reprs(m, 1);
400
401
402 end procedure print_memb_summary;
403
404
405
406
407 procedure print_member_interface(m, indent);
408$
409$ this routine prints the interface descriptions for member m.
410$
411 repr
412 m: member;
413 indent: integer 0..65536;
414
415 libs: sparse set(elmt base_scopes);
416 rds, rds_d, wrts_d: sparse set(symbol);
417 imps, exps: sparse set(routine);
418 l: elmt base_scopes;
419 t: tuple(symbol);
420 p, v: symbol;
421 j: integer 0..65536;
422 fill1, fill2: string;
423 end repr;
424
425
426 $ the value of a member is a quintuple, giving (in this order) the
427 $ libraries referenced, the globals read, the globals written, the
428 $ procedures imported, and the procedures exported.
429 [ libs, rds_d, wrts_d, imps, exps ] := value(m);
430
431 $ the imports list of a module is really the union of its declared
432 $ imports list and of all the procedure exported by the libraries
433 $ of its libraries list.
434 imps := imps +/[ value(l)(5) : l in libs ];
435
436
437 fill2 := (indent*4+3) * ' '; fill1 := fill2(5..#fill2);
438
439 if libs /= {} then $ print libraries list
440 print;
441 print(fill1, 'libraries');
442
443 t := sort_by_name( [ v : v in libs ] );
444
445 (forall v in t)
446 print(
447 fill2,
448 rpad(name(v) + if v = t(#t) then ';' else ',' end,
449 (39-indent*4) ),
450 if forall p in value(v)(5) |
451 p notin act_calls{m} then
smfk 202 '$ declared but not used.'
453 else
454 ''
455 end
456 );
457 end forall;
458 end if;
459
460
461 rds := rds_d + { v in act_reads{m} |
462 v notin globals{m} and is_param(v) = om };
463 if rds /= {} then $ print reads list
464 print;
465 print(fill1, 'reads');
466
467 t := sort_by_name( [ v : v in rds ]);
468
469 (forall v in t)
470 print(
471 fill2,
472 rpad(name(scope(v)) + '.' + name(v) +
473 if v = t(#t) then ';' else ',' end,
474 (39-indent*4) ),
475 if v notin act_reads{m} then
smfk 203 '$ declared but not used.'
smfk 204 elseif v notin act_exposd{m} then
smfk 205 '$ not used before its first definition.'
477 elseif v notin rds_d and v notin wrts_d then
478 '$ ===used but not declared==='
479 else
480 ''
481 end
482 );
483 end forall;
484 end if;
485
486
487 if wrts_d /= {} then $ print writes list
488 print;
489 print(fill1, 'writes');
490
491 t := sort_by_name( [ v : v in wrts_d ] );
492
493 (forall v in t)
494 print(
495 fill2,
496 rpad(name(scope(v)) + '.' + name(v) +
497 if v = t(#t) then ';' else ',' end,
498 (39-indent*4) ),
499 if v notin act_writes{m} then
500 if v in act_reads{m} then
smfk 206 '$ writes declared but only reads used.'
502 else
smfk 207 '$ declared but not used.'
504 end
505 else
506 ''
507 end
508 );
509 end forall;
510 end if;
511
512
513 if imps /= {} then $ print imports list
514 print;
515 print(fill1, 'imports');
516
517 t := sort_by_name( [ v : v in imps ] );
518
519 (forall p in t)
520 print(
521 fill2,
522 rpad(name(membof(p)) + '.' + name(p) +
523 '(' +/[ case name(rptyps(p)(j)) of
524 ('rd'): 'rd', ('wr'): 'wr', ('rw'): 'rw'
525 else om end +
526 if j = rnargs(p) then
527 if rvary(p) /= om then '(*)' else '' end
528 else
529 ', '
530 end : j in [ 1..rnargs(p) ] ] + ')' +
531 if p = t(#t) then ';' else ',' end,
532 (39-indent*4) ),
533 if p notin act_calls{m} then
smfk 208 '$ imported but not used.'
535 else
536 ''
537 end
538 );
539 end forall;
540 end if;
541
542
543 if exps /= {} then $ print exports list
544 print;
545 print(fill1, 'exports');
546
547 t := sort_by_name( [ v : v in exps ] );
548
549 (forall p in t)
550 print(
551 fill2,
552 name(p) +
553 '(' +/[ case name(rptyps(p)(j)) of
554 ('rd'): 'rd', ('wr'): 'wr', ('rw'): 'rw'
555 else om end +
556 if j = rnargs(p) then
557 if rvary(p) /= om then '(*)' else '' end
558 else
559 ', '
560 end : j in [ 1..rnargs(p) ] ] + ')' +
561 if p = t(#t) then ';' else ',' end
562 );
563 end forall;
564 end if;
565
566
567 end procedure print_member_interface;
568
569
570
571
572 procedure print_proc_summary(p);
573$
574$ this routine prints the summary for the procedure p.
575$
576 repr
577 p, q: routine;
578 t: tuple(symbol);
579 v: symbol;
580 o: tuple(occurrence);
581 dvo: occurrence;
582 j: integer 0..65536;
583 end repr;
584
585
586 print(' procedure', name(p) + ';');
587
smfk 209 if exists v in globals_e{p} | is_param(v) = om then
589 print;
590 print(' reads');
591
592 t := sort_by_name(
smfk 210 [ v : v in globals_e{p} | is_param(v) = om ] );
594
595 (forall v in t)
596 print(
597 ' ',
598 name(scope(v)) + '.' + name(v) +
599 if v = t(#t) then ';' else ',' end
600 );
601 end forall;
602 end if;
603
604
605 if exists v in globals_w{p} | is_param(v) = om then
606 print;
607 print(' writes');
608
609 t := sort_by_name(
610 [ v : v in globals_w{p} | is_param(v) = om ] );
611
612 (forall v in t)
613 print(
614 ' ',
615 name(scope(v)) + '.' + name(v) +
616 if v = t(#t) then ';' else ',' end
617 );
618 end forall;
619 end if;
620
621
622 if cgraph{p} /= {} then $ print imports list
623 print;
624 print(' imports');
625
626 t := sort_by_name( [ q : q in cgraph{p} ] );
627
628 (forall q in t)
629 print(
630 ' ',
631 name(membof(q)) + '.' + name(q) +
632 '(' +/[ case name(rptyps(q)(j)) of
633 ('rd'): 'rd', ('wr'): 'wr', ('rw'): 'rw'
634 else om end +
635 if j = rnargs(q) then
636 if rvary(q) /= om then '(*)' else '' end
637 else
638 ', '
639 end : j in [ 1..rnargs(q) ] ] + ')' +
640 if q = t(#t) then ';' else ',' end
641 );
642 end forall;
643 end if;
644
645
646 $ print the representations of the local variables
647 print_reprs(p, 2);
648
649
650 if globals_du{p} /= {} then
651 print;
652 o := sort_by_occs( [ dvo : dvo in globals_du{p} ] );
653
654 (forall dvo in o)
655 print(
656 ' ',
657 name(scope(oi_sym(dvo))) + '.' +
658 name(alias(oi_sym(dvo)) ? oi_sym(dvo)),
659 'is used destructively at', oi_stmt(dvo)
660 );
661 end forall;
662 end if;
663
664 print;
665 print(' end procedure', name(p) + ';');
666
667
668 end procedure print_proc_summary;
669
670
671
672
673 procedure print_decls(sc, indent);
674$
675$ this routine prints the global variables defined in scope sc together
676$ with their forms. sc is a static scope, i.e. a librar-, directory-,
677$ program-, or module scope.
678$
679 repr
680 sc: elmt base_scopes;
681 indent: integer 0..65536;
682
683 m: member;
684 t: tuple(symbol);
685 v: symbol;
686
687 fill1, fill2: string;
688 end repr;
689
690
691 if globals{m := sc} = {} then return; end if;
692
693 fill2 := (indent*4+3) * ' '; fill1 := fill2(5..#fill2);
694
695 print;
696 print(fill1, 'var');
697
698 t := sort_by_name( [ v : v in globals{m} ] );
699
700 (forall v in t)
701 print(
702 fill2,
703 rpad(name(v) +
704 if value(v) /= om then ' := ' + value(v) else '' end +
705 if v = t(#t) then ';' else ',' end, (39-indent*4)),
706 if v notin act_reads{m} and v notin act_writes{m} then
smfk 211 '$ declared but not used.'
708 else
709 ''
710 end
711 );
712 end forall;
713
714
715 end procedure print_decls;
716
717
718
719
720 procedure print_reprs(sc, indent);
721$
722$ this procedure prints the local variables of the scope sc together
723$ with their forms. the list is sorted alphabetically, and takes the
724$ form of a declaration.
725$
726 repr
727 sc: elmt base_scopes;
728 indent: integer 0..65536;
729
730 v: symbol;
731 t: tuple(symbol);
smfk 212 vo: occurrence;
732
733 fill1, fill2: string;
734 end repr;
735
736
737 all_bases := []; $ set of all bases
738
739 $ build a tuple with all variables of sc
740 t := [];
741 (for_sym(v, sc))
742 if is_fbase(form(v)) then
743 all_bases with:= v;
smff 154 elseif '(' in name(v) or '$' in name(v) then
745 pass; $ system internal name
746 elseif v = sym_main then
747 pass;
748 elseif v in variables and is_internal(v) = om then
smfk 213 if occsof{v} /= {}
smfk 214 and forall vo in occsof{v} | argno(vo) = 1
smfk 215 and oi_op(vo) = q1_asn
smfk 216 and arg2(instno(vo)) = sym_om
smfk 217 and ffrom{vo} = {}
smfk 218 then
smfk 219 continue;
smfk 220 end if;
749 t with:= v;
750 elseif v in routs then
751 t with:= v;
752 end if;
753 end; $ end for_sym
754
755 $ for program and module scopes, we repeat the declarations for
756 $ exported procedures. for library and directory scopes, these
757 $ symbols have already been added to t in the preceding loop.
758 if sc_type(sc) = sc_prog or sc_type(sc) = sc_mod then
759 $ (the value of a member is a quintuple, giving (in this order)
760 $ the libraries referenced, the globals read, the globals writ-
761 $ ten, the procedures imported, and the procedures exported.)
762 (forall v in value(sc)(5)) t with:= v; end forall;
763 end if;
764
765 if #all_bases = 0 and #t = 0 then return; end if;
766
767 fill2 := (indent*4+3) * ' '; fill1 := fill2(5..#fill2);
768 print;
769 print(fill1, 'repr');
770
771 (forall v in all_bases)
772 print(
773 fill2,
774 'base',
775 rpad(name(v) + ':', (18-indent*4)),
776 format_form(ft_elmt(form(v))) + ';'
777 );
778 end forall;
779
780 if #all_bases > 0 and #t > 0 then print; end if;
781
782 (forall v in sort_by_name(t))
783 print(
784 fill2,
785 rpad(name(v) + ':', (23-indent*4)),
786 format_form(form(v)) + ';'
787 );
788 end forall;
789
790 print(fill1, 'end repr;');
791
792
793 end procedure print_reprs;
794
795
796
797
798 procedure sort_by_name(t);
799$
800$ this function returns the tuple t of symbols sorted by the variable
801$ name of the symbol.
802$
803 repr
804 t: tuple(symbol);
805 sym: symbol;
806 j, k, m, n, l: integer 0..65536;
807 end repr;
808
809
810 macro before(l, r); $ defines partial order
811 ( name(t(l)) < name(t(r)) )
812 endm;
813
814
815 if #t = 0 then return t; end if; $ trivial case
816
817 $ sort the variables alphabetically, using heap sort
818 (init n := #t; j := n div 2; while j >= 1 step j -:= 1;)
819 (init k := j; while (l := k+k) <= n)
820 $ which child will be promoted ?
821 m := if l < n and before(l, l+1) then l+1 else l end;
822
823 $ will a child be promoted ?
824 if before(k, m) then
825 sym := t(k); t(k) := t(m); t(m) := sym; k := m;
826 else
827 quit init k;
828 end if;
829 end init k;
830 end init n;
831
832 (init j := n; while j > 1)
833 sym := t(j); t(j) := t(1); t(1) := sym; j -:= 1;
834 (init k := 1; while (l := k+k) <= j)
835 $ which child will be promoted ?
836 m := if l < j and before(l, l+1) then l+1 else l end;
837
838 $ will a child be promoted ?
839 if before(k, m) then
840 sym := t(k); t(k) := t(m); t(m) := sym; k := m;
841 else
842 quit init k;
843 end if;
844 end init k;
845 end init j;
846
847 return t;
848
849
850 end procedure sort_by_name;
851
852
853
854
855 procedure sort_by_occs(t);
856$
857$ this function returns the tuple t of occurrences sorted by the
858$ variable name and the statement number of the occurrence. aliased
859$ variables are grouped by their original name.
860$
861 repr
862 t: tuple(occurrence);
863 oi: occurrence;
864 j, k, m, n, l, r: integer 0..65536;
865 end repr;
866
867
868 macro before(l, r); $ defines partial order
869 ( ( name(alias(oi_sym(t(l))) ? oi_sym(t(l))) <
870 name(alias(oi_sym(t(r))) ? oi_sym(t(r))) )
871 or
872 ( ( name(alias(oi_sym(t(l))) ? oi_sym(t(l))) =
873 name(alias(oi_sym(t(r))) ? oi_sym(t(r))) )
874 and
875 ( stmtof(instno(t(l))) < stmtof(instno(t(r))) ) ) )
876 endm;
877
878
879 if #t = 0 then return t; end if; $ trivial case
880
881 $ sort the variables alphabetically, using heap sort
882 (init n := #t; j := n div 2; while j >= 1 step j -:= 1;)
883 (init k := j; while (l := k+k) <= n)
884 $ which child will be promoted ?
885 m := if l < n and before(l, l+1) then l+1 else l end;
886
887 $ will a child be promoted ?
888 if before(k, m) then
889 oi := t(k); t(k) := t(m); t(m) := oi; k := m;
890 else
891 quit init k;
892 end if;
893 end init k;
894 end init n;
895
896 (init j := n; while j > 1)
897 oi := t(j); t(j) := t(1); t(1) := oi; j -:= 1;
898 (init k := 1; while (l := k+k) <= j)
899 $ which child will be promoted ?
900 m := if l < j and before(l, l+1) then l+1 else l end;
901
902 $ will a child be promoted ?
903 if before(k, m) then
904 oi := t(k); t(k) := t(m); t(m) := oi; k := m;
905 else
906 quit init k;
907 end if;
908 end init k;
909 end init j;
910
911 return t;
912
913
914 end procedure sort_by_occs;
915
916
917
918
919 procedure codedmp(sc);
920$
921$ this routine dumps the code for the scope sc.
922$
923$ assert if is_atom x then # str x <= 6 else true end;
924$ assert is_string opcode(i);
925$ assert # opcode(i) <= 10;
926$ assert is_string copy_flag(i);
927$ assert # copy_flag(i) <= 9;
928$
929 repr
930 sc: elmt base_scopes;
931 b: elmt blocks;
932 i: elmt insts;
933 v: symbol;
934 t, undrs: string;
935 j1, j2: integer 0..65536;
936 cstmt_count: integer;
937 ustmt_count: integer;
938 end repr;
939
940 title('code table dump for ' + name(sc));
941
942 undrs := 80 * '-';
943 line := 0;
944
945 cstmt_count := ustmt_count := sc_estmt_ct(sc);
946
947 (for_block(b, sc))
948 print('routine:', rpad(name(routof(b)), 10),
949 ' interval:', rpad(str intof(b), 6),
950 ' block:', rpad(str b, 6),
951 ' statement:', cstmt_count-ustmt_count+1
952 );
953 print;
954 print('i opcode copy_flag shr arguments');
955 print(undrs);
956 line +:= 4;
957
958 (for_inst(i, b))
959 if opcode(i) = q1_stmt then
960 cstmt_count +:= 1;
961 t := rpad(str (cstmt_count-ustmt_count+1), 10) + ' ' +
962 rpad(str cstmt_count, 10) + ' ';
963 else
964 t := '' +/[ rpad(name(v), 10) + ' ' : v in args(i) ];
965 end if;
966
967 print(
968 rpad(str i, 6),
969 rpad(opcode(i), 10),
970 rpad(copy_flag(i) ? '', 9),
971 if share_flag(i) = om then ' ' else '+ ' end,
972 t(1..(48 min #t))
973 );
974
975 if line >= lines_per_segment then
976 eject;
977 print('i opcode copy_flag shr arguments');
978 print(undrs);
979 line := 2;
980 else
981 line +:= 1;
982 end if;
983
984 loop init j1 := 1; j2 := 48;
985 doing j1 +:= 48; j2 +:= 48;
986 while j1 <= #t
987 do
988 print(rpad('', 31), t(j1..(j2 min #t)));
989
990 if line >= lines_per_segment then
991 eject;
992 print('i opcode copy_flag shr arguments');
993 print(undrs);
994 line := 2;
995 else
996 line +:= 1;
997 end if;
998
999 end loop;
1000
1001 end; $ end for_inst;
1002
1003 if lines_per_segment - line <= 8 then
1004 eject;
1005 line := 0;
1006 else
1007 print; print;
1008 line +:= 2;
1009 end if;
1010
1011 end; $ end for_block;
1012
1013 end procedure codedmp;
1014
1015
1016
1017
1018 procedure intdmp(sc);
1019
1020$ this routine dumps the interval graph for scope 'sc'
1021
1022 repr
1023 sc: elmt base_scopes;
1024 end repr;
1025
1026 if sc notin routs then return; end if;
1027
1028 title('interval graph dump for ' + name(sc));
1029 line := lines_per_segment;
1030
1031$ walk the graph recursively starting with the entry point
1032 outint := rentry(sc);
1033 dmp_int(rentry(sc), 0);
1034
1035 end procedure intdmp;
1036
1037
1038
1039
1040 procedure dmp_int(i, indent);
1041$
1042$ this routine dumps the interval graph for the inteval i.
1043$
1044 repr
1045 i: elmt blocks;
1046 m, n: elmt blocks;
1047 t, undrs: string;
1048 j1, j2: integer 0..65536;
1049 end repr;
1050
1051 undrs := 80 * '-';
1052
1053 (forall n in int_nodes(i))
1054
1055 if line >= lines_per_segment then
1056 print('interval nodes cessors');
1057 print(undrs);
1058 line := 2;
1059 end if;
1060
1061 t := '' +/[ rpad(str m, 9) : m in cessor{n} |
1062 intof(m) /= n or n = outint ];
1063 print(
1064 lpad(rpad(str i, 8), ((indent+1) min 6)*9-1),
1065 rpad(str n, 6), ':',
1066 t(1..( (80 - ((indent+2) min 8)*9) min #t) )
1067 );
1068 line +:= 1;
1069
1070 if line >= lines_per_segment then
1071 eject;
1072 print('interval nodes cessors');
1073 print(undrs);
1074 line := 2;
1075 end if;
1076
smff 155 loop init j1 := 1;
smff 156 doing j1 +:= (80-((indent+2) min 8)*9);
1080 while j1 <= #t
1081 do
1082 print(
1083 rpad('', ((indent+2) min 8) * 9 - 1),
smff 157 t(j1..(j1 + (80-((indent+2) min 8)*9)) min #t)
1085 );
1086 line +:= 1;
1087
1088 if line >= lines_per_segment then
1089 eject;
1090 print('interval nodes cessors');
1091 print(undrs);
1092 line := 2;
1093 end if;
1094 end loop;
1095
1096 $ descend recursively
1097 if n /= outint and int_nodes(n) /= om then
1098 dmp_int(n, indent+1);
1099 end if;
1100
1101 end forall;
1102
1103 end procedure dmp_int;
1104
1105
1106 end module setl_optimizer - dumps;
1107
1108