OPT: SETL optimizer.
OPT: SETL optimizer. stlopt.opl
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 smfk 13 prog_level := 'opt(84180)'; 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)) 167 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; 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 smfi 72 errblk := {}, $ blocks with type_zero message. smfi 73 errstmt := {}, $ statements with type_zero message. 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 79 errblk: set(elmt blocks); smfi 80 errstmt: set(integer); 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 72$$--(forall o in all_o) 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 smfk 73 and oi_sym(vo1) in errvars smfk 74 and ( blockof(i) in errblk smfk 75 or stmtof(i) in errstmt ) 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 92 errblk with:= blockof(i); errstmt with:= stmtof(i); 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 257 errstmt with:= stmtof(i); errblk with:= blockof(i); 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 333 macro basedtup(eb); 334 [ grstup, eb, false, based ] 335 endm; 336 337 macro basedknt(c); 338 [ grstup, c, true, based ] 339 endm; 340 341 macro basedset(eb); 342 [ grsset, eb, om, based ] 343 endm; 344 345 macro basedmap(eb); 346 [ grsmap, eb, false, based ] 347 endm; 348 349 macro based_map(ebx, eby); 350 [ grsmap, based_pair(ebx, eby), om, based ] 351 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 ]; 53 tps := [ typ(i) : 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 125 if opc = q1_with then 126 $ ebz is the range set type for the multi-valued map 127 ebz := genabase(basedset(eby), [], []); 128 locspr_of(ebz) := sprse; 129 130 eb1 := genabase(based_map(ebx, ebz), [], []); 131 maptyp_of(eb1) := ft_mmap; 132 else $ opc = q1_less 133 eb1 := genabase(based_map(ebx, eby), [], []); 134 maptyp_of(eb1) := ft_map; 135 end if; 136 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. 143 if argsi(1) = argsi(2) then 144 locspr_of(eb1) := locl; 145 146 eb2 := eb1; 147 148 else 149 locspr_of(eb1) := remt; 150 151 eb2 := genabase(based_map(ebx, eby), [], []); 152 locspr_of(eb2) := remt; 153 maptyp_of(eb2) := ft_map; 154 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 168 eb1 := genabase(basedset(ebx), [], []); 169 locspr_of(eb1) := locl; 170 171 eb2 := eb1; 172 173 else 174 eb1 := genabase(basedset(ebx), [], []); 175 locspr_of(eb1) := remt; 176 177 eb2 := genabase(basedset(ebx), [], []); 178 locspr_of(eb2) := 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 ], []); 205 aux_repr(get_oi(ins, jbig)) := 206 genabase(basedknt(comps), [], []); 207 aux_repr(get_oi(ins, jsml)) := 208 genabase( 209 basedknt(comps(1..#comps-1)), 210 [], 211 [] ); 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 221 aux_repr(vo1) := genabase(basedtup(ebx),[],[]); 222 aux_repr(vo2) := genabase(basedtup(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 232 if grosstyp(typ2) = 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 238 eb1 := genabase( 239 basedknt( [ ebx : j in [ 1..#comps-1 ] ] ), 240 [], 241 [] ); 242 eb2 := genabase( 243 basedknt( [ ebx : j in [ 1..#comps ] ] ), 244 [], 245 [] ); 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, []); 253 eb1 := genabase(basedtup(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 264 if grosstyp(typ1) = grsmap and 265 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 271 eb1 := genabase(based_map(ebx, eby), [], []); 272 locspr_of(eb1) := locl; 273 maptyp_of(eb1) := ft_map; 274 275 eb2 := eb1; 276 277 else 278 eb1 := genabase(based_map(ebx, eby), [], []); 279 locspr_of(eb1) := remt; 280 maptyp_of(eb1) := ft_map; 281 282 eb2 := genabase(based_map(ebx, eby), [], []); 283 locspr_of(eb2) := remt; 284 maptyp_of(eb2) := 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 306 eb2 := genabase(based_map(ebx, eby), [], []); 307 locspr_of(eb2) := locl; 308 maptyp_of(eb2) := 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 340 aux_repr(vo2) := 341 genabase(basedknt(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) := 356 basedknt( [ 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; 365 aux_repr(vo2) := basedtup(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 392 eb1 := genabase(based_map(ebx, eby), [], []); 393 locspr_of(eb1) := locl; 394 maptyp_of(eb1) := 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 407 eb1 := genabase(based_map(ebx, eby), [], []); 408 locspr_of(eb1) := locl; 409 maptyp_of(eb1) := 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 439 eb1 := genabase(basedknt(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, []); 453 eb1 := genabase( 454 basedknt([ ebx : q in [ 1..#comps ] ]), 455 [], []); 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, []); 466 eb1 := genabase(basedtup(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 479 if grosstyp(typ2) = 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. 487 ebz := genabase(basedset(eby), [], [] ); 488 locspr_of(ebz) := sprse; 489 490 eb2 := genabase(based_map(ebx, ebz), [], []); 491 locspr_of(eb2) := locl; 492 maptyp_of(eb2) := 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 smfd 503 if grosstyp(typ1) = 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. smfd 511 ebz := genabase(basedset(eby), [], [] ); smfd 512 locspr_of(ebz) := sprse; smfd 513 smfd 514 eb1 := genabase(based_map(ebx, ebz), [], []); smfd 515 locspr_of(eb1) := locl; smfd 516 maptyp_of(eb1) := 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 smfd 529 eb1 := genabase(based_map(ebx, eby), [], []); smfd 530 locspr_of(eb1) := locl; smfd 531 maptyp_of(eb1) := 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 548 eb3 := genabase(basedset(ebx), [], []); 549 locspr_of(eb3) := 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 571 eb2 := genabase(based_pair(ebx, eby), [], []); 572 573 eb3 := genabase(based_map(ebx, eby), [], []); 574 locspr_of(eb3) := locl; 575 maptyp_of(eb3) := 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; 598 if grosstyp(typ1) = grsmap then 599 maptyp_of(eb1) := ft_smap; 600 end if; 601 602 else 603 if grosstyp(typ1) = grsset then 604 locspr_of(eb1) := sprse; 605 end if; 606 if grosstyp(typ1) = 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 633 eb1 := genabase(basedset(ebx), [], []); 634 locspr_of(eb1) := remt; 635 636 eb2 := genabase(basedset(ebx), [], []); 637 locspr_of(eb2) := remt; 638 639 eb3 := genabase(basedset(ebx), [], []); 640 locspr_of(eb3) := 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 656 ebz := genabase(basedset(eby), [], [] ); 657 locspr_of(ebz) := sprse; 658 659 eb1 := genabase(based_map(ebx, ebz), [], []); 660 locspr_of(eb1) := remt; 661 maptyp_of(eb1) := ft_mmap; 662 663 eb2 := genabase(based_map(ebx, eby), [], []); 664 locspr_of(eb2) := remt; 665 maptyp_of(eb2) := ft_map; 666 667 eb3 := genabase(based_map(ebx, eby), [], []); 668 locspr_of(eb3) := remt; 669 maptyp_of(eb3) := 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; 688 aux_repr(vo2) := 689 genabase(basedknt(bcomps2), [], []); 690 (forall tpc = comps3(j)) 691 bcomps3 with:= genabase(tpc, tup13, []); 692 end forall; 693 aux_repr(vo3) := 694 genabase(basedknt(bcomps3), [], []); 695 aux_repr(vo1) := 696 genabase(basedknt(bcomps2 + bcomps3), 697 [], []); 698 else 699 if (forall tpc = comps2(j) | 700 tpc = comptyp(typ3)) then 701 eb := genabase(comptyp(typ3), tup123, []); 702 aux_repr(vo1) := aux_repr(vo3) := 703 genabase(basedtup(eb), [], []); 704 aux_repr(vo2) := 705 genabase( basedknt( 706 [ eb : q in [1..#comps2] ]), 707 [], []); 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,[]); 716 aux_repr(vo1) := aux_repr(vo2) := 717 genabase(basedtup(eb), [], []); 718 aux_repr(vo3) := 719 genabase( basedknt( 720 [ eb : q in [1..#comps3] ]), 721 [], []); 722 end if; 723 else 724 if (tpc := comptyp(typ2)) = comptyp(typ3) then 725 eb := genabase(tpc, tup123, []); 726 aux_repr(vo1) := aux_repr(vo2) := 727 aux_repr(vo3) := 728 genabase(basedtup(eb), [], []); 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 750 eb3 := genabase(based_map(ebx, eby), [], []); 751 locspr_of(eb3) := sprse; 752 maptyp_of(eb3) := 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 764 eb3 := genabase( 765 basedknt([ ebx : q in [ 1..#comps ] ]), 766 [], 767 [] ); 768 769 aux_repr(vo3) := eb3; 770 end if; 771 else 772 ebx := genabase(comptyp(typ3), tup3, []); 773 aux_repr(vo3) := basedtup(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 786 eb3 := genabase(basedset(ebx), [], []); 787 locspr_of(eb3) := 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 797 eb3 := genabase(based_map(ebx, eby), [], []); 798 locspr_of(eb3) := sprse; 799 maptyp_of(eb3) := 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 811 eb3 := genabase( 812 basedknt([ ebx : q in [ 1..#comps ] ]), 813 [], 814 [] ); 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; 822 aux_repr(vo3) := basedtup(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 840 eb1 := genabase(basedset(ebx), [], []); 841 locspr_of(eb1) := 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. 852 ebz := genabase(basedset(eby), [], [] ); 853 locspr_of(ebz) := sprse; 854 855 eb1 := genabase(based_map(ebx, ebz), [], []); 856 locspr_of(eb1) := neutrl; 857 maptyp_of(eb1) := 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, []); 868 aux_repr(vo1) := basedtup(ebx); 869 aux_repr(vo2) := ebx; 870 871 872 (q1_dom): $ a1 := domain a2 873 874 if grosstyp(typ2) = grsmap then 875 ebx := genabase(domtyp(typ2), tup12, tup1); 876 eby := genabase(rangetyp(typ2), tup12, [] ); 877 878 eb1 := genabase(basedset(ebx), [], []); 879 locspr_of(eb1) := neutrl; 880 881 eb2 := genabase(based_map(ebx, eby), [], []); 882 locspr_of(eb2) := sprse; 883 maptyp_of(eb2) := ft_map; 884 885 aux_repr(vo1) := eb1; 886 aux_repr(vo2) := eb2; 887 end if; 888 889 (q1_range): $ a1 := range a2 890 891 if grosstyp(typ2) = grsmap then 892 ebx := genabase(domtyp(typ2), tup12, [] ); 893 eby := genabase(rangetyp(typ2), tup12, tup1); 894 895 eb1 := genabase(basedset(eby), [], []); 896 locspr_of(eb1) := neutrl; 897 898 eb2 := genabase(based_map(ebx, eby), [], []); 899 locspr_of(eb2) := sprse; 900 maptyp_of(eb2) := 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 915 eb2 := genabase(basedset(ebx), [], []); 916 locspr_of(eb2) := sprse; 917 918 eb3 := genabase(basedset(ebx), [], []); 919 locspr_of(eb3) := 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 929 eb2 := genabase(based_map(ebx, eby), [], []); 930 locspr_of(eb2) := sprse; 931 maptyp_of(eb2) := ft_map; 932 933 eb3 := genabase(based_map(ebx, eby), [], []); 934 locspr_of(eb3) := locl; 935 maptyp_of(eb3) := 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 951 eb2 := genabase(basedset(ebx), [], []); 952 locspr_of(eb2) := 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 962 eb1 := genabase(based_pair(ebx, eby), [], []); 963 964 eb2 := genabase(based_map(ebx, eby), [], []); 965 locspr_of(eb2) := sprse; 966 maptyp_of(eb2) := 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 976 if grosstyp(typ2) = 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 985 eb2 := genabase( 986 basedknt( [ ebx : j in [1..#comps2] ] ), 987 [], 988 [] ); 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; 998 aux_repr(vo2) := genabase(basedtup(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 1015 if grosstyp(typ1) = grstup then 1016 if #ivs = 2 then $ treat as homogeneous tuple 1017 1018 ebx := genabase(typ2, tup12, []); 1019 aux_repr(vo1) := genabase(basedtup(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 1033 aux_repr(vo1) := genabase(basedknt(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 1048 eb1 := genabase(basedset(ebx), [], []); 1049 locspr_of(eb1) := 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 1066 ebz := genabase(basedset(eby), [], []); 1067 locspr_of(ebz) := sprse; 1068 1069 eb1 := genabase(based_map(ebx, ebz), [], []); 1070 locspr_of(eb1) := neutrl; 1071 maptyp_of(eb1) := ft_mmap; 1072 1073 else 1074 eb1 := genabase(based_map(ebx, eby), [], []); 1075 locspr_of(eb1) := neutrl; 1076 maptyp_of(eb1) := ft_smap; 1077 end if; 1078 1079 aux_repr(vo1) := eb1; 1080 1081 eb2 := genabase(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 1101 if is_knt(typj) then 1102 comps := comptyp(typj); 1103 if (forall tpc = comps(j) | tpc = comptyp(typ1)) then 1104 eb := genabase(comptyp(typ1), tupj, []); 1105 aux_repr(vo1) := genabase(basedtup(eb), [], []); 1106 aux_repr(voj) := 1107 genabase( 1108 basedknt( [ eb : q in [ 1..#comps ] ] ), 1109 [], 1110 [] ); 1111 end if; 1112 else 1113 ebx := genabase(comptyp(typj), tupj, []); 1114 1115 aux_repr(vo1) := genabase(basedtup(ebx), [], []); 1116 aux_repr(voj) := genabase(basedtup(ebx), [], []); 1117 end if; 1118 end if; 1119 1120 1121 (q1_case): $ t := a1(a2); if t /= om then go to t; 1122 1123 if grosstyp(typ1) = grsmap and domtyp(typ1) = typ2 then 1124 ebx := genabase(typ2, tup12, tup1); 1125 eby := genabase(type_gen, tup1, [] ); 1126 1127 eb1 := genabase(based_map(ebx, eby), [], []); 1128 locspr_of(eb1) := remt; 1129 maptyp_of(eb1) := 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 129 print(' new root', root, 130 'with element mode', elmt_mode(root), 131 'has', nbases(root), 'descendents.' ); 132 print(' its scope is', bscp, 133 'and its user base is', ubase); 134 print(' its effective indicator is', 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 smfk 175 if is_const(v) = om and v /= sym_om 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 smfk 180 if is_const(v) = om and v /= sym_om 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