COMPILATION LISTING OF SEGMENT fort_converter Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 11/10/88 1343.9 mst Thu Options: optimize map 1 /****^ ****************************************************** 2* * * 3* * Copyright, (C) Honeywell Limited, 1983 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* ****************************************************** */ 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(86-07-14,BWong), approve(86-07-14,MCR7286), audit(86-07-17,Ginter), 14* install(86-07-28,MR12.0-1105): 15* Fix fortran bug 463. 16* END HISTORY COMMENTS */ 17 18 19 /* format: style3,^delnl,linecom */ 20 fort_converter: 21 proc (a_ptr); 22 23 /* Written: Oct 77 - May 78, GDC & PES */ 24 25 /* Modified: 26* 02 Aug 85, BW - 463: Removed code to set must_save_stack_extent. 27* The saving will no longer be done because of fortran_io_ 28* problems. 29* 25 Oct 84, HH - 444: Remove generation of 'sub_index' operators for 30* substring lengths. 31* 22 Jun 84, MM - Install typeless functions support. 32* 18 Aug 83, HH - 399: 'effectively_constant' doesn't free quads correctly. 33* 14 Aug 83, HH - 398: Leave loop index defined when removing implied loops 34* from I/O statements. 35* 27 Jul 83, HH - 392: Prevent replacement of named string constants by the 36* string value in 'opt_subscript_op's. 37* 17 Jun 83, HH - 383: Add support for 'process_param_list_op'. 38* 14 Apr 83, HH - 376: Move support of 'len' builtin to the code generator. 39* 31 Jan 83, HH - Install LA/VLA support. 40* 28 Nov 82, HH - 361: ASSIGNment of a format which the parser has made 41* into a named constant is not handled correctly. 42* 11 Nov 82, HH - 363: 'optimize_vector' used 'dimension.size (i)' even 43* when one of the bounds of that dimension was variable, and the 44* code to unthread the final opt statement neglected to link the 45* previous operator of the opt statement to the first operator. 46* Also, 'optimize_vector' forgot to remove calculation of the virtual 47* origin of an array that was to be written as a vector starting at 48* its first word. 49* 5 May 82, TO - Add runtime_stack_extent required for character*(*) function. 50* 25 Mar 82, TO - Fixed navy bug 3 - "end if" not processed by "process_hold_stack_entry" 51* if statement following does not have "put_in_map" set. Typically failed 52* if following statement was "else if" without code. 53* 16 Nov 81, MEP - Fixed bug 343, cat now looks at subrprog options.ansi_77 54* 28 October 1981, CRD - Support inquire statement. 55* 20 October 1981, CRD - Internal files. 56* 3 August 1981, CRD - Fix bug 332. 57* 28 July 1981, CRD - Change assign_label to replace format label with 58* associated format variable. 59* 13 July 1981, CRD - Force creation of back targets for zero trip DO loops. 60* 10 June 1981, CRD - New polish for backspace/endfile/rewind. 61* 12 May 1981, CRD - Add equiv_op, not_equiv_op. 62* 13 March 1981, CRD - Implement assumed size arrays. 63* 25 February 1981, CRD - Implement array lower bounds ^= 1. 64* 9 December 1980, CRD - Implement Fortran 77 block IF statement. 65* 19 November 1980, CRD - Implement Fortran 77 zero trip DO loops. Also fix 66* a bug in which star extent arrays only got a virtual_origin symbol 67* if they had variable extents. Also fix optimize_vector to handle 68* star extent arrays correctly. 69* 17 August 1980, CRD - Fix bug in subscript handling. 70* 14 August 1980, CRD - Fix bug in handling of CHAR builtin. 71* 29 July 1980, CRD - Change many calls to create_constant to 72* create_integer_constant instead. 73* 28 July 1980, CRD - Add code for LEN builtin. 74* 30 June 1980, MEP - Add code for substr'ing 75* 23 June 1980, CRD - Add code to compute must_save_stack_extent. 76* 23 June 1980, CRD - Check ansi77 mode for concatenation. 77* 18 June 1980, CRD - Change concatenation routines to generate sub_index 78* operators for the length. 79* 6 June 80, CRD - Changes for new concatenation representation in the quads. 80* 5 May 80, CRD - Rewrote compress_concat, fixing bugs. 81* 2 May 80, MEP+CRD - Fix bug 258. Changed new_free_object to use currentsize 82* builtin instead of size. 83* 1 May 80, CRD - Fix unreported bug (the main loop was not handling counts 84* properly.) 85* 31 Mar 80, MEP - Add code to recognize the sharing of virtual origins. 86* 18 Dec 79, PES - Change to accept (read write)_namelist_op rather than namelist_op, to fix 87* bug 249, in which the optimizer appears to ignore the fact that a namelist read sets 88* the values in the namelist. Also, make string_op an illegal input. 89* 17 Sept 79, RAB - change last_assigned_op from 97 to 99 for register optimizer 90* 13 Aug 79, RAB - change last_assigned_op from 95 to 97 in preparation for concatenation & substr 91* 12 Jul 79, PES - Make encode_op processing bump the ref_count of it's output operand 92* if it's an array ref node. Part of making encode/decode work as documented. 93* 26 Jun 79, PES - Fix bug 217, in which the appearance of a reference to an element of 94* a logical array in a compound if statement condition might cause compiler 95* error 446, uninitialized array subscript. 96* 21 Jun 79, RAB - Fix bug 216, in which the conversion rules are not properly obeyed 97* for ** in that the integer will be converted to match 98* the data type of . 99* 05 Feb 79, PES - Fix bug 201, in which incorrect code is generated when optimizing 100* for ** except when the positive 101* integer constant is a power of two, or one greater than a power of two. 102* 13 Dec 78, PES - Fix bug 199, in which implied do loops in i/o statements may 103* not optimize properly if there is more than one variable contained at a 104* given level of nesting. 105* 08 Dec 78, PES - Fix bug in handling of nested statement function invocations. 106* 25 Oct 78, PES - Changes for larger common blocks and arrays. 107* 04 Sep 78, PES - Fix bug in handling of division in subscripts, and 108* bug in handling of statement functions in subscripts. 109* 28 Jul 78, PES - Audit changes, fix bug in handling of character string 110* temporaries (167). 111**/ 112 113 /* In the comments, the construction stands for a single token which is described by 114* phrase; the construction <...> stands for an arbitrary number of stack entries of irrelevant nature; 115* braces {} are used to enclose a group which is repeated one or more times; 116* and the top of the stack is enclosed in parens--typically (<>) since the top of the stack is normally 117* the first unused item rather than the last used item. */ 118 119 120 /* arguments */ 121 122 dcl a_ptr ptr; 123 124 /* automatic */ 125 126 dcl ( 127 block_if_clause_count, 128 block_if_offset, 129 combination_type, 130 dim_size_offset, 131 eol_offset, 132 exit_offset, 133 first_free_object init (1), 134 hold_offset, 135 i, 136 j, 137 last_io_op, 138 last_op_index, 139 next_statement_index, 140 n_ops, 141 one, 142 op_index, 143 polish_offset, 144 rand_data_type (8), 145 rand_node_type (8), 146 save_polish_offset, 147 sf_num_args, 148 sf_offset, 149 sub_offset, 150 temp_index, 151 true_rand, 152 tkx, 153 virtual_origin_offset, 154 work_stack_offset, 155 zero 156 ) fixed bin (18); 157 158 dcl (subscript_processing, first_statement_function_done, suspend_subscript, 159 calls_local_entries, concatenates_star_extents) 160 bit (1) aligned init ("0"b); 161 162 dcl 1 sub_stack aligned based (sub_stack_p), 163 2 last fixed bin (18), 164 2 nested bit (1), 165 2 symbol_node ptr unaligned, 166 2 dim_node ptr unaligned, 167 2 n_dimensions fixed bin (18), 168 2 dimension fixed bin (18), 169 2 element, 170 3 constant fixed bin (18), 171 3 var fixed bin (18), 172 2 cum, 173 3 temp fixed bin (18), 174 3 constant fixed bin (18), 175 2 dim, 176 3 mult fixed bin (18), 177 3 temp fixed bin (18), 178 3 offset fixed bin (18); 179 180 dcl 1 sf_stack aligned based (sf_stack_p), 181 2 last fixed bin (18), 182 2 polish_offset fixed bin (18), 183 2 sf fixed bin (18), 184 2 current_arg fixed bin (18), 185 2 cur_sf_param fixed bin (18), 186 2 def_chain ptr unaligned, 187 2 num_args fixed bin (18), 188 2 arg_info (sf_num_args refer (sf_stack.num_args)), 189 3 operand fixed bin (18), 190 3 chain_start fixed bin (18), 191 3 chain_end fixed bin (18); 192 193 dcl 1 exit_stack aligned based (exit_stack_p), 194 2 last fixed bin (18), 195 2 op fixed bin (18), 196 2 count fixed bin (18), 197 2 do_label fixed bin (18), 198 2 xmit_at_this_level 199 fixed bin (18), 200 2 ptr ptr unaligned, 201 2 zero_trip_branch 202 fixed bin (18); 203 204 dcl 1 eol_stack aligned based (eol_stack_p), 205 2 last fixed bin (18), 206 2 op fixed bin (18), 207 2 work_stack_offset 208 fixed bin (18); 209 210 dcl 1 hold_stack aligned based (hold_stack_p), 211 2 last fixed bin (18), 212 2 op_code fixed bin (18), 213 2 ptr ptr unaligned; 214 215 dcl stack (0:511) fixed bin (18); 216 217 dcl 1 fort_data$builtin_name 218 aligned external static structure, 219 2 number_of_names fixed bin (15), 220 2 description (100), 221 3 name char (8) aligned, 222 3 generic_name bit (1) unaligned, 223 3 reserved bit (35) unaligned, 224 3 generic_func (4) fixed bin (18), 225 3 result_type fixed bin (18); 226 227 declare 1 virtual_origin_list 228 aligned based (virtual_origin_list_ptr), 229 2 last fixed binary (18), 230 2 symbol_node pointer unaligned, 231 2 element_size fixed binary (17), 232 2 numb_of_dims fixed binary (17), 233 2 units fixed binary (3) unsigned; 234 235 declare 1 block_if_stack aligned based (block_if_stack_p), 236 2 last fixed binary (18), 237 2 n_clauses fixed binary (18), 238 2 clause fixed binary (18), 239 2 test_op fixed binary (18), 240 2 n_jumps fixed binary (18), 241 2 jump (block_if_clause_count refer (block_if_stack.n_clauses)) fixed binary (18); 242 243 declare 1 dim_size_list aligned based (dim_size_list_ptr), 244 2 last fixed binary (18), 245 2 bits aligned, 246 3 var unaligned, 247 4 lower bit (1) unaligned, 248 4 upper bit (1) unaligned, 249 3 pad bit (34) unaligned, 250 2 lower_bound fixed binary (24), 251 2 upper_bound fixed binary (24), 252 2 size fixed binary (24); 253 254 dcl (array_ptr, block_if_stack_p, dim_size_list_ptr, eol_stack_p, 255 exit_stack_p, hold_stack_p, last_opt_statement, last_quad_p, opst, 256 r, s, sf_stack_p, sf_substitute_ptr, shared_struc_ptr, stm_ptr, 257 sub_stack_p, subp_ptr, temp_node_ptr, temp_ptr, virtual_origin_base, 258 virtual_origin_list_ptr) 259 ptr; 260 261 /* based */ 262 263 dcl p (0:polish_max_len - 1) fixed bin (18) aligned based (polish_base), 264 q (0:quad_max_len - 1) fixed bin (18) aligned based (quadruple_base), 265 w (0:object_max_len - 1) fixed bin (18) aligned based (object_base), 266 x (0:operand_max_len - 1) fixed bin (18) aligned based (operand_base); 267 268 dcl (polish_base, quadruple_base, object_base, operand_base) 269 ptr; 270 271 dcl (polish_max_len, quad_max_len, object_max_len, operand_max_len) 272 fixed bin (18); 273 274 /* builtin */ 275 276 dcl (addr, binary, bit, char, currentsize, fixed, hbound, index, max, null, ptr, rel, size, string, substr, unspec) 277 builtin; 278 279 /* include files */ 280 1 1 /* BEGIN fort_utilities.incl.pl1 */ 1 2 1 3 /* Created: October 1977, Richard Barnes 1 4* 1 5* Modified: 1 6* 22 May 1978, DSL - add create_constant. 1 7* 09 Oct 1978, PES - make create_(constant node) return fixed bin(18) unsigned. 1 8* 13 Dec 1978, PES - Get create_node from include file, rather than copy. 1 9**/ 1 10 2 1 /* BEGIN fort_create_node.incl.pl1 */ 2 2 2 3 /* Created: October 1977, Richard Barnes 2 4* 2 5* Modified: 2 6* 22 May 1978, DSL - add create_constant. 2 7* 09 Oct 1978, PES - make create_(constant node) return fixed bin(18) unsigned. 2 8* 13 Dec 1978, PES - changes for large common and arrays. 2 9**/ 2 10 create_node: proc(type,length) returns(fixed bin (18)); 2 11 2 12 dcl length fixed bin; 2 13 dcl offset fixed bin(18); 2 14 dcl type fixed bin(4); 2 15 dcl storage(length) fixed bin aligned based; 2 16 dcl x(0:operand_max_len-1) fixed bin(35) aligned based(operand_base); 2 17 dcl (addr,char,ltrim,unspec) builtin; 2 18 2 19 2 20 if (length + next_free_operand) < operand_max_len 2 21 then do; 2 22 offset = next_free_operand; 2 23 next_free_operand = next_free_operand + length; 2 24 unspec(addr(x(offset)) -> storage) = "0"b; 2 25 addr(x(offset)) -> node.node_type = type; 2 26 return(offset); 2 27 end; 2 28 else do; 2 29 call print_message(407, "operand region", ltrim(char(operand_max_len))); /* FATAL */ 2 30 end; 2 31 2 32 end create_node; 2 33 2 34 /* END fort_create_node.incl.pl1 */ 1 11 1 12 1 13 create_constant: proc(data_type,value) returns(fixed bin (18)); 1 14 1 15 dcl (data_type,a_data_type) fixed bin(4); /* data type of constant */ 1 16 dcl (value,a_value) bit(72) aligned; /* value of constant */ 1 17 1 18 dcl addr builtin; 1 19 dcl binary builtin; 1 20 dcl bool builtin; 1 21 dcl char builtin; 1 22 dcl data_size fixed bin(17); 1 23 dcl decimal builtin; 1 24 dcl hash_index fixed bin; 1 25 dcl hash_table(0:hash_table_size-1) fixed bin(35) aligned based(operand_base); 1 26 dcl hash_table_size fixed bin int static options(constant) init(211); 1 27 dcl hbound builtin; 1 28 dcl ltrim builtin; 1 29 dcl mod builtin; 1 30 dcl mod_2_sum bit(36) aligned; 1 31 dcl node_offset fixed bin; 1 32 dcl node_ptr pointer; 1 33 dcl size builtin; 1 34 dcl v_array(2) bit(36) aligned based(addr(a_value)); 1 35 dcl x(0:operand_max_len-1) fixed bin(35) aligned based(operand_base); 1 36 3 1 /* BEGIN INCLUDE FILE relocation_bits.incl.pl1 */ 3 2 3 3 /* This include file defines the relocation bits as bit (6) entities. See 3 4* also relbts.incl.pl1 and reloc_lower.incl.pl1. */ 3 5 3 6 dcl ( rc_a initial("000000"b), /* absolute */ 3 7 rc_t initial("010000"b), /* text */ 3 8 rc_nt initial("010001"b), /* negative text */ 3 9 rc_lp18 initial("010010"b), /* linkage, 18 bit */ 3 10 rc_nlp18 initial("010011"b), /* negative link, 18 bit */ 3 11 rc_lp15 initial("010100"b), /* linkage, 15 bit */ 3 12 rc_dp initial("010101"b), /* def section */ 3 13 rc_s initial("010110"b), /* symbol segment */ 3 14 rc_ns initial("010111"b), /* negative symbol */ 3 15 rc_is18 initial("011000"b), /* internal static 18 */ 3 16 rc_is15 initial("011001"b), /* internal static 15 */ 3 17 rc_lb initial("011000"b), /* link block */ 3 18 rc_nlb initial("011001"b), /* negative link block */ 3 19 rc_sr initial("011010"b), /* self relative */ 3 20 rc_e initial("011111"b)) /* escape */ 3 21 bit(6) int static options(constant); 3 22 3 23 /* END INCLUDE FILE relocation_bits.incl.pl1 */ 1 37 1 38 1 39 1 40 a_data_type = data_type; 1 41 a_value = value; 1 42 1 43 if a_data_type = char_mode | a_data_type <= 0 | a_data_type > hbound(data_type_size,1) 1 44 then do; 1 45 call print_message(452, ltrim(char(decimal(a_data_type,12)))); /* cannot create the node */ 1 46 end; 1 47 else data_size = data_type_size(a_data_type); 1 48 1 49 if data_size = 1 1 50 then do; 1 51 mod_2_sum = v_array(1); 1 52 v_array(2) = "0"b; 1 53 end; 1 54 else mod_2_sum = bool(v_array(1),v_array(2),"0110"b); 1 55 1 56 1 57 hash_index = mod(binary(mod_2_sum,35),hash_table_size); 1 58 1 59 /* Search the hash table for the constant. */ 1 60 1 61 node_offset = hash_table(hash_index); 1 62 do while(node_offset > 0); /* search the entire bucket */ 1 63 node_ptr = addr(x(node_offset)); 1 64 1 65 if node_ptr -> constant.value = a_value /* must be same value */ 1 66 then if node_ptr -> node.data_type = a_data_type /* and same data type */ 1 67 then return(node_offset); 1 68 1 69 node_offset = node_ptr -> node.hash_chain; /* NB - pointer remains pointing at last item in bucket */ 1 70 end; 1 71 1 72 /* a new constant node must be created */ 1 73 1 74 node_offset = create_node(constant_node, size(constant)); 1 75 1 76 if hash_table(hash_index) = 0 /* Is this the first item in the bucket? */ 1 77 then hash_table(hash_index) = node_offset; /* yes */ 1 78 else node_ptr -> node.hash_chain = node_offset; /* no, add it to the end */ 1 79 1 80 node_ptr = addr(x(node_offset)); 1 81 node_ptr -> constant.data_type = a_data_type; 1 82 node_ptr -> constant.operand_type = constant_type; 1 83 node_ptr -> constant.is_addressable = "1"b; 1 84 node_ptr -> constant.reloc = rc_t; 1 85 node_ptr -> constant.value = a_value; 1 86 1 87 constant_info(data_size).constant_count = constant_info(data_size).constant_count + 1; 1 88 1 89 if constant_info(data_size).first_constant = 0 /* Is this the first item of this size? */ 1 90 then constant_info(data_size).first_constant = node_offset; /* yes */ 1 91 else addr(x(constant_info(data_size).last_constant)) -> constant.next_constant = node_offset; /* no, add it */ 1 92 1 93 constant_info(data_size).last_constant = node_offset; 1 94 1 95 return(node_offset); 1 96 1 97 end create_constant; 1 98 1 99 /* END fort_utilities.incl.pl1 */ 281 282 4 1 /* BEGIN fort_nodes.incl.pl1 */ 4 2 4 3 4 4 4 5 /****^ HISTORY COMMENTS: 4 6* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 4 7* install(86-07-28,MR12.0-1105): 4 8* Fix fortran bug 473. 4 9* 2) change(88-04-28,RWaters), approve(88-04-28,MCR7875), audit(88-07-13,Huen), 4 10* install(88-11-10,MR12.2-1209): 4 11* Implement SCP 6339: Allow character variable to be up to 128K-1 (131071) 4 12* character long. 4 13* END HISTORY COMMENTS */ 4 14 4 15 4 16 /* Written: June 1976 by David Levin and Richard Barnes 4 17* 4 18*Modified: 4 19* Feb 24 1977 by G. Chang for the optimizer 4 20* Sept 12, 1977 by R. Barnes for the loop optimizer 4 21* Nov 16, 1977 by D. Levin to add machine state node for loop optimizer 4 22* Oct 09 1978 by P Smee for larger common and arrays. 4 23* Dec 05 1978 by P Smee for %options statement. 4 24* Jan 17 1979 by R Barnes for machine_state.value_in_xr 4 25* May 23 1979 by P Smee to add source.line_number 4 26* July 19 1979 by R Barnes for char mode changes 4 27* Sept 17 1979 by R Barnes for register optimizer changes 4 28* Oct 3 1979 by C R Davis for new EAQ management scheme. 4 29* 29 Oct 1979 by C R Davis for machine_state.eaq.reserved. 4 30* 3 Nov 1979 by R. Barnes for pointer node and to change 4 31* machine_state.next from a fixed bin to a pointer. 4 32* 18 Dec 1979 by R. Barnes for loop_ref_count to finalize 4 33* changes for the register optimizer. 4 34* 17 Dec 1979 by C R Davis for symbol.descriptor 4 35* 22 Dec 1979 by R. Barnes to remove in_list. 4 36* 22 Jan 1980 by P E Smee to try for long char arrays. 4 37* 23 Jan 1980 by C R Davis to fix bugs with yesterday's changes. 4 38* 4 Mar 1980 by C R Davis to rename node.multi_position to 4 39* node.stack_indirect, and to add machine_state.stack_extended 4 40* and machine_state.last_dynamic_temp. 4 41* 5 Jun 1980 by M E Presser to alter arg_desc node for use 4 42* in stack-extensions and arg-descriptor generation. 4 43* 16 July 1980 by C R Davis for symbol.variable_arglist. 4 44* 8 Jan 81 by M E Presser for label.not_referencable 4 45* 17 Feb 1981 by C R Davis for new dimension node layout. 4 46* 11 March 1981 by MEP for dimension.assumed_size 4 47* 3 May 1982 by TO to add star_extent_function to subprogram node. 4 48* Mod 1 25 August 1982 by TO to add VLA_chain and LA_chain to subprogram node. 4 49* Mod 1 2 September 1982 by TO to add 5 more entries to storage_info in 4 50* the subprogram node (13-17), and to add VLA and LA bits to the 4 51* symbol node. 4 52* Mod 1 2 September 1982 by TO move fields around in nodes to get correct 4 53* 24 (really 35) bit fields and still maintain mapping between 4 54* node, temporary, and array_ref (others limit to word 6 like node.) 4 55* 19 Jun 83, HH - 145: Add 'branched_to', 'ends_do_loop' & 'loop_end' 4 56* to 'label' node. 4 57* 19 Feb 86, BW & AG - 473.a: Add 'VLA' to 'arg_desc' node. 4 58*END Modifications */ 4 59 4 60 4 61 /* GENERAL NODE TEMPLATE */ 4 62 4 63 dcl 1 node aligned based structure, 4 64 4 65 /* WORD 1 */ 4 66 4 67 2 node_type fixed bin (4) unaligned, 4 68 2 data_type fixed bin (4) unaligned unsigned, 4 69 2 operand_type fixed bin (4) unaligned, 4 70 4 71 2 addressing_bits unaligned structure, 4 72 3 is_addressable bit (1), 4 73 3 value_in, 4 74 4 eaq bit (1), 4 75 4 x bit (1), 4 76 3 allocated bit (1), 4 77 3 needs_pointer bit (1), 4 78 3 stack_indirect bit (1), 4 79 3 large_address bit (1), 4 80 3 address_in_base bit (1), 4 81 3 dont_update bit (1), /* for optimizer */ 4 82 3 not_in_storage bit (1), /* for optimizer */ 4 83 3 globally_assigned bit (1), /* for optimizer */ 4 84 4 85 2 bits unaligned structure, 4 86 3 standard_bits, 4 87 4 allocate bit (1), 4 88 4 set bit (1), 4 89 4 referenced bit (1), 4 90 4 passed_as_arg bit (1), 4 91 4 92 3 fill bit (7), /* These bits may be used by individual nodes. */ 4 93 4 94 /* WORD 2 */ 4 95 4 96 2 address aligned structure, 4 97 3 base bit (3) unaligned, /* For labels and constants, base and offset are */ 4 98 3 offset fixed bin (14) unaligned, /* combined to: fixed bin (18) unsigned unaligned. */ 4 99 3 char_num fixed bin (2) unaligned unsigned, 4 100 3 bit_num fixed bin (4) unaligned unsigned, 4 101 3 fill bit (4) unaligned, 4 102 3 inhibit bit (1) unaligned, 4 103 3 ext_base bit (1) unaligned, 4 104 3 tag bit (6) unaligned, 4 105 4 106 /* WORD 3 */ 4 107 4 108 2 units fixed bin (3) unaligned unsigned, 4 109 2 fill bit (3) unaligned, /* already used in symbol node */ 4 110 2 reloc_hold bit (6) unaligned, 4 111 2 reloc bit (6) unaligned, 4 112 2 addr_hold bit (18) unaligned, 4 113 4 114 /* WORD 4. Must not change for constant, char_constant, header, label, or symbol nodes. */ 4 115 4 116 2 next fixed bin (18) unsigned unaligned, 4 117 2 hash_chain fixed bin (18) unsigned unaligned, /* No hash chain for header nodes. */ 4 118 4 119 /* WORD 5 */ 4 120 4 121 2 pad fixed bin (18) unsigned unaligned, 4 122 2 loop_ref_count fixed bin (17) unaligned, /* Only for symbols and temporaries. */ 4 123 4 124 /* WORD 6 */ 4 125 4 126 2 location fixed bin (24) aligned; /* Only for array refs, symbols, temporaries, and headers. */ 4 127 4 128 /* ARG DESCRIPTOR NODE */ 4 129 4 130 dcl 1 arg_desc based aligned, 4 131 4 132 /* WORD 1 */ 4 133 4 134 2 node_type fixed bin (4) unaligned, 4 135 2 n_args fixed bin (12) unaligned, 4 136 2 pad bit (18) unaligned, 4 137 4 138 /* WORDS 2 - N_ARGS + 1 */ 4 139 4 140 2 arg(num_args refer(n_args)) aligned, 4 141 3 data_type fixed bin (4) unaligned unsigned, 4 142 3 must_be unaligned, 4 143 4 array bit (1) unaligned, 4 144 4 scalar bit (1) unaligned, 4 145 4 VLA bit (1) unaligned, 4 146 3 star_extents bit (1) unaligned, 4 147 3 pad bit (9) unaligned, 4 148 3 symbol fixed bin (18) unaligned; 4 149 4 150 dcl num_args fixed bin; 4 151 4 152 4 153 /* ARRAY REF NODE -- Must be same size as TEMPORARY NODE. */ 4 154 4 155 dcl 1 array_ref aligned based structure, 4 156 4 157 /* WORD 1 */ 4 158 4 159 2 node_type fixed bin (4) unaligned, 4 160 2 data_type fixed bin (4) unaligned unsigned, 4 161 2 operand_type fixed bin (4) unaligned, 4 162 4 163 2 addressing_bits unaligned structure, 4 164 3 is_addressable bit (1), 4 165 3 value_in, 4 166 4 eaq bit (1), 4 167 4 x bit (1), 4 168 3 allocated bit (1), 4 169 3 needs_pointer bit (1), 4 170 3 stack_indirect bit (1), 4 171 3 large_address bit (1), 4 172 3 address_in_base bit (1), 4 173 3 dont_update bit (1), /* for optimizer */ 4 174 3 not_in_storage bit (1), /* for optimizer */ 4 175 3 globally_assigned bit (1), /* for optimizer */ 4 176 4 177 2 bits unaligned structure, 4 178 3 standard_bits, 4 179 4 allocate bit (1), 4 180 4 set bit (1), 4 181 4 referenced bit (1), 4 182 4 passed_as_arg bit (1), 4 183 4 184 3 variable_length bit (1), 4 185 4 186 3 variable_offset bit (1), 4 187 4 188 3 invariant bit (1), /* must line up with temporary node */ 4 189 3 irreducible bit (1), /* .. */ 4 190 3 used_across_loops bit (1), /* .. */ 4 191 4 192 3 large_offset bit (1), 4 193 4 194 3 has_address bit (1), 4 195 4 196 /* WORD 2 */ 4 197 4 198 2 address aligned structure, 4 199 3 base bit (3) unaligned, 4 200 3 offset fixed bin (14) unaligned, 4 201 3 char_num fixed bin (2) unaligned unsigned, 4 202 3 bit_num fixed bin (4) unaligned unsigned, 4 203 3 fill bit (4) unaligned, 4 204 3 inhibit bit (1) unaligned, 4 205 3 ext_base bit (1) unaligned, 4 206 3 tag bit (6) unaligned, 4 207 4 208 /* WORD 3 */ 4 209 4 210 2 units fixed bin (3) unaligned unsigned, 4 211 2 fill bit (3) unaligned, 4 212 2 reloc_hold bit (6) unaligned, 4 213 2 reloc bit (6) unaligned, 4 214 2 addr_hold bit (18) unaligned, 4 215 4 216 /* WORD 4 */ 4 217 4 218 2 next fixed bin (18) unsigned unaligned, 4 219 2 loop_end_fu_pos fixed bin (17) unaligned, /* must overlay temporary.loop_end_fu_pos */ 4 220 4 221 /* WORD 5 */ 4 222 4 223 2 pad fixed bin (18) unsigned unaligned, 4 224 2 v_offset fixed bin (18) unsigned unaligned, 4 225 4 226 /* WORD 6 */ 4 227 4 228 2 location fixed bin (24) aligned, 4 229 4 230 /* WORD 7 */ 4 231 4 232 2 ref_count fixed bin (17) unaligned, /* must overlay temporary.ref_count */ 4 233 2 output_by fixed bin (18) unsigned unal, /* must overlay temporary.output_by */ 4 234 4 235 /* WORD 8 */ 4 236 4 237 2 length fixed bin (24) aligned, 4 238 4 239 /* WORD 9 */ 4 240 4 241 2 start_input_to fixed bin (18) unsigned unal, /* must overlay temporary.start_input_to */ 4 242 2 end_input_to fixed bin (18) unsigned unal, /* must overlay temporary.end_input_to */ 4 243 4 244 /* WORD 10 */ 4 245 4 246 2 ref_count_copy fixed bin (17) unaligned, /* must overlay temporary.ref_count_copy */ 4 247 2 parent fixed bin (18) unsigned unaligned, 4 248 4 249 /* WORD 11 */ 4 250 4 251 2 unused fixed bin (24) aligned; /* Pad to size of 'temporary'. */ 4 252 4 253 4 254 /* CONSTANT NODE */ 4 255 4 256 dcl 1 constant aligned based structure, 4 257 4 258 /* WORD 1 */ 4 259 4 260 2 node_type fixed bin (4) unaligned, 4 261 2 data_type fixed bin (4) unaligned unsigned, 4 262 2 operand_type fixed bin (4) unaligned, 4 263 4 264 2 addressing_bits unaligned structure, 4 265 3 is_addressable bit (1), 4 266 3 value_in, 4 267 4 eaq bit (1), 4 268 4 x bit (1), 4 269 3 allocated bit (1), 4 270 3 needs_pointer bit (1), 4 271 3 stack_indirect bit (1), 4 272 3 large_address bit (1), 4 273 3 address_in_base bit (1), 4 274 3 dont_update bit (1), /* for optimizer */ 4 275 3 not_in_storage bit (1), /* for optimizer */ 4 276 3 globally_assigned bit (1), /* for optimizer */ 4 277 4 278 2 bits unaligned structure, 4 279 3 standard_bits, 4 280 4 allocate bit (1), 4 281 4 set bit (1), 4 282 4 referenced bit (1), 4 283 4 passed_as_arg bit (1), 4 284 4 285 3 fill bit (7), 4 286 4 287 /* WORD 2 */ 4 288 4 289 2 address aligned structure, 4 290 3 location fixed bin (18) unsigned unaligned, 4 291 3 op bit (10) unaligned, 4 292 3 inhibit bit (1) unaligned, 4 293 3 ext_base bit (1) unaligned, 4 294 3 tag bit (6) unaligned, 4 295 4 296 /* WORD 3 */ 4 297 4 298 2 units fixed bin (3) unaligned unsigned, 4 299 2 fill bit (3) unaligned, 4 300 2 reloc_hold bit (6) unaligned, 4 301 2 reloc bit (6) unaligned, 4 302 2 addr_hold bit (18) unaligned, 4 303 4 304 /* WORD 4 */ 4 305 4 306 2 next_constant fixed bin (18) unsigned unaligned, 4 307 2 hash_chain fixed bin (18) unsigned unaligned, 4 308 4 309 /* WORDS 5 & 6 */ 4 310 4 311 2 value bit (72) aligned; 4 312 4 313 4 314 /* CHARACTER CONSTANT NODE */ 4 315 4 316 dcl 1 char_constant aligned based structure, 4 317 4 318 /* WORD 1 */ 4 319 4 320 2 node_type fixed bin (4) unaligned, 4 321 2 data_type fixed bin (4) unaligned unsigned, 4 322 2 operand_type fixed bin (4) unaligned, 4 323 4 324 2 addressing_bits unaligned structure, 4 325 3 is_addressable bit (1), 4 326 3 value_in, 4 327 4 eaq bit (1), 4 328 4 x bit (1), 4 329 3 allocated bit (1), 4 330 3 needs_pointer bit (1), 4 331 3 stack_indirect bit (1), 4 332 3 large_address bit (1), 4 333 3 address_in_base bit (1), 4 334 3 dont_update bit (1), /* for optimizer */ 4 335 3 not_in_storage bit (1), /* for optimizer */ 4 336 3 globally_assigned bit (1), /* for optimizer */ 4 337 4 338 2 bits unaligned structure, 4 339 3 standard_bits, 4 340 4 allocate bit (1), 4 341 4 set bit (1), 4 342 4 referenced bit (1), 4 343 4 passed_as_arg bit (1), 4 344 4 345 3 no_value_stored bit (1), 4 346 4 347 3 fill bit (6), 4 348 4 349 /* WORD 2 */ 4 350 4 351 2 address aligned structure, 4 352 3 location fixed bin (18) unsigned unaligned, 4 353 3 char_num fixed bin (2) unaligned unsigned, 4 354 3 bit_num fixed bin (4) unaligned unsigned, 4 355 3 fill bit (4) unaligned, 4 356 3 inhibit bit (1) unaligned, 4 357 3 ext_base bit (1) unaligned, 4 358 3 tag bit (6) unaligned, 4 359 4 360 /* WORD 3 */ 4 361 4 362 2 units fixed bin (3) unaligned unsigned, 4 363 2 fill bit (3) unaligned, 4 364 2 reloc_hold bit (6) unaligned, 4 365 2 reloc bit (6) unaligned, 4 366 2 addr_hold bit (18) unaligned, 4 367 4 368 /* WORD 4 */ 4 369 4 370 2 next_constant fixed bin (18) unsigned unaligned, 4 371 2 hash_chain fixed bin (18) unsigned unaligned, 4 372 4 373 /* WORDS 5 thru n */ 4 374 4 375 2 length fixed bin (18) unsigned unaligned, 4 376 2 value char(char_constant_length refer(char_constant.length)) unaligned; 4 377 4 378 dcl char_constant_length fixed bin (18) unsigned; 4 379 4 380 4 381 /* DIMENSION NODE */ 4 382 4 383 dcl 1 dimension aligned based structure, 4 384 4 385 /* WORD 1 */ 4 386 4 387 2 node_type fixed bin (4) unaligned, /* The only field in common with other nodes */ 4 388 4 389 2 number_of_dims fixed bin (3) unaligned, /* Number of dimensions */ 4 390 4 391 2 v_bound (7) unaligned, /* Variable bound info - up to 7 dims. */ 4 392 3 lower bit (1) unaligned, /* On if lower bound is variable */ 4 393 3 upper bit (1) unaligned, /* On if upper bound is variable */ 4 394 4 395 2 has_virtual_origin bit (1) unaligned, /* On if virtual_origin is valid */ 4 396 2 has_array_size bit (1) unaligned, /* On if array_size is valid */ 4 397 2 has_dim_sizes bit (1) unaligned, /* On if dim.size (*) is valid */ 4 398 4 399 2 variable_virtual_origin bit (1) unaligned, /* On if virtual_origin is variable */ 4 400 2 variable_array_size bit (1) unaligned, /* On if array_size is variable */ 4 401 2 assumed_size bit (1) unaligned, /* On if array has assumed size */ 4 402 4 403 2 fill bit (7) unaligned, 4 404 4 405 /* WORD 2 */ 4 406 4 407 2 virtual_origin fixed bin (24) aligned, 4 408 4 409 /* WORD 3 */ 4 410 4 411 2 element_count fixed bin (24) aligned, 4 412 4 413 /* WORD 4 */ 4 414 4 415 2 array_size fixed bin (24) aligned, /* Expressed in symbol.units */ 4 416 4 417 /* WORD 5 */ 4 418 4 419 2 VLA_base_addressor fixed bin (18) aligned, 4 420 4 421 /* WORDS 6 - n (max = 26) */ 4 422 4 423 2 dim (num_dims refer (dimension.number_of_dims)) aligned, 4 424 4 425 3 lower_bound fixed bin (24) aligned, /* Lower bound of this dimension */ 4 426 4 427 3 upper_bound fixed bin (24) aligned, /* Upper bound of this dimension */ 4 428 4 429 3 size fixed bin (24) aligned; /* No. of elements in this dimension */ 4 430 4 431 dcl num_dims fixed bin (3); 4 432 4 433 4 434 /* HEADER NODE */ 4 435 4 436 dcl 1 header aligned based structure, 4 437 4 438 /* WORD 1 */ 4 439 4 440 2 node_type fixed bin (4) unaligned, 4 441 2 data_type fixed bin (4) unaligned unsigned, 4 442 2 operand_type fixed bin (4) unaligned, 4 443 4 444 2 addressing_bits unaligned structure, 4 445 3 is_addressable bit (1), 4 446 3 value_in, 4 447 4 eaq bit (1), 4 448 4 x bit (1), 4 449 3 allocated bit (1), 4 450 3 needs_pointer bit (1), 4 451 3 stack_indirect bit (1), 4 452 3 large_address bit (1), 4 453 3 address_in_base bit (1), 4 454 3 dont_update bit (1), /* for optimizer */ 4 455 3 not_in_storage bit (1), /* for optimizer */ 4 456 3 globally_assigned bit (1), /* for optimizer */ 4 457 4 458 2 bits unaligned structure, 4 459 3 storage_info, 4 460 4 standard_bits, 4 461 5 allocate bit (1), 4 462 5 set bit (1), 4 463 5 referenced bit (1), 4 464 5 passed_as_arg bit (1), 4 465 4 initialed bit (1), /* On if any member has initial attribute. */ 4 466 4 467 3 alignment structure unaligned, 4 468 4 even bit (1), 4 469 4 odd bit (1), 4 470 4 character bit (1), 4 471 4 472 3 storage_class structure unaligned, 4 473 4 automatic bit (1), 4 474 4 static bit (1), 4 475 4 in_common bit (1), 4 476 4 477 /* WORD 2 */ 4 478 4 479 2 address aligned structure, 4 480 3 base bit (3) unaligned, 4 481 3 offset fixed bin (14) unaligned, 4 482 3 char_num fixed bin (2) unaligned unsigned, 4 483 3 bit_num fixed bin (4) unaligned unsigned, 4 484 3 fill bit (4) unaligned, 4 485 3 inhibit bit (1) unaligned, 4 486 3 ext_base bit (1) unaligned, 4 487 3 tag bit (6) unaligned, 4 488 4 489 /* WORD 3 */ 4 490 4 491 2 units fixed bin (3) unaligned unsigned, 4 492 2 VLA bit (1) unaligned, /* chain for VLA's */ 4 493 2 LA bit (1) unaligned, /* chain for LA's */ 4 494 2 fill bit (1) unaligned, 4 495 2 reloc_hold bit (6) unaligned, 4 496 2 reloc bit (6) unaligned, 4 497 2 addr_hold bit (18) unaligned, 4 498 4 499 /* WORD 4 */ 4 500 4 501 2 next_header fixed bin (18) unsigned unaligned, 4 502 2 first_element fixed bin (18) unsigned unaligned, 4 503 4 504 /* WORD 5 */ 4 505 4 506 2 last_element fixed bin (18) unsigned unaligned, 4 507 2 name_length fixed bin (17) unaligned, 4 508 4 509 /* WORD 6 */ 4 510 4 511 2 location fixed bin (24) aligned, 4 512 4 513 /* WORD 7 */ 4 514 4 515 2 length fixed bin (24) aligned, 4 516 4 517 /* WORD 8 */ 4 518 4 519 2 VLA_base_addressor fixed bin (18) aligned, 4 520 4 521 /* WORDS 9 - n. This field is variable in length. Its length is zero for equivalence groups. */ 4 522 4 523 2 block_name char(allocate_symbol_name refer (header.name_length)) aligned; 4 524 4 525 dcl allocate_symbol_name fixed bin; 4 526 4 527 4 528 /* LABEL NODE */ 4 529 4 530 dcl 1 label aligned based structure, 4 531 4 532 /* WORD 1 */ 4 533 4 534 2 node_type fixed bin (4) unaligned, 4 535 2 data_type fixed bin (4) unaligned unsigned, 4 536 2 operand_type fixed bin (4) unaligned, 4 537 4 538 2 addressing_bits unaligned structure, 4 539 3 is_addressable bit (1), 4 540 3 value_in, 4 541 4 eaq bit (1), 4 542 4 x bit (1), 4 543 3 allocated bit (1), 4 544 3 needs_pointer bit (1), 4 545 3 stack_indirect bit (1), 4 546 3 large_address bit (1), 4 547 3 address_in_base bit (1), 4 548 3 dont_update bit (1), /* for optimizer */ 4 549 3 not_in_storage bit (1), /* for optimizer */ 4 550 3 globally_assigned bit (1), /* for optimizer */ 4 551 4 552 2 bits unaligned structure, 4 553 3 storage_info, 4 554 4 standard_bits, 4 555 5 allocate bit (1), 4 556 5 set bit (1), 4 557 5 referenced bit (1), 4 558 5 passed_as_arg bit (1), 4 559 4 referenced_executable bit (1), 4 560 4 561 3 usage, /* Label is on a non-executable stmnt if both bits are ON. */ 4 562 4 format bit (1), 4 563 4 executable bit (1), 4 564 4 565 3 restore_prs bit (1), 4 566 3 not_referencable bit (1), 4 567 3 branched_to bit (1), 4 568 3 ends_do_loop bit (1), 4 569 4 570 /* WORD 2 */ 4 571 4 572 2 address aligned structure, 4 573 3 location fixed bin (18) unsigned unaligned, 4 574 3 op bit (10) unaligned, 4 575 3 inhibit bit (1) unaligned, 4 576 3 ext_base bit (1) unaligned, 4 577 3 tag bit (6) unaligned, 4 578 4 579 /* WORD 3 */ 4 580 4 581 2 units fixed bin (3) unaligned unsigned, 4 582 2 fill bit (3) unaligned, 4 583 2 reloc_hold bit (6) unaligned, 4 584 2 reloc bit (6) unaligned, 4 585 2 addr_hold bit (18) unaligned, 4 586 4 587 /* WORD 4 */ 4 588 4 589 2 next_label fixed bin (18) unsigned unaligned, 4 590 2 hash_chain fixed bin (18) unsigned unaligned, 4 591 4 592 /* WORD 5 */ 4 593 4 594 2 format_var fixed bin (18) unsigned unaligned, 4 595 2 name fixed bin (17) unaligned, 4 596 4 597 /* WORD 6 */ 4 598 4 599 2 statement fixed bin (18) unsigned unaligned, 4 600 2 loop_end fixed bin (18) unsigned unaligned; 4 601 4 602 4 603 /* LIBRARY NODE */ 4 604 4 605 dcl 1 library aligned based structure, 4 606 4 607 /* WORD 1 */ 4 608 4 609 2 node_type fixed bin (4) unaligned, /* The only field in common with the other nodes. */ 4 610 2 fill bit (13) unaligned, 4 611 2 next_library_node fixed bin (18) unsigned unaligned, 4 612 4 613 /* WORD 2 */ 4 614 4 615 2 character_operand fixed bin (18) unsigned aligned; 4 616 4 617 4 618 /* MACHINE_STATE NODE */ 4 619 4 620 dcl 1 machine_state aligned based structure, 4 621 4 622 /* WORD 1 */ 4 623 4 624 2 node_type fixed bin (4) unal, 4 625 2 pad bit (31) unal, 4 626 4 627 /* WORD 2 */ 4 628 4 629 2 next pointer unaligned, 4 630 4 631 /* WORDS 3-104 */ 4 632 4 633 2 ms aligned, 4 634 4 635 3 eaq (4), /* One for each of the A, Q, EAQ, and IND */ 4 636 4 name fixed bin, 4 637 4 number fixed bin, 4 638 4 variable(4) fixed bin (18), 4 639 4 reserved bit (1) aligned, 4 640 3 rounded bit (1) aligned, 4 641 3 indicators_valid fixed bin (18), 4 642 4 643 3 value_in_xr bit (1) aligned, 4 644 4 645 3 index_regs(0:7), 4 646 4 bits structure unaligned, 4 647 5 global bit (1), 4 648 5 reserved bit (1), 4 649 5 mbz bit (34), 4 650 4 type fixed bin (18), 4 651 4 variable fixed bin (18), 4 652 4 used fixed bin (18), 4 653 4 mbz fixed bin (18), 4 654 4 655 3 address_in_base bit (1) aligned, 4 656 4 657 3 base_regs(0:7), 4 658 4 bits structure unaligned, 4 659 5 global bit (1), 4 660 5 reserved bit (1), 4 661 5 mbz bit (34), 4 662 4 type fixed bin (18), 4 663 4 variable fixed bin (18), 4 664 4 used fixed bin (18), 4 665 4 offset fixed bin (18), 4 666 4 667 3 stack_extended bit (1) aligned, 4 668 3 last_dynamic_temp fixed bin (18); 4 669 4 670 /* POINTER NODE */ 4 671 4 672 dcl 1 pointer aligned based structure, 4 673 4 674 /* WORD 1 */ 4 675 4 676 2 node_type fixed bin (4) unaligned, 4 677 2 pad bit (4) unaligned, 4 678 2 code fixed bin (9) unaligned unsigned, 4 679 2 variable fixed bin (18) unaligned unsigned, 4 680 4 681 /* WORD 2 */ 4 682 4 683 2 offset fixed bin (18) unaligned unsigned, 4 684 2 count fixed bin (18) unaligned unsigned, 4 685 4 686 /* WORD 3 */ 4 687 4 688 2 hash_chain fixed bin (18) aligned; 4 689 4 690 4 691 /* SOURCE NODE */ 4 692 4 693 dcl 1 source aligned based structure, 4 694 4 695 /* WORD 1 */ 4 696 4 697 2 node_type fixed bin (4) unal, 4 698 2 pad bit (13) unal, 4 699 2 line_number fixed bin (17) unaligned, 4 700 4 701 /* WORD 2 */ 4 702 4 703 2 uid bit (36) aligned, 4 704 4 705 /* WORDS 3 & 4 */ 4 706 4 707 2 dtm fixed bin (71) unaligned, 4 708 4 709 /* WORD 5 */ 4 710 4 711 2 next fixed bin (18) unsigned unaligned, 4 712 2 initial_subprogram fixed bin (18) unsigned unaligned, 4 713 4 714 /* WORDS 6 - ? (depends on length of pathname) */ 4 715 4 716 2 pathname char(256) varying; 4 717 4 718 4 719 /* STATEMENT NODE - This node only appears in the polish. */ 4 720 4 721 dcl 1 statement aligned based structure, 4 722 4 723 /* WORD 1 */ 4 724 4 725 2 op_code fixed bin aligned, /* Always equal to "stat_op". */ 4 726 4 727 /* WORD 2 */ 4 728 4 729 2 next bit (18) unaligned, /* "0"b = no next stmnt */ 4 730 2 location bit (18) unaligned, /* (18)"1"b = no text */ 4 731 4 732 /* WORD 3 */ 4 733 4 734 2 source_id structure unaligned, 4 735 3 file fixed bin (8) unsigned, /* 0 = first file */ 4 736 3 line bit (14), 4 737 3 statement bit (5), /* 1 = first statement */ 4 738 4 739 2 length bit (9) unaligned, 4 740 4 741 /* WORD 4 */ 4 742 4 743 2 bits structure unaligned, 4 744 3 put_in_map bit (1) unaligned, 4 745 3 put_in_profile bit (1) unaligned, 4 746 3 pad bit (7) unaligned, 4 747 4 748 2 start fixed bin (26) unaligned; 4 749 4 750 4 751 /* SUBPROGRAM NODE */ 4 752 4 753 dcl 1 subprogram aligned based structure, 4 754 4 755 /* WORD 1 */ 4 756 4 757 2 node_type fixed bin (4) unaligned, /* The only field in common with the other nodes. */ 4 758 2 subprogram_type fixed bin (3) unaligned, 4 759 2 default_is unaligned, 4 760 3 auto bit (1), 4 761 3 static bit (1), 4 762 2 need_PS bit (1) unaligned, 4 763 2 need_prologue bit (1) unaligned, 4 764 2 multiple_entry bit (1) unaligned, 4 765 2 namelist_used bit (1) unaligned, 4 766 2 has_parameters bit (1) unaligned, 4 767 2 star_extent_function bit (1) unaligned, 4 768 2 fill bit (1) unaligned, 4 769 4 770 2 symbol fixed bin (18) unsigned unaligned, /* symbol node for subprogram name */ 4 771 4 772 /* WORD 2 */ 4 773 4 774 2 previous_subprogram fixed bin (18) unsigned unaligned, 4 775 2 next_subprogram fixed bin (18) unsigned unaligned, 4 776 4 777 /* WORD 3 */ 4 778 4 779 2 common_chain fixed bin (18) unsigned unaligned, 4 780 2 equiv_chain fixed bin (18) unsigned unaligned, 4 781 4 782 /* WORD 4 */ 4 783 4 784 2 first_symbol fixed bin (18) unsigned unaligned, 4 785 2 last_symbol fixed bin (18) unsigned unaligned, 4 786 4 787 /* WORD 5 */ 4 788 4 789 2 first_label fixed bin (18) unsigned unaligned, 4 790 2 last_label fixed bin (18) unsigned unaligned, 4 791 4 792 /* WORD 6 */ 4 793 4 794 2 first_polish fixed bin (18) unsigned unaligned, 4 795 2 last_polish fixed bin (18) unsigned unaligned, 4 796 4 797 /* WORD 7 */ 4 798 4 799 2 map unaligned, 4 800 3 first fixed bin (18) unsigned unaligned, 4 801 3 last fixed bin (18) unsigned unaligned, 4 802 4 803 /* WORD 8 */ 4 804 4 805 2 entry_info fixed bin (18) unsigned unaligned, 4 806 2 runtime fixed bin (18) unsigned unaligned, 4 807 4 808 /* WORD 9 */ 4 809 4 810 2 first_quad fixed bin (18) unsigned unaligned, 4 811 2 last_quad fixed bin (18) unsigned unaligned, 4 812 4 813 /* WORD 10 */ 4 814 4 815 2 options aligned like fortran_options, 4 816 4 817 /* WORDS 11 - 44 */ 4 818 4 819 2 storage_info(17) aligned, 4 820 3 first fixed bin (18) unsigned unaligned, 4 821 3 last fixed bin (18) unsigned unaligned, 4 822 3 next_loc fixed bin (18) aligned, 4 823 4 824 /* WORD 45 */ 4 825 4 826 2 loop_vector_p pointer unaligned, 4 827 4 828 /* WORD 46 */ 4 829 4 830 2 n_loops fixed bin (18) unsigned unaligned, 4 831 2 max_operators fixed bin (18) unsigned unaligned, 4 832 4 833 /* WORD 47 */ 4 834 4 835 2 VLA_chain fixed bin (18) unsigned unaligned, /* Mod 1 */ 4 836 2 LA_chain fixed bin (18) unsigned unaligned, /* Mod 1 */ 4 837 /* WORD 48 */ 4 838 4 839 2 max_sym fixed bin (18) aligned; 4 840 4 841 4 842 /* SYMBOL NODE */ 4 843 4 844 dcl 1 symbol aligned based structure, 4 845 4 846 /* WORD 1 */ 4 847 4 848 2 node_type fixed bin (4) unaligned, 4 849 2 data_type fixed bin (4) unaligned unsigned, 4 850 2 operand_type fixed bin (4) unaligned, 4 851 4 852 2 addressing_bits unaligned structure, 4 853 3 is_addressable bit (1), 4 854 3 value_in, 4 855 4 eaq bit (1), 4 856 4 x bit (1), 4 857 3 allocated bit (1), 4 858 3 needs_pointer bit (1), 4 859 3 stack_indirect bit (1), 4 860 3 large_address bit (1), 4 861 3 address_in_base bit (1), 4 862 3 dont_update bit (1), /* for optimizer */ 4 863 3 not_in_storage bit (1), /* for optimizer */ 4 864 3 globally_assigned bit (1), /* for optimizer */ 4 865 4 866 2 bits unaligned structure, 4 867 3 storage_info, 4 868 4 standard_bits, 4 869 5 allocate bit (1), 4 870 5 set bit (1), 4 871 5 referenced bit (1), 4 872 5 passed_as_arg bit (1), 4 873 4 initialed bit (1), /* Allows variable to become a constant. */ 4 874 4 875 3 variable_arglist bit (1), 4 876 3 dummy_arg bit (1), 4 877 3 variable_extents bit (1), 4 878 3 needs_descriptors bit (1), 4 879 3 put_in_symtab bit (1), 4 880 3 by_compiler bit (1), 4 881 4 882 /* WORD 2 */ 4 883 4 884 2 address aligned structure, 4 885 3 base bit (3) unaligned, 4 886 3 offset fixed bin (14) unaligned, 4 887 3 char_num fixed bin (2) unaligned unsigned, 4 888 3 bit_num fixed bin (4) unaligned unsigned, 4 889 3 fill bit (4) unaligned, 4 890 3 inhibit bit (1) unaligned, 4 891 3 ext_base bit (1) unaligned, 4 892 3 tag bit (6) unaligned, 4 893 4 894 /* WORD 3 */ 4 895 4 896 2 units fixed bin (3) unaligned unsigned, 4 897 2 aliasable bit (1) unaligned, 4 898 2 has_constant_value bit (1) unaligned, 4 899 2 new_induction_var bit (1) unaligned, 4 900 2 reloc_hold bit (6) unaligned, 4 901 2 reloc bit (6) unaligned, 4 902 2 addr_hold bit (18) unaligned, 4 903 4 904 /* WORD 4 */ 4 905 4 906 2 next_symbol fixed bin (18) unsigned unaligned, 4 907 2 hash_chain fixed bin (18) unsigned unaligned, 4 908 4 909 /* WORD 5 */ 4 910 4 911 2 ext_attributes unaligned structure, 4 912 3 VLA bit (1), /* symbol is Very large Element */ 4 913 3 LA bit (1), /* symbol is Large Element */ 4 914 3 pad bit (18-2), 4 915 4 916 2 loop_ref_count fixed bin (17) unaligned, 4 917 4 918 /* WORD 6 */ 4 919 4 920 2 location fixed bin (24) aligned, 4 921 4 922 /* WORD 7 */ 4 923 4 924 2 v_length fixed bin (18) unsigned unaligned, 4 925 2 general fixed bin (18) unsigned unaligned, 4 926 4 927 /* WORD 8 */ 4 928 4 929 2 parent fixed bin (18) unsigned unaligned, 4 930 2 next_member fixed bin (18) unsigned unaligned, 4 931 4 932 /* WORD 9 */ 4 933 4 934 2 attributes aligned structure, 4 935 3 mode_bits unaligned structure, 4 936 4 char_size fixed bin (20) unsigned, 4 937 4 mode, 4 938 5 integer bit (1), 4 939 5 real bit (1), 4 940 5 double_precision bit (1), 4 941 5 complex bit (1), 4 942 5 logical bit (1), 4 943 5 character bit (1), 4 944 5 label_value bit (1), 4 945 5 entry_value bit (1), 4 946 4 947 3 misc_attributes unaligned structure, 4 948 4 function bit (1), 4 949 4 subroutine bit (1), 4 950 4 entry_point bit (1), 4 951 4 external bit (1), 4 952 4 builtin bit (1), 4 953 4 stmnt_func bit (1), 4 954 4 namelist bit (1), 4 955 4 dimensioned bit (1), 4 956 4 957 /* WORD 10 */ 4 958 4 959 3 storage_class unaligned structure, 4 960 4 automatic bit (1), 4 961 4 static bit (1), 4 962 4 in_common bit (1), 4 963 4 equivalenced bit (1), 4 964 4 parameter bit (1), 4 965 4 constant bit (1), /* If external or entry_point. */ 4 966 4 named_constant bit (1), 4 967 4 968 3 variable bit (1) unaligned, 4 969 3 in_equiv_stmnt bit (1) unaligned, 4 970 3 star_extents bit (1) unaligned, 4 971 3 descriptor bit (1) unaligned, 4 972 2 pad bit (25) unaligned, 4 973 4 974 /* WORD 11 */ 4 975 4 976 2 dimension fixed bin (18) unsigned unaligned, /* Bounds may be added after symbol is declared. */ 4 977 2 initial fixed bin (18) unsigned unaligned, 4 978 4 979 /* WORD 12 */ 4 980 4 981 2 runtime bit (18) unaligned, 4 982 2 name_length fixed bin (17) unaligned, 4 983 4 984 /* WORD 13 */ 4 985 4 986 2 coordinate fixed bin (17) unaligned, /* used by loop optimizer */ 4 987 2 element_size fixed bin (17) unaligned, 4 988 4 989 /* WORD 14 */ 4 990 4 991 2 secondary pointer unaligned, /* used by loop optimizer */ 4 992 4 993 /* WORD 15 */ 4 994 4 995 2 offset fixed bin (24) aligned, 4 996 4 997 /* WORDS 16 - n. This field is variable in length. */ 4 998 4 999 2 name char(allocate_symbol_name refer (symbol.name_length)) aligned; 4 1000 4 1001 4 1002 4 1003 /* TEMPORARY NODE -- Must be same size as ARRAY REF NODE. */ 4 1004 4 1005 dcl 1 temporary aligned based structure, 4 1006 4 1007 /* WORD 1 */ 4 1008 4 1009 2 node_type fixed bin (4) unaligned, 4 1010 2 data_type fixed bin (4) unaligned unsigned, 4 1011 2 operand_type fixed bin (4) unaligned, 4 1012 4 1013 2 addressing_bits unaligned structure, 4 1014 3 is_addressable bit (1), 4 1015 3 value_in, 4 1016 4 eaq bit (1), 4 1017 4 x bit (1), 4 1018 3 allocated bit (1), 4 1019 3 needs_pointer bit (1), 4 1020 3 stack_indirect bit (1), 4 1021 3 large_address bit (1), 4 1022 3 address_in_base bit (1), 4 1023 3 dont_update bit (1), /* for optimizer */ 4 1024 3 not_in_storage bit (1), /* for optimizer */ 4 1025 3 globally_assigned bit (1), /* for optimizer */ 4 1026 4 1027 2 bits unaligned structure, 4 1028 3 standard_bits, 4 1029 4 allocate bit (1), 4 1030 4 set bit (1), 4 1031 4 referenced bit (1), 4 1032 4 passed_as_arg bit (1), 4 1033 4 1034 3 variable_length bit (1), 4 1035 4 1036 3 fill bit (1), /* can be used */ 4 1037 4 1038 3 invariant bit (1), /* must line up with array_ref node */ 4 1039 3 irreducible bit (1), /* .. */ 4 1040 3 used_across_loops bit (1), /* .. */ 4 1041 3 frozen_for_do bit (1), 4 1042 3 used_as_subscript bit (1), 4 1043 4 1044 /* WORD 2 */ 4 1045 4 1046 2 address aligned structure, 4 1047 3 base bit (3) unaligned, 4 1048 3 offset fixed bin (14) unaligned, 4 1049 3 char_num fixed bin (2) unaligned unsigned, 4 1050 3 bit_num fixed bin (4) unaligned unsigned, 4 1051 3 fill bit (4) unaligned, 4 1052 3 inhibit bit (1) unaligned, 4 1053 3 ext_base bit (1) unaligned, 4 1054 3 tag bit (6) unaligned, 4 1055 4 1056 /* WORD 3 */ 4 1057 4 1058 2 units fixed bin (3) unaligned unsigned, 4 1059 2 fill bit (3) unaligned, 4 1060 2 reloc_hold bit (6) unaligned, 4 1061 2 reloc bit (6) unaligned, 4 1062 2 addr_hold bit (18) unaligned, 4 1063 4 1064 /* WORD 4 */ 4 1065 4 1066 2 next fixed bin (18) unsigned unaligned, 4 1067 2 loop_end_fu_pos fixed bin (17) unaligned, /* must overlay array_ref.loop_end_fu_pos */ 4 1068 4 1069 /* WORD 5 */ 4 1070 4 1071 2 pad fixed bin (18) unsigned unaligned, 4 1072 2 loop_ref_count fixed bin (17) unaligned, 4 1073 4 1074 /* WORD 6 */ 4 1075 4 1076 2 location fixed bin (24) aligned, 4 1077 4 1078 /* WORD 7*/ 4 1079 4 1080 2 ref_count fixed bin (17) unaligned, /* must overlay array_ref.ref_count */ 4 1081 2 output_by fixed bin (18) unsigned unal, /* must overlay array_ref.output_by */ 4 1082 4 1083 /* WORD 8 */ 4 1084 4 1085 2 size fixed bin (24) aligned, /* size in words */ 4 1086 4 1087 /* WORD 9 */ 4 1088 4 1089 2 start_input_to fixed bin (18) unsigned unal, /* must overlay array_ref.start_input_to */ 4 1090 2 end_input_to fixed bin (18) unsigned unal, /* must overlay array_ref.end_input_to */ 4 1091 4 1092 /* WORD 10 */ 4 1093 4 1094 2 ref_count_copy fixed bin (17) unaligned, /* must overlay array_ref.ref_count_copy */ 4 1095 2 ms_ref_count fixed bin (17) unaligned, /* counts occurances in saved machine states */ 4 1096 4 1097 /* WORD 11 */ 4 1098 4 1099 2 length fixed bin (24) aligned; /* length in characters */ 4 1100 4 1101 /* END fort_nodes.incl.pl1 */ 283 284 5 1 /* BEGIN fort_system_constants.incl.pl1 */ 5 2 5 3 5 4 5 5 /****^ HISTORY COMMENTS: 5 6* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 5 7* install(86-07-28,MR12.0-1105): 5 8* Fix fortran bug 428. 5 9* END HISTORY COMMENTS */ 5 10 5 11 5 12 /* Created: June 1976, David Levin */ 5 13 5 14 /* Modified: 5 15* 15 Dec 85, RW - 428: Changed max_char_length from 256 to 512. 5 16* 22 Jun 84, MM - Install typeless functions support. 5 17* 17 Jun 83, HH - 383: Added 'process_param_list_op'. 5 18* 12 Jan 83, HH - Added 'form_VLA_packed_ptr_op'. 5 19* 05 Oct 82, HH - Added 'units_per_word'. 5 20* 27 Sep 82, HH - Added 'max_fixed_bin_18', 'max_fixed_bin_24' and 'sys_info$max_seg_size'. 5 21* Removed 'max_stored_value' and 'min_stored_value'. 5 22* 24 October 1981, ME Presser - added inquire_op. 5 23* 20 October 1981, C R Davis - add (read write)_internal_file_op. 5 24* 11 May 1981, Marshall Presser - added op-codes for .EQV. and .NEQV. 5 25* 28 April 1981, Marshall Presser - added default_main_entry_point_name 5 26* 11 March 1981, Marshall Presser - add min_stored_value 5 27* 8 December 1980, C R Davis - add block_if_op, else_if_op, else_op. 5 28* 15 January 1980, C R Davis - add bits_per_char. 5 29* 21 December 1979, Richard A. Barnes - add unrecoverable_errror and 5 30* max_error_level. 5 31* 3 November 1979, Richard Barnes - add pointer_node. 5 32* 17 September 1979, Richard Barnes - add load_preg_op & load_xreg_op 5 33* 13 September 1979, Paul Smee - add colon and concat token types, 5 34* change value of EOS_token, remove default_char_size. 5 35* 31 August 1979, Charlie Davis - change offset units to 5 36* be consistent with those in runtime symbols. 5 37* 13 August 1979, Richard Barnes - add cat_op & substr_op 5 38* 19 July 1979, Richard Barnes - char mode 5 39* 10 October 1978, Paul Smee - double max_stored_value and bias. 5 40* 15 June 1978, Paul Smee - add max_num_of_rands 5 41* 16 November 1977, David Levin - add machine_state_node 5 42* 12 September 1977, Richard Barnes - new ops for loop optimizer 5 43* 30 August 1977, David Levin - change bias from 65536 to 131072. 5 44* 5 July 1977, David Levin - add open_op, close_op, and iostat_op. 5 45* 28 April 1977, David Levin - add xmit_vector_op in operator list 5 46* 22 April 1977, David Levin - add max_prec_single, last_assigned_mode 5 47* 24 February 1977, Gabriel Chang for the optimizer. 5 48* 23 February 1977, David Levin to change name of count operand. 5 49* 28 October 1976, David Levin and Gabriel Chang to add 2 new ops and 5 50* 1 new node type. 5 51* 2 September 1976, David Levin - add 8 new ops and change name of 5 52* data_op. 5 53**/ 5 54 /* SYSTEM CONSTANTS */ 5 55 5 56 dcl bias init(262144) fixed bin(19) int static options(constant); 5 57 dcl gap_value init(0) fixed bin int static options(constant); 5 58 dcl max_fixed_bin_18 init(111111111111111111b) fixed bin (18) static options (constant); 5 59 dcl max_fixed_bin_24 init(111111111111111111111111b) fixed bin (24) static options (constant); 5 60 dcl max_num_of_rands init(127) fixed bin int static options(constant); 5 61 dcl sys_info$max_seg_size 5 62 fixed bin (18) ext; 5 63 5 64 dcl ( unrecoverable_error init(3), 5 65 max_error_level init(4)) 5 66 fixed bin int static options(constant); 5 67 5 68 dcl (main_program init(0), 5 69 block_data init(1), 5 70 subroutine init(2), 5 71 function init(3), 5 72 chars_per_word init(4), 5 73 chars_per_dw init(8), 5 74 bits_per_char init(9), 5 75 first_auto_loc init(64), 5 76 max_prec_single init(8)) fixed bin(9) int static options(constant); 5 77 dcl max_char_length init(512) fixed bin(10) int static options(constant); 5 78 5 79 dcl blank_common_name init("blnk*com") char(8) aligned int static options(constant); 5 80 declare default_main_entry_point_name 5 81 char (5) int static options (constant) initial ("main_"); 5 82 declare unnamed_block_data_subprg_name 5 83 char (29) int static options (constant) initial ("unnamed block data subprogram"); 5 84 5 85 /* NODE TYPES */ 5 86 5 87 dcl (fill_node init(0), 5 88 source_node init(1), 5 89 symbol_node init(2), 5 90 dimension_node init(3), 5 91 temporary_node init(4), 5 92 constant_node init(5), 5 93 label_node init(6), 5 94 header_node init(7), 5 95 char_constant_node init(8), 5 96 array_ref_node init(9), 5 97 proc_frame_node init(10), 5 98 library_node init(11), 5 99 subprogram_node init(12), 5 100 arg_desc_node init(13), 5 101 pointer_node init(14), 5 102 machine_state_node init(15)) fixed bin(4) aligned internal static options(constant); 5 103 5 104 /* DATA TYPES */ 5 105 5 106 dcl (int_mode init(1), 5 107 real_mode init(2), 5 108 dp_mode init(3), 5 109 cmpx_mode init(4), 5 110 logical_mode init(5), 5 111 char_mode init(6), 5 112 typeless_mode init(7), 5 113 last_assigned_mode init(7)) fixed bin(4) aligned internal static options(constant); 5 114 5 115 dcl data_type_size(7) init(1,1,2,2,1,0,1) fixed bin int static options(constant); 5 116 5 117 5 118 /* OPERAND TYPES */ 5 119 5 120 dcl (variable_type init(1), 5 121 constant_type init(2), 5 122 array_ref_type init(3), 5 123 temp_type init(4), 5 124 count_type init(5), 5 125 rel_constant init(6), 5 126 bif init(7), 5 127 statement_function init(8), 5 128 external init(9), 5 129 entry_type init(10), 5 130 dummy init(11), 5 131 error init(12)) fixed bin(4) aligned internal static options(constant); 5 132 5 133 5 134 /* OFFSET UNITS */ 5 135 5 136 dcl 5 137 (word_units init (0), 5 138 bit_units init (1), 5 139 char_units init (2), 5 140 halfword_units init (3)) fixed bin (3) aligned internal static options(constant); 5 141 5 142 dcl units_per_word (0:3) init (1, 36, 4, 2) fixed bin (6) static options (constant); 5 143 5 144 5 145 /* TOKEN MASKS */ 5 146 5 147 dcl 5 148 (is_operand initial("101000000"b), 5 149 is_operator initial("010000000"b), 5 150 is_constant initial("001000000"b), 5 151 is_arith_constant initial("000100000"b)) bit(9) aligned internal static options(constant); 5 152 5 153 5 154 /* TOKEN TYPES */ 5 155 5 156 dcl (no_token initial("000000000"b), 5 157 ident initial("100000000"b), 5 158 plus initial("010000001"b), 5 159 minus initial("010000010"b), 5 160 asterisk initial("010000011"b), 5 161 slash initial("010000100"b), 5 162 expon initial("010000101"b), 5 163 not initial("010000110"b), 5 164 and initial("010000111"b), 5 165 or initial("010001000"b), 5 166 eq initial("010001001"b), 5 167 ne initial("010001010"b), 5 168 lt initial("010001011"b), 5 169 gt initial("010001100"b), 5 170 le initial("010001101"b), 5 171 ge initial("010001110"b), 5 172 assign initial("010001111"b), 5 173 comma initial("010010000"b), 5 174 left_parn initial("010010001"b), 5 175 right_parn initial("010010010"b), 5 176 apostrophe initial("010010011"b), 5 177 colon initial("010010100"b), 5 178 concat initial("010010101"b), 5 179 substr_left_parn initial("010010110"b), 5 180 eqv initial("010010111"b), 5 181 neqv initial("010011000"b), 5 182 EOS_token initial("010011111"b), 5 183 char_string initial("001000001"b), 5 184 logical_const initial("001000010"b), 5 185 false initial("001000010"b), /* Must be identical to true except low order bit off. */ 5 186 true initial("001000011"b), /* Must be identical to false except low order bit on. */ 5 187 label_const initial("001000100"b), 5 188 octal_const initial("001000101"b), 5 189 dec_int initial("001100110"b), 5 190 real_const initial("001100111"b), 5 191 double_const initial("001101000"b), 5 192 complex_const initial("001101001"b)) bit(9) aligned internal static options(constant); 5 193 5 194 5 195 /* OPERATOR NAMES */ 5 196 5 197 declare 5 198 (assign_op initial(1), 5 199 add_op initial(2), 5 200 sub_op initial(3), 5 201 mult_op initial(4), 5 202 div_op initial(5), 5 203 exponentiation_op initial(6), 5 204 negate_op initial(7), 5 205 less_op initial(8), 5 206 less_or_equal_op initial(9), 5 207 equal_op initial(10), 5 208 not_equal_op initial(11), 5 209 greater_or_equal_op initial(12), 5 210 greater_op initial(13), 5 211 or_op initial(14), 5 212 and_op initial(15), 5 213 not_op initial(16), 5 214 jump_op initial(17), 5 215 jump_logical_op initial(18), 5 216 jump_arithmetic_op initial(19), 5 217 jump_computed_op initial(20), 5 218 jump_assigned_op initial(21), 5 219 assign_label_op initial(22), 5 220 read_op initial(23), 5 221 write_op initial(24), 5 222 format_op initial(25), 5 223 end_label_op initial(26), 5 224 error_label_op initial(27), 5 225 xmit_scalar_op initial(28), 5 226 xmit_array_op initial(29), 5 227 xmit_vector_op initial(30), 5 228 endfile_op initial(31), 5 229 rewind_op initial(32), 5 230 backspace_op initial(33), 5 231 margin_op initial(34), 5 232 openfile_op initial(35), 5 233 closefile_op initial(36), 5 234 record_number_op initial(37), 5 235 string_op initial(38), 5 236 string_length_op initial(39), 5 237 terminate_op initial(40), 5 238 return_op initial(41), 5 239 pause_op initial(42), 5 240 stop_op initial(43), 5 241 item_op initial(44), 5 242 exit_op initial(45), 5 243 eol_op initial(46), 5 244 do_op initial(47), 5 245 builtin_op initial(48), 5 246 sf_op initial(49), 5 247 sf_def_op initial(50), 5 248 subscript_op initial(51), 5 249 func_ref_op initial(52), 5 250 block_data_op initial(53), 5 251 increment_polish_op initial(54), 5 252 main_op initial(55), 5 253 func_op initial(56), 5 254 subr_op initial(57), 5 255 stat_op initial(58), 5 256 label_op initial(59), 5 257 call_op initial(60), 5 258 chain_op initial(61), 5 259 endunit_op initial(62), 5 260 non_executable initial(63), 5 261 no_op initial(64), 5 262 form_VLA_packed_ptr_op initial(65), 5 263 opt_subscript_op initial(66), 5 264 left_shift_op initial(67), 5 265 right_shift_op initial(68), 5 266 store_zero_op initial(69), 5 267 storage_add_op initial(70), 5 268 storage_sub_op initial(71), 5 269 neg_storage_add_op initial(72), 5 270 storage_add_one_op initial(73), 5 271 namelist_op initial(74), 5 272 open_op initial(75), 5 273 close_op initial(76), 5 274 iostat_op initial(77), 5 275 convert_to_int_op initial(78), 5 276 convert_to_real_op initial(79), 5 277 convert_to_dp_op initial(80), 5 278 convert_to_cmpx_op initial(81), 5 279 read_scalar_op initial(82), 5 280 read_array_op initial(83), 5 281 read_vector_op initial(84), 5 282 write_scalar_op initial(85), 5 283 write_array_op initial(86), 5 284 write_vector_op initial(87), 5 285 jump_true_op initial(88), 5 286 jump_false_op initial(89), 5 287 sub_index_op initial(90), 5 288 loop_end_op initial(91), 5 289 read_namelist_op initial(92), 5 290 write_namelist_op initial(93), 5 291 decode_string_op initial(94), 5 292 encode_string_op initial(95), 5 293 cat_op initial(96), 5 294 substr_op initial(97), 5 295 load_xreg_op initial(98), 5 296 load_preg_op initial(99), 5 297 block_if_op initial(100), 5 298 else_if_op initial(101), 5 299 else_op initial(102), 5 300 equiv_op initial (103), 5 301 not_equiv_op initial (104), 5 302 read_internal_file_op initial (105), 5 303 write_internal_file_op initial (106), 5 304 inquire_op initial (107), 5 305 process_param_list_op initial (108), 5 306 lhs_fld_op initial (109), 5 307 last_assigned_op initial (109)) fixed bin(18) internal static options(constant); 5 308 5 309 /* END fort_system_constants.incl.pl1 */ 285 286 287 dcl 1 shared_globals aligned based (shared_struc_ptr), 6 1 6 2 /* BEGIN fort_shared_vars.incl.pl1 */ 6 3 6 4 6 5 6 6 /****^ HISTORY COMMENTS: 6 7* 1) change(86-07-14,BWong), approve(86-07-14,MCR7286), audit(86-07-17,Ginter), 6 8* install(86-07-28,MR12.0-1105): 6 9* Fix fortran bug 463. 6 10* END HISTORY COMMENTS */ 6 11 6 12 6 13 /* Created: June 1976, David Levin 6 14* 6 15* Modified: 30 Aug 76, David Levin - to add global variables for listing segment. 6 16* Modified: 22 Nov 76, Richard Barnes - to add profile_size 6 17* Modified: 24 Feb 77, Gabriel Chang - for the optimizer 6 18* Modified: 06 Oct 77, Richard Barnes - for the loop optimizer 6 19* Modified: 16 Nov 77, David Levin - add next_free_(temp array_ref). 6 20* Modified: 09 Oct 78, Paul Smee - for larger common and arrays. 6 21* Modified: 03 Apr 79, Paul Smee - add list of include file data. 6 22* Modified: 17 May 79, Paul Smee - add cur_statement_list. 6 23* Modified: 28 Jun 79, Paul Smee - add compile-time math entry arrays. 6 24* Modified: 13 Sep 79, Paul Smee - add default_char_size. 6 25* Modified: 18 Dec 79, Richard Barnes - add free and freei 6 26* Modified: 03 Mar 80, C R Davis - add must_save_stack_extent. 6 27* Modified: 15 Mar 82, T G Oke - add source (line_number, file_number). 6 28* Modified: 20 Sept 82, T G Oke - add VLA_is_256K flag 6 29* Modified: 22 Sept 82, T G Oke - add area creation info to pass to 6 30* listing generator. 6 31* Modified: 17 May 83, M Mabey - add declared_options. 6 32* Modified: 02 Aug 85, B Wong - 463: changed 'must_save_stack_extent' 6 33* to 'pad' since the variable is no longer used. 6 34**/ 6 35 6 36 2 polish_base ptr, 6 37 2 operand_base ptr, 6 38 2 object_base ptr, 6 39 2 quadruple_base ptr, 6 40 2 opt_base ptr, 6 41 2 relocation_base ptr, 6 42 6 43 2 cref_base ptr, /* base of cross reference segment */ 6 44 2 source_line_base ptr, /* base of source line offset segment */ 6 45 2 listing_base ptr, /* base of listing info segment */ 6 46 2 cur_listing ptr, /* points to listing info for the active subprogram */ 6 47 6 48 2 free(2:4) ptr, /* free chains for optimizer */ 6 49 2 freei ptr, /* .. */ 6 50 6 51 2 polish_max_len fixed bin (19), 6 52 2 operand_max_len fixed bin (19), 6 53 2 object_max_len fixed bin (19), 6 54 2 quad_max_len fixed bin (19), 6 55 2 opt_max_len fixed bin (19), 6 56 6 57 2 next_free_polish fixed bin (18), 6 58 2 next_free_operand fixed bin (18), 6 59 2 next_free_object fixed bin (18), 6 60 2 next_free_listing fixed bin (18), 6 61 2 next_free_quad fixed bin (18), 6 62 2 next_free_array_ref fixed bin (18), /* Chain for freed array_ref nodes. */ 6 63 2 next_free_temp fixed bin (18), /* Chain for freed temporary nodes. */ 6 64 2 next_free_opt fixed bin (18), 6 65 6 66 2 first_segment fixed bin, 6 67 2 number_of_source_segments fixed bin (8), 6 68 2 number_of_lines fixed bin, 6 69 2 number_of_crefs fixed bin, 6 70 2 profile_size fixed bin, 6 71 6 72 2 main_entry_point_name char (32) varying, 6 73 6 74 2 cur_statement fixed bin (18), 6 75 2 cur_statement_list fixed bin (17), 6 76 2 cur_subprogram fixed bin (18), 6 77 2 first_subprogram fixed bin (18), 6 78 2 last_subprogram fixed bin (18), 6 79 2 unnamed_block_data_subprogram 6 80 fixed bin (18), 6 81 2 first_entry_name fixed bin (18), 6 82 2 last_entry_name fixed bin (18), 6 83 6 84 2 constant_info (4) aligned structure, 6 85 3 constant_count fixed bin (17), 6 86 3 first_constant fixed bin (18), 6 87 3 last_constant fixed bin (18), 6 88 6 89 2 options aligned, 6 90 3 user_options aligned like fortran_options, 6 91 3 system_options aligned, 6 92 4 is_fast bit (1) unaligned, 6 93 4 namelist_used bit (1) unaligned, 6 94 4 compile_only bit (1) unaligned, 6 95 4 VLA_is_256K bit (1) unaligned, /* FLAG 255/256K code */ 6 96 4 pad bit (32) unaligned, 6 97 6 98 2 incl_data aligned, 6 99 3 incl_count fixed bin, 6 100 3 file_list (0:255), 6 101 4 source_node_offset fixed bin (18), 6 102 4 incl_len fixed bin (21), 6 103 4 incl_ptr unaligned ptr, 6 104 6 105 2 create_constant entry (fixed bin (4), bit (72) aligned) returns (fixed bin (18)) 6 106 variable, 6 107 2 create_char_constant entry (char (*)) returns (fixed bin (18)) 6 108 variable, 6 109 2 print_message entry options (variable) 6 110 variable, 6 111 2 get_next_temp_segment entry (ptr, fixed bin (18)) returns (ptr) 6 112 variable, 6 113 2 negate_round (6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 6 114 returns (bit (72)) variable, 6 115 2 negate_trunc (6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 6 116 returns (bit (72)) variable, 6 117 2 binop_round (6,6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 6 118 returns (bit (72)) variable, 6 119 2 binop_trunc (6,6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 6 120 returns (bit (72)) variable, 6 121 2 comp_parm (6,6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 6 122 returns (bit (72)) variable, 6 123 2 conv_round (6,6) entry (bit (72), fixed bin (35)) 6 124 returns (bit (72)) variable, 6 125 2 conv_trunc (6,6) entry (bit (72), fixed bin (35)) 6 126 returns (bit (72)) variable, 6 127 2 pad bit (1) aligned, 6 128 6 129 /* The following are used by "print_message - decode_source_id" if use_source_info set. */ 6 130 6 131 2 use_source_info bit (1) aligned, 6 132 2 source_file_number fixed bin (35), 6 133 2 source_line_number fixed bin (35), 6 134 2 Area_create_first fixed bin (18), /* start of text to do creation */ 6 135 2 Area_create_last fixed bin (18), /* Last item */ 6 136 2 Area_init_first fixed bin (18), /* start of text to init areas */ 6 137 2 Area_init_last fixed bin (18), /* Last item */ 6 138 2 declared_options aligned like fortran_declared; 6 139 6 140 dcl num_of_word_constants fixed bin (17) defined (constant_info (1).constant_count); 6 141 dcl first_word_constant fixed bin (18) defined (constant_info (1).first_constant); 6 142 dcl last_word_constant fixed bin (18) defined (constant_info (1).last_constant); 6 143 6 144 dcl num_of_dw_constants fixed bin (17) defined (constant_info (2).constant_count); 6 145 dcl first_dw_constant fixed bin (18) defined (constant_info (2).first_constant); 6 146 dcl last_dw_constant fixed bin (18) defined (constant_info (2).last_constant); 6 147 6 148 dcl num_of_char_constants fixed bin (17) defined (constant_info (3).constant_count); 6 149 dcl first_char_constant fixed bin (18) defined (constant_info (3).first_constant); 6 150 dcl last_char_constant fixed bin (18) defined (constant_info (3).last_constant); 6 151 6 152 dcl num_of_block_constants fixed bin (17) defined (constant_info (4).constant_count); 6 153 dcl first_block_constant fixed bin (18) defined (constant_info (4).first_constant); 6 154 dcl last_block_constant fixed bin (18) defined (constant_info (4).last_constant); 6 155 6 156 /* END fort_shared_vars.incl.pl1 */ 288 289 7 1 /* BEGIN INCLUDE FILE fort_options.incl.pl1 */ 7 2 7 3 /****^ *********************************************************** 7 4* * * 7 5* * Copyright, (C) Honeywell Information Systems Inc., 1987 * 7 6* * * 7 7* *********************************************************** */ 7 8 7 9 /****^ HISTORY COMMENTS: 7 10* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 7 11* install(86-07-28,MR12.0-1105): 7 12* Fix fortran bug 473. 7 13* 2) change(87-06-23,RWaters), approve(87-06-23,MCR7703), audit(87-07-10,Huen), 7 14* install(87-08-06,MR12.1-1069): 7 15* Implemented SCP 6315: fortran error-handling argument. 7 16* END HISTORY COMMENTS */ 7 17 7 18 7 19 /* 7 20* Modified: 12 May 87 by RWaters added debug_io 7 21* Modified: 19 February 1986 by B. Wong & A. Ginter - 473.a: Correct 7 22* comments and size of pad field in fort_declared 7 23* and pad out dfast and fast bit masks to two words. 7 24* Modified: 09 October 1985 by B. Wong - 473: add VLA_auto, VLA_static, 7 25* VLA_parm, VLC, LA_auto, and LA_static. Remove VLA and LA. 7 26* Modified: 28 March 1984 by M. Mabey - Install HFP support. 7 27* Modified: 21 September 1983 by M. Mabey - correct size of pad field in fortran_declared. 7 28* Modified: 16 May 1983 by M. Mabey - add fortran_declared 7 29* Modified: 18 December 1982 by T. Oke - Add 'long_profile'. 7 30* Modified: 22 September 1982 by T. Oke - add VLA and LA 7 31* Modified: 3 May 1982 by T. Oke - add check_multiply 7 32* Modified: 06/24/81 by S. Herbst - add do_rounding & auto_zero to fast_mask and dfast_mask 7 33* Modified: 26 February 1980 by C R Davis - add fast_mask, fix dfast_mask. 7 34* Modified: 31 January 1980 by C R Davis - add stringrange. 7 35* Modified: 13 September 1979 by Paul E. Smee--add ansi_77. 7 36* Modified: 05 December 1978 by Paul E. Smee--add do_rounding, auto_zero. 7 37* Modified: 25 January 1978 by Richard A. Barnes for the loop optimizer 7 38**/ 7 39 7 40 declare 7 41 7 42 1 fortran_options aligned based, 7 43 2 use_library bit (1) unaligned, /* (1) ON if library statements will be parsed */ 7 44 2 optimize bit (1) unaligned, /* (2) ON if optimized code is to be produced */ 7 45 2 time bit (1) unaligned, /* (3) ON for compile timing */ 7 46 2 source_format unaligned, 7 47 3 has_line_numbers bit (1) unaligned, /* (4) ON if each line begins with a line number */ 7 48 3 fold bit (1) unaligned, /* (5) ON if variable names are to be folded to lowercase */ 7 49 3 card bit (1) unaligned, /* (6) ON for card format */ 7 50 3 convert bit (1) unaligned, /* (7) ON for card format to be converted */ 7 51 2 listing unaligned, 7 52 3 source bit (1) unaligned, /* (8) ON for listing of numbered source */ 7 53 3 symbol bit (1) unaligned, /* (9) ON for listing with symbol map */ 7 54 3 map bit (1) unaligned, /* (10) ON for listing with statement map */ 7 55 3 list bit (1) unaligned, /* (11) ON for listing with assembler instructions */ 7 56 2 error_messages unaligned, 7 57 3 brief bit (1) unaligned, /* (12) ON for brief error messages */ 7 58 3 severity fixed bin (3), /* (13-16) suppresses messages below this severity */ 7 59 2 debugging unaligned, 7 60 3 subscriptrange bit (1) unaligned, /* (17) ON for subscript range checking */ 7 61 3 stringrange bit (1) unaligned, /* (18) ON for string range checking */ 7 62 3 brief_table bit (1) unaligned, /* (19) ON for statement table */ 7 63 3 table bit (1) unaligned, /* (20) ON for statement and symbol table */ 7 64 3 profile bit (1) unaligned, /* (21) ON to generate code to meter statements */ 7 65 3 check bit (1) unaligned, /* (22) ON for syntactic and semantic checking only */ 7 66 2 system_debugging unaligned, 7 67 3 stop_after_cg bit (1) unaligned, /* (23) ON if debug stop after code generator */ 7 68 3 stop_after_parse bit (1) unaligned, /* (24) ON if debug stop after parse */ 7 69 2 relocatable bit (1) unaligned, /* (25) ON if relocatable object segment generated */ 7 70 2 optimizing unaligned, 7 71 3 time_optimizer bit (1) unaligned, /* (26) ON if timings for optimizer requested */ 7 72 /* (27) ON if optimizer can loosen safety constraints */ 7 73 3 ignore_articulation_blocks bit (1) unaligned, 7 74 3 consolidate bit(1) unaligned, /* (28) ON if optimizer should run consolidation phase */ 7 75 2 do_rounding bit(1) unaligned, /* (29) ON if floating point round should be used */ 7 76 2 auto_zero bit(1) unaligned, /* (30) ON if auto storage should be zeroed when allocated */ 7 77 2 ansi_77 bit (1) unaligned, /* (31) ON if ansi77 rules are to be followed */ 7 78 2 check_multiply bit (1) unaligned, /* (32) ON if check integer multiply extent */ 7 79 2 VLA_auto bit (1) unaligned, /* (33) ON if auto VLA's being done */ 7 80 2 VLA_parm bit (1) unaligned, /* (34) ON if parm VLA's being done */ 7 81 2 VLA_static bit (1) unaligned, /* (35) ON if static VLA's being done */ 7 82 2 VLC bit (1) unaligned, /* (36) ON if VLC's being done */ 7 83 2 LA_auto bit (1) unaligned, /* (1) ON if auto LA's being done */ 7 84 2 LA_static bit (1) unaligned, /* (2) ON if static LA's being done */ 7 85 2 long_profile bit (1) unaligned, /* (3) ON to generate long_profile */ 7 86 2 static_storage bit (1) unaligned, /* (4) ON if static storage */ 7 87 2 hfp bit (1) unaligned, /* (5) ON if using hex floating point math */ 7 88 2 debug_io bit (1) unaligned, /* (6) */ 7 89 2 pad bit(30) unaligned; /* (7-36) Pad bits */ 7 90 7 91 declare 7 92 7 93 1 fortran_declared aligned based, 7 94 2 ansi66 bit(1) unaligned, /* (1) First word */ 7 95 2 ansi77 bit(1) unaligned, /* (2) */ 7 96 2 auto bit(1) unaligned, /* (3) */ 7 97 2 auto_zero bit(1) unaligned, /* (4) */ 7 98 2 brief bit(1) unaligned, /* (5) */ 7 99 2 binary_floating_point bit(1) unaligned, /* (6) */ 7 100 2 brief_table bit(1) unaligned, /* (7) */ 7 101 2 card bit(1) unaligned, /* (8) */ 7 102 2 check bit(1) unaligned, /* (9) */ 7 103 2 check_multiply bit(1) unaligned, /* (10) */ 7 104 2 consolidate bit(1) unaligned, /* (11) */ 7 105 2 debug bit(1) unaligned, /* (12) */ 7 106 2 debug_cg bit(1) unaligned, /* (13) */ 7 107 2 debug_io bit(1) unaligned, /* (14) */ 7 108 2 default_full bit(1) unaligned, /* (15) */ 7 109 2 default_safe bit(1) unaligned, /* (16) */ 7 110 2 fold bit(1) unaligned, /* (17) */ 7 111 2 free bit(1) unaligned, /* (18) */ 7 112 2 full_optimize bit(1) unaligned, /* (19) */ 7 113 2 hexadecimal_floating_point bit(1) unaligned, 7 114 /* (20) */ 7 115 2 la_auto bit(1) unaligned, /* (21) */ 7 116 2 la_static bit(1) unaligned, /* (22) */ 7 117 2 large_array bit(1) unaligned, /* (23) */ 7 118 2 line_numbers bit(1) unaligned, /* (24) */ 7 119 2 list bit(1) unaligned, /* (25) */ 7 120 2 long bit(1) unaligned, /* (26) */ 7 121 2 long_profile bit(1) unaligned, /* (27) */ 7 122 2 map bit(1) unaligned, /* (28) */ 7 123 2 no_auto_zero bit(1) unaligned, /* (29) */ 7 124 2 no_check bit(1) unaligned, /* (30) */ 7 125 2 no_fold bit(1) unaligned, /* (31) */ 7 126 2 no_large_array bit(1) unaligned, /* (32) */ 7 127 2 no_line_numbers bit(1) unaligned, /* (33) */ 7 128 2 no_map bit(1) unaligned, /* (34) */ 7 129 2 no_optimize bit(1) unaligned, /* (35) */ 7 130 2 no_check_multiply bit(1) unaligned, /* (36) */ 7 131 2 no_debug_io bit(1) unal, /* (1) Second Word */ 7 132 2 no_stringrange bit(1) unaligned, /* (2) */ 7 133 2 no_subscriptrange bit(1) unaligned, /* (3) */ 7 134 2 no_table bit(1) unaligned, /* (4) */ 7 135 2 no_very_large_array bit(1) unaligned, /* (5) */ 7 136 2 no_vla_parm bit(1) unaligned, /* (6) */ 7 137 2 no_version bit(1) unaligned, /* (7) */ 7 138 2 non_relocatable bit(1) unaligned, /* (8) */ 7 139 2 optimize bit(1) unaligned, /* (9) */ 7 140 2 profile bit(1) unaligned, /* (10) */ 7 141 2 relocatable bit(1) unaligned, /* (11) */ 7 142 2 round bit(1) unaligned, /* (12) */ 7 143 2 safe_optimize bit(1) unaligned, /* (13) */ 7 144 2 severity fixed bin(3) unaligned, /* (14-16) */ 7 145 2 static bit(1) unaligned, /* (17) */ 7 146 2 stringrange bit(1) unaligned, /* (18) */ 7 147 2 subscriptrange bit(1) unaligned, /* (19) */ 7 148 2 table bit(1) unaligned, /* (20) */ 7 149 2 time bit(1) unaligned, /* (21) */ 7 150 2 time_ot bit(1) unaligned, /* (22) */ 7 151 2 top_down bit(1) unaligned, /* (23) */ 7 152 2 truncate bit(1) unaligned, /* (24) */ 7 153 2 version bit(1) unaligned, /* (25) */ 7 154 2 very_large_array bit(1) unaligned, /* (26) */ 7 155 2 very_large_common bit(1) unaligned, /* (27) */ 7 156 2 vla_auto bit(1) unaligned, /* (28) */ 7 157 2 vla_parm bit(1) unaligned, /* (29) */ 7 158 2 vla_static bit(1) unaligned, /* (30) */ 7 159 2 pad bit(6) unaligned; /* (31-36) */ 7 160 7 161 7 162 declare /* Options used by DFAST */ 7 163 7 164 dfast_mask bit (72) internal static options (constant) initial ("100110000000000010100000000011"b); 7 165 /* use_library, has_line_numbers, fold, subscriptrange, brief_table */ 7 166 7 167 7 168 declare /* Options used by FAST */ 7 169 7 170 fast_mask bit (72) internal static options (constant) initial ("000100000000000010100000000011"b); 7 171 /* has_line_numbers, subscriptrange, brief_table */ 7 172 7 173 /* END INCLUDE FILE fort_options.incl.pl1 */ 290 291 8 1 /* BEGIN fort_opt_nodes.incl.pl1 */ 8 2 8 3 /* Created: 22 November 1977 by Richard A. Barnes for the optimizing Fortran compiler */ 8 4 8 5 /* Modified: 09 October 1978 by Paul E. Smee for larger common and arrays. 8 6* Modified: 2 June 1979 by RAB to speed up intersection of optimizer 8 7* machine states by adding operator.coordinate and 8 8* flow_unit.is_active_operator 8 9* Modified: 28 June 1979 by RAB to speed up compute_busy_on_exit by 8 10* adding flow_unit.dim_or_alias_or_not_set. 8 11* Modified: 02 July 1979 by RAB to fix 218 by moving loop_end_chain stuff 8 12* to flow_unit node from loop node. 8 13* Modified: 14 August 1979 by RAB to change flow_unit.dim_or_alias_or_not_set 8 14* to flow_unit.always_completely_set. 8 15* Modified: 17 September 1979 by RAB in preparation for register optimizer. 8 16* Modified: 20 September 1979 by RAB for index_value_analysis of register optimizer. 8 17* Modified: 03 November 1979 by RAB for flow_unit.refreshed for register optimizer. 8 18* Modified: 30 November 1979 by RAB to add more info to the loop node 8 19* for the register optimizer. 8 20* Modified: 18 December 1979 by RAB to make remainder of register 8 21* optimizer changes. 8 22* Modified: 17 December 1980 by CRD to add opt_statement.removable. 8 23**/ 8 24 8 25 /* CHAIN (2 words) */ 8 26 8 27 dcl 1 chain based aligned, 8 28 2 next pointer unaligned, 8 29 2 value pointer unaligned; 8 30 8 31 /* EDGE (6 words) */ 8 32 8 33 dcl 1 edge based aligned, 8 34 2 from structure, 8 35 3 value ptr unal, 8 36 3 next ptr unal, 8 37 3 back ptr unal, 8 38 2 to structure, 8 39 3 value ptr unal, 8 40 3 next ptr unal, 8 41 3 back ptr unal; 8 42 8 43 8 44 /* FLOW_UNIT (22 words) */ 8 45 8 46 dcl 1 flow_unit based aligned, 8 47 2 next ptr unal, 8 48 2 back ptr unal, 8 49 2 successors ptr unal, 8 50 2 predecessors ptr unal, 8 51 2 dominator ptr unal, 8 52 2 loop ptr unal, 8 53 2 next_in_loop ptr unal, 8 54 2 loop_end_chain ptr unal, 8 55 2 position fixed bin(17) aligned, 8 56 2 number fixed bin(17) unal, 8 57 2 n_in_loop_end fixed bin(17) unal, 8 58 2 level_number fixed bin(17) aligned, 8 59 2 first_statement fixed bin (18) unsigned unal, 8 60 2 last_statement fixed bin (18) unsigned unal, 8 61 2 insert_statement fixed bin (18) unsigned unal, 8 62 2 insert_operator fixed bin (18) unsigned unal, 8 63 2 info structure unal, 8 64 3 processed bit(1), 8 65 3 loop_entry bit(1), 8 66 3 falls_through bit(1), 8 67 3 has_label bit(1), 8 68 3 entry_pt bit(1), 8 69 3 in_queue bit(1), 8 70 3 is_back_target bit(1), 8 71 3 has_side_effects bit(1), 8 72 3 removed bit(1), 8 73 3 refreshed bit(1), 8 74 3 pad bit(26), 8 75 2 used ptr unal, 8 76 2 set ptr unal, 8 77 2 busy_on_entry ptr unal, 8 78 2 set_multiple ptr unal, 8 79 2 busy_on_exit ptr unal, 8 80 2 dominated_by ptr unal, 8 81 2 is_active_operator ptr unal, 8 82 2 always_completely_set ptr unal; 8 83 8 84 8 85 /* INPUT_TO (3 words) */ 8 86 8 87 dcl 1 input_to based aligned, 8 88 2 next pointer unaligned, 8 89 2 operator pointer unaligned, 8 90 2 which fixed bin aligned; 8 91 8 92 /* LCHAIN (2 words) */ 8 93 8 94 dcl 1 lchain based aligned, 8 95 2 next pointer unaligned, 8 96 2 value fixed bin(18) aligned; 8 97 8 98 /* LOOP (33 words) */ 8 99 8 100 dcl 1 loop based aligned, 8 101 2 number fixed bin(18), 8 102 2 depth fixed bin(18), 8 103 2 father pointer unaligned, 8 104 2 brother pointer unaligned, 8 105 2 prev_brother pointer unaligned, 8 106 2 son pointer unaligned, 8 107 2 last_son pointer unaligned, 8 108 2 entry_unit pointer unaligned, 8 109 2 members pointer unaligned, 8 110 2 back_target pointer unaligned, 8 111 2 exits pointer unaligned, 8 112 2 first_unit pointer unaligned, 8 113 2 last_unit pointer unaligned, 8 114 2 is_member pointer unaligned, 8 115 2 is_exit pointer unaligned, 8 116 2 articulation_blocks pointer unaligned, 8 117 2 used pointer unaligned, 8 118 2 set pointer unaligned, 8 119 2 busy_on_exit pointer unaligned, 8 120 2 set_multiple pointer unaligned, 8 121 2 ancestors_and_me pointer unaligned, 8 122 2 bits structure unaligned, 8 123 3 has_side_effects bit(1), 8 124 3 erases structure unaligned, 8 125 4 xr(0:7) bit(1), 8 126 4 pr(6) bit(1), 8 127 3 avoid_pr(6) bit(1), 8 128 3 all_xrs_globally_assigned bit(1), 8 129 3 pad bit(14), 8 130 2 induction_var pointer unaligned, 8 131 2 may_keep_in_xr pointer unaligned, 8 132 2 computed pointer unaligned, 8 133 2 xregs_used fixed bin(4), 8 134 2 pregs_used fixed bin(4), 8 135 2 global_xr_items pointer unaligned, 8 136 2 global_pr_items pointer unaligned, 8 137 2 range_list pointer unaligned, 8 138 2 msp pointer unaligned, 8 139 2 eligible_ind_var_op_var pointer unaligned, 8 140 2 left_shift_chain pointer unaligned; 8 141 8 142 /* OPERATOR */ 8 143 8 144 dcl 1 operator based aligned, 8 145 8 146 /* WORD 1 */ 8 147 8 148 2 op_code fixed bin(8) unal, 8 149 2 assigns_constant_to_symbol bit(1) unal, 8 150 2 freed bit(1) unal, 8 151 2 number fixed bin(7) unsigned unal, 8 152 2 coordinate fixed bin(18) unsigned unal, 8 153 8 154 /* WORD 2 */ 8 155 8 156 2 next fixed bin(18) unsigned unal, 8 157 2 back fixed bin(18) unsigned unal, 8 158 8 159 /* WORD 3 */ 8 160 8 161 2 primary pointer unal, 8 162 8 163 /* WORD 4 */ 8 164 8 165 2 output fixed bin(18) aligned, 8 166 8 167 /* WORDS 5 - n */ 8 168 8 169 2 operand(n_operands refer (operator.number)) fixed bin (18) aligned; 8 170 8 171 dcl n_operands fixed bin; 8 172 8 173 8 174 /* OPT_STATEMENT */ 8 175 8 176 dcl 1 opt_statement based aligned structure, 8 177 8 178 /* WORD 1 */ 8 179 8 180 2 op_code fixed bin(8) unal, /* must be stat_op */ 8 181 2 number fixed bin(8) unal, /* must be 0 */ 8 182 2 label fixed bin (18) unsigned unal, 8 183 8 184 /* WORD 2 */ 8 185 8 186 2 first_operator fixed bin (18) unsigned unal, 8 187 2 prev_operator fixed bin (18) unsigned unal, 8 188 8 189 /* WORD 3 */ 8 190 8 191 2 next bit(18) unal, /* "0"b = no next statement */ 8 192 2 back bit(18) unal, /* "0"b = no prev statement */ 8 193 8 194 /* WORD 4 */ 8 195 8 196 2 source_id structure unaligned, 8 197 3 file fixed bin (8) unsigned, /* 0 = first file */ 8 198 3 line bit(14), 8 199 3 statement bit(5), /* 1 = first statement */ 8 200 8 201 2 length bit(9) unaligned, 8 202 8 203 /* WORD 5 */ 8 204 8 205 2 bits structure unaligned, 8 206 3 put_in_map bit(1), 8 207 3 put_in_profile bit(1), 8 208 3 processed_by_converter bit(1), 8 209 3 referenced_backwards bit(1), 8 210 3 referenced_by_assign bit(1), 8 211 3 has_operator_list bit(1), 8 212 3 moved bit(1), 8 213 3 removable bit(1), 8 214 3 pad bit(1), 8 215 8 216 2 start fixed bin(26) unaligned, 8 217 8 218 /* WORD 6 */ 8 219 8 220 2 location bit(18) unaligned, /* (18)"1"b = no code */ 8 221 2 machine_state fixed bin (18) unsigned unaligned, 8 222 8 223 /* WORD 7 */ 8 224 8 225 2 flow_unit pointer unaligned, 8 226 8 227 /* WORD 8 */ 8 228 8 229 2 operator_list pointer unaligned; 8 230 8 231 8 232 /* PRIMARY (4 words) */ 8 233 8 234 dcl 1 primary based aligned, 8 235 2 next pointer unaligned, 8 236 2 last pointer unaligned, 8 237 2 data structure aligned, 8 238 3 expression pointer unaligned, 8 239 3 flow_unit pointer unaligned; 8 240 8 241 /* RANGE (3 words) */ 8 242 8 243 dcl 1 range based aligned, 8 244 2 next pointer unaligned, 8 245 2 variable pointer unaligned, 8 246 2 bits structure unaligned, 8 247 3 range_bits structure unaligned, 8 248 4 fb17 bit(1), 8 249 4 fb18_uns bit(1), 8 250 3 mbz bit(34); 8 251 8 252 8 253 /* END fort_opt_nodes.incl.pl1 */ 292 293 294 call count_cases (i); 295 if i ^= last_assigned_op 296 then do; 297 call print_message (382, "The number of operator cases", "last_assigned_op"); 298 return; 299 end; 300 301 shared_struc_ptr = a_ptr; 302 303 polish_base = shared_globals.polish_base; 304 quadruple_base = shared_globals.quadruple_base; 305 object_base = shared_globals.object_base; 306 operand_base = shared_globals.operand_base; 307 308 polish_max_len = shared_globals.polish_max_len; 309 quad_max_len = shared_globals.quad_max_len; 310 object_max_len = shared_globals.object_max_len; 311 operand_max_len = shared_globals.operand_max_len; 312 313 eol_offset = 0; 314 eol_stack_p = addr (w (eol_offset)); 315 hold_offset = 0; 316 hold_stack_p = addr (w (hold_offset)); 317 sf_offset = 0; 318 sf_stack_p = addr (w (sf_offset)); 319 exit_offset = 0; 320 exit_stack_p = addr (w (exit_offset)); 321 sub_offset = 0; 322 sub_stack_p = addr (w (sub_offset)); 323 virtual_origin_offset = 0; 324 virtual_origin_list_ptr, virtual_origin_base = addr (w (virtual_origin_offset)); 325 block_if_offset = 0; 326 block_if_stack_p = addr (w (block_if_offset)); 327 dim_size_offset = 0; 328 dim_size_list_ptr = addr (w (dim_size_offset)); 329 330 one = create_integer_constant (1); 331 332 zero = create_integer_constant (0); 333 334 do cur_subprogram = shared_globals.first_subprogram repeat subp_ptr -> subprogram.next_subprogram 335 while (cur_subprogram > 0); 336 337 subp_ptr = addr (x (cur_subprogram)); 338 unspec (last_opt_statement) = "0"b; 339 last_op_index = 0; 340 work_stack_offset = 0; 341 342 do cur_statement = subp_ptr -> subprogram.first_polish repeat fixed (stm_ptr -> statement.next, 18) 343 while (cur_statement > 0); 344 345 stm_ptr = addr (p (cur_statement)); 346 347 /* Make the statement node for the current statement. */ 348 349 opst = create_opt_statement (); 350 351 next_statement_index = fixed (stm_ptr -> statement.next, 18); 352 if next_statement_index = 0 353 then next_statement_index = subp_ptr -> subprogram.last_polish + 1; 354 last_io_op = 0; 355 356 calls_local_entries = "0"b; 357 concatenates_star_extents = "0"b; 358 359 polish_offset = cur_statement + size (statement); 360 361 /* Check for a label, and add it on if present. The first test is needed as the top of the 362* polish might be followed by a count which happens to look like a label op. */ 363 364 if p (polish_offset) > last_assigned_op 365 then if p (polish_offset + 1) = label_op 366 then do; 367 opst -> opt_statement.label = p (polish_offset); 368 addr (x (p (polish_offset))) -> label.statement = last_op_index; 369 polish_offset = polish_offset + 2; 370 end; 371 372 call process_hold_stack_entry (); 373 opst -> opt_statement.processed_by_converter = "1"b; 374 375 /* Copy tokens from the polish to the working stack one at a time. When an operator is found, 376* process_operator is called to process it. Symbols are checked to see if they are statement_function 377* dummy arguments, and if so the substitution is made. The first time a particular dummy 378* argument is substituted, the quads which were used to evaluate it are rechained so they 379* immediately precede its use. */ 380 381 do polish_offset = polish_offset by 1 while (polish_offset < next_statement_index); 382 383 stack (work_stack_offset) = p (polish_offset); 384 call bump_work_stack_offset (+1); 385 386 if p (polish_offset) <= last_assigned_op & p (polish_offset) > 0 387 then call process_operator (); 388 else if p (polish_offset) > 0 389 then if addr (x (stack (work_stack_offset - 1))) -> node.node_type = symbol_node 390 then if addr (x (stack (work_stack_offset - 1))) -> symbol.dummy_arg 391 then do; 392 do sf_substitute_ptr = sf_stack_p 393 repeat (addr (w (sf_substitute_ptr -> sf_stack.last))) 394 while (sf_substitute_ptr ^= addr (w (0))); 395 396 j = 0; 397 398 do i = sf_substitute_ptr -> sf_stack.def_chain -> symbol.next_member 399 repeat (addr (x (i)) -> symbol.next_member) while (i ^= 0); 400 401 j = j + 1; 402 if i = stack (work_stack_offset - 1) 403 then go to GOT_THE_SF_VAR; 404 end; 405 end; 406 407 call print_message (203); 408 409 GOT_THE_SF_VAR: 410 if sf_substitute_ptr ^= addr (w (0)) 411 then do; 412 if sf_substitute_ptr -> sf_stack.arg_info (j).chain_start ^= 0 413 then call rechain_arg (sf_substitute_ptr, j); 414 stack (work_stack_offset - 1) = 415 sf_substitute_ptr -> sf_stack.arg_info (j).operand; 416 end; 417 end; 418 end; /* Loop over polish for one statement */ 419 420 end; /* Loop over statements */ 421 422 end; /* Loop over program units */ 423 424 if virtual_origin_offset ^= 0 /* if virtual origin list created */ 425 then call free_virtual_origin_list (); 426 427 if dim_size_offset ^= 0 /* if dimension size list created */ 428 then call free_dim_size_list (); 429 430 return; /* end of converter */ 431 432 process_operator: 433 proc (); 434 435 dcl op_code fixed bin (18); 436 437 op_code = stack (work_stack_offset - 1); 438 if op_code < 0 | op_code > last_assigned_op 439 then go to case (0); 440 go to case (op_code); 441 442 count_cases: 443 entry (number_of_cases); 444 445 dcl number_of_cases fixed bin (18); 446 447 number_of_cases = hbound (case, 1); 448 return; 449 450 case (0): /* ERROR */ 451 452 /* No such thing as operator with op_code of 0. */ 453 454 call print_message (200, char (op_code)); 455 return; 456 457 case (1): /* ASSIGN */ 458 459 /* Stack is (<>) <...> 460* Create an assignment op quad, with conversion if needed, and reduce stack 461* to (<>) <...> */ 462 463 call process_assign (); 464 return; 465 466 case (2): /* ADD */ 467 case (3): /* SUB */ 468 case (4): /* MULT */ 469 case (5): /* DIV */ 470 471 /* Stack is (<>) <...> 472* Process the operation as appropriate, and reduce stack to (<>) <...> */ 473 474 call process_arith (subscript_processing & ^suspend_subscript); 475 return; 476 477 case (6): /* EXP */ 478 479 /* Stack is (<>) <...> 480* Process the operation and reduce stack to (<>) <...> */ 481 482 call process_expo (subscript_processing & ^suspend_subscript); 483 return; 484 485 case (7): /* NEG */ 486 487 /* Stack is (<>) <...> In the case where we are not currently evaluating 488* a subscript expression, or we are evaluating a subscript expression but we have a true (non-zero) operand, 489* we share code with the not_op case. If we are evaluating a subscript expression at present, and the operand 490* in the stack is a zero, it indicates that the true operand of the minus is the accumulated 491* subscript value in sub_stack, and we negate it directly. */ 492 493 if ^subscript_processing | suspend_subscript 494 then go to case (16); 495 else if stack (work_stack_offset - 2) ^= 0 496 then go to case (16); 497 else do; 498 sub_stack.dim.offset = -sub_stack.dim.offset; 499 if sub_stack.dim.temp ^= 0 500 then sub_stack.dim.mult = -sub_stack.dim.mult; 501 call bump_work_stack_offset (-1); 502 end; 503 return; 504 505 case (8): /* LESS */ 506 case (9): /* LESS_OR_EQUAL */ 507 case (10): /* EQUAL */ 508 case (11): /* NOT_EQUAL */ 509 case (12): /* GREATER_OR_EQUAL */ 510 case (13): /* GREATER */ 511 512 /* Stack is (<>) <...> 513* we will simply make sure that the data types match, then share code with logical ops. */ 514 515 call get_data_type (2); 516 call conversion; 517 518 case (14): /* OR */ 519 case (15): /* AND */ 520 case (103): /* EQUIV */ 521 case (104): /* NOT_EQUIV */ 522 523 /* Stack is (<>) <...> 524* Create an appropriate quad, and reduce the stack to 525* (<>) <...> */ 526 527 op_index = create_operator (2); 528 stack (work_stack_offset) = create_temporary ((logical_mode)); 529 call bump_work_stack_offset (+1); 530 return; 531 532 case (16): /* NOT */ 533 534 /* Stack is (<>) <...> 535* Create an appropriate quad, and reduce the stack to (<>) <...> */ 536 537 call get_data_type (1); 538 op_index = create_operator (1); 539 stack (work_stack_offset) = create_temporary (rand_data_type (1)); 540 call bump_work_stack_offset (+1); 541 return; 542 543 case (17): /* JUMP */ 544 545 /* Stack is (<>)