COMPILATION LISTING OF SEGMENT fort_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 11/10/88 1345.2 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 /* Created: June 1976 11* 12* Modified: 13* 22 Jun 84, MM - Install typeless functions support. 14* 28 Mar 84, MM - Install HFP support. 15* 12 Jul 83, MM - 379: Add references to fort_declared and replace code 16* to generate options string with a call to fort_defaults_. 17* 19 Jun 83, HH - 145: Add display of new 'label' node fields. 18* 17 Jun 83, HH - 383: Add "process_param_list" to 'op_names'. 19* 13 Jan 83, HH - Add "form_VLA_packed_ptr" to 'op_names' and remove 20* references to the obsolete 'indirect_scan_op'. 21* 22 September 1982, TO - Add VLA_is_256K for shared vars. 22* 7 May 82, TO - To re-compute options string to reflect '%global's. 23* 7 May 82, TO - To include multiply check in options string. 24* 15 March 82, TO - Add source_line_number, source_file_number. 25* 15 March 82, TO - Add "on or after line 16384" message. 26* 2 December 81, MEP - add "round" to options string. 27* 24 October 81, MEP - new operator for inquire statement. 28* 20 October 1981, CRD - new operators for internal files. 29* 12 May 1981, MEP - Added two new operators for display routines: equiv and not_equiv. 30* 17 February 1981, CRD - Change display routines for new dimension 31* node layout. 32* 8 January 1981, CRD - Change display routines for new bit 33* label.not_referencable. 34* 18 December 1980, CRD - Change display routines for new bit 35* opt_statement.removable. 36* 9 December 1980, CRD - Change display routines for three new 37* operators - block_if, else_if, and else. 38* 1 September 1980, CRD - Change diaplay routines for new bit 39* array_ref.has_address. 40* 18 July 1980, CRD - Change display routines for new bit 41* symbol.variable_arglist. 42* 19 June 1980, MEP - fort_display now prints the source statments 43* when it encounters a source node or quad. 44* 7 March 1980, CRD - change multi_position bit to stack_indirect. 45* 29 February 1980, CRD - change options string to properly reflect 46* the new default of -relocatable. 47* 31 January 1980, CRD - changes for new stringrange option. 48* 23 January 1980, CRD - changes to header node and fix offset_unit_names. 49* 21 December 1979, RAB - more register optimizer changes and call probe instead of debug. 50* 5 November 1979, RAB - change display progs for register optimizer 51* 19 October 1979, CRD - increase length of phase names, and always 52* display octal numbers with a trailing "o". 53* 5 October 1979, CRD - node changes for new EAQ scheme. 54* 17 September 1979, RAB - for register optimizer (node changes) 55* 12 September 1979, CRD - fix minor glitch in decode_source_id. 56* 13 August 1979, RAB - add cat_op & substr_op 57* 19 July 1979, RAB - change fort_display for char_mode incl file changes 58* 4 July 1979, RAB - have temporary.loop_end_fu_pos and header.length 59* print out in decimal. 60* 28 Jun 1979, PES - Initialize parameter math entry arrays. 61* 20 Jun 1979, PES - Fix unreported bug in which QUIT/RL before parse is called caused fault. 62* 18 Dec 1978, PES - Make auto_zero and do_rounding the defaults for FAST, DFAST, and run units. 63* 09 Dec 1978, PES - Change so fort_display will show options. 64* 05 Dec 1978, PES - Remove kludge of Jul 31, changes for new options. 65* 25 Oct 1978, PES - Changes for larger common and arrays. 66* 25 Sep 1978, RAB - c/loop_end_fu_num/loop_end_fu_pos/ to help fix 187 67* 31 Jul 1978, PES - Kludge around bug in PLI compiler. 68* 27 Jul 1978, PES - remove references to full and simple command arguments. 69* 26 Jun 1978, DSL - move create_constant to fort_utilities.incl.pl1. 70* 26 Jan 1978, RAB - Change for loop optimizer. 71* 10 Jan 1978, DSL - Implement once_per_statement and once_per_subprogram for error 72* messages, and control them and once_per_compilation using options.brief. 73* See comments in procedure print_meessage_op. 74* 27 Dec 1977, DSL - implement print once per compilation for error messages. 75* 30 Aug 1977, DSL - implement fortran_severity_; display changes: print common 76* block nodes for "dcl", print summary of polish; NOTE -- value of bias 77* changed from 65536 to 131072. 78* 05 Jul 1977, DSL - 1) 3 new operators; 2) remove refs to block_data_subprogram. 79* 03 May 1977, DSL - restore timing info to old format; add trim_floating. 80* 28 Apr 1977, DSL - recompile for new operator, xmit_vector. 81* 25 Mar 1977, DSL - improve error messages, improve display prgms, 82* include counts with timing info only if debugging. 83* 24 Feb 1977, GDC - add optimize capability. 84* 09 Dec 1976, DSL - new compiler_source_info.incl.pl1; 85* new fort_command_structure.incl.pl1; completely rewrite display code. 86* 20 Oct 1976, RAB - add relocation bits, variable max_lens. 87* 12 Sep 1976, DSL - add listing capability, clean up display programs. 88**/ 89 90 /* format: style3,^delnl,linecom */ 91 fort_: 92 procedure (source_info_ptr, /* input; pointer to source info structure */ 93 object_base_ptr, 94 /* input; pointer to object segment */ 95 object_length, /* output; word length of object segment */ 96 options_ptr, 97 /* input; pointer to fort options structure */ 98 declared_ptr, /* input; pointer to fort declared structure */ 99 get_next_source_seg_entry, 100 /* input; routine to provide next source seg or null entry value */ 101 add_to_lib_list_entry, 102 /* input; routine to handle lib pathnames or null entry value */ 103 code); 104 /* output; error code */ 105 106 /* PARAMETERS */ 107 108 dcl add_to_lib_list_entry 109 entry variable; 110 dcl code fixed bin (35); 111 dcl get_next_source_seg_entry 112 entry variable; 113 dcl object_base_ptr pointer; 114 dcl object_length fixed bin (19); 115 dcl options_ptr pointer; 116 dcl declared_ptr pointer; 117 dcl source_info_ptr pointer; 118 119 /* This is the main entry point to the new fortran compiler. */ 120 1 1 /* BEGIN fort_nodes.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 1 7* install(86-07-28,MR12.0-1105): 1 8* Fix fortran bug 473. 1 9* 2) change(88-04-28,RWaters), approve(88-04-28,MCR7875), audit(88-07-13,Huen), 1 10* install(88-11-10,MR12.2-1209): 1 11* Implement SCP 6339: Allow character variable to be up to 128K-1 (131071) 1 12* character long. 1 13* END HISTORY COMMENTS */ 1 14 1 15 1 16 /* Written: June 1976 by David Levin and Richard Barnes 1 17* 1 18*Modified: 1 19* Feb 24 1977 by G. Chang for the optimizer 1 20* Sept 12, 1977 by R. Barnes for the loop optimizer 1 21* Nov 16, 1977 by D. Levin to add machine state node for loop optimizer 1 22* Oct 09 1978 by P Smee for larger common and arrays. 1 23* Dec 05 1978 by P Smee for %options statement. 1 24* Jan 17 1979 by R Barnes for machine_state.value_in_xr 1 25* May 23 1979 by P Smee to add source.line_number 1 26* July 19 1979 by R Barnes for char mode changes 1 27* Sept 17 1979 by R Barnes for register optimizer changes 1 28* Oct 3 1979 by C R Davis for new EAQ management scheme. 1 29* 29 Oct 1979 by C R Davis for machine_state.eaq.reserved. 1 30* 3 Nov 1979 by R. Barnes for pointer node and to change 1 31* machine_state.next from a fixed bin to a pointer. 1 32* 18 Dec 1979 by R. Barnes for loop_ref_count to finalize 1 33* changes for the register optimizer. 1 34* 17 Dec 1979 by C R Davis for symbol.descriptor 1 35* 22 Dec 1979 by R. Barnes to remove in_list. 1 36* 22 Jan 1980 by P E Smee to try for long char arrays. 1 37* 23 Jan 1980 by C R Davis to fix bugs with yesterday's changes. 1 38* 4 Mar 1980 by C R Davis to rename node.multi_position to 1 39* node.stack_indirect, and to add machine_state.stack_extended 1 40* and machine_state.last_dynamic_temp. 1 41* 5 Jun 1980 by M E Presser to alter arg_desc node for use 1 42* in stack-extensions and arg-descriptor generation. 1 43* 16 July 1980 by C R Davis for symbol.variable_arglist. 1 44* 8 Jan 81 by M E Presser for label.not_referencable 1 45* 17 Feb 1981 by C R Davis for new dimension node layout. 1 46* 11 March 1981 by MEP for dimension.assumed_size 1 47* 3 May 1982 by TO to add star_extent_function to subprogram node. 1 48* Mod 1 25 August 1982 by TO to add VLA_chain and LA_chain to subprogram node. 1 49* Mod 1 2 September 1982 by TO to add 5 more entries to storage_info in 1 50* the subprogram node (13-17), and to add VLA and LA bits to the 1 51* symbol node. 1 52* Mod 1 2 September 1982 by TO move fields around in nodes to get correct 1 53* 24 (really 35) bit fields and still maintain mapping between 1 54* node, temporary, and array_ref (others limit to word 6 like node.) 1 55* 19 Jun 83, HH - 145: Add 'branched_to', 'ends_do_loop' & 'loop_end' 1 56* to 'label' node. 1 57* 19 Feb 86, BW & AG - 473.a: Add 'VLA' to 'arg_desc' node. 1 58*END Modifications */ 1 59 1 60 1 61 /* GENERAL NODE TEMPLATE */ 1 62 1 63 dcl 1 node aligned based structure, 1 64 1 65 /* WORD 1 */ 1 66 1 67 2 node_type fixed bin (4) unaligned, 1 68 2 data_type fixed bin (4) unaligned unsigned, 1 69 2 operand_type fixed bin (4) unaligned, 1 70 1 71 2 addressing_bits unaligned structure, 1 72 3 is_addressable bit (1), 1 73 3 value_in, 1 74 4 eaq bit (1), 1 75 4 x bit (1), 1 76 3 allocated bit (1), 1 77 3 needs_pointer bit (1), 1 78 3 stack_indirect bit (1), 1 79 3 large_address bit (1), 1 80 3 address_in_base bit (1), 1 81 3 dont_update bit (1), /* for optimizer */ 1 82 3 not_in_storage bit (1), /* for optimizer */ 1 83 3 globally_assigned bit (1), /* for optimizer */ 1 84 1 85 2 bits unaligned structure, 1 86 3 standard_bits, 1 87 4 allocate bit (1), 1 88 4 set bit (1), 1 89 4 referenced bit (1), 1 90 4 passed_as_arg bit (1), 1 91 1 92 3 fill bit (7), /* These bits may be used by individual nodes. */ 1 93 1 94 /* WORD 2 */ 1 95 1 96 2 address aligned structure, 1 97 3 base bit (3) unaligned, /* For labels and constants, base and offset are */ 1 98 3 offset fixed bin (14) unaligned, /* combined to: fixed bin (18) unsigned unaligned. */ 1 99 3 char_num fixed bin (2) unaligned unsigned, 1 100 3 bit_num fixed bin (4) unaligned unsigned, 1 101 3 fill bit (4) unaligned, 1 102 3 inhibit bit (1) unaligned, 1 103 3 ext_base bit (1) unaligned, 1 104 3 tag bit (6) unaligned, 1 105 1 106 /* WORD 3 */ 1 107 1 108 2 units fixed bin (3) unaligned unsigned, 1 109 2 fill bit (3) unaligned, /* already used in symbol node */ 1 110 2 reloc_hold bit (6) unaligned, 1 111 2 reloc bit (6) unaligned, 1 112 2 addr_hold bit (18) unaligned, 1 113 1 114 /* WORD 4. Must not change for constant, char_constant, header, label, or symbol nodes. */ 1 115 1 116 2 next fixed bin (18) unsigned unaligned, 1 117 2 hash_chain fixed bin (18) unsigned unaligned, /* No hash chain for header nodes. */ 1 118 1 119 /* WORD 5 */ 1 120 1 121 2 pad fixed bin (18) unsigned unaligned, 1 122 2 loop_ref_count fixed bin (17) unaligned, /* Only for symbols and temporaries. */ 1 123 1 124 /* WORD 6 */ 1 125 1 126 2 location fixed bin (24) aligned; /* Only for array refs, symbols, temporaries, and headers. */ 1 127 1 128 /* ARG DESCRIPTOR NODE */ 1 129 1 130 dcl 1 arg_desc based aligned, 1 131 1 132 /* WORD 1 */ 1 133 1 134 2 node_type fixed bin (4) unaligned, 1 135 2 n_args fixed bin (12) unaligned, 1 136 2 pad bit (18) unaligned, 1 137 1 138 /* WORDS 2 - N_ARGS + 1 */ 1 139 1 140 2 arg(num_args refer(n_args)) aligned, 1 141 3 data_type fixed bin (4) unaligned unsigned, 1 142 3 must_be unaligned, 1 143 4 array bit (1) unaligned, 1 144 4 scalar bit (1) unaligned, 1 145 4 VLA bit (1) unaligned, 1 146 3 star_extents bit (1) unaligned, 1 147 3 pad bit (9) unaligned, 1 148 3 symbol fixed bin (18) unaligned; 1 149 1 150 dcl num_args fixed bin; 1 151 1 152 1 153 /* ARRAY REF NODE -- Must be same size as TEMPORARY NODE. */ 1 154 1 155 dcl 1 array_ref aligned based structure, 1 156 1 157 /* WORD 1 */ 1 158 1 159 2 node_type fixed bin (4) unaligned, 1 160 2 data_type fixed bin (4) unaligned unsigned, 1 161 2 operand_type fixed bin (4) unaligned, 1 162 1 163 2 addressing_bits unaligned structure, 1 164 3 is_addressable bit (1), 1 165 3 value_in, 1 166 4 eaq bit (1), 1 167 4 x bit (1), 1 168 3 allocated bit (1), 1 169 3 needs_pointer bit (1), 1 170 3 stack_indirect bit (1), 1 171 3 large_address bit (1), 1 172 3 address_in_base bit (1), 1 173 3 dont_update bit (1), /* for optimizer */ 1 174 3 not_in_storage bit (1), /* for optimizer */ 1 175 3 globally_assigned bit (1), /* for optimizer */ 1 176 1 177 2 bits unaligned structure, 1 178 3 standard_bits, 1 179 4 allocate bit (1), 1 180 4 set bit (1), 1 181 4 referenced bit (1), 1 182 4 passed_as_arg bit (1), 1 183 1 184 3 variable_length bit (1), 1 185 1 186 3 variable_offset bit (1), 1 187 1 188 3 invariant bit (1), /* must line up with temporary node */ 1 189 3 irreducible bit (1), /* .. */ 1 190 3 used_across_loops bit (1), /* .. */ 1 191 1 192 3 large_offset bit (1), 1 193 1 194 3 has_address bit (1), 1 195 1 196 /* WORD 2 */ 1 197 1 198 2 address aligned structure, 1 199 3 base bit (3) unaligned, 1 200 3 offset fixed bin (14) unaligned, 1 201 3 char_num fixed bin (2) unaligned unsigned, 1 202 3 bit_num fixed bin (4) unaligned unsigned, 1 203 3 fill bit (4) unaligned, 1 204 3 inhibit bit (1) unaligned, 1 205 3 ext_base bit (1) unaligned, 1 206 3 tag bit (6) unaligned, 1 207 1 208 /* WORD 3 */ 1 209 1 210 2 units fixed bin (3) unaligned unsigned, 1 211 2 fill bit (3) unaligned, 1 212 2 reloc_hold bit (6) unaligned, 1 213 2 reloc bit (6) unaligned, 1 214 2 addr_hold bit (18) unaligned, 1 215 1 216 /* WORD 4 */ 1 217 1 218 2 next fixed bin (18) unsigned unaligned, 1 219 2 loop_end_fu_pos fixed bin (17) unaligned, /* must overlay temporary.loop_end_fu_pos */ 1 220 1 221 /* WORD 5 */ 1 222 1 223 2 pad fixed bin (18) unsigned unaligned, 1 224 2 v_offset fixed bin (18) unsigned unaligned, 1 225 1 226 /* WORD 6 */ 1 227 1 228 2 location fixed bin (24) aligned, 1 229 1 230 /* WORD 7 */ 1 231 1 232 2 ref_count fixed bin (17) unaligned, /* must overlay temporary.ref_count */ 1 233 2 output_by fixed bin (18) unsigned unal, /* must overlay temporary.output_by */ 1 234 1 235 /* WORD 8 */ 1 236 1 237 2 length fixed bin (24) aligned, 1 238 1 239 /* WORD 9 */ 1 240 1 241 2 start_input_to fixed bin (18) unsigned unal, /* must overlay temporary.start_input_to */ 1 242 2 end_input_to fixed bin (18) unsigned unal, /* must overlay temporary.end_input_to */ 1 243 1 244 /* WORD 10 */ 1 245 1 246 2 ref_count_copy fixed bin (17) unaligned, /* must overlay temporary.ref_count_copy */ 1 247 2 parent fixed bin (18) unsigned unaligned, 1 248 1 249 /* WORD 11 */ 1 250 1 251 2 unused fixed bin (24) aligned; /* Pad to size of 'temporary'. */ 1 252 1 253 1 254 /* CONSTANT NODE */ 1 255 1 256 dcl 1 constant aligned based structure, 1 257 1 258 /* WORD 1 */ 1 259 1 260 2 node_type fixed bin (4) unaligned, 1 261 2 data_type fixed bin (4) unaligned unsigned, 1 262 2 operand_type fixed bin (4) unaligned, 1 263 1 264 2 addressing_bits unaligned structure, 1 265 3 is_addressable bit (1), 1 266 3 value_in, 1 267 4 eaq bit (1), 1 268 4 x bit (1), 1 269 3 allocated bit (1), 1 270 3 needs_pointer bit (1), 1 271 3 stack_indirect bit (1), 1 272 3 large_address bit (1), 1 273 3 address_in_base bit (1), 1 274 3 dont_update bit (1), /* for optimizer */ 1 275 3 not_in_storage bit (1), /* for optimizer */ 1 276 3 globally_assigned bit (1), /* for optimizer */ 1 277 1 278 2 bits unaligned structure, 1 279 3 standard_bits, 1 280 4 allocate bit (1), 1 281 4 set bit (1), 1 282 4 referenced bit (1), 1 283 4 passed_as_arg bit (1), 1 284 1 285 3 fill bit (7), 1 286 1 287 /* WORD 2 */ 1 288 1 289 2 address aligned structure, 1 290 3 location fixed bin (18) unsigned unaligned, 1 291 3 op bit (10) unaligned, 1 292 3 inhibit bit (1) unaligned, 1 293 3 ext_base bit (1) unaligned, 1 294 3 tag bit (6) unaligned, 1 295 1 296 /* WORD 3 */ 1 297 1 298 2 units fixed bin (3) unaligned unsigned, 1 299 2 fill bit (3) unaligned, 1 300 2 reloc_hold bit (6) unaligned, 1 301 2 reloc bit (6) unaligned, 1 302 2 addr_hold bit (18) unaligned, 1 303 1 304 /* WORD 4 */ 1 305 1 306 2 next_constant fixed bin (18) unsigned unaligned, 1 307 2 hash_chain fixed bin (18) unsigned unaligned, 1 308 1 309 /* WORDS 5 & 6 */ 1 310 1 311 2 value bit (72) aligned; 1 312 1 313 1 314 /* CHARACTER CONSTANT NODE */ 1 315 1 316 dcl 1 char_constant aligned based structure, 1 317 1 318 /* WORD 1 */ 1 319 1 320 2 node_type fixed bin (4) unaligned, 1 321 2 data_type fixed bin (4) unaligned unsigned, 1 322 2 operand_type fixed bin (4) unaligned, 1 323 1 324 2 addressing_bits unaligned structure, 1 325 3 is_addressable bit (1), 1 326 3 value_in, 1 327 4 eaq bit (1), 1 328 4 x bit (1), 1 329 3 allocated bit (1), 1 330 3 needs_pointer bit (1), 1 331 3 stack_indirect bit (1), 1 332 3 large_address bit (1), 1 333 3 address_in_base bit (1), 1 334 3 dont_update bit (1), /* for optimizer */ 1 335 3 not_in_storage bit (1), /* for optimizer */ 1 336 3 globally_assigned bit (1), /* for optimizer */ 1 337 1 338 2 bits unaligned structure, 1 339 3 standard_bits, 1 340 4 allocate bit (1), 1 341 4 set bit (1), 1 342 4 referenced bit (1), 1 343 4 passed_as_arg bit (1), 1 344 1 345 3 no_value_stored bit (1), 1 346 1 347 3 fill bit (6), 1 348 1 349 /* WORD 2 */ 1 350 1 351 2 address aligned structure, 1 352 3 location fixed bin (18) unsigned unaligned, 1 353 3 char_num fixed bin (2) unaligned unsigned, 1 354 3 bit_num fixed bin (4) unaligned unsigned, 1 355 3 fill bit (4) unaligned, 1 356 3 inhibit bit (1) unaligned, 1 357 3 ext_base bit (1) unaligned, 1 358 3 tag bit (6) unaligned, 1 359 1 360 /* WORD 3 */ 1 361 1 362 2 units fixed bin (3) unaligned unsigned, 1 363 2 fill bit (3) unaligned, 1 364 2 reloc_hold bit (6) unaligned, 1 365 2 reloc bit (6) unaligned, 1 366 2 addr_hold bit (18) unaligned, 1 367 1 368 /* WORD 4 */ 1 369 1 370 2 next_constant fixed bin (18) unsigned unaligned, 1 371 2 hash_chain fixed bin (18) unsigned unaligned, 1 372 1 373 /* WORDS 5 thru n */ 1 374 1 375 2 length fixed bin (18) unsigned unaligned, 1 376 2 value char(char_constant_length refer(char_constant.length)) unaligned; 1 377 1 378 dcl char_constant_length fixed bin (18) unsigned; 1 379 1 380 1 381 /* DIMENSION NODE */ 1 382 1 383 dcl 1 dimension aligned based structure, 1 384 1 385 /* WORD 1 */ 1 386 1 387 2 node_type fixed bin (4) unaligned, /* The only field in common with other nodes */ 1 388 1 389 2 number_of_dims fixed bin (3) unaligned, /* Number of dimensions */ 1 390 1 391 2 v_bound (7) unaligned, /* Variable bound info - up to 7 dims. */ 1 392 3 lower bit (1) unaligned, /* On if lower bound is variable */ 1 393 3 upper bit (1) unaligned, /* On if upper bound is variable */ 1 394 1 395 2 has_virtual_origin bit (1) unaligned, /* On if virtual_origin is valid */ 1 396 2 has_array_size bit (1) unaligned, /* On if array_size is valid */ 1 397 2 has_dim_sizes bit (1) unaligned, /* On if dim.size (*) is valid */ 1 398 1 399 2 variable_virtual_origin bit (1) unaligned, /* On if virtual_origin is variable */ 1 400 2 variable_array_size bit (1) unaligned, /* On if array_size is variable */ 1 401 2 assumed_size bit (1) unaligned, /* On if array has assumed size */ 1 402 1 403 2 fill bit (7) unaligned, 1 404 1 405 /* WORD 2 */ 1 406 1 407 2 virtual_origin fixed bin (24) aligned, 1 408 1 409 /* WORD 3 */ 1 410 1 411 2 element_count fixed bin (24) aligned, 1 412 1 413 /* WORD 4 */ 1 414 1 415 2 array_size fixed bin (24) aligned, /* Expressed in symbol.units */ 1 416 1 417 /* WORD 5 */ 1 418 1 419 2 VLA_base_addressor fixed bin (18) aligned, 1 420 1 421 /* WORDS 6 - n (max = 26) */ 1 422 1 423 2 dim (num_dims refer (dimension.number_of_dims)) aligned, 1 424 1 425 3 lower_bound fixed bin (24) aligned, /* Lower bound of this dimension */ 1 426 1 427 3 upper_bound fixed bin (24) aligned, /* Upper bound of this dimension */ 1 428 1 429 3 size fixed bin (24) aligned; /* No. of elements in this dimension */ 1 430 1 431 dcl num_dims fixed bin (3); 1 432 1 433 1 434 /* HEADER NODE */ 1 435 1 436 dcl 1 header aligned based structure, 1 437 1 438 /* WORD 1 */ 1 439 1 440 2 node_type fixed bin (4) unaligned, 1 441 2 data_type fixed bin (4) unaligned unsigned, 1 442 2 operand_type fixed bin (4) unaligned, 1 443 1 444 2 addressing_bits unaligned structure, 1 445 3 is_addressable bit (1), 1 446 3 value_in, 1 447 4 eaq bit (1), 1 448 4 x bit (1), 1 449 3 allocated bit (1), 1 450 3 needs_pointer bit (1), 1 451 3 stack_indirect bit (1), 1 452 3 large_address bit (1), 1 453 3 address_in_base bit (1), 1 454 3 dont_update bit (1), /* for optimizer */ 1 455 3 not_in_storage bit (1), /* for optimizer */ 1 456 3 globally_assigned bit (1), /* for optimizer */ 1 457 1 458 2 bits unaligned structure, 1 459 3 storage_info, 1 460 4 standard_bits, 1 461 5 allocate bit (1), 1 462 5 set bit (1), 1 463 5 referenced bit (1), 1 464 5 passed_as_arg bit (1), 1 465 4 initialed bit (1), /* On if any member has initial attribute. */ 1 466 1 467 3 alignment structure unaligned, 1 468 4 even bit (1), 1 469 4 odd bit (1), 1 470 4 character bit (1), 1 471 1 472 3 storage_class structure unaligned, 1 473 4 automatic bit (1), 1 474 4 static bit (1), 1 475 4 in_common bit (1), 1 476 1 477 /* WORD 2 */ 1 478 1 479 2 address aligned structure, 1 480 3 base bit (3) unaligned, 1 481 3 offset fixed bin (14) unaligned, 1 482 3 char_num fixed bin (2) unaligned unsigned, 1 483 3 bit_num fixed bin (4) unaligned unsigned, 1 484 3 fill bit (4) unaligned, 1 485 3 inhibit bit (1) unaligned, 1 486 3 ext_base bit (1) unaligned, 1 487 3 tag bit (6) unaligned, 1 488 1 489 /* WORD 3 */ 1 490 1 491 2 units fixed bin (3) unaligned unsigned, 1 492 2 VLA bit (1) unaligned, /* chain for VLA's */ 1 493 2 LA bit (1) unaligned, /* chain for LA's */ 1 494 2 fill bit (1) unaligned, 1 495 2 reloc_hold bit (6) unaligned, 1 496 2 reloc bit (6) unaligned, 1 497 2 addr_hold bit (18) unaligned, 1 498 1 499 /* WORD 4 */ 1 500 1 501 2 next_header fixed bin (18) unsigned unaligned, 1 502 2 first_element fixed bin (18) unsigned unaligned, 1 503 1 504 /* WORD 5 */ 1 505 1 506 2 last_element fixed bin (18) unsigned unaligned, 1 507 2 name_length fixed bin (17) unaligned, 1 508 1 509 /* WORD 6 */ 1 510 1 511 2 location fixed bin (24) aligned, 1 512 1 513 /* WORD 7 */ 1 514 1 515 2 length fixed bin (24) aligned, 1 516 1 517 /* WORD 8 */ 1 518 1 519 2 VLA_base_addressor fixed bin (18) aligned, 1 520 1 521 /* WORDS 9 - n. This field is variable in length. Its length is zero for equivalence groups. */ 1 522 1 523 2 block_name char(allocate_symbol_name refer (header.name_length)) aligned; 1 524 1 525 dcl allocate_symbol_name fixed bin; 1 526 1 527 1 528 /* LABEL NODE */ 1 529 1 530 dcl 1 label aligned based structure, 1 531 1 532 /* WORD 1 */ 1 533 1 534 2 node_type fixed bin (4) unaligned, 1 535 2 data_type fixed bin (4) unaligned unsigned, 1 536 2 operand_type fixed bin (4) unaligned, 1 537 1 538 2 addressing_bits unaligned structure, 1 539 3 is_addressable bit (1), 1 540 3 value_in, 1 541 4 eaq bit (1), 1 542 4 x bit (1), 1 543 3 allocated bit (1), 1 544 3 needs_pointer bit (1), 1 545 3 stack_indirect bit (1), 1 546 3 large_address bit (1), 1 547 3 address_in_base bit (1), 1 548 3 dont_update bit (1), /* for optimizer */ 1 549 3 not_in_storage bit (1), /* for optimizer */ 1 550 3 globally_assigned bit (1), /* for optimizer */ 1 551 1 552 2 bits unaligned structure, 1 553 3 storage_info, 1 554 4 standard_bits, 1 555 5 allocate bit (1), 1 556 5 set bit (1), 1 557 5 referenced bit (1), 1 558 5 passed_as_arg bit (1), 1 559 4 referenced_executable bit (1), 1 560 1 561 3 usage, /* Label is on a non-executable stmnt if both bits are ON. */ 1 562 4 format bit (1), 1 563 4 executable bit (1), 1 564 1 565 3 restore_prs bit (1), 1 566 3 not_referencable bit (1), 1 567 3 branched_to bit (1), 1 568 3 ends_do_loop bit (1), 1 569 1 570 /* WORD 2 */ 1 571 1 572 2 address aligned structure, 1 573 3 location fixed bin (18) unsigned unaligned, 1 574 3 op bit (10) unaligned, 1 575 3 inhibit bit (1) unaligned, 1 576 3 ext_base bit (1) unaligned, 1 577 3 tag bit (6) unaligned, 1 578 1 579 /* WORD 3 */ 1 580 1 581 2 units fixed bin (3) unaligned unsigned, 1 582 2 fill bit (3) unaligned, 1 583 2 reloc_hold bit (6) unaligned, 1 584 2 reloc bit (6) unaligned, 1 585 2 addr_hold bit (18) unaligned, 1 586 1 587 /* WORD 4 */ 1 588 1 589 2 next_label fixed bin (18) unsigned unaligned, 1 590 2 hash_chain fixed bin (18) unsigned unaligned, 1 591 1 592 /* WORD 5 */ 1 593 1 594 2 format_var fixed bin (18) unsigned unaligned, 1 595 2 name fixed bin (17) unaligned, 1 596 1 597 /* WORD 6 */ 1 598 1 599 2 statement fixed bin (18) unsigned unaligned, 1 600 2 loop_end fixed bin (18) unsigned unaligned; 1 601 1 602 1 603 /* LIBRARY NODE */ 1 604 1 605 dcl 1 library aligned based structure, 1 606 1 607 /* WORD 1 */ 1 608 1 609 2 node_type fixed bin (4) unaligned, /* The only field in common with the other nodes. */ 1 610 2 fill bit (13) unaligned, 1 611 2 next_library_node fixed bin (18) unsigned unaligned, 1 612 1 613 /* WORD 2 */ 1 614 1 615 2 character_operand fixed bin (18) unsigned aligned; 1 616 1 617 1 618 /* MACHINE_STATE NODE */ 1 619 1 620 dcl 1 machine_state aligned based structure, 1 621 1 622 /* WORD 1 */ 1 623 1 624 2 node_type fixed bin (4) unal, 1 625 2 pad bit (31) unal, 1 626 1 627 /* WORD 2 */ 1 628 1 629 2 next pointer unaligned, 1 630 1 631 /* WORDS 3-104 */ 1 632 1 633 2 ms aligned, 1 634 1 635 3 eaq (4), /* One for each of the A, Q, EAQ, and IND */ 1 636 4 name fixed bin, 1 637 4 number fixed bin, 1 638 4 variable(4) fixed bin (18), 1 639 4 reserved bit (1) aligned, 1 640 3 rounded bit (1) aligned, 1 641 3 indicators_valid fixed bin (18), 1 642 1 643 3 value_in_xr bit (1) aligned, 1 644 1 645 3 index_regs(0:7), 1 646 4 bits structure unaligned, 1 647 5 global bit (1), 1 648 5 reserved bit (1), 1 649 5 mbz bit (34), 1 650 4 type fixed bin (18), 1 651 4 variable fixed bin (18), 1 652 4 used fixed bin (18), 1 653 4 mbz fixed bin (18), 1 654 1 655 3 address_in_base bit (1) aligned, 1 656 1 657 3 base_regs(0:7), 1 658 4 bits structure unaligned, 1 659 5 global bit (1), 1 660 5 reserved bit (1), 1 661 5 mbz bit (34), 1 662 4 type fixed bin (18), 1 663 4 variable fixed bin (18), 1 664 4 used fixed bin (18), 1 665 4 offset fixed bin (18), 1 666 1 667 3 stack_extended bit (1) aligned, 1 668 3 last_dynamic_temp fixed bin (18); 1 669 1 670 /* POINTER NODE */ 1 671 1 672 dcl 1 pointer aligned based structure, 1 673 1 674 /* WORD 1 */ 1 675 1 676 2 node_type fixed bin (4) unaligned, 1 677 2 pad bit (4) unaligned, 1 678 2 code fixed bin (9) unaligned unsigned, 1 679 2 variable fixed bin (18) unaligned unsigned, 1 680 1 681 /* WORD 2 */ 1 682 1 683 2 offset fixed bin (18) unaligned unsigned, 1 684 2 count fixed bin (18) unaligned unsigned, 1 685 1 686 /* WORD 3 */ 1 687 1 688 2 hash_chain fixed bin (18) aligned; 1 689 1 690 1 691 /* SOURCE NODE */ 1 692 1 693 dcl 1 source aligned based structure, 1 694 1 695 /* WORD 1 */ 1 696 1 697 2 node_type fixed bin (4) unal, 1 698 2 pad bit (13) unal, 1 699 2 line_number fixed bin (17) unaligned, 1 700 1 701 /* WORD 2 */ 1 702 1 703 2 uid bit (36) aligned, 1 704 1 705 /* WORDS 3 & 4 */ 1 706 1 707 2 dtm fixed bin (71) unaligned, 1 708 1 709 /* WORD 5 */ 1 710 1 711 2 next fixed bin (18) unsigned unaligned, 1 712 2 initial_subprogram fixed bin (18) unsigned unaligned, 1 713 1 714 /* WORDS 6 - ? (depends on length of pathname) */ 1 715 1 716 2 pathname char(256) varying; 1 717 1 718 1 719 /* STATEMENT NODE - This node only appears in the polish. */ 1 720 1 721 dcl 1 statement aligned based structure, 1 722 1 723 /* WORD 1 */ 1 724 1 725 2 op_code fixed bin aligned, /* Always equal to "stat_op". */ 1 726 1 727 /* WORD 2 */ 1 728 1 729 2 next bit (18) unaligned, /* "0"b = no next stmnt */ 1 730 2 location bit (18) unaligned, /* (18)"1"b = no text */ 1 731 1 732 /* WORD 3 */ 1 733 1 734 2 source_id structure unaligned, 1 735 3 file fixed bin (8) unsigned, /* 0 = first file */ 1 736 3 line bit (14), 1 737 3 statement bit (5), /* 1 = first statement */ 1 738 1 739 2 length bit (9) unaligned, 1 740 1 741 /* WORD 4 */ 1 742 1 743 2 bits structure unaligned, 1 744 3 put_in_map bit (1) unaligned, 1 745 3 put_in_profile bit (1) unaligned, 1 746 3 pad bit (7) unaligned, 1 747 1 748 2 start fixed bin (26) unaligned; 1 749 1 750 1 751 /* SUBPROGRAM NODE */ 1 752 1 753 dcl 1 subprogram aligned based structure, 1 754 1 755 /* WORD 1 */ 1 756 1 757 2 node_type fixed bin (4) unaligned, /* The only field in common with the other nodes. */ 1 758 2 subprogram_type fixed bin (3) unaligned, 1 759 2 default_is unaligned, 1 760 3 auto bit (1), 1 761 3 static bit (1), 1 762 2 need_PS bit (1) unaligned, 1 763 2 need_prologue bit (1) unaligned, 1 764 2 multiple_entry bit (1) unaligned, 1 765 2 namelist_used bit (1) unaligned, 1 766 2 has_parameters bit (1) unaligned, 1 767 2 star_extent_function bit (1) unaligned, 1 768 2 fill bit (1) unaligned, 1 769 1 770 2 symbol fixed bin (18) unsigned unaligned, /* symbol node for subprogram name */ 1 771 1 772 /* WORD 2 */ 1 773 1 774 2 previous_subprogram fixed bin (18) unsigned unaligned, 1 775 2 next_subprogram fixed bin (18) unsigned unaligned, 1 776 1 777 /* WORD 3 */ 1 778 1 779 2 common_chain fixed bin (18) unsigned unaligned, 1 780 2 equiv_chain fixed bin (18) unsigned unaligned, 1 781 1 782 /* WORD 4 */ 1 783 1 784 2 first_symbol fixed bin (18) unsigned unaligned, 1 785 2 last_symbol fixed bin (18) unsigned unaligned, 1 786 1 787 /* WORD 5 */ 1 788 1 789 2 first_label fixed bin (18) unsigned unaligned, 1 790 2 last_label fixed bin (18) unsigned unaligned, 1 791 1 792 /* WORD 6 */ 1 793 1 794 2 first_polish fixed bin (18) unsigned unaligned, 1 795 2 last_polish fixed bin (18) unsigned unaligned, 1 796 1 797 /* WORD 7 */ 1 798 1 799 2 map unaligned, 1 800 3 first fixed bin (18) unsigned unaligned, 1 801 3 last fixed bin (18) unsigned unaligned, 1 802 1 803 /* WORD 8 */ 1 804 1 805 2 entry_info fixed bin (18) unsigned unaligned, 1 806 2 runtime fixed bin (18) unsigned unaligned, 1 807 1 808 /* WORD 9 */ 1 809 1 810 2 first_quad fixed bin (18) unsigned unaligned, 1 811 2 last_quad fixed bin (18) unsigned unaligned, 1 812 1 813 /* WORD 10 */ 1 814 1 815 2 options aligned like fortran_options, 1 816 1 817 /* WORDS 11 - 44 */ 1 818 1 819 2 storage_info(17) aligned, 1 820 3 first fixed bin (18) unsigned unaligned, 1 821 3 last fixed bin (18) unsigned unaligned, 1 822 3 next_loc fixed bin (18) aligned, 1 823 1 824 /* WORD 45 */ 1 825 1 826 2 loop_vector_p pointer unaligned, 1 827 1 828 /* WORD 46 */ 1 829 1 830 2 n_loops fixed bin (18) unsigned unaligned, 1 831 2 max_operators fixed bin (18) unsigned unaligned, 1 832 1 833 /* WORD 47 */ 1 834 1 835 2 VLA_chain fixed bin (18) unsigned unaligned, /* Mod 1 */ 1 836 2 LA_chain fixed bin (18) unsigned unaligned, /* Mod 1 */ 1 837 /* WORD 48 */ 1 838 1 839 2 max_sym fixed bin (18) aligned; 1 840 1 841 1 842 /* SYMBOL NODE */ 1 843 1 844 dcl 1 symbol aligned based structure, 1 845 1 846 /* WORD 1 */ 1 847 1 848 2 node_type fixed bin (4) unaligned, 1 849 2 data_type fixed bin (4) unaligned unsigned, 1 850 2 operand_type fixed bin (4) unaligned, 1 851 1 852 2 addressing_bits unaligned structure, 1 853 3 is_addressable bit (1), 1 854 3 value_in, 1 855 4 eaq bit (1), 1 856 4 x bit (1), 1 857 3 allocated bit (1), 1 858 3 needs_pointer bit (1), 1 859 3 stack_indirect bit (1), 1 860 3 large_address bit (1), 1 861 3 address_in_base bit (1), 1 862 3 dont_update bit (1), /* for optimizer */ 1 863 3 not_in_storage bit (1), /* for optimizer */ 1 864 3 globally_assigned bit (1), /* for optimizer */ 1 865 1 866 2 bits unaligned structure, 1 867 3 storage_info, 1 868 4 standard_bits, 1 869 5 allocate bit (1), 1 870 5 set bit (1), 1 871 5 referenced bit (1), 1 872 5 passed_as_arg bit (1), 1 873 4 initialed bit (1), /* Allows variable to become a constant. */ 1 874 1 875 3 variable_arglist bit (1), 1 876 3 dummy_arg bit (1), 1 877 3 variable_extents bit (1), 1 878 3 needs_descriptors bit (1), 1 879 3 put_in_symtab bit (1), 1 880 3 by_compiler bit (1), 1 881 1 882 /* WORD 2 */ 1 883 1 884 2 address aligned structure, 1 885 3 base bit (3) unaligned, 1 886 3 offset fixed bin (14) unaligned, 1 887 3 char_num fixed bin (2) unaligned unsigned, 1 888 3 bit_num fixed bin (4) unaligned unsigned, 1 889 3 fill bit (4) unaligned, 1 890 3 inhibit bit (1) unaligned, 1 891 3 ext_base bit (1) unaligned, 1 892 3 tag bit (6) unaligned, 1 893 1 894 /* WORD 3 */ 1 895 1 896 2 units fixed bin (3) unaligned unsigned, 1 897 2 aliasable bit (1) unaligned, 1 898 2 has_constant_value bit (1) unaligned, 1 899 2 new_induction_var bit (1) unaligned, 1 900 2 reloc_hold bit (6) unaligned, 1 901 2 reloc bit (6) unaligned, 1 902 2 addr_hold bit (18) unaligned, 1 903 1 904 /* WORD 4 */ 1 905 1 906 2 next_symbol fixed bin (18) unsigned unaligned, 1 907 2 hash_chain fixed bin (18) unsigned unaligned, 1 908 1 909 /* WORD 5 */ 1 910 1 911 2 ext_attributes unaligned structure, 1 912 3 VLA bit (1), /* symbol is Very large Element */ 1 913 3 LA bit (1), /* symbol is Large Element */ 1 914 3 pad bit (18-2), 1 915 1 916 2 loop_ref_count fixed bin (17) unaligned, 1 917 1 918 /* WORD 6 */ 1 919 1 920 2 location fixed bin (24) aligned, 1 921 1 922 /* WORD 7 */ 1 923 1 924 2 v_length fixed bin (18) unsigned unaligned, 1 925 2 general fixed bin (18) unsigned unaligned, 1 926 1 927 /* WORD 8 */ 1 928 1 929 2 parent fixed bin (18) unsigned unaligned, 1 930 2 next_member fixed bin (18) unsigned unaligned, 1 931 1 932 /* WORD 9 */ 1 933 1 934 2 attributes aligned structure, 1 935 3 mode_bits unaligned structure, 1 936 4 char_size fixed bin (20) unsigned, 1 937 4 mode, 1 938 5 integer bit (1), 1 939 5 real bit (1), 1 940 5 double_precision bit (1), 1 941 5 complex bit (1), 1 942 5 logical bit (1), 1 943 5 character bit (1), 1 944 5 label_value bit (1), 1 945 5 entry_value bit (1), 1 946 1 947 3 misc_attributes unaligned structure, 1 948 4 function bit (1), 1 949 4 subroutine bit (1), 1 950 4 entry_point bit (1), 1 951 4 external bit (1), 1 952 4 builtin bit (1), 1 953 4 stmnt_func bit (1), 1 954 4 namelist bit (1), 1 955 4 dimensioned bit (1), 1 956 1 957 /* WORD 10 */ 1 958 1 959 3 storage_class unaligned structure, 1 960 4 automatic bit (1), 1 961 4 static bit (1), 1 962 4 in_common bit (1), 1 963 4 equivalenced bit (1), 1 964 4 parameter bit (1), 1 965 4 constant bit (1), /* If external or entry_point. */ 1 966 4 named_constant bit (1), 1 967 1 968 3 variable bit (1) unaligned, 1 969 3 in_equiv_stmnt bit (1) unaligned, 1 970 3 star_extents bit (1) unaligned, 1 971 3 descriptor bit (1) unaligned, 1 972 2 pad bit (25) unaligned, 1 973 1 974 /* WORD 11 */ 1 975 1 976 2 dimension fixed bin (18) unsigned unaligned, /* Bounds may be added after symbol is declared. */ 1 977 2 initial fixed bin (18) unsigned unaligned, 1 978 1 979 /* WORD 12 */ 1 980 1 981 2 runtime bit (18) unaligned, 1 982 2 name_length fixed bin (17) unaligned, 1 983 1 984 /* WORD 13 */ 1 985 1 986 2 coordinate fixed bin (17) unaligned, /* used by loop optimizer */ 1 987 2 element_size fixed bin (17) unaligned, 1 988 1 989 /* WORD 14 */ 1 990 1 991 2 secondary pointer unaligned, /* used by loop optimizer */ 1 992 1 993 /* WORD 15 */ 1 994 1 995 2 offset fixed bin (24) aligned, 1 996 1 997 /* WORDS 16 - n. This field is variable in length. */ 1 998 1 999 2 name char(allocate_symbol_name refer (symbol.name_length)) aligned; 1 1000 1 1001 1 1002 1 1003 /* TEMPORARY NODE -- Must be same size as ARRAY REF NODE. */ 1 1004 1 1005 dcl 1 temporary aligned based structure, 1 1006 1 1007 /* WORD 1 */ 1 1008 1 1009 2 node_type fixed bin (4) unaligned, 1 1010 2 data_type fixed bin (4) unaligned unsigned, 1 1011 2 operand_type fixed bin (4) unaligned, 1 1012 1 1013 2 addressing_bits unaligned structure, 1 1014 3 is_addressable bit (1), 1 1015 3 value_in, 1 1016 4 eaq bit (1), 1 1017 4 x bit (1), 1 1018 3 allocated bit (1), 1 1019 3 needs_pointer bit (1), 1 1020 3 stack_indirect bit (1), 1 1021 3 large_address bit (1), 1 1022 3 address_in_base bit (1), 1 1023 3 dont_update bit (1), /* for optimizer */ 1 1024 3 not_in_storage bit (1), /* for optimizer */ 1 1025 3 globally_assigned bit (1), /* for optimizer */ 1 1026 1 1027 2 bits unaligned structure, 1 1028 3 standard_bits, 1 1029 4 allocate bit (1), 1 1030 4 set bit (1), 1 1031 4 referenced bit (1), 1 1032 4 passed_as_arg bit (1), 1 1033 1 1034 3 variable_length bit (1), 1 1035 1 1036 3 fill bit (1), /* can be used */ 1 1037 1 1038 3 invariant bit (1), /* must line up with array_ref node */ 1 1039 3 irreducible bit (1), /* .. */ 1 1040 3 used_across_loops bit (1), /* .. */ 1 1041 3 frozen_for_do bit (1), 1 1042 3 used_as_subscript bit (1), 1 1043 1 1044 /* WORD 2 */ 1 1045 1 1046 2 address aligned structure, 1 1047 3 base bit (3) unaligned, 1 1048 3 offset fixed bin (14) unaligned, 1 1049 3 char_num fixed bin (2) unaligned unsigned, 1 1050 3 bit_num fixed bin (4) unaligned unsigned, 1 1051 3 fill bit (4) unaligned, 1 1052 3 inhibit bit (1) unaligned, 1 1053 3 ext_base bit (1) unaligned, 1 1054 3 tag bit (6) unaligned, 1 1055 1 1056 /* WORD 3 */ 1 1057 1 1058 2 units fixed bin (3) unaligned unsigned, 1 1059 2 fill bit (3) unaligned, 1 1060 2 reloc_hold bit (6) unaligned, 1 1061 2 reloc bit (6) unaligned, 1 1062 2 addr_hold bit (18) unaligned, 1 1063 1 1064 /* WORD 4 */ 1 1065 1 1066 2 next fixed bin (18) unsigned unaligned, 1 1067 2 loop_end_fu_pos fixed bin (17) unaligned, /* must overlay array_ref.loop_end_fu_pos */ 1 1068 1 1069 /* WORD 5 */ 1 1070 1 1071 2 pad fixed bin (18) unsigned unaligned, 1 1072 2 loop_ref_count fixed bin (17) unaligned, 1 1073 1 1074 /* WORD 6 */ 1 1075 1 1076 2 location fixed bin (24) aligned, 1 1077 1 1078 /* WORD 7*/ 1 1079 1 1080 2 ref_count fixed bin (17) unaligned, /* must overlay array_ref.ref_count */ 1 1081 2 output_by fixed bin (18) unsigned unal, /* must overlay array_ref.output_by */ 1 1082 1 1083 /* WORD 8 */ 1 1084 1 1085 2 size fixed bin (24) aligned, /* size in words */ 1 1086 1 1087 /* WORD 9 */ 1 1088 1 1089 2 start_input_to fixed bin (18) unsigned unal, /* must overlay array_ref.start_input_to */ 1 1090 2 end_input_to fixed bin (18) unsigned unal, /* must overlay array_ref.end_input_to */ 1 1091 1 1092 /* WORD 10 */ 1 1093 1 1094 2 ref_count_copy fixed bin (17) unaligned, /* must overlay array_ref.ref_count_copy */ 1 1095 2 ms_ref_count fixed bin (17) unaligned, /* counts occurances in saved machine states */ 1 1096 1 1097 /* WORD 11 */ 1 1098 1 1099 2 length fixed bin (24) aligned; /* length in characters */ 1 1100 1 1101 /* END fort_nodes.incl.pl1 */ 121 122 2 1 /* BEGIN fort_opt_nodes.incl.pl1 */ 2 2 2 3 /* Created: 22 November 1977 by Richard A. Barnes for the optimizing Fortran compiler */ 2 4 2 5 /* Modified: 09 October 1978 by Paul E. Smee for larger common and arrays. 2 6* Modified: 2 June 1979 by RAB to speed up intersection of optimizer 2 7* machine states by adding operator.coordinate and 2 8* flow_unit.is_active_operator 2 9* Modified: 28 June 1979 by RAB to speed up compute_busy_on_exit by 2 10* adding flow_unit.dim_or_alias_or_not_set. 2 11* Modified: 02 July 1979 by RAB to fix 218 by moving loop_end_chain stuff 2 12* to flow_unit node from loop node. 2 13* Modified: 14 August 1979 by RAB to change flow_unit.dim_or_alias_or_not_set 2 14* to flow_unit.always_completely_set. 2 15* Modified: 17 September 1979 by RAB in preparation for register optimizer. 2 16* Modified: 20 September 1979 by RAB for index_value_analysis of register optimizer. 2 17* Modified: 03 November 1979 by RAB for flow_unit.refreshed for register optimizer. 2 18* Modified: 30 November 1979 by RAB to add more info to the loop node 2 19* for the register optimizer. 2 20* Modified: 18 December 1979 by RAB to make remainder of register 2 21* optimizer changes. 2 22* Modified: 17 December 1980 by CRD to add opt_statement.removable. 2 23**/ 2 24 2 25 /* CHAIN (2 words) */ 2 26 2 27 dcl 1 chain based aligned, 2 28 2 next pointer unaligned, 2 29 2 value pointer unaligned; 2 30 2 31 /* EDGE (6 words) */ 2 32 2 33 dcl 1 edge based aligned, 2 34 2 from structure, 2 35 3 value ptr unal, 2 36 3 next ptr unal, 2 37 3 back ptr unal, 2 38 2 to structure, 2 39 3 value ptr unal, 2 40 3 next ptr unal, 2 41 3 back ptr unal; 2 42 2 43 2 44 /* FLOW_UNIT (22 words) */ 2 45 2 46 dcl 1 flow_unit based aligned, 2 47 2 next ptr unal, 2 48 2 back ptr unal, 2 49 2 successors ptr unal, 2 50 2 predecessors ptr unal, 2 51 2 dominator ptr unal, 2 52 2 loop ptr unal, 2 53 2 next_in_loop ptr unal, 2 54 2 loop_end_chain ptr unal, 2 55 2 position fixed bin(17) aligned, 2 56 2 number fixed bin(17) unal, 2 57 2 n_in_loop_end fixed bin(17) unal, 2 58 2 level_number fixed bin(17) aligned, 2 59 2 first_statement fixed bin (18) unsigned unal, 2 60 2 last_statement fixed bin (18) unsigned unal, 2 61 2 insert_statement fixed bin (18) unsigned unal, 2 62 2 insert_operator fixed bin (18) unsigned unal, 2 63 2 info structure unal, 2 64 3 processed bit(1), 2 65 3 loop_entry bit(1), 2 66 3 falls_through bit(1), 2 67 3 has_label bit(1), 2 68 3 entry_pt bit(1), 2 69 3 in_queue bit(1), 2 70 3 is_back_target bit(1), 2 71 3 has_side_effects bit(1), 2 72 3 removed bit(1), 2 73 3 refreshed bit(1), 2 74 3 pad bit(26), 2 75 2 used ptr unal, 2 76 2 set ptr unal, 2 77 2 busy_on_entry ptr unal, 2 78 2 set_multiple ptr unal, 2 79 2 busy_on_exit ptr unal, 2 80 2 dominated_by ptr unal, 2 81 2 is_active_operator ptr unal, 2 82 2 always_completely_set ptr unal; 2 83 2 84 2 85 /* INPUT_TO (3 words) */ 2 86 2 87 dcl 1 input_to based aligned, 2 88 2 next pointer unaligned, 2 89 2 operator pointer unaligned, 2 90 2 which fixed bin aligned; 2 91 2 92 /* LCHAIN (2 words) */ 2 93 2 94 dcl 1 lchain based aligned, 2 95 2 next pointer unaligned, 2 96 2 value fixed bin(18) aligned; 2 97 2 98 /* LOOP (33 words) */ 2 99 2 100 dcl 1 loop based aligned, 2 101 2 number fixed bin(18), 2 102 2 depth fixed bin(18), 2 103 2 father pointer unaligned, 2 104 2 brother pointer unaligned, 2 105 2 prev_brother pointer unaligned, 2 106 2 son pointer unaligned, 2 107 2 last_son pointer unaligned, 2 108 2 entry_unit pointer unaligned, 2 109 2 members pointer unaligned, 2 110 2 back_target pointer unaligned, 2 111 2 exits pointer unaligned, 2 112 2 first_unit pointer unaligned, 2 113 2 last_unit pointer unaligned, 2 114 2 is_member pointer unaligned, 2 115 2 is_exit pointer unaligned, 2 116 2 articulation_blocks pointer unaligned, 2 117 2 used pointer unaligned, 2 118 2 set pointer unaligned, 2 119 2 busy_on_exit pointer unaligned, 2 120 2 set_multiple pointer unaligned, 2 121 2 ancestors_and_me pointer unaligned, 2 122 2 bits structure unaligned, 2 123 3 has_side_effects bit(1), 2 124 3 erases structure unaligned, 2 125 4 xr(0:7) bit(1), 2 126 4 pr(6) bit(1), 2 127 3 avoid_pr(6) bit(1), 2 128 3 all_xrs_globally_assigned bit(1), 2 129 3 pad bit(14), 2 130 2 induction_var pointer unaligned, 2 131 2 may_keep_in_xr pointer unaligned, 2 132 2 computed pointer unaligned, 2 133 2 xregs_used fixed bin(4), 2 134 2 pregs_used fixed bin(4), 2 135 2 global_xr_items pointer unaligned, 2 136 2 global_pr_items pointer unaligned, 2 137 2 range_list pointer unaligned, 2 138 2 msp pointer unaligned, 2 139 2 eligible_ind_var_op_var pointer unaligned, 2 140 2 left_shift_chain pointer unaligned; 2 141 2 142 /* OPERATOR */ 2 143 2 144 dcl 1 operator based aligned, 2 145 2 146 /* WORD 1 */ 2 147 2 148 2 op_code fixed bin(8) unal, 2 149 2 assigns_constant_to_symbol bit(1) unal, 2 150 2 freed bit(1) unal, 2 151 2 number fixed bin(7) unsigned unal, 2 152 2 coordinate fixed bin(18) unsigned unal, 2 153 2 154 /* WORD 2 */ 2 155 2 156 2 next fixed bin(18) unsigned unal, 2 157 2 back fixed bin(18) unsigned unal, 2 158 2 159 /* WORD 3 */ 2 160 2 161 2 primary pointer unal, 2 162 2 163 /* WORD 4 */ 2 164 2 165 2 output fixed bin(18) aligned, 2 166 2 167 /* WORDS 5 - n */ 2 168 2 169 2 operand(n_operands refer (operator.number)) fixed bin (18) aligned; 2 170 2 171 dcl n_operands fixed bin; 2 172 2 173 2 174 /* OPT_STATEMENT */ 2 175 2 176 dcl 1 opt_statement based aligned structure, 2 177 2 178 /* WORD 1 */ 2 179 2 180 2 op_code fixed bin(8) unal, /* must be stat_op */ 2 181 2 number fixed bin(8) unal, /* must be 0 */ 2 182 2 label fixed bin (18) unsigned unal, 2 183 2 184 /* WORD 2 */ 2 185 2 186 2 first_operator fixed bin (18) unsigned unal, 2 187 2 prev_operator fixed bin (18) unsigned unal, 2 188 2 189 /* WORD 3 */ 2 190 2 191 2 next bit(18) unal, /* "0"b = no next statement */ 2 192 2 back bit(18) unal, /* "0"b = no prev statement */ 2 193 2 194 /* WORD 4 */ 2 195 2 196 2 source_id structure unaligned, 2 197 3 file fixed bin (8) unsigned, /* 0 = first file */ 2 198 3 line bit(14), 2 199 3 statement bit(5), /* 1 = first statement */ 2 200 2 201 2 length bit(9) unaligned, 2 202 2 203 /* WORD 5 */ 2 204 2 205 2 bits structure unaligned, 2 206 3 put_in_map bit(1), 2 207 3 put_in_profile bit(1), 2 208 3 processed_by_converter bit(1), 2 209 3 referenced_backwards bit(1), 2 210 3 referenced_by_assign bit(1), 2 211 3 has_operator_list bit(1), 2 212 3 moved bit(1), 2 213 3 removable bit(1), 2 214 3 pad bit(1), 2 215 2 216 2 start fixed bin(26) unaligned, 2 217 2 218 /* WORD 6 */ 2 219 2 220 2 location bit(18) unaligned, /* (18)"1"b = no code */ 2 221 2 machine_state fixed bin (18) unsigned unaligned, 2 222 2 223 /* WORD 7 */ 2 224 2 225 2 flow_unit pointer unaligned, 2 226 2 227 /* WORD 8 */ 2 228 2 229 2 operator_list pointer unaligned; 2 230 2 231 2 232 /* PRIMARY (4 words) */ 2 233 2 234 dcl 1 primary based aligned, 2 235 2 next pointer unaligned, 2 236 2 last pointer unaligned, 2 237 2 data structure aligned, 2 238 3 expression pointer unaligned, 2 239 3 flow_unit pointer unaligned; 2 240 2 241 /* RANGE (3 words) */ 2 242 2 243 dcl 1 range based aligned, 2 244 2 next pointer unaligned, 2 245 2 variable pointer unaligned, 2 246 2 bits structure unaligned, 2 247 3 range_bits structure unaligned, 2 248 4 fb17 bit(1), 2 249 4 fb18_uns bit(1), 2 250 3 mbz bit(34); 2 251 2 252 2 253 /* END fort_opt_nodes.incl.pl1 */ 123 124 3 1 /* BEGIN fort_listing_nodes.incl.pl1 */ 3 2 3 3 /* Created: 30 August 1976, David Levin 3 4* 3 5*Last Modified: 9 October 1978, Paul Smee 3 6**/ 3 7 3 8 dcl 1 cross_reference(261120) aligned structure based(cref_base), 3 9 2 symbol fixed bin (18) unsigned unaligned, 3 10 2 line_no fixed bin(17) unaligned; 3 11 3 12 dcl 1 listing_info aligned structure based(cur_listing), 3 13 2 subprogram fixed bin (18) unsigned, 3 14 2 next fixed bin (18) unsigned, 3 15 2 first_line fixed bin (18) unsigned, 3 16 2 last_line fixed bin (18) unsigned, 3 17 2 first_cref fixed bin (18) unsigned, 3 18 2 last_cref fixed bin (18) unsigned, 3 19 2 first_error fixed bin (18) unsigned, 3 20 2 last_error fixed bin (18) unsigned; 3 21 3 22 dcl listing_seg(0:261119) fixed bin based(listing_base); 3 23 3 24 dcl 1 error_text aligned structure based, 3 25 2 next fixed bin (18) unsigned, 3 26 2 length fixed bin, 3 27 2 string char(error_text_length refer(error_text.length)) aligned; 3 28 3 29 dcl error_text_length fixed bin; 3 30 3 31 dcl 1 source_list (130560) aligned structure based (source_line_base), 3 32 2 file_number fixed bin (8) unaligned, 3 33 2 line_start fixed bin (21) unsigned unaligned, 3 34 2 unused_bits bit (6) unaligned, 3 35 2 line_length fixed bin (18) unsigned unaligned, 3 36 2 line_number_in_file fixed bin (18) unsigned unaligned; 3 37 3 38 /* END fort_listing_nodes.incl.pl1 */ 125 126 4 1 /* BEGIN fort_system_constants.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 428. 4 9* END HISTORY COMMENTS */ 4 10 4 11 4 12 /* Created: June 1976, David Levin */ 4 13 4 14 /* Modified: 4 15* 15 Dec 85, RW - 428: Changed max_char_length from 256 to 512. 4 16* 22 Jun 84, MM - Install typeless functions support. 4 17* 17 Jun 83, HH - 383: Added 'process_param_list_op'. 4 18* 12 Jan 83, HH - Added 'form_VLA_packed_ptr_op'. 4 19* 05 Oct 82, HH - Added 'units_per_word'. 4 20* 27 Sep 82, HH - Added 'max_fixed_bin_18', 'max_fixed_bin_24' and 'sys_info$max_seg_size'. 4 21* Removed 'max_stored_value' and 'min_stored_value'. 4 22* 24 October 1981, ME Presser - added inquire_op. 4 23* 20 October 1981, C R Davis - add (read write)_internal_file_op. 4 24* 11 May 1981, Marshall Presser - added op-codes for .EQV. and .NEQV. 4 25* 28 April 1981, Marshall Presser - added default_main_entry_point_name 4 26* 11 March 1981, Marshall Presser - add min_stored_value 4 27* 8 December 1980, C R Davis - add block_if_op, else_if_op, else_op. 4 28* 15 January 1980, C R Davis - add bits_per_char. 4 29* 21 December 1979, Richard A. Barnes - add unrecoverable_errror and 4 30* max_error_level. 4 31* 3 November 1979, Richard Barnes - add pointer_node. 4 32* 17 September 1979, Richard Barnes - add load_preg_op & load_xreg_op 4 33* 13 September 1979, Paul Smee - add colon and concat token types, 4 34* change value of EOS_token, remove default_char_size. 4 35* 31 August 1979, Charlie Davis - change offset units to 4 36* be consistent with those in runtime symbols. 4 37* 13 August 1979, Richard Barnes - add cat_op & substr_op 4 38* 19 July 1979, Richard Barnes - char mode 4 39* 10 October 1978, Paul Smee - double max_stored_value and bias. 4 40* 15 June 1978, Paul Smee - add max_num_of_rands 4 41* 16 November 1977, David Levin - add machine_state_node 4 42* 12 September 1977, Richard Barnes - new ops for loop optimizer 4 43* 30 August 1977, David Levin - change bias from 65536 to 131072. 4 44* 5 July 1977, David Levin - add open_op, close_op, and iostat_op. 4 45* 28 April 1977, David Levin - add xmit_vector_op in operator list 4 46* 22 April 1977, David Levin - add max_prec_single, last_assigned_mode 4 47* 24 February 1977, Gabriel Chang for the optimizer. 4 48* 23 February 1977, David Levin to change name of count operand. 4 49* 28 October 1976, David Levin and Gabriel Chang to add 2 new ops and 4 50* 1 new node type. 4 51* 2 September 1976, David Levin - add 8 new ops and change name of 4 52* data_op. 4 53**/ 4 54 /* SYSTEM CONSTANTS */ 4 55 4 56 dcl bias init(262144) fixed bin(19) int static options(constant); 4 57 dcl gap_value init(0) fixed bin int static options(constant); 4 58 dcl max_fixed_bin_18 init(111111111111111111b) fixed bin (18) static options (constant); 4 59 dcl max_fixed_bin_24 init(111111111111111111111111b) fixed bin (24) static options (constant); 4 60 dcl max_num_of_rands init(127) fixed bin int static options(constant); 4 61 dcl sys_info$max_seg_size 4 62 fixed bin (18) ext; 4 63 4 64 dcl ( unrecoverable_error init(3), 4 65 max_error_level init(4)) 4 66 fixed bin int static options(constant); 4 67 4 68 dcl (main_program init(0), 4 69 block_data init(1), 4 70 subroutine init(2), 4 71 function init(3), 4 72 chars_per_word init(4), 4 73 chars_per_dw init(8), 4 74 bits_per_char init(9), 4 75 first_auto_loc init(64), 4 76 max_prec_single init(8)) fixed bin(9) int static options(constant); 4 77 dcl max_char_length init(512) fixed bin(10) int static options(constant); 4 78 4 79 dcl blank_common_name init("blnk*com") char(8) aligned int static options(constant); 4 80 declare default_main_entry_point_name 4 81 char (5) int static options (constant) initial ("main_"); 4 82 declare unnamed_block_data_subprg_name 4 83 char (29) int static options (constant) initial ("unnamed block data subprogram"); 4 84 4 85 /* NODE TYPES */ 4 86 4 87 dcl (fill_node init(0), 4 88 source_node init(1), 4 89 symbol_node init(2), 4 90 dimension_node init(3), 4 91 temporary_node init(4), 4 92 constant_node init(5), 4 93 label_node init(6), 4 94 header_node init(7), 4 95 char_constant_node init(8), 4 96 array_ref_node init(9), 4 97 proc_frame_node init(10), 4 98 library_node init(11), 4 99 subprogram_node init(12), 4 100 arg_desc_node init(13), 4 101 pointer_node init(14), 4 102 machine_state_node init(15)) fixed bin(4) aligned internal static options(constant); 4 103 4 104 /* DATA TYPES */ 4 105 4 106 dcl (int_mode init(1), 4 107 real_mode init(2), 4 108 dp_mode init(3), 4 109 cmpx_mode init(4), 4 110 logical_mode init(5), 4 111 char_mode init(6), 4 112 typeless_mode init(7), 4 113 last_assigned_mode init(7)) fixed bin(4) aligned internal static options(constant); 4 114 4 115 dcl data_type_size(7) init(1,1,2,2,1,0,1) fixed bin int static options(constant); 4 116 4 117 4 118 /* OPERAND TYPES */ 4 119 4 120 dcl (variable_type init(1), 4 121 constant_type init(2), 4 122 array_ref_type init(3), 4 123 temp_type init(4), 4 124 count_type init(5), 4 125 rel_constant init(6), 4 126 bif init(7), 4 127 statement_function init(8), 4 128 external init(9), 4 129 entry_type init(10), 4 130 dummy init(11), 4 131 error init(12)) fixed bin(4) aligned internal static options(constant); 4 132 4 133 4 134 /* OFFSET UNITS */ 4 135 4 136 dcl 4 137 (word_units init (0), 4 138 bit_units init (1), 4 139 char_units init (2), 4 140 halfword_units init (3)) fixed bin (3) aligned internal static options(constant); 4 141 4 142 dcl units_per_word (0:3) init (1, 36, 4, 2) fixed bin (6) static options (constant); 4 143 4 144 4 145 /* TOKEN MASKS */ 4 146 4 147 dcl 4 148 (is_operand initial("101000000"b), 4 149 is_operator initial("010000000"b), 4 150 is_constant initial("001000000"b), 4 151 is_arith_constant initial("000100000"b)) bit(9) aligned internal static options(constant); 4 152 4 153 4 154 /* TOKEN TYPES */ 4 155 4 156 dcl (no_token initial("000000000"b), 4 157 ident initial("100000000"b), 4 158 plus initial("010000001"b), 4 159 minus initial("010000010"b), 4 160 asterisk initial("010000011"b), 4 161 slash initial("010000100"b), 4 162 expon initial("010000101"b), 4 163 not initial("010000110"b), 4 164 and initial("010000111"b), 4 165 or initial("010001000"b), 4 166 eq initial("010001001"b), 4 167 ne initial("010001010"b), 4 168 lt initial("010001011"b), 4 169 gt initial("010001100"b), 4 170 le initial("010001101"b), 4 171 ge initial("010001110"b), 4 172 assign initial("010001111"b), 4 173 comma initial("010010000"b), 4 174 left_parn initial("010010001"b), 4 175 right_parn initial("010010010"b), 4 176 apostrophe initial("010010011"b), 4 177 colon initial("010010100"b), 4 178 concat initial("010010101"b), 4 179 substr_left_parn initial("010010110"b), 4 180 eqv initial("010010111"b), 4 181 neqv initial("010011000"b), 4 182 EOS_token initial("010011111"b), 4 183 char_string initial("001000001"b), 4 184 logical_const initial("001000010"b), 4 185 false initial("001000010"b), /* Must be identical to true except low order bit off. */ 4 186 true initial("001000011"b), /* Must be identical to false except low order bit on. */ 4 187 label_const initial("001000100"b), 4 188 octal_const initial("001000101"b), 4 189 dec_int initial("001100110"b), 4 190 real_const initial("001100111"b), 4 191 double_const initial("001101000"b), 4 192 complex_const initial("001101001"b)) bit(9) aligned internal static options(constant); 4 193 4 194 4 195 /* OPERATOR NAMES */ 4 196 4 197 declare 4 198 (assign_op initial(1), 4 199 add_op initial(2), 4 200 sub_op initial(3), 4 201 mult_op initial(4), 4 202 div_op initial(5), 4 203 exponentiation_op initial(6), 4 204 negate_op initial(7), 4 205 less_op initial(8), 4 206 less_or_equal_op initial(9), 4 207 equal_op initial(10), 4 208 not_equal_op initial(11), 4 209 greater_or_equal_op initial(12), 4 210 greater_op initial(13), 4 211 or_op initial(14), 4 212 and_op initial(15), 4 213 not_op initial(16), 4 214 jump_op initial(17), 4 215 jump_logical_op initial(18), 4 216 jump_arithmetic_op initial(19), 4 217 jump_computed_op initial(20), 4 218 jump_assigned_op initial(21), 4 219 assign_label_op initial(22), 4 220 read_op initial(23), 4 221 write_op initial(24), 4 222 format_op initial(25), 4 223 end_label_op initial(26), 4 224 error_label_op initial(27), 4 225 xmit_scalar_op initial(28), 4 226 xmit_array_op initial(29), 4 227 xmit_vector_op initial(30), 4 228 endfile_op initial(31), 4 229 rewind_op initial(32), 4 230 backspace_op initial(33), 4 231 margin_op initial(34), 4 232 openfile_op initial(35), 4 233 closefile_op initial(36), 4 234 record_number_op initial(37), 4 235 string_op initial(38), 4 236 string_length_op initial(39), 4 237 terminate_op initial(40), 4 238 return_op initial(41), 4 239 pause_op initial(42), 4 240 stop_op initial(43), 4 241 item_op initial(44), 4 242 exit_op initial(45), 4 243 eol_op initial(46), 4 244 do_op initial(47), 4 245 builtin_op initial(48), 4 246 sf_op initial(49), 4 247 sf_def_op initial(50), 4 248 subscript_op initial(51), 4 249 func_ref_op initial(52), 4 250 block_data_op initial(53), 4 251 increment_polish_op initial(54), 4 252 main_op initial(55), 4 253 func_op initial(56), 4 254 subr_op initial(57), 4 255 stat_op initial(58), 4 256 label_op initial(59), 4 257 call_op initial(60), 4 258 chain_op initial(61), 4 259 endunit_op initial(62), 4 260 non_executable initial(63), 4 261 no_op initial(64), 4 262 form_VLA_packed_ptr_op initial(65), 4 263 opt_subscript_op initial(66), 4 264 left_shift_op initial(67), 4 265 right_shift_op initial(68), 4 266 store_zero_op initial(69), 4 267 storage_add_op initial(70), 4 268 storage_sub_op initial(71), 4 269 neg_storage_add_op initial(72), 4 270 storage_add_one_op initial(73), 4 271 namelist_op initial(74), 4 272 open_op initial(75), 4 273 close_op initial(76), 4 274 iostat_op initial(77), 4 275 convert_to_int_op initial(78), 4 276 convert_to_real_op initial(79), 4 277 convert_to_dp_op initial(80), 4 278 convert_to_cmpx_op initial(81), 4 279 read_scalar_op initial(82), 4 280 read_array_op initial(83), 4 281 read_vector_op initial(84), 4 282 write_scalar_op initial(85), 4 283 write_array_op initial(86), 4 284 write_vector_op initial(87), 4 285 jump_true_op initial(88), 4 286 jump_false_op initial(89), 4 287 sub_index_op initial(90), 4 288 loop_end_op initial(91), 4 289 read_namelist_op initial(92), 4 290 write_namelist_op initial(93), 4 291 decode_string_op initial(94), 4 292 encode_string_op initial(95), 4 293 cat_op initial(96), 4 294 substr_op initial(97), 4 295 load_xreg_op initial(98), 4 296 load_preg_op initial(99), 4 297 block_if_op initial(100), 4 298 else_if_op initial(101), 4 299 else_op initial(102), 4 300 equiv_op initial (103), 4 301 not_equiv_op initial (104), 4 302 read_internal_file_op initial (105), 4 303 write_internal_file_op initial (106), 4 304 inquire_op initial (107), 4 305 process_param_list_op initial (108), 4 306 lhs_fld_op initial (109), 4 307 last_assigned_op initial (109)) fixed bin(18) internal static options(constant); 4 308 4 309 /* END fort_system_constants.incl.pl1 */ 127 128 129 dcl 1 shared_globals structure aligned, 5 1 5 2 /* BEGIN fort_shared_vars.incl.pl1 */ 5 3 5 4 5 5 5 6 /****^ HISTORY COMMENTS: 5 7* 1) change(86-07-14,BWong), approve(86-07-14,MCR7286), audit(86-07-17,Ginter), 5 8* install(86-07-28,MR12.0-1105): 5 9* Fix fortran bug 463. 5 10* END HISTORY COMMENTS */ 5 11 5 12 5 13 /* Created: June 1976, David Levin 5 14* 5 15* Modified: 30 Aug 76, David Levin - to add global variables for listing segment. 5 16* Modified: 22 Nov 76, Richard Barnes - to add profile_size 5 17* Modified: 24 Feb 77, Gabriel Chang - for the optimizer 5 18* Modified: 06 Oct 77, Richard Barnes - for the loop optimizer 5 19* Modified: 16 Nov 77, David Levin - add next_free_(temp array_ref). 5 20* Modified: 09 Oct 78, Paul Smee - for larger common and arrays. 5 21* Modified: 03 Apr 79, Paul Smee - add list of include file data. 5 22* Modified: 17 May 79, Paul Smee - add cur_statement_list. 5 23* Modified: 28 Jun 79, Paul Smee - add compile-time math entry arrays. 5 24* Modified: 13 Sep 79, Paul Smee - add default_char_size. 5 25* Modified: 18 Dec 79, Richard Barnes - add free and freei 5 26* Modified: 03 Mar 80, C R Davis - add must_save_stack_extent. 5 27* Modified: 15 Mar 82, T G Oke - add source (line_number, file_number). 5 28* Modified: 20 Sept 82, T G Oke - add VLA_is_256K flag 5 29* Modified: 22 Sept 82, T G Oke - add area creation info to pass to 5 30* listing generator. 5 31* Modified: 17 May 83, M Mabey - add declared_options. 5 32* Modified: 02 Aug 85, B Wong - 463: changed 'must_save_stack_extent' 5 33* to 'pad' since the variable is no longer used. 5 34**/ 5 35 5 36 2 polish_base ptr, 5 37 2 operand_base ptr, 5 38 2 object_base ptr, 5 39 2 quadruple_base ptr, 5 40 2 opt_base ptr, 5 41 2 relocation_base ptr, 5 42 5 43 2 cref_base ptr, /* base of cross reference segment */ 5 44 2 source_line_base ptr, /* base of source line offset segment */ 5 45 2 listing_base ptr, /* base of listing info segment */ 5 46 2 cur_listing ptr, /* points to listing info for the active subprogram */ 5 47 5 48 2 free(2:4) ptr, /* free chains for optimizer */ 5 49 2 freei ptr, /* .. */ 5 50 5 51 2 polish_max_len fixed bin (19), 5 52 2 operand_max_len fixed bin (19), 5 53 2 object_max_len fixed bin (19), 5 54 2 quad_max_len fixed bin (19), 5 55 2 opt_max_len fixed bin (19), 5 56 5 57 2 next_free_polish fixed bin (18), 5 58 2 next_free_operand fixed bin (18), 5 59 2 next_free_object fixed bin (18), 5 60 2 next_free_listing fixed bin (18), 5 61 2 next_free_quad fixed bin (18), 5 62 2 next_free_array_ref fixed bin (18), /* Chain for freed array_ref nodes. */ 5 63 2 next_free_temp fixed bin (18), /* Chain for freed temporary nodes. */ 5 64 2 next_free_opt fixed bin (18), 5 65 5 66 2 first_segment fixed bin, 5 67 2 number_of_source_segments fixed bin (8), 5 68 2 number_of_lines fixed bin, 5 69 2 number_of_crefs fixed bin, 5 70 2 profile_size fixed bin, 5 71 5 72 2 main_entry_point_name char (32) varying, 5 73 5 74 2 cur_statement fixed bin (18), 5 75 2 cur_statement_list fixed bin (17), 5 76 2 cur_subprogram fixed bin (18), 5 77 2 first_subprogram fixed bin (18), 5 78 2 last_subprogram fixed bin (18), 5 79 2 unnamed_block_data_subprogram 5 80 fixed bin (18), 5 81 2 first_entry_name fixed bin (18), 5 82 2 last_entry_name fixed bin (18), 5 83 5 84 2 constant_info (4) aligned structure, 5 85 3 constant_count fixed bin (17), 5 86 3 first_constant fixed bin (18), 5 87 3 last_constant fixed bin (18), 5 88 5 89 2 options aligned, 5 90 3 user_options aligned like fortran_options, 5 91 3 system_options aligned, 5 92 4 is_fast bit (1) unaligned, 5 93 4 namelist_used bit (1) unaligned, 5 94 4 compile_only bit (1) unaligned, 5 95 4 VLA_is_256K bit (1) unaligned, /* FLAG 255/256K code */ 5 96 4 pad bit (32) unaligned, 5 97 5 98 2 incl_data aligned, 5 99 3 incl_count fixed bin, 5 100 3 file_list (0:255), 5 101 4 source_node_offset fixed bin (18), 5 102 4 incl_len fixed bin (21), 5 103 4 incl_ptr unaligned ptr, 5 104 5 105 2 create_constant entry (fixed bin (4), bit (72) aligned) returns (fixed bin (18)) 5 106 variable, 5 107 2 create_char_constant entry (char (*)) returns (fixed bin (18)) 5 108 variable, 5 109 2 print_message entry options (variable) 5 110 variable, 5 111 2 get_next_temp_segment entry (ptr, fixed bin (18)) returns (ptr) 5 112 variable, 5 113 2 negate_round (6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 5 114 returns (bit (72)) variable, 5 115 2 negate_trunc (6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 5 116 returns (bit (72)) variable, 5 117 2 binop_round (6,6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 5 118 returns (bit (72)) variable, 5 119 2 binop_trunc (6,6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 5 120 returns (bit (72)) variable, 5 121 2 comp_parm (6,6) entry (fixed bin (35), bit (72), bit (72), fixed bin (35)) 5 122 returns (bit (72)) variable, 5 123 2 conv_round (6,6) entry (bit (72), fixed bin (35)) 5 124 returns (bit (72)) variable, 5 125 2 conv_trunc (6,6) entry (bit (72), fixed bin (35)) 5 126 returns (bit (72)) variable, 5 127 2 pad bit (1) aligned, 5 128 5 129 /* The following are used by "print_message - decode_source_id" if use_source_info set. */ 5 130 5 131 2 use_source_info bit (1) aligned, 5 132 2 source_file_number fixed bin (35), 5 133 2 source_line_number fixed bin (35), 5 134 2 Area_create_first fixed bin (18), /* start of text to do creation */ 5 135 2 Area_create_last fixed bin (18), /* Last item */ 5 136 2 Area_init_first fixed bin (18), /* start of text to init areas */ 5 137 2 Area_init_last fixed bin (18), /* Last item */ 5 138 2 declared_options aligned like fortran_declared; 5 139 5 140 dcl num_of_word_constants fixed bin (17) defined (constant_info (1).constant_count); 5 141 dcl first_word_constant fixed bin (18) defined (constant_info (1).first_constant); 5 142 dcl last_word_constant fixed bin (18) defined (constant_info (1).last_constant); 5 143 5 144 dcl num_of_dw_constants fixed bin (17) defined (constant_info (2).constant_count); 5 145 dcl first_dw_constant fixed bin (18) defined (constant_info (2).first_constant); 5 146 dcl last_dw_constant fixed bin (18) defined (constant_info (2).last_constant); 5 147 5 148 dcl num_of_char_constants fixed bin (17) defined (constant_info (3).constant_count); 5 149 dcl first_char_constant fixed bin (18) defined (constant_info (3).first_constant); 5 150 dcl last_char_constant fixed bin (18) defined (constant_info (3).last_constant); 5 151 5 152 dcl num_of_block_constants fixed bin (17) defined (constant_info (4).constant_count); 5 153 dcl first_block_constant fixed bin (18) defined (constant_info (4).first_constant); 5 154 dcl last_block_constant fixed bin (18) defined (constant_info (4).last_constant); 5 155 5 156 /* END fort_shared_vars.incl.pl1 */ 130 131 132 dcl 1 parse_globals structure aligned, 6 1 6 2 2 source_info_ptr ptr, 6 3 6 4 2 add_to_lib_list entry(char(*),fixed bin(35)) 6 5 variable, 6 6 2 get_next_source_seg entry(ptr) 6 7 variable, 6 8 2 add_to_lib_list_run entry(char(*),fixed bin(35)) 6 9 entry; 6 10 133 134 135 dcl 1 cg_globals structure aligned, 7 1 7 2 /* BEGIN fort_cg_vars.incl.pl1 */ 7 3 7 4 /* Created: June 1976 7 5* 7 6* Modified: 7 7* 9 December 1976, David Levin - change version_name to ext static 7 8* 10 September 1976, David Levin - to add date time compiled, user id, options,version, and compiler name 7 9* 6 June 1978, Richard Barnes - for loop optimizer 7 10* 9 Oct 1978, Paul E. Smee - changes for larger common and arrays. 7 11* 30 Nov 1978, Paul E. Smee - add fort_version_info$version_number*/ 7 12 7 13 2 num_of_lib_names fixed bin(17), 7 14 2 first_lib_name fixed bin (18) unsigned, 7 15 2 last_lib_name fixed bin (18) unsigned, 7 16 7 17 2 error_level fixed bin(17), 7 18 7 19 2 message_structure structure aligned, 7 20 3 message_number fixed bin (18), 7 21 3 number_of_operands fixed bin, 7 22 3 operands(3), 7 23 4 is_string bit(1) aligned, 7 24 4 operand_index fixed bin (18), 7 25 4 string_length fixed bin, 7 26 4 string_ptr ptr, 7 27 7 28 2 print_message_op entry variable, 7 29 2 create_constant_block entry(ptr,fixed bin) returns(fixed bin (18) unsigned) 7 30 variable, 7 31 2 date_time_compiled fixed bin(71), 7 32 2 objectname char(32) varying, 7 33 2 vuser_id char(32) varying, 7 34 2 options_string char(256) varying; 7 35 7 36 dcl fort_version_info$version_name char(132) varying ext static; 7 37 dcl fort_version_info$version_number char(16) ext static; 7 38 7 39 dcl compiler_name char(8) int static options(constant) init("fortran2"); 7 40 7 41 /* END fort_cg_vars.incl.pl1 */ 136 8 1 8 2 /* BEGIN fort_message_table_.incl.pl1 */ 8 3 8 4 /* Written: June 1976 */ 8 5 8 6 /* Modified: 27 Dec 1977 DSL - new message format. */ 8 7 8 8 dcl 1 fort_message_table$fort_message_table external, 8 9 2 max_message_num fixed bin, 8 10 2 descrip(525), 8 11 3 flags_for_message unaligned structure, 8 12 4 print_once bit(1), 8 13 4 once_per_stmnt bit(1), 8 14 4 once_per_subpgm bit(1), 8 15 4 saved_operand bit(2), 8 16 3 level fixed bin(3) unal, 8 17 3 length fixed bin(8) unal, 8 18 3 offset fixed bin(17) unal; 8 19 8 20 /* END fort_message_table_.incl.pl1 */ 8 21 137 138 9 1 /* BEGIN INCLUDE FILE fort_options.incl.pl1 */ 9 2 9 3 /****^ *********************************************************** 9 4* * * 9 5* * Copyright, (C) Honeywell Information Systems Inc., 1987 * 9 6* * * 9 7* *********************************************************** */ 9 8 9 9 /****^ HISTORY COMMENTS: 9 10* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 9 11* install(86-07-28,MR12.0-1105): 9 12* Fix fortran bug 473. 9 13* 2) change(87-06-23,RWaters), approve(87-06-23,MCR7703), audit(87-07-10,Huen), 9 14* install(87-08-06,MR12.1-1069): 9 15* Implemented SCP 6315: fortran error-handling argument. 9 16* END HISTORY COMMENTS */ 9 17 9 18 9 19 /* 9 20* Modified: 12 May 87 by RWaters added debug_io 9 21* Modified: 19 February 1986 by B. Wong & A. Ginter - 473.a: Correct 9 22* comments and size of pad field in fort_declared 9 23* and pad out dfast and fast bit masks to two words. 9 24* Modified: 09 October 1985 by B. Wong - 473: add VLA_auto, VLA_static, 9 25* VLA_parm, VLC, LA_auto, and LA_static. Remove VLA and LA. 9 26* Modified: 28 March 1984 by M. Mabey - Install HFP support. 9 27* Modified: 21 September 1983 by M. Mabey - correct size of pad field in fortran_declared. 9 28* Modified: 16 May 1983 by M. Mabey - add fortran_declared 9 29* Modified: 18 December 1982 by T. Oke - Add 'long_profile'. 9 30* Modified: 22 September 1982 by T. Oke - add VLA and LA 9 31* Modified: 3 May 1982 by T. Oke - add check_multiply 9 32* Modified: 06/24/81 by S. Herbst - add do_rounding & auto_zero to fast_mask and dfast_mask 9 33* Modified: 26 February 1980 by C R Davis - add fast_mask, fix dfast_mask. 9 34* Modified: 31 January 1980 by C R Davis - add stringrange. 9 35* Modified: 13 September 1979 by Paul E. Smee--add ansi_77. 9 36* Modified: 05 December 1978 by Paul E. Smee--add do_rounding, auto_zero. 9 37* Modified: 25 January 1978 by Richard A. Barnes for the loop optimizer 9 38**/ 9 39 9 40 declare 9 41 9 42 1 fortran_options aligned based, 9 43 2 use_library bit (1) unaligned, /* (1) ON if library statements will be parsed */ 9 44 2 optimize bit (1) unaligned, /* (2) ON if optimized code is to be produced */ 9 45 2 time bit (1) unaligned, /* (3) ON for compile timing */ 9 46 2 source_format unaligned, 9 47 3 has_line_numbers bit (1) unaligned, /* (4) ON if each line begins with a line number */ 9 48 3 fold bit (1) unaligned, /* (5) ON if variable names are to be folded to lowercase */ 9 49 3 card bit (1) unaligned, /* (6) ON for card format */ 9 50 3 convert bit (1) unaligned, /* (7) ON for card format to be converted */ 9 51 2 listing unaligned, 9 52 3 source bit (1) unaligned, /* (8) ON for listing of numbered source */ 9 53 3 symbol bit (1) unaligned, /* (9) ON for listing with symbol map */ 9 54 3 map bit (1) unaligned, /* (10) ON for listing with statement map */ 9 55 3 list bit (1) unaligned, /* (11) ON for listing with assembler instructions */ 9 56 2 error_messages unaligned, 9 57 3 brief bit (1) unaligned, /* (12) ON for brief error messages */ 9 58 3 severity fixed bin (3), /* (13-16) suppresses messages below this severity */ 9 59 2 debugging unaligned, 9 60 3 subscriptrange bit (1) unaligned, /* (17) ON for subscript range checking */ 9 61 3 stringrange bit (1) unaligned, /* (18) ON for string range checking */ 9 62 3 brief_table bit (1) unaligned, /* (19) ON for statement table */ 9 63 3 table bit (1) unaligned, /* (20) ON for statement and symbol table */ 9 64 3 profile bit (1) unaligned, /* (21) ON to generate code to meter statements */ 9 65 3 check bit (1) unaligned, /* (22) ON for syntactic and semantic checking only */ 9 66 2 system_debugging unaligned, 9 67 3 stop_after_cg bit (1) unaligned, /* (23) ON if debug stop after code generator */ 9 68 3 stop_after_parse bit (1) unaligned, /* (24) ON if debug stop after parse */ 9 69 2 relocatable bit (1) unaligned, /* (25) ON if relocatable object segment generated */ 9 70 2 optimizing unaligned, 9 71 3 time_optimizer bit (1) unaligned, /* (26) ON if timings for optimizer requested */ 9 72 /* (27) ON if optimizer can loosen safety constraints */ 9 73 3 ignore_articulation_blocks bit (1) unaligned, 9 74 3 consolidate bit(1) unaligned, /* (28) ON if optimizer should run consolidation phase */ 9 75 2 do_rounding bit(1) unaligned, /* (29) ON if floating point round should be used */ 9 76 2 auto_zero bit(1) unaligned, /* (30) ON if auto storage should be zeroed when allocated */ 9 77 2 ansi_77 bit (1) unaligned, /* (31) ON if ansi77 rules are to be followed */ 9 78 2 check_multiply bit (1) unaligned, /* (32) ON if check integer multiply extent */ 9 79 2 VLA_auto bit (1) unaligned, /* (33) ON if auto VLA's being done */ 9 80 2 VLA_parm bit (1) unaligned, /* (34) ON if parm VLA's being done */ 9 81 2 VLA_static bit (1) unaligned, /* (35) ON if static VLA's being done */ 9 82 2 VLC bit (1) unaligned, /* (36) ON if VLC's being done */ 9 83 2 LA_auto bit (1) unaligned, /* (1) ON if auto LA's being done */ 9 84 2 LA_static bit (1) unaligned, /* (2) ON if static LA's being done */ 9 85 2 long_profile bit (1) unaligned, /* (3) ON to generate long_profile */ 9 86 2 static_storage bit (1) unaligned, /* (4) ON if static storage */ 9 87 2 hfp bit (1) unaligned, /* (5) ON if using hex floating point math */ 9 88 2 debug_io bit (1) unaligned, /* (6) */ 9 89 2 pad bit(30) unaligned; /* (7-36) Pad bits */ 9 90 9 91 declare 9 92 9 93 1 fortran_declared aligned based, 9 94 2 ansi66 bit(1) unaligned, /* (1) First word */ 9 95 2 ansi77 bit(1) unaligned, /* (2) */ 9 96 2 auto bit(1) unaligned, /* (3) */ 9 97 2 auto_zero bit(1) unaligned, /* (4) */ 9 98 2 brief bit(1) unaligned, /* (5) */ 9 99 2 binary_floating_point bit(1) unaligned, /* (6) */ 9 100 2 brief_table bit(1) unaligned, /* (7) */ 9 101 2 card bit(1) unaligned, /* (8) */ 9 102 2 check bit(1) unaligned, /* (9) */ 9 103 2 check_multiply bit(1) unaligned, /* (10) */ 9 104 2 consolidate bit(1) unaligned, /* (11) */ 9 105 2 debug bit(1) unaligned, /* (12) */ 9 106 2 debug_cg bit(1) unaligned, /* (13) */ 9 107 2 debug_io bit(1) unaligned, /* (14) */ 9 108 2 default_full bit(1) unaligned, /* (15) */ 9 109 2 default_safe bit(1) unaligned, /* (16) */ 9 110 2 fold bit(1) unaligned, /* (17) */ 9 111 2 free bit(1) unaligned, /* (18) */ 9 112 2 full_optimize bit(1) unaligned, /* (19) */ 9 113 2 hexadecimal_floating_point bit(1) unaligned, 9 114 /* (20) */ 9 115 2 la_auto bit(1) unaligned, /* (21) */ 9 116 2 la_static bit(1) unaligned, /* (22) */ 9 117 2 large_array bit(1) unaligned, /* (23) */ 9 118 2 line_numbers bit(1) unaligned, /* (24) */ 9 119 2 list bit(1) unaligned, /* (25) */ 9 120 2 long bit(1) unaligned, /* (26) */ 9 121 2 long_profile bit(1) unaligned, /* (27) */ 9 122 2 map bit(1) unaligned, /* (28) */ 9 123 2 no_auto_zero bit(1) unaligned, /* (29) */ 9 124 2 no_check bit(1) unaligned, /* (30) */ 9 125 2 no_fold bit(1) unaligned, /* (31) */ 9 126 2 no_large_array bit(1) unaligned, /* (32) */ 9 127 2 no_line_numbers bit(1) unaligned, /* (33) */ 9 128 2 no_map bit(1) unaligned, /* (34) */ 9 129 2 no_optimize bit(1) unaligned, /* (35) */ 9 130 2 no_check_multiply bit(1) unaligned, /* (36) */ 9 131 2 no_debug_io bit(1) unal, /* (1) Second Word */ 9 132 2 no_stringrange bit(1) unaligned, /* (2) */ 9 133 2 no_subscriptrange bit(1) unaligned, /* (3) */ 9 134 2 no_table bit(1) unaligned, /* (4) */ 9 135 2 no_very_large_array bit(1) unaligned, /* (5) */ 9 136 2 no_vla_parm bit(1) unaligned, /* (6) */ 9 137 2 no_version bit(1) unaligned, /* (7) */ 9 138 2 non_relocatable bit(1) unaligned, /* (8) */ 9 139 2 optimize bit(1) unaligned, /* (9) */ 9 140 2 profile bit(1) unaligned, /* (10) */ 9 141 2 relocatable bit(1) unaligned, /* (11) */ 9 142 2 round bit(1) unaligned, /* (12) */ 9 143 2 safe_optimize bit(1) unaligned, /* (13) */ 9 144 2 severity fixed bin(3) unaligned, /* (14-16) */ 9 145 2 static bit(1) unaligned, /* (17) */ 9 146 2 stringrange bit(1) unaligned, /* (18) */ 9 147 2 subscriptrange bit(1) unaligned, /* (19) */ 9 148 2 table bit(1) unaligned, /* (20) */ 9 149 2 time bit(1) unaligned, /* (21) */ 9 150 2 time_ot bit(1) unaligned, /* (22) */ 9 151 2 top_down bit(1) unaligned, /* (23) */ 9 152 2 truncate bit(1) unaligned, /* (24) */ 9 153 2 version bit(1) unaligned, /* (25) */ 9 154 2 very_large_array bit(1) unaligned, /* (26) */ 9 155 2 very_large_common bit(1) unaligned, /* (27) */ 9 156 2 vla_auto bit(1) unaligned, /* (28) */ 9 157 2 vla_parm bit(1) unaligned, /* (29) */ 9 158 2 vla_static bit(1) unaligned, /* (30) */ 9 159 2 pad bit(6) unaligned; /* (31-36) */ 9 160 9 161 9 162 declare /* Options used by DFAST */ 9 163 9 164 dfast_mask bit (72) internal static options (constant) initial ("100110000000000010100000000011"b); 9 165 /* use_library, has_line_numbers, fold, subscriptrange, brief_table */ 9 166 9 167 9 168 declare /* Options used by FAST */ 9 169 9 170 fast_mask bit (72) internal static options (constant) initial ("000100000000000010100000000011"b); 9 171 /* has_line_numbers, subscriptrange, brief_table */ 9 172 9 173 /* END INCLUDE FILE fort_options.incl.pl1 */ 139 140 141 dcl 1 csi aligned based (source_info_ptr) like compiler_source_info; 142 10 1 /* BEGIN INCLUDE FILE ... compiler_source_info.incl.pl1 */ 10 2 /* coded in 1973 by B. Wolman */ 10 3 /* modified 12/75 by M. Weaver to include more source info */ 10 4 /* modified 12/76 by M. Weaver to include still more source info (version 2) */ 10 5 10 6 dcl 1 compiler_source_info aligned based, 10 7 2 version fixed bin, 10 8 2 given_ename char (32) var, 10 9 2 dirname char (168) var, 10 10 2 segname char (32) var, 10 11 2 date_time_modified fixed bin (71), 10 12 2 unique_id bit (36), 10 13 2 input_lng fixed bin (21), 10 14 2 input_pointer ptr; 10 15 10 16 dcl compiler_source_info_version_2 fixed bin static init (2) options (constant); 10 17 10 18 /* END INCLUDE FILE ... compiler_source_info.incl.pl1 */ 143 144 11 1 /* BEGIN INCLUDE FILE relocation_bits.incl.pl1 */ 11 2 11 3 /* This include file defines the relocation bits as bit (6) entities. See 11 4* also relbts.incl.pl1 and reloc_lower.incl.pl1. */ 11 5 11 6 dcl ( rc_a initial("000000"b), /* absolute */ 11 7 rc_t initial("010000"b), /* text */ 11 8 rc_nt initial("010001"b), /* negative text */ 11 9 rc_lp18 initial("010010"b), /* linkage, 18 bit */ 11 10 rc_nlp18 initial("010011"b), /* negative link, 18 bit */ 11 11 rc_lp15 initial("010100"b), /* linkage, 15 bit */ 11 12 rc_dp initial("010101"b), /* def section */ 11 13 rc_s initial("010110"b), /* symbol segment */ 11 14 rc_ns initial("010111"b), /* negative symbol */ 11 15 rc_is18 initial("011000"b), /* internal static 18 */ 11 16 rc_is15 initial("011001"b), /* internal static 15 */ 11 17 rc_lb initial("011000"b), /* link block */ 11 18 rc_nlb initial("011001"b), /* negative link block */ 11 19 rc_sr initial("011010"b), /* self relative */ 11 20 rc_e initial("011111"b)) /* escape */ 11 21 bit(6) int static options(constant); 11 22 11 23 /* END INCLUDE FILE relocation_bits.incl.pl1 */ 145 146 147 dcl (addr, addrel, baseno, binary, bool, convert, divide, fixed, hbound, lbound, index, length, max, min, mod, null, 148 ptr, rel, size, string, substr, unspec, verify) 149 builtin; 150 151 dcl cleanup condition; 152 153 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 154 dcl release_temp_segments_ 155 entry (char (*), (*) ptr, fixed bin (35)); 156 157 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); 158 dcl release_temp_segment_ 159 entry (char (*), ptr, fixed bin (35)); 160 161 dcl display_entries$fdisplay 162 entry (ptr) external static variable; 163 164 dcl error_table_$translation_aborted 165 fixed bin (35) external static; 166 dcl error_table_$translation_failed 167 fixed bin (35) external static; 168 169 dcl x (0:operand_max_len - 1) fixed bin (35) based (operand_base); 170 171 dcl 1 polish_region structure aligned based (polish_base), 172 2 polish_string (0:polish_max_len - 1) fixed bin (18) aligned; 173 174 dcl quad (0:quad_max_len - 1) fixed bin (18) based (quadruple_base); 175 176 dcl intermediate_base ptr; 177 178 dcl hash_table_size init (211) fixed bin int static options (constant); 179 dcl hash_table (0:hash_table_size - 1) fixed bin (35) based (operand_base); 180 181 dcl node_offset fixed bin (18); 182 dcl phase fixed bin (18); 183 184 dcl ( 185 node_ptr, 186 tsegp (10) 187 ) ptr; 188 dcl allocate_temp_segs (number_of_temps) ptr based; 189 dcl number_of_temps fixed bin (18); 190 191 dcl num_opt_segs fixed bin (18); 192 193 dcl i fixed bin (18); 194 dcl max_length fixed bin (19); 195 dcl (p, q) pointer; 196 197 dcl 1 packed_ptr_st based aligned, 198 2 packed_ptr pointer unaligned; 199 200 dcl 1 meter_info aligned structure, 201 2 per_phase_info (0:7) aligned structure, 202 3 npages fixed bin (17), 203 3 ncpu fixed bin (52), 204 3 polish_count fixed bin (18), 205 3 operand_count fixed bin (18), 206 3 quadruple_count 207 fixed bin (18), 208 3 opt_count fixed bin (18); 209 210 dcl (cpu, total_cpu) fixed bin (52); 211 dcl last_phase fixed bin (18); 212 213 dcl last_error_subprogram 214 fixed bin (18); 215 dcl last_error_statement 216 fixed bin (18); 217 dcl begin_subprogram_errors 218 fixed bin (18); 219 dcl begin_statement_errors 220 fixed bin (18); 221 dcl msg_table_len fixed bin (18); 222 223 dcl 1 error_msg (200) aligned, 224 2 number fixed bin (18), 225 2 opnd fixed bin (18), 226 2 count fixed bin (18), 227 2 statement fixed bin (18); 228 229 dcl fortran_severity_ fixed bin (35) ext static; 230 231 232 dcl message_printed bit (550) aligned init ("0"b); 233 dcl produce_listing bit (1) aligned; 234 235 dcl ( 236 initialization init (1), 237 in_parse init (2), 238 in_converter init (3), 239 in_optimizer init (4), 240 in_code_generator init (5), 241 in_listing_generator 242 init (6), 243 in_clean_up init (7) 244 ) fixed bin int static options (constant); 245 246 dcl phase_name (7) char (16) aligned int static options (constant) 247 init ("setup", "parse", "converter", "optimizer", "code generator", "listing", "cleanup"); 248 249 dcl date_string char (24); 250 dcl user_id char (32) aligned; 251 dcl static_user_id char (32) varying int static init (""); 252 253 dcl clock_ ext entry (fixed bin (71)); 254 dcl cu_$decode_entry_value 255 entry (entry, pointer, pointer); 256 dcl date_time_ ext entry (fixed bin (71), char (*)); 257 dcl fort_defaults_$options_string 258 ext entry (ptr, char (256) varying, fixed bin (19)); 259 dcl get_group_id_ ext entry (char (*) aligned); 260 dcl ioa_ ext entry options (variable); 261 dcl ioa_$nnl ext entry options (variable); 262 dcl ioa_$rsnp ext entry options (variable); 263 dcl probe ext entry options (variable); 264 dcl hcs_$terminate_noname 265 ext entry (ptr, fixed bin (35)); 266 dcl hcs_$usage_values ext entry (fixed bin (17), fixed bin (52)); 267 dcl pl1_operators_$VLA_words_per_seg_ 268 fixed bin (19) ext; 269 270 271 272 /* Main entry into the new fortran compiler */ 273 274 unspec (shared_globals) = "0"b; 275 276 /* get caller's source routine or use the compiler's internal one */ 277 278 call cu_$decode_entry_value (get_next_source_seg_entry, p, q); 279 if p = null 280 then get_next_source_seg = get_next_source_seg_comp; 281 /* use the compiler's routine */ 282 else get_next_source_seg = get_next_source_seg_entry; 283 /* use the caller's routine */ 284 285 /* get caller's lib list routine or use internal one */ 286 287 call cu_$decode_entry_value (add_to_lib_list_entry, p, q); 288 if p = null 289 then shared_globals.options.compile_only = "1"b; /* use the compiler's routine */ 290 else do; /* use the caller's routine */ 291 shared_globals.options.compile_only = "0"b; 292 add_to_lib_list_run = add_to_lib_list_entry; 293 end; 294 295 /* pick up the declared fortran options */ 296 297 shared_globals.declared_options = declared_ptr -> fortran_declared; 298 299 /* set Multics/FAST switch */ 300 301 shared_globals.options.is_fast = "0"b; 302 max_length = sys_info$max_seg_size; 303 goto initialize; 304 305 306 /* entry to compile one source segment from within FAST/DFAST */ 307 308 compile: 309 entry (source_info_ptr, /* input; pointer to source info structure */ 310 object_base_ptr, 311 /* input; pointer to object segment */ 312 object_length, /* output; word length of object segment */ 313 options_ptr, 314 /* input; pointer to fort options structure */ 315 code); 316 /* output; error code */ 317 318 /* use compiler's internal routines */ 319 320 get_next_source_seg = get_next_source_seg_comp; 321 unspec (shared_globals) = "0"b; 322 shared_globals.options.compile_only = "1"b; 323 shared_globals.options.is_fast = "1"b; /* Multics/FAST switch */ 324 unspec (shared_globals.declared_options) = "0"b; 325 max_length = 65536; 326 goto initialize; 327 328 329 /* entry called by run unit man to compile source programs for execution */ 330 331 compile_run: 332 entry (source_info_ptr, /* input; pointer to source info structure */ 333 object_base_ptr, 334 /* input; pointer to object segment */ 335 object_length, /* output; word length of object segment */ 336 options_ptr, 337 /* input; pointer to fort options structure */ 338 get_next_source_seg_entry, 339 /* input; routine to provide next source seg or null entry value */ 340 add_to_lib_list_entry, 341 /* input; routine to handle lib pathnames or null entry value */ 342 code); 343 /* output; error code */ 344 345 /* use caller's routines */ 346 347 get_next_source_seg = get_next_source_seg_entry; 348 add_to_lib_list_run = add_to_lib_list_entry; 349 unspec (shared_globals) = "0"b; 350 shared_globals.options.compile_only = "0"b; 351 shared_globals.options.is_fast = "1"b; /* Multics/FAST switch */ 352 unspec (shared_globals.declared_options) = "0"b; 353 max_length = 65536; 354 355 initialize: /* initialize local variables and pick up the user options */ 356 if csi.version ^= compiler_source_info_version_2 357 then do; 358 code = error_table_$translation_aborted; 359 return; 360 end; 361 362 phase = initialization; 363 364 shared_globals.options.user_options = options_ptr -> fortran_options; 365 produce_listing = string (shared_globals.options.listing) ^= "0"b; 366 367 if shared_globals.options.time 368 then do; 369 unspec (meter_info) = "0"b; /* Initialize the metering array. */ 370 371 call hcs_$usage_values (npages (0), ncpu (0)); 372 end; 373 374 display_entries$fdisplay = fort_display; 375 376 /* derive objectname */ 377 378 if csi.given_ename = "" 379 then objectname = "object"; 380 else if length (csi.given_ename) > 8 381 then if substr (csi.given_ename, length (csi.given_ename) - 7, 8) = ".fortran" 382 then objectname = substr (csi.given_ename, 1, length (csi.given_ename) - 8); 383 else objectname = csi.given_ename; 384 else objectname = csi.given_ename; 385 386 /* set date time compiled */ 387 388 call clock_ (date_time_compiled); 389 390 /* determine user id */ 391 392 if length (static_user_id) = 0 393 then do; 394 call get_group_id_ (user_id); 395 396 i = index (user_id, " ") - 1; 397 if i < 0 398 then i = length (user_id); 399 400 static_user_id = substr (user_id, 1, i); 401 end; 402 403 vuser_id = static_user_id; 404 405 /* initialize global variables */ 406 407 num_of_lib_names, first_lib_name, last_lib_name, num_of_word_constants, first_word_constant, last_word_constant, 408 num_of_dw_constants, first_dw_constant, last_dw_constant, num_of_char_constants, first_char_constant, 409 last_char_constant, num_of_block_constants, first_block_constant, last_block_constant = 0; 410 411 num_opt_segs = 0; 412 413 polish_max_len, operand_max_len, quad_max_len, object_max_len = max_length; 414 415 opt_max_len = sys_info$max_seg_size; 416 417 next_free_temp, next_free_array_ref = 0; 418 419 next_free_object = 0; 420 next_free_opt, next_free_polish, next_free_quad = 1; 421 /* must be initialized to non-zero for the optimizer */ 422 next_free_operand = hash_table_size; 423 424 cur_statement, cur_subprogram, first_subprogram, last_subprogram = 0; 425 426 first_entry_name, last_entry_name = 0; 427 428 error_level, msg_table_len, begin_statement_errors, begin_subprogram_errors, incl_count, last_error_subprogram = 429 0; 430 431 last_error_statement = -1; 432 433 434 /* make sure window is shut tight for cleanup handler */ 435 436 number_of_temps = 0; 437 tsegp (*) = null; 438 opt_base = null; 439 440 441 /* set up a cleanup handler */ 442 443 on cleanup 444 call clean_up; 445 446 /* get work segments */ 447 448 number_of_temps = 3; /* require at least three temp segs */ 449 450 if produce_listing 451 then number_of_temps = number_of_temps + 3; /* cref, listing_info, source_line */ 452 453 if shared_globals.options.optimize 454 then number_of_temps = number_of_temps + 2; /* quadruples & optimizer stuff */ 455 456 call get_temp_segments_ ("fort_", addr (tsegp) -> allocate_temp_segs, code); 457 if code ^= 0 458 then return; 459 460 /* set work area pointers and zero object length */ 461 462 intermediate_base, polish_base = tsegp (1); 463 operand_base = tsegp (2); 464 relocation_base = tsegp (3); 465 object_base = object_base_ptr; 466 object_length = 0; 467 468 /* if a listing is to be produced, set appropriate global variables */ 469 470 if produce_listing 471 then do; 472 cref_base = tsegp (4); /* contains cross ref info */ 473 source_line_base = tsegp (5); /* char offset for each source line */ 474 listing_base = tsegp (6); /* error text and listing info nodes */ 475 476 /* build node for errors before the first subprogram */ 477 478 cur_listing = listing_base; 479 unspec (listing_info) = "0"b; /* initialize */ 480 481 number_of_crefs = 0; 482 next_free_listing = size (listing_info); 483 end; 484 485 /* if optimizing set up for those phases */ 486 487 if shared_globals.options.optimize 488 then do; 489 opt_base = tsegp (number_of_temps); /* get last temp_base seg pointer */ 490 opt_base -> packed_ptr = null; 491 num_opt_segs = 1; 492 quadruple_base = tsegp (number_of_temps - 1); 493 end; 494 495 call BEGIN_COMPILER_PHASE (in_parse, "0"b); 496 497 source_line_number, source_file_number = 0; 498 use_source_info = "0"b; /* Turn off source numbers */ 499 call parse_source (source_info_ptr); 500 source_line_number, source_file_number = 0; 501 use_source_info = "0"b; /* Turn off source numbers */ 502 503 /* compute options string to reflect control arguments and '%global' cards. */ 504 505 call fort_defaults_$options_string (addr (shared_globals.options), options_string, 506 pl1_operators_$VLA_words_per_seg_); 507 508 /* if no fatal errors in parse then invoke (optimizer and) code generator */ 509 510 if error_level < unrecoverable_error & ^shared_globals.options.check 511 then do; 512 513 514 515 if shared_globals.options.optimize 516 then do; 517 call BEGIN_COMPILER_PHASE (in_converter, (shared_globals.options.stop_after_parse)); 518 519 call converter; 520 521 intermediate_base = quadruple_base; 522 523 call BEGIN_COMPILER_PHASE (in_optimizer, (shared_globals.options.stop_after_parse)); 524 525 call optimizer; 526 527 call BEGIN_COMPILER_PHASE (in_code_generator, (shared_globals.options.stop_after_parse)); 528 529 call optimizing_cg; 530 end; 531 532 else do; 533 call BEGIN_COMPILER_PHASE (in_code_generator, (shared_globals.options.stop_after_parse)); 534 535 call code_generator; 536 end; 537 538 object_length = next_free_object; 539 end; 540 541 /* set return code and object length */ 542 543 if error_level > unrecoverable_error 544 then do; 545 fort_abort: 546 code = error_table_$translation_aborted; 547 object_length = 0; 548 end; 549 else if error_level = unrecoverable_error 550 then do; 551 code = error_table_$translation_failed; 552 object_length = 0; 553 end; 554 else code = 0; 555 556 /* Before a listing can be produced, all error messages must be printed. */ 557 558 call print_message_op$epilogue; /* Prints outstanding message counts. */ 559 560 /* if user requested a listing, produce it now */ 561 562 if produce_listing 563 then do; 564 call BEGIN_COMPILER_PHASE (in_listing_generator, (shared_globals.options.stop_after_cg)); 565 566 call listing_generator; 567 end; 568 569 /* clean up and return */ 570 571 call BEGIN_COMPILER_PHASE (in_clean_up, shared_globals.options.stop_after_cg & ^produce_listing); 572 573 call clean_up; 574 575 if shared_globals.options.time 576 then do; 577 call hcs_$usage_values (npages (hbound (per_phase_info, 1)), ncpu (hbound (per_phase_info, 1))); 578 polish_count (hbound (per_phase_info, 1)) = next_free_polish; 579 operand_count (hbound (per_phase_info, 1)) = next_free_operand; 580 quadruple_count (hbound (per_phase_info, 1)) = next_free_quad; 581 opt_count (hbound (per_phase_info, 1)) = next_free_opt; 582 583 call date_time_ (date_time_compiled, date_string); 584 585 call ioa_ 586 ( 587 "^/Segment ^a (^d lines)^/Compiled by ^a on ^a^/ 588 Phase CPU % Pages Polish Operand^[ Quadruple Optimizer^]" 589 , objectname, number_of_lines, compiler_name, date_string, shared_globals.options.optimize); 590 591 592 total_cpu = ncpu (hbound (per_phase_info, 1)) - ncpu (0); 593 last_phase = 0; 594 595 do i = 1 to hbound (per_phase_info, 1); 596 597 /* if phase was skipped, do not print a line for it */ 598 599 if ncpu (i) > 0 600 then do; 601 602 /* compute time for this phase */ 603 604 cpu = ncpu (i) - ncpu (last_phase); 605 606 /* print info for this phase */ 607 608 call ioa_ ("^15a^9.3f^6.1f^6d^9o^10o^[^11o^10o^]", phase_name (i), cpu / 1.0e6, 609 100.0e0 * cpu / total_cpu, npages (i) - npages (last_phase), polish_count (i), 610 operand_count (i), shared_globals.options.optimize, quadruple_count (i), 611 opt_count (i)); 612 last_phase = i; 613 end; 614 end; 615 616 /* print totals */ 617 618 call ioa_ ("TOTAL ^9.3f^12d^/", total_cpu / 1.0e6, 619 npages (hbound (per_phase_info, 1)) - npages (0)); 620 621 if num_opt_segs > 1 622 then call ioa_ ("^/^d temp segments were used by the optimizer.", num_opt_segs); 623 624 end; 625 626 return; 627 628 clean_up: 629 proc; 630 631 dcl code fixed bin (35); 632 dcl i fixed bin; 633 dcl p ptr; 634 635 do i = 1 to shared_globals.incl_count; 636 call hcs_$terminate_noname ((shared_globals.incl_ptr (i)), code); 637 end; 638 639 code = 0; 640 641 if opt_base ^= null & baseno (opt_base) ^= "0"b 642 then do; 643 644 do while (opt_base ^= null & baseno (opt_base) ^= "0"b); 645 p = opt_base; 646 opt_base = p -> packed_ptr; 647 call release_temp_segment_ ("fort_", p, code); 648 end; 649 650 number_of_temps = number_of_temps - 1; 651 end; 652 653 call release_temp_segments_ ("fort_", addr (tsegp) -> allocate_temp_segs, code); 654 polish_base, operand_base, quadruple_base, opt_base, object_base = null; 655 656 end clean_up; 657 658 BEGIN_COMPILER_PHASE: 659 proc (new_phase, call_probe); 660 661 dcl new_phase fixed bin (17); 662 dcl call_probe bit (1) aligned; 663 664 665 if shared_globals.options.time 666 then do; 667 call hcs_$usage_values (npages (phase), ncpu (phase)); 668 polish_count (phase) = next_free_polish; 669 operand_count (phase) = next_free_operand; 670 quadruple_count (phase) = next_free_quad; 671 opt_count (phase) = next_free_opt; 672 end; 673 674 if call_probe 675 then do; 676 call ioa_$nnl ("^a done! pb:", phase_name (phase)); 677 call probe (); 678 end; 679 680 phase = new_phase; 681 end BEGIN_COMPILER_PHASE; 682 683 abort_compiler: 684 proc (msg); 685 686 dcl msg char (*); 687 688 689 call ioa_ ("Compiler Error: ^a", msg); 690 goto fort_abort; 691 end abort_compiler; 692 693 parse_source: 694 proc (source_ptr); 695 696 dcl source_ptr ptr; 697 dcl ext_parse entry (ptr, ptr); 698 699 shared_globals.create_constant = create_constant; 700 shared_globals.create_char_constant = create_char_constant; 701 shared_globals.print_message = print_message; 702 shared_globals.get_next_temp_segment = get_next_temp_segment; 703 704 parse_globals.source_info_ptr = source_ptr; 705 706 if shared_globals.options.compile_only 707 then parse_globals.add_to_lib_list_run = add_to_lib_list; 708 709 parse_globals.add_to_lib_list = parse_globals.add_to_lib_list_run; 710 711 call ext_parse (addr (shared_globals), addr (parse_globals)); 712 713 end parse_source; 714 715 converter: 716 proc; 717 718 dcl fort_converter entry (ptr); 719 720 call fort_converter (addr (shared_globals)); 721 722 end converter; 723 724 optimizer: 725 proc; 726 727 dcl fort_optimizer entry (ptr); 728 729 call fort_optimizer (addr (shared_globals)); 730 731 end optimizer; 732 733 code_generator: 734 proc; 735 736 dcl ext_code_generator entry (ptr, ptr); 737 738 shared_globals.create_constant = create_constant; 739 shared_globals.create_char_constant = create_char_constant; 740 shared_globals.print_message = print_message; 741 742 cg_globals.print_message_op = print_message_op; 743 cg_globals.create_constant_block = create_constant_block; 744 745 call ext_code_generator (addr (shared_globals), addr (cg_globals)); 746 747 end code_generator; 748 749 optimizing_cg: 750 proc; 751 752 dcl fort_optimizing_cg entry (ptr, ptr); 753 754 shared_globals.create_constant = create_constant; 755 shared_globals.create_char_constant = create_char_constant; 756 shared_globals.print_message = print_message; 757 758 cg_globals.print_message_op = print_message_op; 759 cg_globals.create_constant_block = create_constant_block; 760 761 call fort_optimizing_cg (addr (shared_globals), addr (cg_globals)); 762 763 end optimizing_cg; 764 765 listing_generator: 766 proc; 767 768 dcl ext_listing_generator 769 entry (ptr, ptr, ptr); 770 771 call ext_listing_generator (addr (shared_globals), addr (parse_globals), addr (cg_globals)); 772 773 end listing_generator; 774 12 1 /* BEGIN fort_utilities.incl.pl1 */ 12 2 12 3 /* Created: October 1977, Richard Barnes 12 4* 12 5* Modified: 12 6* 22 May 1978, DSL - add create_constant. 12 7* 09 Oct 1978, PES - make create_(constant node) return fixed bin(18) unsigned. 12 8* 13 Dec 1978, PES - Get create_node from include file, rather than copy. 12 9**/ 12 10 13 1 /* BEGIN fort_create_node.incl.pl1 */ 13 2 13 3 /* Created: October 1977, Richard Barnes 13 4* 13 5* Modified: 13 6* 22 May 1978, DSL - add create_constant. 13 7* 09 Oct 1978, PES - make create_(constant node) return fixed bin(18) unsigned. 13 8* 13 Dec 1978, PES - changes for large common and arrays. 13 9**/ 13 10 create_node: proc(type,length) returns(fixed bin (18)); 13 11 13 12 dcl length fixed bin; 13 13 dcl offset fixed bin(18); 13 14 dcl type fixed bin(4); 13 15 dcl storage(length) fixed bin aligned based; 13 16 dcl x(0:operand_max_len-1) fixed bin(35) aligned based(operand_base); 13 17 dcl (addr,char,ltrim,unspec) builtin; 13 18 13 19 13 20 if (length + next_free_operand) < operand_max_len 13 21 then do; 13 22 offset = next_free_operand; 13 23 next_free_operand = next_free_operand + length; 13 24 unspec(addr(x(offset)) -> storage) = "0"b; 13 25 addr(x(offset)) -> node.node_type = type; 13 26 return(offset); 13 27 end; 13 28 else do; 13 29 call print_message(407, "operand region", ltrim(char(operand_max_len))); /* FATAL */ 13 30 end; 13 31 13 32 end create_node; 13 33 13 34 /* END fort_create_node.incl.pl1 */ 12 11 12 12 12 13 create_constant: proc(data_type,value) returns(fixed bin (18)); 12 14 12 15 dcl (data_type,a_data_type) fixed bin(4); /* data type of constant */ 12 16 dcl (value,a_value) bit(72) aligned; /* value of constant */ 12 17 12 18 dcl addr builtin; 12 19 dcl binary builtin; 12 20 dcl bool builtin; 12 21 dcl char builtin; 12 22 dcl data_size fixed bin(17); 12 23 dcl decimal builtin; 12 24 dcl hash_index fixed bin; 12 25 dcl hash_table(0:hash_table_size-1) fixed bin(35) aligned based(operand_base); 12 26 dcl hash_table_size fixed bin int static options(constant) init(211); 12 27 dcl hbound builtin; 12 28 dcl ltrim builtin; 12 29 dcl mod builtin; 12 30 dcl mod_2_sum bit(36) aligned; 12 31 dcl node_offset fixed bin; 12 32 dcl node_ptr pointer; 12 33 dcl size builtin; 12 34 dcl v_array(2) bit(36) aligned based(addr(a_value)); 12 35 dcl x(0:operand_max_len-1) fixed bin(35) aligned based(operand_base); 12 36 14 1 /* BEGIN INCLUDE FILE relocation_bits.incl.pl1 */ 14 2 14 3 /* This include file defines the relocation bits as bit (6) entities. See 14 4* also relbts.incl.pl1 and reloc_lower.incl.pl1. */ 14 5 14 6 dcl ( rc_a initial("000000"b), /* absolute */ 14 7 rc_t initial("010000"b), /* text */ 14 8 rc_nt initial("010001"b), /* negative text */ 14 9 rc_lp18 initial("010010"b), /* linkage, 18 bit */ 14 10 rc_nlp18 initial("010011"b), /* negative link, 18 bit */ 14 11 rc_lp15 initial("010100"b), /* linkage, 15 bit */ 14 12 rc_dp initial("010101"b), /* def section */ 14 13 rc_s initial("010110"b), /* symbol segment */ 14 14 rc_ns initial("010111"b), /* negative symbol */ 14 15 rc_is18 initial("011000"b), /* internal static 18 */ 14 16 rc_is15 initial("011001"b), /* internal static 15 */ 14 17 rc_lb initial("011000"b), /* link block */ 14 18 rc_nlb initial("011001"b), /* negative link block */ 14 19 rc_sr initial("011010"b), /* self relative */ 14 20 rc_e initial("011111"b)) /* escape */ 14 21 bit(6) int static options(constant); 14 22 14 23 /* END INCLUDE FILE relocation_bits.incl.pl1 */ 12 37 12 38 12 39 12 40 a_data_type = data_type; 12 41 a_value = value; 12 42 12 43 if a_data_type = char_mode | a_data_type <= 0 | a_data_type > hbound(data_type_size,1) 12 44 then do; 12 45 call print_message(452, ltrim(char(decimal(a_data_type,12)))); /* cannot create the node */ 12 46 end; 12 47 else data_size = data_type_size(a_data_type); 12 48 12 49 if data_size = 1 12 50 then do; 12 51 mod_2_sum = v_array(1); 12 52 v_array(2) = "0"b; 12 53 end; 12 54 else mod_2_sum = bool(v_array(1),v_array(2),"0110"b); 12 55 12 56 12 57 hash_index = mod(binary(mod_2_sum,35),hash_table_size); 12 58 12 59 /* Search the hash table for the constant. */ 12 60 12 61 node_offset = hash_table(hash_index); 12 62 do while(node_offset > 0); /* search the entire bucket */ 12 63 node_ptr = addr(x(node_offset)); 12 64 12 65 if node_ptr -> constant.value = a_value /* must be same value */ 12 66 then if node_ptr -> node.data_type = a_data_type /* and same data type */ 12 67 then return(node_offset); 12 68 12 69 node_offset = node_ptr -> node.hash_chain; /* NB - pointer remains pointing at last item in bucket */ 12 70 end; 12 71 12 72 /* a new constant node must be created */ 12 73 12 74 node_offset = create_node(constant_node, size(constant)); 12 75 12 76 if hash_table(hash_index) = 0 /* Is this the first item in the bucket? */ 12 77 then hash_table(hash_index) = node_offset; /* yes */ 12 78 else node_ptr -> node.hash_chain = node_offset; /* no, add it to the end */ 12 79 12 80 node_ptr = addr(x(node_offset)); 12 81 node_ptr -> constant.data_type = a_data_type; 12 82 node_ptr -> constant.operand_type = constant_type; 12 83 node_ptr -> constant.is_addressable = "1"b; 12 84 node_ptr -> constant.reloc = rc_t; 12 85 node_ptr -> constant.value = a_value; 12 86 12 87 constant_info(data_size).constant_count = constant_info(data_size).constant_count + 1; 12 88 12 89 if constant_info(data_size).first_constant = 0 /* Is this the first item of this size? */ 12 90 then constant_info(data_size).first_constant = node_offset; /* yes */ 12 91 else addr(x(constant_info(data_size).last_constant)) -> constant.next_constant = node_offset; /* no, add it */ 12 92 12 93 constant_info(data_size).last_constant = node_offset; 12 94 12 95 return(node_offset); 12 96 12 97 end create_constant; 12 98 12 99 /* END fort_utilities.incl.pl1 */ 775 776 777 create_char_constant: 778 proc (value) returns (fixed bin (18)); 779 780 dcl value char (*); 781 dcl a_value char (char_constant_length) aligned based (addr (string_bit_array)); 782 dcl cc_offset fixed bin (18); 783 dcl cc_ptr pointer; 784 dcl hash_index fixed bin (18); 785 786 dcl (i, j, k, which) fixed bin (18); 787 dcl mod_2_sum bit (36) aligned; 788 dcl string_bit_array (0:255) bit (36) aligned; 789 790 dcl mask (3) bit (36) int static aligned 791 init ("111111111000000000000000000000000000"b, "111111111111111111000000000000000000"b, 792 "111111111111111111111111111000000000"b); 793 794 795 char_constant_length = length (value); 796 a_value = value; 797 which = 3; 798 799 /* calculate the hash index for the constant */ 800 801 join: 802 if length (a_value) = 0 803 then hash_index = 0; 804 else if length (a_value) = 1 805 then do; 806 hash_index = binary (unspec (substr (a_value, 1, 1)) & "001111111"b, 9); 807 end; 808 else do; 809 mod_2_sum = "0"b; 810 811 j = divide (length (a_value) - 1, 4, 17, 0); 812 k = length (a_value) - 4 * j; 813 814 if k ^= 4 815 then string_bit_array (j) = string_bit_array (j) & mask (k); 816 817 do i = 0 to j; 818 mod_2_sum = bool (mod_2_sum, string_bit_array (i), "0110"b); 819 end; 820 821 hash_index = mod (binary (substr (mod_2_sum, 2, 35), 35), hash_table_size); 822 end; 823 824 /* search the hash table bucket for the constant */ 825 826 cc_offset = hash_table (hash_index); 827 do while (cc_offset > 0); /* search the entire bucket */ 828 cc_ptr = addr (x (cc_offset)); 829 830 if cc_ptr -> node.node_type = char_constant_node 831 /* all constants in same hash table */ 832 then if cc_ptr -> char_constant.length = char_constant_length 833 then if cc_ptr -> char_constant.value = a_value 834 then return (cc_offset); 835 836 cc_offset = cc_ptr -> node.hash_chain; /* will point to last item in bucket. get offset of next const */ 837 end; 838 839 /* a new constant node must be created */ 840 841 cc_offset = create_node (char_constant_node, size (char_constant)); 842 843 if hash_table (hash_index) = 0 /* Is this the first item in this bucket? */ 844 then hash_table (hash_index) = cc_offset; /* yes */ 845 else cc_ptr -> node.hash_chain = cc_offset; /* no, add it to end */ 846 847 cc_ptr = addr (x (cc_offset)); 848 cc_ptr -> char_constant.data_type = char_mode; 849 cc_ptr -> char_constant.operand_type = constant_type; 850 cc_ptr -> char_constant.length = char_constant_length; 851 cc_ptr -> char_constant.value = a_value; 852 cc_ptr -> char_constant.is_addressable = "1"b; 853 cc_ptr -> char_constant.reloc = rc_t; 854 855 constant_count (which) = constant_count (which) + 1; 856 857 if first_constant (which) = 0 /* is this the first char constant? */ 858 then first_constant (which) = cc_offset; /* yes */ 859 else addr (x (last_constant (which))) -> char_constant.next_constant = cc_offset; 860 /* no, add it to list */ 861 862 last_constant (which) = cc_offset; 863 864 return (cc_offset); 865 866 867 create_constant_block: 868 entry (pt, nwords) returns (fixed bin (18)); 869 870 dcl pt ptr, /* points at block of data */ 871 nwords fixed bin (18); /* length of data */ 872 873 dcl b_value char (char_constant_length) based (pt) aligned; 874 875 which = 4; 876 char_constant_length = chars_per_word * nwords; 877 a_value = b_value; 878 go to join; 879 880 end create_char_constant; 881 882 add_to_lib_list: 883 proc (pathname, code); 884 885 dcl pathname char (*); 886 dcl a_pathname char (256) var; 887 dcl code fixed bin (35); 888 dcl char_node_offset fixed bin (18); 889 890 891 a_pathname = pathname; 892 code = 0; /* No error possible, except to abort compilation. */ 893 894 /* create character constant node and/or get its offset */ 895 896 char_node_offset = create_char_constant (pathname); 897 addr (x (char_node_offset)) -> char_constant.allocate = "1"b; 898 /* Force allocation of the constant. */ 899 900 /* is the list of library names non-empty */ 901 902 if first_lib_name > 0 903 then do; 904 node_offset = first_lib_name; 905 906 /* yes, search the library list */ 907 908 do while (node_offset > 0); 909 node_ptr = addr (x (node_offset)); 910 if node_ptr -> library.character_operand = char_node_offset 911 then return; 912 node_offset = node_ptr -> library.next_library_node; 913 end; 914 915 end; 916 917 918 /* build a new library node and thread it into the chain. */ 919 920 num_of_lib_names = num_of_lib_names + 1; 921 922 node_offset = create_node (library_node, size (library)); 923 924 addr (x (node_offset)) -> library.character_operand = char_node_offset; 925 926 if last_lib_name = 0 927 then first_lib_name = node_offset; 928 else addr (x (last_lib_name)) -> library.next_library_node = node_offset; 929 930 last_lib_name = node_offset; 931 932 end add_to_lib_list; 933 934 get_next_source_seg_comp: 935 proc (p); 936 937 dcl p ptr; 938 939 p -> compiler_source_info.input_pointer = null (); 940 941 end get_next_source_seg_comp; 942 943 get_next_temp_segment: 944 proc (seg_base, next_free) returns (ptr); 945 946 dcl seg_base ptr; /* -> base of temp segment (input/output) */ 947 dcl next_free fixed bin (18); /* used for making allocations (output) */ 948 949 dcl p ptr; 950 dcl code fixed bin (35); 951 952 call get_temp_segment_ ("fort_", p, code); 953 954 if code ^= 0 955 then call abort_compiler ("Can't get new temp segment."); 956 957 num_opt_segs = num_opt_segs + 1; 958 959 p -> packed_ptr = seg_base; 960 seg_base = p; 961 next_free = 1; 962 963 return (p); 964 965 end get_next_temp_segment; 966 967 /* Message printing utilizes "cur_statement" as the address of the word */ 968 /* starting a statement node. However this functionality does not work for */ 969 /* some messages called from "ext_parse" and perhaps other areas. Two fields*/ 970 /* have been added to shared_structure.incl.pl1, source_line_number, and */ 971 /* source_file_number. These are used rather than the numbers from the nodes*/ 972 /* if "use_source_info is set. */ 973 974 print_message: 975 proc options (variable, no_quick_blocks); 976 977 dcl cu_$arg_list_ptr entry (ptr); 978 dcl cu_$arg_count entry (fixed bin); 979 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 980 dcl decode_descriptor_ entry (ptr, fixed bin, fixed bin, bit (1) aligned, fixed bin, fixed bin, fixed bin); 981 982 dcl (arg_list_ptr, arg_ptr) 983 ptr; 984 dcl packed bit (1) aligned; 985 dcl fixed_bin fixed bin (18) based; 986 dcl code fixed bin (35); 987 dcl (nargs, i, arg_len, a_type, ndims, size, scale) 988 fixed bin (17); 989 990 dcl ( 991 real_fixed_bin init (1), 992 character_string init (21), 993 char_string_varing init (22) 994 ) fixed bin int static options (constant); 995 996 dcl bad_arg char (12) aligned int static options (constant) init ("BAD ARGUMENT"); 997 998 999 /* get the number of arguments */ 1000 1001 call cu_$arg_count (nargs); 1002 message_structure.number_of_operands = nargs - 1; 1003 1004 /* get the argument list pointer */ 1005 1006 call cu_$arg_list_ptr (arg_list_ptr); 1007 1008 /* get the first argument */ 1009 1010 call cu_$arg_ptr (1, arg_ptr, arg_len, code); 1011 message_structure.message_number = arg_ptr -> fixed_bin; 1012 1013 /* get one to three optional arguments */ 1014 1015 do i = 2 to nargs; 1016 call cu_$arg_ptr (i, arg_ptr, arg_len, code); 1017 call decode_descriptor_ (arg_list_ptr, i, a_type, packed, ndims, size, scale); 1018 1019 if a_type = real_fixed_bin 1020 then do; 1021 message_structure.operands (i - 1).is_string = "0"b; 1022 message_structure.operands (i - 1).operand_index = arg_ptr -> fixed_bin; 1023 end; 1024 else if a_type = character_string | a_type = char_string_varing 1025 then do; 1026 message_structure.operands (i - 1).is_string = "1"b; 1027 if a_type = character_string 1028 then message_structure.operands (i - 1).string_length = arg_len; 1029 else message_structure.operands (i - 1).string_length = addrel (arg_ptr, -1) -> fixed_bin; 1030 message_structure.operands (i - 1).string_ptr = arg_ptr; 1031 end; 1032 1033 else do; /* Bad argument. */ 1034 message_structure.operands (i - 1).is_string = "1"b; 1035 message_structure.operands (i - 1).string_length = length (bad_arg); 1036 message_structure.operands (i - 1).string_ptr = addr (bad_arg); 1037 end; 1038 end; 1039 1040 call print_message_op; 1041 1042 end print_message; 1043 1044 print_message_op: 1045 proc; 1046 1047 dcl (node_ptr, table_base) 1048 ptr; 1049 dcl (a_message_number, opnd) 1050 fixed bin (18); 1051 dcl (i, arg_length, noprds, new_slot, message_length, message_offset) 1052 fixed bin (18); 1053 1054 dcl arg_string (3) char (256) var; 1055 dcl arg_char_string char (arg_length) based; 1056 1057 dcl header_line char (128) varying; 1058 1059 dcl print_on_terminal bit (1) aligned; 1060 1061 dcl (a_node_type, an_error_level) 1062 fixed bin (4) aligned; 1063 1064 dcl 1 table_overlay aligned based (table_base), 1065 2 spacer (message_offset) fixed bin, 1066 2 formating_string 1067 char (message_length) unal; 1068 1069 1070 /* First, get and validate error message number. If severity is zero or message length is 1071* zero, chances are that message is not in table. Then, get its severity level. */ 1072 1073 a_message_number = message_structure.message_number; 1074 1075 if a_message_number <= 0 | a_message_number > hbound (fort_message_table$fort_message_table.descrip, 1) 1076 | fort_message_table$fort_message_table.descrip (a_message_number).level = 0 1077 | fixed (fort_message_table$fort_message_table.descrip (a_message_number).length, 17) = 0 1078 then do; 1079 a_message_number = hbound (fort_message_table$fort_message_table.descrip, 1); 1080 message_structure.number_of_operands = 1; 1081 message_structure.operands (1).operand_index = message_structure.message_number - bias; 1082 message_structure.operands (1).is_string = "0"b; 1083 end; 1084 1085 an_error_level = fort_message_table$fort_message_table.descrip (a_message_number).level; 1086 1087 print_on_terminal = an_error_level >= shared_globals.options.severity; 1088 /* Decide if user wants it online. */ 1089 1090 1091 /* Format the error message only if it is to be printed somewhere. */ 1092 1093 if print_on_terminal | produce_listing 1094 then do; 1095 1096 /* The following block of code implements restricted message printing. This is simply 1097* effort to reduce the number of redundant error messages printed, without reducing 1098* formation available to the user. Use of the -brief control argument reduces the number 1099* times a given message is printed, also. 1100* 1101* Three flags control the number of times a message is printed and they are part of 1102* e message table entry for each error message. The flag "print_once" must be set to "1"b 1103* r messages that participate in this feature. Additionally, the flag "once_per_stmnt" 1104* the flag "once_per_subpgm" may be "1"b. It is an error if all three are "1"b. 1105* 1106* If only "print_once" is "1"b, the message is printed once per subprogram if 1107* rief is not specified, and once per compilation if it is. If "print_once" and 1108* nce_per_subpgm" are "1"b, the message is printed once per statement if -brief is not 1109* ecified, and once per subprogram if it is. if "print_once" and "once_per_stmnt" are 1110* "b, the message is always printed once per statement. */ 1111 1112 if fort_message_table$fort_message_table.descrip (a_message_number).print_once 1113 then do; 1114 1115 /* If match includes an operand, extract operand from current message. */ 1116 1117 opnd = 1118 binary (fort_message_table$fort_message_table.descrip (a_message_number).saved_operand) 1119 ; 1120 if opnd ^= 0 1121 then if message_structure.operands (opnd).is_string 1122 then do; 1123 arg_length = message_structure.operands (opnd).string_length; 1124 opnd = 1125 create_char_constant 1126 ((message_structure.operands (opnd).string_ptr -> arg_char_string)); 1127 end; 1128 else opnd = message_structure.operands (opnd).operand_index; 1129 1130 /* If previous message was from a different statement or subprogram, eliminate all messages 1131* from the list that are no longer relavant. */ 1132 1133 if begin_statement_errors ^= 0 & last_error_statement ^= cur_statement 1134 then do; 1135 do i = begin_statement_errors to msg_table_len; 1136 call print_message_summary (i, "statement"); 1137 end; 1138 1139 msg_table_len = begin_statement_errors - 1; 1140 begin_statement_errors = 0; 1141 end; 1142 1143 if begin_subprogram_errors ^= 0 & cur_subprogram ^= 0 1144 & cur_subprogram ^= last_error_subprogram 1145 then do; 1146 do i = begin_subprogram_errors to msg_table_len; 1147 call print_message_summary (i, "subprogram"); 1148 end; 1149 1150 msg_table_len = begin_subprogram_errors - 1; 1151 begin_subprogram_errors = 0; 1152 begin_statement_errors = 0; 1153 end; 1154 1155 last_error_statement = cur_statement; 1156 1157 /* Look new message up in the table. */ 1158 1159 do i = 1 to msg_table_len; 1160 if a_message_number = error_msg (i).number 1161 then if opnd = error_msg (i).opnd 1162 then do; 1163 1164 /* This message has already been printed. Update its count if necessary. */ 1165 1166 if cur_statement ^= error_msg (i).statement 1167 then do; /* A new line. */ 1168 error_msg (i).statement = cur_statement; 1169 error_msg (i).count = error_msg (i).count + 1; 1170 end; 1171 1172 else if fort_message_table$fort_message_table.descrip (a_message_number) 1173 .once_per_stmnt 1174 then error_msg (i).count = error_msg (i).count + 1; 1175 /* Multiple occurances on the line. */ 1176 1177 last_error_subprogram = cur_subprogram; 1178 return; 1179 end; /* message has occured before */ 1180 end; /* loop to look up message */ 1181 1182 /* First time for this message, find appropriate slot. */ 1183 1184 if msg_table_len < hbound (error_msg, 1) 1185 /* Allocate a new slot if there's room, */ 1186 then msg_table_len = msg_table_len + 1; 1187 1188 else do; /* or reuse one if there's not. */ 1189 if begin_statement_errors = 1 1190 then call print_message_summary (1, "statement"); 1191 else if begin_subprogram_errors = 1 1192 then call print_message_summary (1, "subprogram"); 1193 else call print_message_summary (1, "compilation"); 1194 1195 do i = 2 to msg_table_len; 1196 error_msg (i - 1) = error_msg (i); 1197 end; 1198 1199 if begin_statement_errors > 0 1200 then begin_statement_errors = begin_statement_errors - 1; 1201 if begin_subprogram_errors > 0 1202 then begin_subprogram_errors = begin_subprogram_errors - 1; 1203 end; 1204 1205 /* Now decide what type of message it is. */ 1206 1207 if fort_message_table$fort_message_table.descrip (a_message_number).once_per_stmnt 1208 | (fort_message_table$fort_message_table.descrip (a_message_number).once_per_subpgm 1209 & ^shared_globals.options.brief) 1210 then do; 1211 if begin_statement_errors = 0 1212 then begin_statement_errors = msg_table_len; 1213 new_slot = msg_table_len; 1214 end; 1215 1216 else if fort_message_table$fort_message_table.descrip (a_message_number).once_per_subpgm 1217 | ^shared_globals.options.brief 1218 then do; 1219 if begin_statement_errors = 0 1220 then new_slot = msg_table_len; 1221 1222 else do; 1223 new_slot = begin_statement_errors; 1224 begin_statement_errors = begin_statement_errors + 1; 1225 1226 do i = begin_statement_errors to msg_table_len; 1227 error_msg (i) = error_msg (i - 1); 1228 end; 1229 end; 1230 if begin_subprogram_errors = 0 1231 then begin_subprogram_errors = new_slot; 1232 end; 1233 1234 else do; 1235 if begin_subprogram_errors > 0 1236 then do; 1237 new_slot = begin_subprogram_errors; 1238 begin_subprogram_errors = begin_subprogram_errors + 1; 1239 if begin_statement_errors > 0 1240 then begin_statement_errors = begin_statement_errors + 1; 1241 1242 do i = begin_subprogram_errors to msg_table_len; 1243 error_msg (i) = error_msg (i - 1); 1244 end; 1245 end; 1246 1247 else if begin_statement_errors > 0 1248 then do; 1249 new_slot = begin_statement_errors; 1250 begin_statement_errors = begin_statement_errors + 1; 1251 1252 do i = begin_statement_errors to msg_table_len; 1253 error_msg (i) = error_msg (i - 1); 1254 end; 1255 end; 1256 1257 else new_slot = msg_table_len; 1258 end; 1259 1260 error_msg (new_slot).number = a_message_number; 1261 error_msg (new_slot).opnd = opnd; 1262 error_msg (new_slot).count = 0; 1263 error_msg (new_slot).statement = cur_statement; 1264 end; 1265 1266 1267 /* Produce a header for terminal output. */ 1268 1269 if print_on_terminal /* if message to appear on the terminal */ 1270 & cur_subprogram ^= 0 /* and a subprogram node exisits */ 1271 & cur_subprogram ^= last_error_subprogram 1272 /* and message is for a new subprogram */ 1273 & (cur_subprogram ^= first_subprogram | cur_subprogram ^= last_subprogram) 1274 /* but not the only subprogram */ 1275 then do; 1276 node_ptr = addr (x (cur_subprogram)); 1277 if node_ptr -> subprogram.symbol ^= 0 1278 /* name is associated with the program unit */ 1279 then do; 1280 call ioa_ ("^/^-Messages for ^a:", 1281 addr (x (node_ptr -> subprogram.symbol)) -> symbol.name); 1282 1283 last_error_subprogram = cur_subprogram; 1284 end; 1285 end; 1286 1287 1288 /* expand error text if needed for listing or terminal */ 1289 1290 arg_string (1) = ""; 1291 arg_string (2) = ""; 1292 arg_string (3) = ""; 1293 1294 noprds = message_structure.number_of_operands; 1295 1296 do i = 1 to noprds; 1297 1298 /* Caller can provide a character string */ 1299 1300 if message_structure.operands (i).is_string 1301 then do; 1302 arg_length = message_structure.operands (i).string_length; 1303 arg_string (i) = message_structure.operands (i).string_ptr -> arg_char_string; 1304 end; 1305 1306 /* or caller can provide a count */ 1307 1308 else if message_structure.operands (i).operand_index < 0 1309 then arg_string (i) = binary_to_char (bias + message_structure.operands (i).operand_index); 1310 1311 /* or caller can provide an operand offset */ 1312 1313 else do; 1314 arg_string (i) = 1315 identify_node (addr (x (message_structure.operands (i).operand_index))); 1316 end; /* code for operand offset */ 1317 end; /* loop thru args */ 1318 1319 /* get message out of error message table */ 1320 1321 message_length = fixed (fort_message_table$fort_message_table.descrip (a_message_number).length, 17); 1322 message_offset = fixed (fort_message_table$fort_message_table.descrip (a_message_number).offset, 17); 1323 1324 table_base = ptr (addr (fort_message_table$fort_message_table), 0); 1325 1326 1327 /* build header string for error message */ 1328 1329 if an_error_level = 1 1330 then do; 1331 header_line = "WARNING "; 1332 header_line = header_line || binary_to_char (a_message_number); 1333 end; 1334 1335 else if an_error_level = max_error_level 1336 then do; 1337 header_line = "FATAL ERROR "; 1338 header_line = header_line || binary_to_char (a_message_number); 1339 end; 1340 1341 else do; 1342 header_line = "ERROR "; 1343 header_line = header_line || binary_to_char (a_message_number); 1344 header_line = header_line || ", severity "; 1345 header_line = header_line || binary_to_char ((an_error_level)); 1346 end; 1347 1348 /* add source line info, if it exists */ 1349 1350 header_line = header_line || decode_source_id ((cur_statement), intermediate_base, use_source_info); 1351 1352 /* print message on terminal if requested by user */ 1353 1354 if print_on_terminal 1355 then do; 1356 1357 call ioa_ ("^/^a", header_line); 1358 /* print header for this error message */ 1359 1360 /* determine if message text is necessary */ 1361 1362 if shared_globals.options.brief | substr (message_printed, a_message_number, 1) 1363 then if noprds > 0 1364 then call ioa_ ("^v(^a^x^)", noprds, arg_string (1), arg_string (2), arg_string (3)); 1365 else ; 1366 else do; 1367 call ioa_ (formating_string, arg_string (1), arg_string (2), arg_string (3)); 1368 substr (message_printed, a_message_number, 1) = "1"b; 1369 end; 1370 1371 /* if debugging call probe */ 1372 1373 if string (shared_globals.options.system_debugging) ^= "0"b 1374 then do; 1375 call ioa_$nnl ("Calling probe:"); 1376 call probe (); 1377 end; 1378 end; 1379 1380 /* save error text if producing a listing */ 1381 1382 if produce_listing 1383 then do; 1384 1385 /* Make educated guess for returned string length. Actual string may be shorter. */ 1386 1387 call create_listing_node (length (header_line) + 2 + message_length 1388 + length (arg_string (1)) 1389 + length (arg_string (2)) + length (arg_string (3))); 1390 1391 /* Have ioa_ do the hard work for us. Just the control string is copied by compiler. */ 1392 1393 call ioa_$rsnp ("^/^a^/" || formating_string, 1394 /* control string */ 1395 p -> error_text.string, 1396 /* target string */ 1397 error_text_length, /* actual length of error message */ 1398 header_line, 1399 arg_string (1), arg_string (2), arg_string (3)); 1400 /* substituted strings */ 1401 1402 call finish_listing_node; 1403 end; 1404 end; 1405 1406 1407 error_level = max (error_level, an_error_level); 1408 1409 fortran_severity_ = error_level; 1410 1411 if error_level >= max_error_level 1412 then goto fort_abort; 1413 return; 1414 1415 1416 print_message_op$epilogue: 1417 entry; /* Prints outstanding count information at end of compilation. */ 1418 1419 if begin_statement_errors > 0 1420 then do; 1421 do i = begin_statement_errors to msg_table_len; 1422 call print_message_summary (i, "statement"); 1423 end; 1424 msg_table_len = begin_statement_errors - 1; 1425 end; 1426 1427 if begin_subprogram_errors > 0 1428 then do; 1429 do i = begin_subprogram_errors to msg_table_len; 1430 call print_message_summary (i, "subprogram"); 1431 end; 1432 msg_table_len = begin_subprogram_errors - 1; 1433 end; 1434 1435 do i = 1 to msg_table_len; 1436 call print_message_summary (i, "compilation"); 1437 end; 1438 return; 1439 1440 1441 print_message_summary: 1442 procedure (entry, type); /* Procedure to print summary lines. */ 1443 1444 dcl entry fixed bin (18); 1445 dcl lvl fixed bin (18); 1446 dcl msg fixed bin (18); 1447 dcl type char (32) varying; 1448 1449 if error_msg (entry).count = 0 1450 then return; 1451 1452 msg = error_msg (entry).number; 1453 lvl = fort_message_table$fort_message_table.descrip (msg).level; 1454 1455 if ^produce_listing & (lvl < shared_globals.options.severity) 1456 then return; 1457 1458 if lvl = 1 1459 then header_line = "^/WARNING ^d"; 1460 else header_line = "^/ERROR ^d"; 1461 1462 if error_msg (entry).opnd > 0 1463 then do; 1464 header_line = header_line || ", for "; 1465 header_line = header_line || identify_node (addr (x (error_msg (entry).opnd))); 1466 header_line = header_line || ","; 1467 end; 1468 1469 header_line = header_line || " has occurred an additional "; 1470 1471 if error_msg (entry).count = 1 1472 then header_line = header_line || "time in this ^a."; 1473 else do; 1474 header_line = header_line || binary_to_char ((error_msg (entry).count)); 1475 header_line = header_line || " times in this ^a."; 1476 end; 1477 1478 if lvl >= shared_globals.options.severity 1479 then call ioa_ (header_line, msg, type); 1480 1481 if produce_listing 1482 then do; 1483 call create_listing_node (length (header_line) + length (type) + 3); 1484 1485 call ioa_$rsnp (header_line, /* control string */ 1486 p -> error_text.string, 1487 /* target string */ 1488 error_text_length, /* actual length */ 1489 msg, type); 1490 /* substituted strings */ 1491 1492 call finish_listing_node; 1493 end; 1494 end /* print_message_summary */; 1495 1496 1497 create_listing_node: 1498 procedure (estimated_length); 1499 1500 dcl estimated_length fixed bin (18); 1501 1502 /* except during the parse, this routine must first find the correct listing_info node */ 1503 1504 if listing_info.subprogram ^= cur_subprogram 1505 then do; 1506 node_ptr = cur_listing; /* remember current node to prevent infinite loop */ 1507 do cur_listing = addr (listing_seg (listing_info.next)) 1508 repeat addr (listing_seg (listing_info.next)) 1509 while (cur_listing ^= node_ptr & listing_info.subprogram ^= cur_subprogram); 1510 end; 1511 1512 if listing_info.subprogram ^= cur_subprogram 1513 then call abort_compiler ("Cannot find listing_info node for the current subprogram."); 1514 end; 1515 1516 p = addr (listing_seg (next_free_listing)); /* point to new error_text node */ 1517 1518 p -> error_text.length = estimated_length; 1519 end /* create_listing_node */; 1520 1521 1522 1523 finish_listing_node: 1524 procedure; 1525 1526 p -> error_text.length = error_text_length; 1527 1528 if last_error = 0 1529 then first_error = next_free_listing; 1530 else addr (listing_seg (last_error)) -> error_text.next = next_free_listing; 1531 1532 last_error = next_free_listing; 1533 1534 next_free_listing = next_free_listing + size (error_text); 1535 end /* finish_listing_node */; 1536 1537 1538 identify_node: 1539 procedure (a_node_ptr) returns (char (260) varying); 1540 1541 dcl a_node_ptr ptr; 1542 1543 node_ptr = a_node_ptr; 1544 a_node_type = node_ptr -> node.node_type; 1545 1546 if a_node_type = constant_node 1547 then do; 1548 return (print_constant_value (node_ptr, "1"b)); 1549 end; 1550 1551 else if a_node_type = char_constant_node 1552 then do; 1553 return (print_constant_value (node_ptr, "1"b)); 1554 end; 1555 1556 else if a_node_type = temporary_node 1557 then return ("an expression"); 1558 1559 else if a_node_type = array_ref_node 1560 then do; 1561 node_ptr = addr (x (node_ptr -> array_ref.parent)); 1562 return ("element in array " || node_ptr -> symbol.name); 1563 end; 1564 1565 else if a_node_type = symbol_node 1566 then return (node_ptr -> symbol.name); 1567 1568 else if a_node_type = label_node 1569 then return (binary_to_char ((node_ptr -> label.name))); 1570 1571 else if a_node_type = header_node 1572 then if node_ptr -> header.in_common 1573 then return (node_ptr -> header.block_name); 1574 else return ("equivalence group"); 1575 1576 else do; 1577 return ("NODE" || binary_to_char ((message_structure.operands (i).operand_index))); 1578 end; 1579 end /* identify_node */; 1580 end /* print_message_op */; 1581 1582 1583 1584 binary_to_char: 1585 proc (value) returns (char (12) varying); 1586 1587 dcl value fixed bin (18); 1588 dcl output picture "(11)-9"; 1589 1590 output = value; 1591 return (substr (output, verify (output, " "))); 1592 end binary_to_char; 1593 1594 1595 /* If line number = 0 then output "on or after line 16384", THIS IS A SPECIAL CASE. */ 1596 1597 decode_source_id: 1598 proc (stmnt_off, int_base, use_source_info) returns (char (64) varying); 1599 1600 dcl stmnt_off fixed bin (18); 1601 dcl int_base ptr; 1602 dcl use_source_info bit (1) aligned; 1603 1604 dcl id_line char (64) varying; 1605 dcl i fixed bin (18); 1606 dcl 1 source_id auto unaligned like statement.source_id; 1607 1608 id_line = ""; 1609 1610 if stmnt_off > 0 1611 then do; 1612 if int_base = polish_base 1613 then source_id = addr (polish_string (stmnt_off)) -> statement.source_id; 1614 else source_id = addr (quad (stmnt_off)) -> opt_statement.source_id; 1615 1616 if source_id.line ^= "0"b | use_source_info = "1"b 1617 then do; 1618 i = binary (source_id.statement, 5); 1619 if use_source_info = "1"b & 1620 source_line_number ^= binary (source_id.line, 14) 1621 then i = 0; /* If not right statement */ 1622 if i > 1 /* don't mention statement no. 1 explicitly */ 1623 then do; 1624 id_line = id_line || " in statement "; 1625 id_line = id_line || binary_to_char (i); 1626 end; 1627 1628 if use_source_info 1629 then i = source_line_number; 1630 else i = binary (source_id.line, 14); 1631 1632 if i = 0 1633 then 1634 id_line = id_line || " on or after line 16384"; 1635 else do; 1636 id_line = id_line || " on line "; 1637 id_line = id_line || binary_to_char (i); 1638 end; 1639 1640 if use_source_info 1641 then i = source_file_number; 1642 else i = binary (source_id.file, 8); 1643 1644 if i ^= 0 /* only print file no for second thru nth file */ 1645 then do; 1646 id_line = id_line || " of file "; 1647 id_line = id_line || binary_to_char (i); 1648 end; 1649 end; 1650 end; 1651 else if use_source_info 1652 then do; /* NO CURRENT STATEMENT */ 1653 id_line = id_line || " on line " || binary_to_char ((source_line_number)); 1654 if source_file_number > 0 1655 then id_line = id_line || " of file " || binary_to_char ((source_file_number)); 1656 end; 1657 return (id_line); 1658 end decode_source_id; 1659 1660 print_constant_value: 1661 procedure (n_ptr, need_hdr) returns (char (256) varying); 1662 1663 dcl based_bit bit (1) aligned based; 1664 dcl 1 based_double aligned based, 1665 2 based_dp float bin (63) unaligned; 1666 dcl based_integer fixed bin (35) aligned based; 1667 dcl based_real float bin (27) aligned based; 1668 dcl chars (2) char (4) aligned; 1669 dcl cs char (256) varying; 1670 dcl (i, j, k, l) fixed bin (18); 1671 dcl ltrim builtin; 1672 dcl min builtin; 1673 dcl n_ptr pointer; 1674 dcl need_hdr bit (1) aligned; 1675 dcl node_ptr pointer; 1676 dcl piece char (24); 1677 dcl rtrim builtin; 1678 dcl value_ptr pointer; 1679 1680 node_ptr = n_ptr; 1681 1682 if node_ptr -> node.data_type <= 0 | node_ptr -> node.data_type > hbound (print_routine, 1) 1683 then return ("UNKNOWN DATA TYPE"); 1684 1685 cs = ""; /* initialize */ 1686 value_ptr = addr (node_ptr -> constant.value); 1687 goto print_routine (node_ptr -> node.data_type); 1688 1689 1690 print_routine (1): /* integer */ 1691 if need_hdr 1692 then cs = "integer constant "; 1693 1694 cs = cs || ltrim (convert (cs, value_ptr -> based_integer)); 1695 return (cs); 1696 1697 1698 print_routine (2): /* real */ 1699 if need_hdr 1700 then cs = "real constant "; 1701 1702 cs = cs || trim_floating (value_ptr, "e"); 1703 return (cs); 1704 1705 1706 print_routine (3): /* double precision */ 1707 if need_hdr 1708 then cs = "double precision constant "; 1709 1710 cs = cs || trim_floating (value_ptr, "d"); 1711 return (cs); 1712 1713 1714 print_routine (4): /* complex */ 1715 if need_hdr 1716 then cs = "complex constant "; 1717 1718 cs = cs || "("; 1719 cs = cs || trim_floating (value_ptr, "e"); 1720 cs = cs || ", "; 1721 cs = cs || trim_floating (addrel (value_ptr, 1), "e"); 1722 cs = cs || ")"; 1723 return (cs); 1724 1725 1726 print_routine (5): /* logical */ 1727 if need_hdr 1728 then cs = "logical value "; 1729 1730 if value_ptr -> based_bit 1731 then cs = cs || ".true."; 1732 else cs = cs || ".false."; 1733 return (cs); 1734 1735 1736 print_routine (6): /* character */ 1737 if node_ptr -> char_constant.no_value_stored 1738 then return ("NO VALUE STORED"); 1739 1740 if verify (node_ptr -> char_constant.value, 1741 " !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~") = 0 1742 then do; 1743 if need_hdr 1744 then cs = """"; 1745 cs = cs || node_ptr -> char_constant.value; 1746 if need_hdr 1747 then cs = cs || """"; 1748 end; 1749 1750 else do; 1751 cs = " 1752 "; 1753 do i = 1 to node_ptr -> char_constant.length by chars_per_word; 1754 l = min (chars_per_word, node_ptr -> char_constant.length - i + 1); 1755 1756 chars (1) = substr (node_ptr -> char_constant.value, i, l); 1757 chars (2) = chars (1); 1758 1759 do j = 1 to l; 1760 k = binary (unspec (substr (chars (2), j, 1)), 9); 1761 if k < 32 | k > 127 /* i.e. non-printable */ 1762 then substr (chars (2), j, 1) = "."; 1763 end; 1764 1765 call ioa_$rsnp ("^-^wo ^a", piece, k, unspec (chars (1)), substr (chars (2), 1, l)); 1766 if l < chars_per_word 1767 then substr (piece, l * 3 + 2, (chars_per_word - l) * 3) = " "; 1768 1769 if length (cs) + k > 256 1770 then do; 1771 call ioa_ ("^/String too long for format."); 1772 cs = substr (cs, 1, length (cs) - 1); 1773 /* remove final newline char */ 1774 call ioa_ (cs); 1775 cs = " 1776 "; 1777 end; 1778 1779 cs = cs || substr (piece, 1, k); 1780 end; 1781 1782 cs = substr (cs, 1, length (cs) - 1); /* remove final newline char */ 1783 end; 1784 return (cs); 1785 1786 1787 1788 trim_floating: 1789 proc (fpn_ptr, expon_char) returns (char (36) varying); 1790 1791 1792 dcl expon_char char (1) aligned; 1793 dcl fpn_ptr ptr; 1794 1795 dcl assign_ entry (ptr, fixed bin, fixed bin (35), ptr, fixed bin, fixed bin (35)); 1796 1797 dcl fpn_prec fixed bin (35); 1798 dcl fpn_type fixed bin; 1799 dcl ret_value char (36) varying; 1800 dcl temp char (36) varying; 15 1 /* BEGIN INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 15 2 15 3 15 4 /****^ HISTORY COMMENTS: 15 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 15 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 15 7* Added pascal_string_type_dtype descriptor type. Its number is 87. 15 8* Objects of this type are PASCAL string types. 15 9* 2) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 15 10* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 15 11* Added the new C types. 15 12* END HISTORY COMMENTS */ 15 13 15 14 /* This include file defines mnemonic names for the Multics 15 15* standard descriptor types, using both pl1 and cobol terminology. 15 16* PG 780613 15 17* JRD 790530 15 18* JRD 791016 15 19* MBW 810731 15 20* TGO 830614 Add hex types. 15 21* Modified June 83 JMAthane to add PASCAL data types 15 22* TGO 840120 Add float dec extended and generic, float binary generic 15 23**/ 15 24 15 25 dcl (real_fix_bin_1_dtype init (1), 15 26 real_fix_bin_2_dtype init (2), 15 27 real_flt_bin_1_dtype init (3), 15 28 real_flt_bin_2_dtype init (4), 15 29 cplx_fix_bin_1_dtype init (5), 15 30 cplx_fix_bin_2_dtype init (6), 15 31 cplx_flt_bin_1_dtype init (7), 15 32 cplx_flt_bin_2_dtype init (8), 15 33 real_fix_dec_9bit_ls_dtype init (9), 15 34 real_flt_dec_9bit_dtype init (10), 15 35 cplx_fix_dec_9bit_ls_dtype init (11), 15 36 cplx_flt_dec_9bit_dtype init (12), 15 37 pointer_dtype init (13), 15 38 offset_dtype init (14), 15 39 label_dtype init (15), 15 40 entry_dtype init (16), 15 41 structure_dtype init (17), 15 42 area_dtype init (18), 15 43 bit_dtype init (19), 15 44 varying_bit_dtype init (20), 15 45 char_dtype init (21), 15 46 varying_char_dtype init (22), 15 47 file_dtype init (23), 15 48 real_fix_dec_9bit_ls_overp_dtype init (29), 15 49 real_fix_dec_9bit_ts_overp_dtype init (30), 15 50 real_fix_bin_1_uns_dtype init (33), 15 51 real_fix_bin_2_uns_dtype init (34), 15 52 real_fix_dec_9bit_uns_dtype init (35), 15 53 real_fix_dec_9bit_ts_dtype init (36), 15 54 real_fix_dec_4bit_uns_dtype init (38), /* digit-aligned */ 15 55 real_fix_dec_4bit_ts_dtype init (39), /* byte-aligned */ 15 56 real_fix_dec_4bit_bytealigned_uns_dtype init (40), /* COBOL */ 15 57 real_fix_dec_4bit_ls_dtype init (41), /* digit-aligned */ 15 58 real_flt_dec_4bit_dtype init (42), /* digit-aligned */ 15 59 real_fix_dec_4bit_bytealigned_ls_dtype init (43), 15 60 real_flt_dec_4bit_bytealigned_dtype init (44), 15 61 cplx_fix_dec_4bit_bytealigned_ls_dtype init (45), 15 62 cplx_flt_dec_4bit_bytealigned_dtype init (46), 15 63 real_flt_hex_1_dtype init (47), 15 64 real_flt_hex_2_dtype init (48), 15 65 cplx_flt_hex_1_dtype init (49), 15 66 cplx_flt_hex_2_dtype init (50), 15 67 c_typeref_dtype init (54), 15 68 c_enum_dtype init (55), 15 69 c_enum_const_dtype init (56), 15 70 c_union_dtype init (57), 15 71 algol68_straight_dtype init (59), 15 72 algol68_format_dtype init (60), 15 73 algol68_array_descriptor_dtype init (61), 15 74 algol68_union_dtype init (62), 15 75 15 76 cobol_comp_6_dtype init (1), 15 77 cobol_comp_7_dtype init (1), 15 78 cobol_display_ls_dtype init (9), 15 79 cobol_structure_dtype init (17), 15 80 cobol_char_string_dtype init (21), 15 81 cobol_display_ls_overp_dtype init (29), 15 82 cobol_display_ts_overp_dtype init (30), 15 83 cobol_display_uns_dtype init (35), 15 84 cobol_display_ts_dtype init (36), 15 85 cobol_comp_8_uns_dtype init (38), /* digit aligned */ 15 86 cobol_comp_5_ts_dtype init (39), /* byte aligned */ 15 87 cobol_comp_5_uns_dtype init (40), 15 88 cobol_comp_8_ls_dtype init (41), /* digit aligned */ 15 89 real_flt_dec_extended_dtype init (81), /* 9-bit exponent */ 15 90 cplx_flt_dec_extended_dtype init (82), /* 9-bit exponent */ 15 91 real_flt_dec_generic_dtype init (83), /* generic float decimal */ 15 92 cplx_flt_dec_generic_dtype init (84), 15 93 real_flt_bin_generic_dtype init (85), /* generic float binary */ 15 94 cplx_flt_bin_generic_dtype init (86)) fixed bin internal static options (constant); 15 95 15 96 dcl (ft_integer_dtype init (1), 15 97 ft_real_dtype init (3), 15 98 ft_double_dtype init (4), 15 99 ft_complex_dtype init (7), 15 100 ft_complex_double_dtype init (8), 15 101 ft_external_dtype init (16), 15 102 ft_logical_dtype init (19), 15 103 ft_char_dtype init (21), 15 104 ft_hex_real_dtype init (47), 15 105 ft_hex_double_dtype init (48), 15 106 ft_hex_complex_dtype init (49), 15 107 ft_hex_complex_double_dtype init (50) 15 108 ) fixed bin internal static options (constant); 15 109 15 110 dcl (algol68_short_int_dtype init (1), 15 111 algol68_int_dtype init (1), 15 112 algol68_long_int_dtype init (2), 15 113 algol68_real_dtype init (3), 15 114 algol68_long_real_dtype init (4), 15 115 algol68_compl_dtype init (7), 15 116 algol68_long_compl_dtype init (8), 15 117 algol68_bits_dtype init (19), 15 118 algol68_bool_dtype init (19), 15 119 algol68_char_dtype init (21), 15 120 algol68_byte_dtype init (21), 15 121 algol68_struct_struct_char_dtype init (22), 15 122 algol68_struct_struct_bool_dtype init (20) 15 123 ) fixed bin internal static options (constant); 15 124 15 125 dcl (label_constant_runtime_dtype init (24), 15 126 int_entry_runtime_dtype init (25), 15 127 ext_entry_runtime_dtype init (26), 15 128 ext_procedure_runtime_dtype init (27), 15 129 picture_runtime_dtype init (63) 15 130 ) fixed bin internal static options (constant); 15 131 15 132 dcl (pascal_integer_dtype init (1), 15 133 pascal_real_dtype init (4), 15 134 pascal_label_dtype init (24), 15 135 pascal_internal_procedure_dtype init (25), 15 136 pascal_exportable_procedure_dtype init (26), 15 137 pascal_imported_procedure_dtype init (27), 15 138 pascal_typed_pointer_type_dtype init (64), 15 139 pascal_char_dtype init (65), 15 140 pascal_boolean_dtype init (66), 15 141 pascal_record_file_type_dtype init (67), 15 142 pascal_record_type_dtype init (68), 15 143 pascal_set_dtype init (69), 15 144 pascal_enumerated_type_dtype init (70), 15 145 pascal_enumerated_type_element_dtype init (71), 15 146 pascal_enumerated_type_instance_dtype init (72), 15 147 pascal_user_defined_type_dtype init (73), 15 148 pascal_user_defined_type_instance_dtype init (74), 15 149 pascal_text_file_dtype init (75), 15 150 pascal_procedure_type_dtype init (76), 15 151 pascal_variable_formal_parameter_dtype init (77), 15 152 pascal_value_formal_parameter_dtype init (78), 15 153 pascal_entry_formal_parameter_dtype init (79), 15 154 pascal_parameter_procedure_dtype init (80), 15 155 pascal_string_type_dtype init (87)) fixed bin int static options (constant); 15 156 15 157 15 158 /* END INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 1801 1802 1803 if expon_char = "d" 1804 then do; 1805 fpn_prec = 63; 1806 if shared_globals.options.hfp 1807 then fpn_type = ft_hex_double_dtype; 1808 else fpn_type = ft_double_dtype; 1809 end; 1810 else do; 1811 fpn_prec = 27; 1812 if shared_globals.options.hfp 1813 then fpn_type = ft_hex_real_dtype; 1814 else fpn_type = ft_real_dtype; 1815 end; 1816 call assign_ (addr (temp), 2 * varying_char_dtype, maxlength (temp), fpn_ptr, 2 * fpn_type + 1, fpn_prec); 1817 temp = ltrim (rtrim (temp)); /* trim off all blanks */ 1818 1819 /* trim off low order zeroes */ 1820 1821 if substr (temp, 1, 1) = "0" 1822 then ret_value = rtrim (substr (temp, 1, length (temp) - 5), "0"); 1823 /* all digits are significant */ 1824 else ret_value = rtrim (substr (temp, 1, length (temp) - 6), "0"); 1825 /* last digit is really noise */ 1826 1827 if substr (ret_value, length (ret_value), 1) = "." 1828 then ret_value = ret_value || "0"; 1829 1830 if substr (temp, length (temp) - 4, 5) ^= "e+000" /* convert exponent if not zero */ 1831 then do; 1832 temp = substr (temp, length (temp) - 4, 5); 1833 /* makes the rest easier to read */ 1834 1835 ret_value = ret_value || expon_char; /* get proper character */ 1836 ret_value = ret_value || substr (temp, 2, 1); 1837 /* exponent sign */ 1838 if substr (temp, 3, 1) ^= "0" 1839 then ret_value = ret_value || substr (temp, 3, 3); 1840 else if substr (temp, 4, 1) ^= "0" 1841 then ret_value = ret_value || substr (temp, 4, 2); 1842 else ret_value = ret_value || substr (temp, 5, 1); 1843 /* exponent value */ 1844 end; 1845 1846 return (ret_value); 1847 end /* trim_floating */; 1848 end print_constant_value; 1849 1850 fort_display: 1851 proc (command_structure_ptr); 1852 1853 1854 /* Operator Names */ 1855 declare count_array (-3:109) fixed bin (18), /* must have same upper bound as op_names */ 1856 op_names (-3:109) char (20) aligned int static options (constant) 1857 initial (/* WARNING - change "count_array" */ "quadruple", "operand", "count", "zero", 1858 "assign", 1859 "add", "sub", "mult", "div", "exponentiation", "negate", "less", "less_or_equal", "equal", 1860 "not_equal", "greater_or_equal", "greater", "or", "and", "not", "jump", "jump_logical", 1861 "jump_arithmetic", "jump_computed", "jump_assigned", "assign_label", "read", "write", 1862 "format", 1863 "end_label", "error_label", "xmit_scalar", "xmit_array", "xmit_vector", "endfile", "rewind", 1864 "backspace", "margin", "openfile", "closefile", "record_number", "string", "string_length", 1865 "terminate", "return", "pause", "stop", "item", "exit", "eol", "do", "builtin", "sf", 1866 "sf_def", 1867 "subscript", "func_ref", "block_data", "increment_polish", "main", "function", "subroutine", 1868 "stat", "label", "call", "chain", "endunit", "non_executable", "no_op", 1869 "form_VLA_packed_ptr", 1870 "opt_subscript", "left_shift", "right_shift", "store_zero", "storage_add", "storage_sub", 1871 "neg_storage_add", "storage_add_one", "namelist", "open", "close", "iostat", 1872 "convert_to_int", 1873 "convert_to_real", "convert_to_dp", "convert_to_cmpx", "read_scalar", "read_array", 1874 "read_vector", "write_scalar", "write_array", "write_vector", "jump_true", "jump_false", 1875 "sub_index", "loop_end", "read_namelist", "write_namelist", "decode_string", 1876 "encode_string", 1877 "cat", "substr", "load_xreg", "load_preg", "block_if", "else_if", "else", "equiv", 1878 "not_equiv", "read_internal_file", "write_internal_file", "inquire", "process_param_list", 1879 "lhs_fld"); 1880 1881 1882 dcl node_names (0:15) char (24) 1883 init ("filler", "source", "symbol", "dimension", "temporary", "constant", "label", "header", 1884 "character constant", "array_ref", "proc_frame", "library", "subprogram", "arg_desc", 1885 "pointer", 1886 "machine_state") int static options (constant); 1887 1888 1889 1890 dcl node_size (0:15) fixed bin (18); 1891 1892 node_size (0) = 1; /* filler */ 1893 node_size (1) = 0; /* source */ 1894 node_size (2) = 0; /* symbol */ 1895 node_size (3) = 0; /* dimension */ 1896 node_size (4) = size (temporary); /* temporary */ 1897 node_size (5) = size (constant); /* constant */ 1898 node_size (6) = size (label); /* label */ 1899 node_size (7) = 0; /* header */ 1900 node_size (8) = 0; /* character constant */ 1901 node_size (9) = size (array_ref); /* array ref */ 1902 node_size (10) = 12; /* proc frame */ 1903 node_size (11) = size (library); /* library */ 1904 node_size (12) = size (subprogram); /* subprogram */ 1905 node_size (13) = 0; /* arg desc */ 1906 node_size (14) = size (pointer); /* pointer */ 1907 node_size (15) = size (machine_state); /* machine_state */ 1908 1909 1910 1911 dcl mode_names (0:7) char (24) 1912 init ("undefined", "integer", "real", "double precision", "complex", "logical", "character", 1913 "typeless") 1914 int static options (constant); 1915 1916 1917 1918 dcl operand_names (0:12) char (24) 1919 init ("undefined", "variable", "constant", "array reference", "temporary", "count", 1920 "relative constant", "bif", "statement function", "external", "entry", "dummy", "error") 1921 int static options (constant); 1922 1923 dcl offset_unit_names (0:7) character (16) 1924 initial ("word_units", "bit_units", "char_units", "halfword_units", 1925 "UNUSED", "UNUSED", "UNUSED", "UNUSED") 1926 int static options (constant); 1927 1928 dcl subr_type (0:3) char (12) int static options (constant) 1929 init ("main program", "block data ", "subroutine ", "function "); 1930 1931 dcl ( 1932 all_fields init ("1"b), 1933 (just_name, dont_walk) 1934 init ("0"b) 1935 ) bit (1) aligned int static options (constant); 1936 1937 dcl ons char (256) varying; 1938 dcl source_segment character (csi.input_lng) based (csi.input_pointer); 1939 dcl stat_start fixed binary (27); 1940 dcl stat_length fixed binary (9); 1941 dcl cs ptr; 1942 dcl sp ptr; 1943 1944 dcl first_time bit (1) aligned; 1945 1946 dcl n fixed bin (18), 1947 nodetype fixed bin (18), 1948 offset fixed bin (18); 1949 1950 dcl command_structure_ptr 1951 ptr; 1952 dcl i fixed bin (18); 1953 dcl (subp, next_one, item) 1954 fixed bin (18); 1955 1956 dcl 1 command_structure structure aligned based (command_structure_ptr), 16 1 16 2 /* BEGIN fort_command_structure.incl.pl1 16 3* 16 4* Created: June 1976. 16 5* 16 6* Modified: 16 7* February 24, 1977 by G.D. Chang for the optimizer. 16 8* December 3, 1976, David Levin reorder subfields. 16 9* November 16, 1976 By D.S.Levin to allow long names. 16 10* October 9, 1978 by Paul E. Smee for larger common and arrays. 16 11**/ 16 12 16 13 2 region unaligned structure, 16 14 3 operand bit(1), 16 15 3 polish bit(1), 16 16 3 quadruple bit(1), 16 17 16 18 2 operator unaligned structure, 16 19 3 with_argument, 16 20 4 number_arg, 16 21 5 display bit(1), 16 22 5 stmnt bit(1), 16 23 5 bucket bit(1), 16 24 4 character_arg, 16 25 5 declaration bit(1), 16 26 16 27 3 without_args, 16 28 4 dump bit(1), 16 29 4 cur_stmnt bit(1), 16 30 4 list_subprograms bit(1), 16 31 4 list_symbols bit(1), 16 32 4 list_labels bit(1), 16 33 4 list_polish_string bit(1), 16 34 4 list_word_consts bit(1), 16 35 4 list_dw_constants bit(1), 16 36 4 list_char_constants bit(1), 16 37 4 list_lib_names bit(1), 16 38 4 node_summary bit(1), 16 39 16 40 2 options unaligned structure, 16 41 3 walk bit(1), 16 42 3 brief bit(1), 16 43 16 44 2 starting_offset fixed bin (18) unsigned, 16 45 2 stopping_offset fixed bin (18) unsigned, 16 46 16 47 2 dcl_name char(256) varying; 16 48 16 49 /* END fort_command_structure.incl.pl1 */ 16 50 1957 1958 1959 /* display polish for the current statement */ 1960 1961 if command_structure.cur_stmnt 1962 then do; 1963 if cur_statement < 0 /* no current statement */ 1964 then do; 1965 call ioa_ ("cur_statement = ^oo", cur_statement); 1966 return; 1967 end; 1968 1969 if intermediate_base = polish_base 1970 then do; 1971 if polish_string (cur_statement) ^= stat_op 1972 /* cur_statement does not point to correct polish */ 1973 then do; 1974 call ioa_ ("cur_statement = ^oo", cur_statement); 1975 call display_int_text ((cur_statement), (cur_statement)); 1976 return; 1977 end; 1978 1979 /* Get offset of last polish word. If next statement exists, last polish word 1980* is one less than next statement's first word. If next does not exist, this 1981* is last statement of a subprogram or the last statement parsed so far. It is 1982* the last statement parsed if subprogram.last_polish is still zero. */ 1983 1984 offset = binary (addr (polish_string (cur_statement)) -> statement.next, 18) - 1; 1985 1986 if offset < 0 1987 then if addr (x (cur_subprogram)) -> subprogram.last_polish = 0 1988 then offset = next_free_polish - 1; 1989 else offset = addr (x (cur_subprogram)) -> subprogram.last_polish; 1990 1991 call display_int_text ((cur_statement), (offset)); 1992 end; 1993 1994 else do; 1995 sp = addr (quad (cur_statement)); 1996 1997 if sp -> opt_statement.op_code ^= stat_op 1998 then do; 1999 call ioa_ ("cur_statement = ^oo", cur_statement); 2000 call display_quadruples ((cur_statement), (cur_statement)); 2001 return; 2002 end; 2003 2004 offset = binary (sp -> opt_statement.next, 18); 2005 2006 if offset > 0 2007 then offset = addr (quad (offset)) -> opt_statement.prev_operator; 2008 2009 call display_quadruples ((cur_statement), (offset)); 2010 end; 2011 end; 2012 2013 2014 /* display all polish for all statements whose line number is "starting_offset" */ 2015 2016 if command_structure.stmnt & ^region.quadruple 2017 then do; 2018 first_time = "1"b; /* to get into the inner loop the first time */ 2019 2020 do subp = first_subprogram repeat cs -> subprogram.next_subprogram while (subp > 0); 2021 cs = addr (x (subp)); 2022 2023 do item = cs -> subprogram.first_polish repeat next_one while (item > 0 | first_time); 2024 sp = addr (polish_string (item)); 2025 next_one = binary (sp -> statement.next, 18); 2026 2027 if binary (sp -> statement.line, 18) = starting_offset 2028 then do; 2029 2030 /* Get offset of last polish word. If next statement exists, last polish word 2031* is one less than next statement's first word. If next does not exist, this 2032* is last statement of a subprogram or the last statement parsed so far. It is 2033* the last statement parsed if subprogram.last_polish is still zero. */ 2034 2035 offset = next_one - 1; 2036 2037 if offset < 0 2038 then if cs -> subprogram.last_polish = 0 2039 then offset = next_free_polish - 1; 2040 else offset = cs -> subprogram.last_polish; 2041 2042 call display_int_text ((item), (offset)); 2043 end; 2044 2045 first_time = "0"b; 2046 end; 2047 2048 end; 2049 2050 call ioa_ ("Search for line ^d completed.", starting_offset); 2051 end; 2052 2053 /* display all quads for all statements whose line number is starting_offset */ 2054 2055 if command_structure.stmnt & region.quadruple 2056 then do; 2057 do subp = first_subprogram repeat cs -> subprogram.next_subprogram while (subp > 0); 2058 cs = addr (x (subp)); 2059 2060 do item = cs -> subprogram.first_quad repeat next_one while (item > 0); 2061 sp = addr (quad (item)); 2062 next_one = binary (sp -> opt_statement.next, 18); 2063 2064 if binary (sp -> opt_statement.line, 18) = starting_offset 2065 then do; 2066 if next_one > 0 2067 then offset = addr (quad (next_one)) -> opt_statement.prev_operator; 2068 else offset = next_one; 2069 2070 call display_quadruples ((item), (offset)); 2071 end; 2072 end; 2073 end; 2074 2075 call ioa_ ("Search for line ^d completed.", starting_offset); 2076 end; 2077 2078 2079 /* display all symbols whose name is specified in "dcl_name" */ 2080 2081 if command_structure.declaration 2082 then do; 2083 /* look thru entire operand region */ 2084 2085 do offset = hash_table_size repeat offset + get_node_size (node_ptr) 2086 while (offset < next_free_operand); 2087 2088 node_ptr = addr (x (offset)); 2089 2090 if node_ptr -> node.node_type = symbol_node 2091 then if node_ptr -> symbol.name = dcl_name 2092 then call display_node ((offset), ^command_structure.brief, (command_structure.walk)); 2093 2094 if node_ptr -> node.node_type = header_node 2095 then if node_ptr -> header.in_common 2096 then if node_ptr -> header.block_name = dcl_name 2097 then call display_node ((offset), ^command_structure.brief, (command_structure.walk)); 2098 end; 2099 2100 call ioa_ ("Search for symbol ^a completed.", dcl_name); 2101 end; 2102 2103 2104 /* display a portion of the operand region or the polish region */ 2105 2106 if command_structure.display 2107 then do; 2108 if region.operand 2109 then do; 2110 offset = max (starting_offset, hash_table_size); 2111 stopping_offset = max (stopping_offset, offset); 2112 2113 do while (offset <= stopping_offset); 2114 call display_node ((offset), ^command_structure.brief, (command_structure.walk)); 2115 offset = offset + get_node_size (addr (x (offset))); 2116 end; 2117 end; 2118 2119 else if region.polish 2120 then call display_int_text ((starting_offset), (stopping_offset)); 2121 2122 else if region.quadruple 2123 then call display_quadruples ((starting_offset), (stopping_offset)); 2124 2125 else do; 2126 call ioa_ ("polish- ^p, operand- ^p, object- ^p", polish_base, operand_base, object_base); 2127 end; 2128 end; 2129 2130 2131 /* dump an entire region */ 2132 2133 if command_structure.dump 2134 then do; 2135 2136 if region.operand 2137 then do offset = hash_table_size repeat offset + get_node_size (addr (x (offset))) 2138 while (offset < next_free_operand); 2139 call display_node ((offset), ^command_structure.brief, dont_walk); 2140 end; 2141 2142 if region.polish 2143 then call display_int_text (1, next_free_polish - 1); 2144 2145 else if region.quadruple 2146 then do subp = first_subprogram repeat cs -> subprogram.next_subprogram while (subp > 0); 2147 cs = addr (x (subp)); 2148 call display_quadruples ((cs -> subprogram.first_quad), 0); 2149 end; 2150 2151 end; 2152 2153 2154 /* display all known numeric and logical constants */ 2155 2156 if command_structure.list_word_consts 2157 then do; 2158 2159 do offset = first_word_constant repeat addr (x (offset)) -> constant.next_constant while (offset > 0); 2160 call display_node ((offset), ^command_structure.brief, dont_walk); 2161 end; 2162 2163 do offset = first_dw_constant repeat addr (x (offset)) -> constant.next_constant while (offset > 0); 2164 call display_node ((offset), ^command_structure.brief, dont_walk); 2165 end; 2166 2167 if first_word_constant = 0 & first_dw_constant = 0 2168 then call ioa_ ("No numeric or logical constants."); 2169 end; 2170 2171 2172 /* display all known character constants */ 2173 2174 if command_structure.list_char_constants 2175 then if first_char_constant = 0 2176 then call ioa_ ("No character constants."); 2177 else do offset = first_char_constant repeat addr (x (offset)) -> char_constant.next_constant 2178 while (offset > 0); 2179 2180 call display_node ((offset), ^command_structure.brief, dont_walk); 2181 end; 2182 2183 2184 /* display all character constants on library chain */ 2185 2186 if command_structure.list_lib_names 2187 then if first_lib_name = 0 2188 then call ioa_ ("No library names."); 2189 else do offset = first_lib_name repeat addr (x (offset)) -> library.next_library_node while (offset > 0); 2190 2191 call display_node ((addr (x (offset)) -> library.character_operand), ^command_structure.brief, 2192 dont_walk); 2193 end; 2194 2195 2196 /* count nodes in operand region */ 2197 2198 if command_structure.node_summary 2199 then do; 2200 unspec (count_array) = "0"b; 2201 2202 call ioa_ ("^/^- #^-Node^/"); 2203 2204 do n = hash_table_size repeat n + get_node_size (node_ptr) while (n < next_free_operand); 2205 node_ptr = addr (x (n)); 2206 nodetype = node_ptr -> node.node_type; 2207 2208 count_array (nodetype) = count_array (nodetype) + 1; 2209 end; 2210 2211 do n = 0 to hbound (node_names, 1); 2212 if count_array (n) > 0 2213 then call ioa_ ("^-^5d ^a", count_array (n), node_names (n)); 2214 end; 2215 2216 unspec (count_array) = "0"b; 2217 2218 call ioa_ ("^/^- #^-Operator/Operand^/"); 2219 2220 i = 1; 2221 do while (i < next_free_polish); 2222 2223 n = polish_string (i); 2224 i = i + 1; 2225 2226 if n < 0 2227 then count_array (-1) = count_array (-1) + 1; 2228 /* a count */ 2229 2230 else if n = 0 2231 then count_array (0) = count_array (0) + 1; 2232 /* a zero */ 2233 2234 else if n <= hbound (op_names, 1) 2235 then do; 2236 count_array (n) = count_array (n) + 1; 2237 /* an operator */ 2238 2239 if n = stat_op 2240 then i = i + size (statement) - 1; 2241 2242 else if n = increment_polish_op 2243 then i = i + polish_string (i) + 1; 2244 end; 2245 2246 else count_array (-2) = count_array (-2) + 1; 2247 /* an operand */ 2248 end; 2249 2250 do i = lbound (op_names, 1) to hbound (op_names, 1); 2251 2252 if count_array (i) > 0 2253 then call ioa_ ("^-^5d ^a", count_array (i), op_names (i)); 2254 end; 2255 end; 2256 2257 2258 /* display all subprogram nodes */ 2259 2260 if command_structure.list_subprograms 2261 then do offset = first_subprogram repeat addr (x (offset)) -> subprogram.next_subprogram while (offset > 0); 2262 call display_node ((offset), ^command_structure.brief, (command_structure.walk)); 2263 end; 2264 2265 2266 /* display specified buckets in all subprograms */ 2267 2268 if command_structure.bucket 2269 then do; 2270 starting_offset = max (1, starting_offset); 2271 stopping_offset = min (stopping_offset, hbound (node_ptr -> subprogram.storage_info, 1)); 2272 2273 do subp = first_subprogram repeat cs -> subprogram.next_subprogram while (subp > 0); 2274 cs = addr (x (subp)); 2275 2276 first_time = "1"b; /* only print info if a bucket is found */ 2277 2278 do i = starting_offset to stopping_offset; 2279 offset = cs -> subprogram.storage_info (i).first; 2280 2281 if offset ^= 0 2282 then do; 2283 if first_time 2284 then call display_node ((subp), just_name, dont_walk); 2285 first_time = "0"b; 2286 call ioa_ ("^/Bucket ^d", i); 2287 end; 2288 2289 do while (offset > 0); 2290 call display_node ((offset), just_name, dont_walk); 2291 offset = addr (x (offset)) -> node.next; 2292 end; /* loop thru a single bucket chain */ 2293 end; /* loop thru a subprogram's buckets */ 2294 end; /* loop thru subprograms */ 2295 2296 call ioa_ ("Search for buckets ^d thru ^d completed.", starting_offset, stopping_offset); 2297 end; 2298 2299 abort_display: 2300 return; 2301 2302 display_int_text: 2303 proc (start, stop); /* displays a portion of the polish string */ 2304 2305 dcl (an_offset, content) 2306 fixed bin (18); 2307 dcl (start, stop) fixed bin (18); 2308 dcl op_ptr ptr; 2309 2310 an_offset = start; 2311 2312 do while (an_offset <= stop); 2313 2314 content = polish_string (an_offset); 2315 an_offset = an_offset + 1; /* move to next polish word */ 2316 2317 if content < 0 /* COUNT */ 2318 then call ioa_ ("^/COUNT: ^d", content + bias); 2319 2320 else if content = 0 /* ZERO */ 2321 then call ioa_ ("^/ZERO"); 2322 2323 else if content <= hbound (op_names, 1) /* printable OPERATOR */ 2324 then do; 2325 call ioa_ ("^/OPERATOR @ ^oo: ^a", an_offset - 1, op_names (content)); 2326 2327 if content = stat_op 2328 then do; 2329 op_ptr = addr (polish_string (an_offset - 1)); 2330 stat_start = binary (op_ptr -> statement.start, 26); 2331 stat_length = binary (op_ptr -> statement.length, 9); 2332 2333 call ioa_ ("^4x^a start ^d, length ^d, next ^oo, obj ^oo", 2334 decode_source_id (an_offset - 1, polish_base, "0"b), stat_start, 2335 stat_length, binary (op_ptr -> statement.next, 18), 2336 binary (op_ptr -> statement.location, 18)); 2337 2338 if op_ptr -> statement.put_in_profile 2339 then call ioa_ ("^5xPut in profile."); 2340 else if op_ptr -> statement.put_in_map 2341 then call ioa_ ("^5xPut in map."); 2342 else call ioa_ ("^5xNot in map or profile."); 2343 call ioa_ ("^/^5x^a", substr (source_segment, stat_start + 1, stat_length)); 2344 an_offset = an_offset + size (statement) - 1; 2345 /* stat_op is more than one word long */ 2346 end; 2347 2348 else if content = increment_polish_op 2349 then do; 2350 if command_structure.walk 2351 then call dump_words (addr (polish_string (an_offset + 1)), polish_string (an_offset)); 2352 2353 an_offset = an_offset + polish_string (an_offset) + 1; 2354 /* skip over data words */ 2355 end; 2356 end; /* printable operator */ 2357 2358 else if content < hash_table_size /* unknown OPERATOR */ 2359 then call ioa_ ("^/OPERATOR @ ^oo: ^d", an_offset - 1, content); 2360 2361 else if content < next_free_operand /* OPERAND */ 2362 then call display_node ((content), just_name, dont_walk); 2363 2364 else call ioa_ ("^/VALUE: ^wo", content); 2365 end; 2366 2367 end display_int_text; 2368 2369 dump_words: 2370 proc (a_base, a_count); 2371 2372 dcl a_base ptr; 2373 dcl a_count fixed bin (18); 2374 dcl bp ptr; 2375 dcl (count, i) fixed bin (18); 2376 dcl w (4) bit (36) aligned based; 2377 2378 bp = a_base; 2379 count = a_count; 2380 2381 do i = 0 to count - 1 by 4; 2382 call ioa_ ("^12oo:^v(^x^wo^)", binary (rel (bp), 18), min (4, count - i), bp -> w); 2383 bp = addrel (bp, 4); 2384 end; 2385 end /* dump_words */; 2386 2387 get_node_size: 2388 proc (pt) returns (fixed bin (18)); 2389 2390 dcl (p, pt) ptr; 2391 dcl node_type fixed bin (18); 2392 dcl currentsize builtin; 2393 2394 p = pt; 2395 node_type = p -> node.node_type; 2396 2397 if node_type < 0 | node_type > hbound (node_size, 1) 2398 then do; 2399 unknown_node: 2400 call ioa_ ("Compiler error: Unknown node ^d at ^p to ""get_node_size"".", node_type, p); 2401 goto abort_display; 2402 end; 2403 2404 if node_size (node_type) ^= 0 2405 then return (node_size (node_type)); 2406 2407 if node_type = symbol_node 2408 then do; 2409 return (currentsize (p -> symbol)); 2410 end; 2411 2412 if node_type = header_node 2413 then do; 2414 return (currentsize (p -> header)); 2415 end; 2416 2417 if node_type = char_constant_node 2418 then do; 2419 if p -> char_constant.no_value_stored 2420 then char_constant_length = 0; 2421 else char_constant_length = p -> char_constant.length; 2422 2423 return (size (char_constant)); 2424 end; 2425 2426 if node_type = dimension_node 2427 then return (currentsize (p -> dimension)); 2428 2429 if node_type = source_node 2430 then return (size (source) - divide (256 - length (p -> source.pathname), 4, 17, 0)); 2431 2432 if node_type = arg_desc_node 2433 then do; 2434 return (currentsize (p -> arg_desc)); 2435 end; 2436 2437 goto unknown_node; 2438 end get_node_size; 2439 2440 display_node: 2441 proc (an_offset, dump_sw, walk_sw); 2442 2443 dcl a_node_type fixed bin (18); 2444 dcl an_offset fixed bin (18); 2445 dcl chain fixed bin (18); 2446 dcl dump_sw bit (1) aligned; 2447 dcl eaq_names (0:17) char (8) aligned int static options (constant) 2448 init ("EMPTY", "Q", "A", "AQ", "EAQ", "DEAQ", "IEAQ", "IQ", "IND", "INVALID", "TZE", "TNZ", 2449 "TMI", "TPL", "TMOZ", "TPNZ", "TNC", "TRC"); 2450 dcl eaq_regs (4) char (4) aligned int static options (constant) 2451 init ("A", "Q", "EAQ", "IND"); 2452 dcl everything bit (1) aligned; 2453 dcl (ft, ls, nx) fixed bin (18); 2454 dcl node_offset fixed bin (18); 2455 dcl node_ptr ptr; 2456 dcl prt_sw bit (1) aligned; 2457 dcl walk_chains bit (1) aligned; 2458 dcl walk_sw bit (1) aligned; 2459 dcl i fixed bin; 2460 2461 /* copy input arguments */ 2462 2463 node_offset = an_offset; 2464 everything = dump_sw; 2465 walk_chains = walk_sw | ^everything; /* make sure brief means BRIEF!! */ 2466 2467 /* validate our input */ 2468 2469 if node_offset < hash_table_size | node_offset >= next_free_operand 2470 then do; 2471 call ioa_ ("Operand offset ^oo is not valid.", node_offset); 2472 return; 2473 end; 2474 2475 node_ptr = addr (x (node_offset)); 2476 2477 a_node_type = node_ptr -> node.node_type; 2478 2479 if a_node_type >= 0 & a_node_type <= hbound (node_names, 1) 2480 then call ioa_ ("^/^a NODE: ^oo", node_names (a_node_type), node_offset); 2481 else do; 2482 unknown_node: 2483 call ioa_ ("^/unknown NODE ^d: ^oo", a_node_type, node_offset); 2484 return; 2485 end; 2486 2487 goto output_node (a_node_type); 2488 2489 2490 output_node (0): /* FILLER */ 2491 if x (an_offset) ^= 0 2492 then call ioa_ ("^/^5x^wo", x (an_offset)); 2493 return; 2494 2495 2496 output_node (1): /* SOURCE */ 2497 if ^everything 2498 then return; 2499 2500 call ioa_ ("^/^5xuid: ^wo, dtm: ^oo^/^5xnext: ^oo, subprogram: ^oo^/^5xpath: ^a", node_ptr -> source.uid, 2501 node_ptr -> source.dtm, node_ptr -> source.next, node_ptr -> source.initial_subprogram, 2502 node_ptr -> source.pathname); 2503 return; 2504 2505 2506 output_node (2): /* SYMBOL */ 2507 call ioa_ ("^2xoperand type: ^a, data type: ^a, name: ^a", operand_names (node_ptr -> node.operand_type), 2508 mode_names (node_ptr -> node.data_type), node_ptr -> symbol.name); 2509 2510 if ^everything 2511 then return; 2512 2513 call get_addressing_attributes; 2514 2515 /* special SYMBOL addressing attributes */ 2516 2517 if node_ptr -> symbol.initialed 2518 then ons = ons || "initialed "; 2519 if node_ptr -> symbol.variable_arglist 2520 then ons = ons || "variable_arglist "; 2521 if node_ptr -> symbol.dummy_arg 2522 then ons = ons || "dummy_arg "; 2523 if node_ptr -> symbol.variable_extents 2524 then ons = ons || "variable_extents "; 2525 if node_ptr -> symbol.needs_descriptors 2526 then ons = ons || "needs_descriptors "; 2527 if node_ptr -> symbol.put_in_symtab 2528 then ons = ons || "put_in_symtab "; 2529 if node_ptr -> symbol.by_compiler 2530 then ons = ons || "by_compiler "; 2531 2532 if node_ptr -> symbol.aliasable 2533 then ons = ons || "aliasable "; 2534 if node_ptr -> symbol.has_constant_value 2535 then ons = ons || "has_constant_value "; 2536 if node_ptr -> symbol.new_induction_var 2537 then ons = ons || "new_induction_var "; 2538 2539 if node_ptr -> symbol.integer 2540 then ons = ons || "integer "; 2541 if node_ptr -> symbol.real 2542 then ons = ons || "real "; 2543 if node_ptr -> symbol.double_precision 2544 then ons = ons || "double_precision "; 2545 if node_ptr -> symbol.complex 2546 then ons = ons || "complex "; 2547 if node_ptr -> symbol.logical 2548 then ons = ons || "logical "; 2549 if node_ptr -> symbol.character 2550 then do; 2551 ons = ons || "character("; 2552 ons = ons || binary_to_char (node_ptr -> symbol.char_size + 1); 2553 ons = ons || ") "; 2554 end; 2555 if node_ptr -> symbol.label_value 2556 then ons = ons || "label_value "; 2557 if node_ptr -> symbol.entry_value 2558 then ons = ons || "entry_value "; 2559 if node_ptr -> symbol.function 2560 then ons = ons || "function "; 2561 if node_ptr -> symbol.subroutine 2562 then ons = ons || "subroutine "; 2563 if node_ptr -> symbol.entry_point 2564 then ons = ons || "entry_point "; 2565 if node_ptr -> symbol.external 2566 then ons = ons || "external "; 2567 if node_ptr -> symbol.builtin 2568 then do; 2569 ons = ons || "builtin("; 2570 ons = ons || binary_to_char ((node_ptr -> symbol.char_size)); 2571 ons = ons || ") "; 2572 end; 2573 if node_ptr -> symbol.stmnt_func 2574 then do; 2575 ons = ons || "stmnt_func("; 2576 ons = ons || binary_to_char ((node_ptr -> symbol.char_size)); 2577 ons = ons || ") "; 2578 end; 2579 if node_ptr -> symbol.namelist 2580 then ons = ons || "namelist "; 2581 if node_ptr -> symbol.dimensioned 2582 then ons = ons || "dimensioned "; 2583 if node_ptr -> symbol.automatic 2584 then ons = ons || "automatic "; 2585 if node_ptr -> symbol.static 2586 then ons = ons || "static "; 2587 if node_ptr -> symbol.in_common 2588 then ons = ons || "in_common "; 2589 if node_ptr -> symbol.equivalenced 2590 then ons = ons || "equivalenced "; 2591 if node_ptr -> symbol.parameter 2592 then ons = ons || "parameter "; 2593 if node_ptr -> symbol.constant 2594 then ons = ons || "constant "; 2595 if node_ptr -> symbol.named_constant 2596 then ons = ons || "named_constant "; 2597 if node_ptr -> symbol.variable 2598 then ons = ons || "variable "; 2599 if node_ptr -> symbol.in_equiv_stmnt 2600 then ons = ons || "in_equiv_stmnt "; 2601 if node_ptr -> symbol.star_extents 2602 then ons = ons || "star_extents "; 2603 if node_ptr -> symbol.descriptor 2604 then ons = ons || "descriptor "; 2605 2606 call print_common_fields ("hash_chain"); 2607 2608 if node_ptr -> symbol.location ^= 0 2609 then call ioa_ ("^5xlocation: ^oo", node_ptr -> symbol.location); 2610 2611 if node_ptr -> symbol.loop_ref_count ^= 0 2612 then call ioa_ ("^5xloop_ref_count: ^d", node_ptr -> symbol.loop_ref_count); 2613 2614 if node_ptr -> symbol.element_size ^= 0 2615 then call ioa_ ("^5xelement_size: ^oo", node_ptr -> symbol.element_size); 2616 2617 if node_ptr -> symbol.offset ^= 0 2618 then call ioa_ ("^5xoffset: ^oo", node_ptr -> symbol.offset); 2619 2620 if node_ptr -> symbol.general ^= 0 2621 then call ioa_ ("^5xgeneral: ^oo", node_ptr -> symbol.general); 2622 2623 if node_ptr -> symbol.parent ^= 0 2624 then call ioa_ ("^5xparent: ^oo", node_ptr -> symbol.parent); 2625 2626 if node_ptr -> symbol.next_member ^= 0 2627 then call ioa_ ("^5xnext_member: ^oo", node_ptr -> symbol.next_member); 2628 2629 if node_ptr -> symbol.v_length ^= 0 2630 then call ioa_ ("^5xv_length: ^oo", node_ptr -> symbol.v_length); 2631 2632 if node_ptr -> symbol.dimension ^= 0 2633 then do; 2634 call ioa_ ("^5xdimension: ^oo", node_ptr -> symbol.dimension); 2635 if walk_chains 2636 then call display_node ((node_ptr -> symbol.dimension), all_fields, dont_walk); 2637 end; 2638 2639 if node_ptr -> symbol.initial ^= 0 2640 then do; 2641 call ioa_ ("^5xinitial: ^oo", node_ptr -> symbol.initial); 2642 if walk_chains & ^node_ptr -> symbol.namelist 2643 then do chain = node_ptr -> symbol.initial repeat polish_string (chain) while (chain > 0); 2644 call ioa_ ("^5x^5d * (^oo): ^a", polish_string (chain + 1), polish_string (chain + 2), 2645 print_constant_value (addr (x (polish_string (chain + 2))), "1"b)); 2646 end; 2647 end; 2648 2649 if node_ptr -> symbol.runtime ^= "0"b 2650 then call ioa_ ("^5xruntime: ^oo", node_ptr -> symbol.runtime); 2651 2652 if node_ptr -> symbol.coordinate ^= 0 2653 then call ioa_ ("^5xcoordinate: ^d", node_ptr -> symbol.coordinate); 2654 2655 if node_ptr -> symbol.secondary ^= null & unspec (node_ptr -> symbol.secondary) ^= "0"b 2656 then call ioa_ ("^5xsecondary: ^p", node_ptr -> symbol.secondary); 2657 return; 2658 2659 2660 output_node (3): /* DIMENSION */ 2661 if ^everything 2662 then return; 2663 2664 if node_ptr -> dimension.assumed_size 2665 then call ioa_ ("^/^5xassumed_size"); 2666 2667 call ioa_ ("^/^5xndims: ^d", node_ptr -> dimension.number_of_dims); 2668 2669 if node_ptr -> dimension.has_virtual_origin 2670 then if node_ptr -> dimension.variable_virtual_origin 2671 then call ioa_ ("^5xv org operand: ^oo", node_ptr -> dimension.virtual_origin); 2672 else call ioa_ ("^5xv org: ^d units", node_ptr -> dimension.virtual_origin); 2673 2674 if node_ptr -> dimension.element_count ^= 0 2675 then call ioa_ ("^5xelement_count: ^d", node_ptr -> dimension.element_count); 2676 2677 if node_ptr -> dimension.has_array_size 2678 then if node_ptr -> dimension.variable_array_size 2679 then call ioa_ ("^5xarray size operand: ^oo", node_ptr -> dimension.array_size); 2680 else call ioa_ ("^5xarray size: ^d units", node_ptr -> dimension.array_size); 2681 2682 do chain = 1 to node_ptr -> dimension.number_of_dims; 2683 call ioa_ ("^5xdimension ^d info:", chain); 2684 2685 if node_ptr -> dimension.v_bound (chain).lower 2686 then do; 2687 call ioa_ ("^10xlower bound operand: ^oo", node_ptr -> dimension.lower_bound (chain)); 2688 if walk_chains 2689 then call display_node ((node_ptr -> dimension.lower_bound (chain)), all_fields, dont_walk); 2690 end; 2691 else call ioa_ ("^10xlower bound: ^d", node_ptr -> dimension.lower_bound (chain)); 2692 2693 if node_ptr -> dimension.v_bound (chain).upper 2694 then do; 2695 call ioa_ ("^10xupper bound operand: ^oo", node_ptr -> dimension.upper_bound (chain)); 2696 if walk_chains 2697 then call display_node ((node_ptr -> dimension.upper_bound (chain)), all_fields, dont_walk); 2698 end; 2699 else call ioa_ ("^10xupper bound: ^d", node_ptr -> dimension.upper_bound (chain)); 2700 2701 if node_ptr -> dimension.has_dim_sizes 2702 then if string (node_ptr -> dimension.v_bound (chain)) = "00"b 2703 then call ioa_ ("^10xsize: ^d", node_ptr -> dimension.size (chain)); 2704 else call ioa_ ("^10xsize operand: ^oo", node_ptr -> dimension.size (chain)); 2705 2706 end; 2707 return; 2708 2709 2710 output_node (4): /* TEMPORARY */ 2711 call ioa_ ("^2xoperand type: ^a, data type ^a", operand_names (node_ptr -> node.operand_type), 2712 mode_names (node_ptr -> node.data_type)); 2713 2714 if node_ptr -> temporary.ref_count ^= 0 2715 then call ioa_ ("^5xref_count: ^d", node_ptr -> temporary.ref_count); 2716 2717 if node_ptr -> temporary.ms_ref_count ^= 0 2718 then call ioa_ ("^5xMS ref_count: ^d", node_ptr -> temporary.ms_ref_count); 2719 2720 if node_ptr -> temporary.ref_count_copy ^= 0 2721 then call ioa_ ("^5xref_count_copy: ^d", node_ptr -> temporary.ref_count_copy); 2722 2723 if ^everything 2724 then return; 2725 2726 call get_addressing_attributes; 2727 2728 if node_ptr -> temporary.variable_length 2729 then ons = ons || "variable_length "; 2730 if node_ptr -> temporary.invariant 2731 then ons = ons || "invariant "; 2732 if node_ptr -> temporary.irreducible 2733 then ons = ons || "irreducible "; 2734 if node_ptr -> temporary.used_across_loops 2735 then ons = ons || "used_across_loops "; 2736 if node_ptr -> temporary.used_as_subscript 2737 then ons = ons || "used_as_subscript "; 2738 if node_ptr -> temporary.frozen_for_do 2739 then ons = ons || "frozen_for_do "; 2740 2741 call print_common_fields ("loop_end_fu_pos"); 2742 2743 if node_ptr -> temporary.location ^= 0 2744 then call ioa_ ("^5xlocation: ^oo", node_ptr -> temporary.location); 2745 2746 if node_ptr -> temporary.loop_ref_count ^= 0 2747 then call ioa_ ("^5xloop_ref_count: ^d", node_ptr -> temporary.loop_ref_count); 2748 2749 if node_ptr -> temporary.length ^= 0 2750 then call ioa_ ("^5xchar length: ^[^oo^;^d^]", node_ptr -> temporary.variable_length, 2751 node_ptr -> temporary.length); 2752 2753 if node_ptr -> temporary.size ^= 0 2754 then call ioa_ ("^5xsize in words: ^oo", node_ptr -> temporary.size); 2755 2756 if node_ptr -> temporary.output_by ^= 0 2757 then call ioa_ ("^5xoutput_by: ^oo", node_ptr -> temporary.output_by); 2758 2759 if node_ptr -> temporary.start_input_to ^= 0 2760 then call ioa_ ("^5xstart_input_to: ^oo", node_ptr -> temporary.start_input_to); 2761 2762 if node_ptr -> temporary.end_input_to ^= 0 2763 then call ioa_ ("^5xend_input_to: ^oo", node_ptr -> temporary.end_input_to); 2764 return; 2765 2766 2767 output_node (5): /* CONSTANT */ 2768 call ioa_ ("^2xoperand type: ^a, data type ^a, value ^a", operand_names (node_ptr -> node.operand_type), 2769 mode_names (node_ptr -> node.data_type), print_constant_value (node_ptr, "0"b)); 2770 2771 if ^everything 2772 then return; 2773 2774 call get_addressing_attributes; 2775 call print_common_fields ("hash_chain"); 2776 return; 2777 2778 2779 output_node (6): /* LABEL */ 2780 call ioa_ ("^2xoperand type: ^a, data type ^a, name ^d", operand_names (node_ptr -> node.operand_type), 2781 mode_names (node_ptr -> node.data_type), node_ptr -> label.name); 2782 2783 if ^everything 2784 then return; 2785 2786 call get_addressing_attributes; 2787 2788 if node_ptr -> label.executable 2789 then if node_ptr -> label.format 2790 then ons = ons || "declarative "; 2791 else ons = ons || "executable "; 2792 else if node_ptr -> label.format 2793 then ons = ons || "format "; 2794 else ons = ons || "no_usage_attrs "; 2795 2796 if node_ptr -> label.restore_prs 2797 then ons = ons || "restore_prs "; 2798 if node_ptr -> label.referenced_executable 2799 then ons = ons || "referenced_executable "; 2800 if node_ptr -> label.not_referencable 2801 then ons = ons || "not_referencable "; 2802 if node_ptr -> label.branched_to 2803 then ons = ons || "branched_to "; 2804 if node_ptr -> label.ends_do_loop 2805 then ons = ons || "ends_do_loop "; 2806 2807 call print_common_fields ("hash_chain"); 2808 2809 if node_ptr -> label.loop_end ^= 0 2810 then call ioa_ ("^5xloop_end: ^oo", node_ptr -> label.loop_end); 2811 2812 if node_ptr -> label.statement ^= 0 2813 then do; 2814 call ioa_ ("^5xstatement: ^oo", node_ptr -> label.statement); 2815 if walk_chains 2816 then call display_quadruples ((node_ptr -> label.statement), (node_ptr -> label.statement)); 2817 end; 2818 2819 if node_ptr -> label.format_var ^= 0 2820 then do; 2821 call ioa_ ("^5xformat_var: ^oo", node_ptr -> label.format_var); 2822 if walk_chains 2823 then call display_node ((node_ptr -> label.format_var), all_fields, dont_walk); 2824 end; 2825 return; 2826 2827 2828 output_node (7): /* HEADER */ 2829 call ioa_ ("^2xoperand type: ^a, data type ^a", operand_names (node_ptr -> node.operand_type), 2830 mode_names (node_ptr -> node.data_type)); 2831 2832 if node_ptr -> header.in_common 2833 then call ioa_ ("^5xcommon block: ^a", node_ptr -> header.block_name); 2834 2835 if ^everything 2836 then return; 2837 2838 call get_addressing_attributes; 2839 2840 /* get HEADER addressing attributes */ 2841 2842 if node_ptr -> header.initialed 2843 then ons = ons || "initialed "; 2844 if node_ptr -> header.even 2845 then ons = ons || "even "; 2846 if node_ptr -> header.odd 2847 then ons = ons || "odd "; 2848 if node_ptr -> header.character 2849 then ons = ons || "character "; 2850 if node_ptr -> header.automatic 2851 then ons = ons || "automatic "; 2852 if node_ptr -> header.static 2853 then ons = ons || "static "; 2854 if node_ptr -> header.in_common 2855 then ons = ons || "in_common "; 2856 2857 call print_common_fields ("pad"); 2858 2859 if node_ptr -> header.length ^= 0 2860 then call ioa_ ("^5xlength: ^d", node_ptr -> header.length); 2861 2862 if node_ptr -> header.location ^= 0 2863 then call ioa_ ("^5xlocation: ^oo", node_ptr -> header.location); 2864 2865 if node_ptr -> header.first_element ^= 0 2866 then call ioa_ ("^5xfirst_element: ^oo", node_ptr -> header.first_element); 2867 2868 if node_ptr -> header.last_element ^= 0 2869 then call ioa_ ("^5xlast_element: ^oo", node_ptr -> header.last_element); 2870 2871 if walk_chains 2872 then do chain = node_ptr -> header.first_element repeat addr (x (chain)) -> symbol.next_member 2873 while (chain > 0); 2874 call ioa_ ("^8oo ^a", chain, addr (x (chain)) -> symbol.name); 2875 end; 2876 return; 2877 2878 2879 output_node (8): /* CHARACTER CONSTANT */ 2880 call ioa_ ("^2xoperand type: ^a, data type ^a(^d), value ^a", operand_names (node_ptr -> node.operand_type), 2881 mode_names (node_ptr -> node.data_type), node_ptr -> char_constant.length, 2882 print_constant_value (node_ptr, "1"b)); 2883 2884 if ^everything 2885 then return; 2886 2887 call get_addressing_attributes; 2888 2889 if node_ptr -> char_constant.no_value_stored 2890 then ons = ons || "no_value_stored "; 2891 2892 call print_common_fields ("hash_chain"); 2893 return; 2894 2895 2896 output_node (9): /* ARRAY_REF */ 2897 call ioa_ ("^2xoperand type: ^a, data type ^a", operand_names (node_ptr -> node.operand_type), 2898 mode_names (node_ptr -> node.data_type)); 2899 2900 if node_ptr -> array_ref.ref_count ^= 0 2901 then call ioa_ ("^5xref_count: ^d", node_ptr -> array_ref.ref_count); 2902 2903 if node_ptr -> array_ref.ref_count_copy ^= 0 2904 then call ioa_ ("^5xref_count_copy: ^d", node_ptr -> array_ref.ref_count_copy); 2905 2906 if ^everything 2907 then return; 2908 2909 call get_addressing_attributes; 2910 2911 if node_ptr -> array_ref.has_address 2912 then ons = ons || "has_address "; 2913 2914 if node_ptr -> array_ref.variable_offset 2915 then ons = ons || "variable_offset "; 2916 2917 if node_ptr -> array_ref.variable_length 2918 then ons = ons || "variable_length "; 2919 2920 if node_ptr -> array_ref.invariant 2921 then ons = ons || "invariant "; 2922 if node_ptr -> array_ref.irreducible 2923 then ons = ons || "irreducible "; 2924 if node_ptr -> array_ref.used_across_loops 2925 then ons = ons || "used_across_loops "; 2926 2927 if node_ptr -> array_ref.large_offset 2928 then ons = ons || "large_offset "; 2929 2930 call print_common_fields ("loop_end_fu_pos"); 2931 2932 if node_ptr -> array_ref.location ^= 0 2933 then call ioa_ ("^5xlocation: ^oo", node_ptr -> array_ref.location); 2934 2935 if node_ptr -> array_ref.parent ^= 0 2936 then call ioa_ ("^5xparent: ^oo", node_ptr -> array_ref.parent); 2937 2938 if node_ptr -> array_ref.v_offset ^= 0 2939 then call ioa_ ("^5xv_offset: ^oo", node_ptr -> array_ref.v_offset); 2940 2941 if node_ptr -> array_ref.length ^= 0 2942 then call ioa_ ("^5xlength: ^[^oo^;^d^]", node_ptr -> array_ref.variable_length, node_ptr -> array_ref.length); 2943 2944 if node_ptr -> array_ref.output_by ^= 0 2945 then call ioa_ ("^5xoutput_by: ^oo", node_ptr -> array_ref.output_by); 2946 2947 if node_ptr -> array_ref.start_input_to ^= 0 2948 then call ioa_ ("^5xstart_input_to: ^oo", node_ptr -> array_ref.start_input_to); 2949 2950 if node_ptr -> array_ref.end_input_to ^= 0 2951 then call ioa_ ("^5xend_input_to: ^oo", node_ptr -> array_ref.end_input_to); 2952 2953 if walk_chains 2954 then call display_node ((node_ptr -> array_ref.parent), all_fields, dont_walk); 2955 return; 2956 2957 2958 output_node (10): /* PROC_FRAME */ 2959 if ^everything 2960 then return; 2961 2962 call ioa_ (""); 2963 call dump_words (node_ptr, get_node_size (node_ptr)); 2964 return; 2965 2966 2967 output_node (11): /* LIBRARY */ 2968 if ^everything 2969 then return; 2970 2971 if node_ptr -> library.next_library_node ^= 0 2972 then call ioa_ ("^5xnext_library_node: ^oo", node_ptr -> library.next_library_node); 2973 2974 if node_ptr -> library.character_operand ^= 0 2975 then call ioa_ ("^5xcharacter_operand: ^oo", node_ptr -> library.character_operand); 2976 2977 if walk_chains 2978 then call ioa_ ("^5xpath: ^a", print_constant_value (addr (x (node_ptr -> library.character_operand)), "0"b)); 2979 return; 2980 2981 2982 output_node (12): /* SUBPROGRAM */ 2983 chain = node_ptr -> subprogram.symbol; 2984 if chain <= 0 2985 then call ioa_ ("^2x^a: NO NAME!", subr_type (node_ptr -> subprogram.subprogram_type)); 2986 else call ioa_ ("^2x^a: ^a", subr_type (node_ptr -> subprogram.subprogram_type), 2987 addr (x (chain)) -> symbol.name); 2988 2989 if ^everything 2990 then return; 2991 2992 ons = ""; 2993 call ioa_ (""); 2994 2995 if node_ptr -> subprogram.options.ansi_77 2996 then ons = ons || "ansi77 "; 2997 else ons = ons || "ansi66 "; 2998 2999 if node_ptr -> subprogram.options.card 3000 then ons = ons || "card "; 3001 else ons = ons || "free "; 3002 3003 if node_ptr -> subprogram.options.fold 3004 then ons = ons || "fold "; 3005 3006 if ^node_ptr -> subprogram.options.ignore_articulation_blocks 3007 then ons = ons || "safe "; 3008 3009 if node_ptr -> subprogram.options.subscriptrange 3010 then ons = ons || "subrg "; 3011 else ons = ons || "nosubrg "; 3012 3013 if node_ptr -> subprogram.options.stringrange 3014 then ons = ons || "stringrange "; 3015 3016 if node_ptr -> subprogram.options.auto_zero 3017 then ons = ons || "auto_zero "; 3018 else ons = ons || "no_auto_zero "; 3019 3020 if node_ptr -> subprogram.options.do_rounding 3021 then ons = ons || "round "; 3022 else ons = ons || "truncate "; 3023 3024 if node_ptr -> subprogram.options.relocatable 3025 then ons = ons || "rlc "; 3026 else ons = ons || "nrlc "; 3027 3028 if ons ^= "" 3029 then call ioa_ ("^5xoptions: ^a", ons); 3030 3031 ons = ""; 3032 if node_ptr -> subprogram.default_is.auto 3033 then ons = ons || "default_is.auto "; 3034 if node_ptr -> subprogram.default_is.static 3035 then ons = ons || "default_is.static "; 3036 if node_ptr -> subprogram.need_PS 3037 then ons = ons || "need_PS "; 3038 if node_ptr -> subprogram.need_prologue 3039 then ons = ons || "need_prologue "; 3040 if node_ptr -> subprogram.multiple_entry 3041 then ons = ons || "multiple_entry "; 3042 if node_ptr -> subprogram.namelist_used 3043 then ons = ons || "namelist_used "; 3044 if node_ptr -> subprogram.has_parameters 3045 then ons = ons || "has_parameters "; 3046 3047 if ons ^= "" 3048 then call ioa_ ("^5xattr: ^a", ons); 3049 3050 if node_ptr -> subprogram.previous_subprogram ^= 0 | node_ptr -> subprogram.next_subprogram ^= 0 3051 then call ioa_ ("^5xprevious: ^oo, next: ^oo", node_ptr -> subprogram.previous_subprogram, 3052 node_ptr -> subprogram.next_subprogram); 3053 3054 if node_ptr -> subprogram.common_chain ^= 0 | node_ptr -> subprogram.equiv_chain ^= 0 3055 then call ioa_ ("^5xcommon: ^oo, equiv: ^oo", node_ptr -> subprogram.common_chain, 3056 node_ptr -> subprogram.equiv_chain) 3057 ; 3058 3059 if node_ptr -> subprogram.first_symbol ^= 0 | node_ptr -> subprogram.last_symbol ^= 0 3060 then call ioa_ ("^5xsymbols: ^oo ^oo", node_ptr -> subprogram.first_symbol, node_ptr -> subprogram.last_symbol); 3061 3062 if node_ptr -> subprogram.first_label ^= 0 | node_ptr -> subprogram.last_label ^= 0 3063 then call ioa_ ("^5xlabels: ^oo ^oo", node_ptr -> subprogram.first_label, node_ptr -> subprogram.last_label); 3064 3065 if node_ptr -> subprogram.first_polish ^= 0 | node_ptr -> subprogram.last_polish ^= 0 3066 then call ioa_ ("^5xpolish: ^oo ^o", node_ptr -> subprogram.first_polish, node_ptr -> subprogram.last_polish); 3067 3068 if node_ptr -> subprogram.first_quad ^= 0 | node_ptr -> subprogram.last_quad ^= 0 3069 then call ioa_ ("^5xquad: ^oo ^oo", node_ptr -> subprogram.first_quad, node_ptr -> subprogram.last_quad); 3070 3071 if node_ptr -> subprogram.map.first ^= 0 | node_ptr -> subprogram.map.last ^= 0 3072 then call ioa_ ("^5xmap.first: ^oo ^oo", node_ptr -> subprogram.map.first, node_ptr -> subprogram.map.last); 3073 3074 if node_ptr -> subprogram.entry_info ^= 0 3075 then call ioa_ ("^5xentry_info: ^oo", node_ptr -> subprogram.entry_info); 3076 3077 if node_ptr -> subprogram.runtime ^= 0 3078 then call ioa_ ("^5xruntime: ^oo", node_ptr -> subprogram.runtime); 3079 3080 prt_sw = "1"b; /* print header if interesting bucket is found */ 3081 do chain = 1 to hbound (node_ptr -> subprogram.storage_info, 1); 3082 3083 ft = node_ptr -> subprogram.storage_info (chain).first; 3084 ls = node_ptr -> subprogram.storage_info (chain).last; 3085 nx = node_ptr -> subprogram.storage_info (chain).next_loc; 3086 3087 if ft ^= 0 | ls ^= 0 | nx ^= 0 3088 then do; 3089 if prt_sw 3090 then call ioa_ ("^/^5xbucket first last next_loc"); 3091 prt_sw = "0"b; 3092 3093 call ioa_ ("^8d^10oo^10oo^10oo", chain, ft, ls, nx); 3094 end; 3095 end; 3096 3097 if node_ptr -> subprogram.n_loops > 0 3098 then call ioa_ ("^5xloop_vector: ^p, n_loops: ^d, max_operators: ^d, max_sym ^d", 3099 node_ptr -> subprogram.loop_vector_p, node_ptr -> subprogram.n_loops, 3100 node_ptr -> subprogram.max_operators, 3101 node_ptr -> subprogram.max_sym); 3102 3103 return; 3104 3105 3106 output_node (13): /* ARG_DESC */ 3107 if ^everything 3108 then return; 3109 3110 call ioa_ ("^/^-^8d args^/^3xNumber^-Data Type^-^-Attributes", node_ptr -> arg_desc.n_args); 3111 do chain = 1 to node_ptr -> arg_desc.n_args; 3112 3113 ons = ""; 3114 3115 if node_ptr -> arg_desc.arg (chain).must_be.array 3116 then ons = ons || "must_be.array "; 3117 if node_ptr -> arg_desc.arg (chain).must_be.scalar 3118 then ons = ons || "must_be.scalar "; 3119 if node_ptr -> arg_desc.arg (chain).star_extents 3120 then ons = ons || "star_extents "; 3121 3122 call ioa_ ("^3d ^a ^a", chain, mode_names (node_ptr -> arg_desc.arg (chain).data_type), ons); 3123 end; 3124 return; 3125 3126 3127 output_node (14): /* POINTER */ 3128 call ioa_ ("^5xcode: ^d, var: ^d, offset: ^d, count: ^d, hash_chain: ^oo", 3129 node_ptr -> pointer.code, node_ptr -> pointer.variable, 3130 node_ptr -> pointer.offset, node_ptr -> pointer.count, 3131 node_ptr -> pointer.hash_chain); 3132 return; 3133 3134 3135 output_node (15): /* MACHINE_STATE */ 3136 if node_ptr -> machine_state.next ^= null 3137 then call ioa_ ("^5xnext: ^p", node_ptr -> machine_state.next); 3138 3139 call ioa_ ("^/EAQ state:"); 3140 do i = 1 to 4; /* A, Q, EAQ, IND */ 3141 3142 call ioa_ ("^/^5x^a: name ^a, number ^d.", 3143 eaq_regs (i), 3144 eaq_names (node_ptr -> machine_state.eaq (i).name), 3145 node_ptr -> machine_state.eaq (i).number); 3146 3147 do chain = 1 to hbound (node_ptr -> machine_state.eaq.variable, 1); 3148 if node_ptr -> machine_state.eaq (i).variable (chain) ^= 0 3149 then call ioa_ ("^10x#^2d: ^oo", chain, 3150 node_ptr -> machine_state.eaq (i).variable (chain)); 3151 end; 3152 3153 end; 3154 3155 if node_ptr -> machine_state.indicators_valid > 0 3156 then call ioa_ ("^/^5xIndicators valid for ^a.", 3157 eaq_regs (node_ptr -> machine_state.indicators_valid)); 3158 3159 call ioa_ ("^/^5xType Variable Last used Offset^2/Index registers"); 3160 do chain = 0 to 7; 3161 call ioa_ ("^5x^5d^10oo^10oo^10x^[ global^;^]^[ reserved^;^]", 3162 node_ptr -> machine_state.index_regs (chain).type, 3163 node_ptr -> machine_state.index_regs (chain).variable, 3164 node_ptr -> machine_state.index_regs (chain).used, 3165 node_ptr -> machine_state.index_regs (chain).global, 3166 node_ptr -> machine_state.index_regs (chain).reserved); 3167 end; 3168 3169 call ioa_ ("^/Base registers"); 3170 do chain = 0 to 7; 3171 call ioa_ ("^5x^5d^10oo^10oo^10d^[ global^;^]^[ reserved^;^]", 3172 node_ptr -> machine_state.base_regs (chain).type, 3173 node_ptr -> machine_state.base_regs (chain).variable, 3174 node_ptr -> machine_state.base_regs (chain).used, 3175 node_ptr -> machine_state.base_regs (chain).offset, 3176 node_ptr -> machine_state.base_regs (chain).global, 3177 node_ptr -> machine_state.base_regs (chain).reserved); 3178 end; 3179 3180 if node_ptr -> machine_state.stack_extended 3181 then call ioa_ ("^/Stack is extended^[; last_dynamic_temp = ^oo^].", 3182 (node_ptr -> machine_state.last_dynamic_temp ^= 0), 3183 node_ptr -> machine_state.last_dynamic_temp); 3184 3185 return; 3186 3187 3188 get_addressing_attributes: 3189 procedure; /* creates string from addressing attribute bits */ 3190 3191 ons = ""; 3192 3193 if node_ptr -> node.is_addressable 3194 then ons = ons || "is_addressable "; 3195 if node_ptr -> node.value_in.eaq 3196 then ons = ons || "value_in.eaq "; 3197 if node_ptr -> node.value_in.x 3198 then ons = ons || "value_in.x "; 3199 if node_ptr -> node.allocated 3200 then ons = ons || "allocated "; 3201 if node_ptr -> node.needs_pointer 3202 then ons = ons || "needs_pointer "; 3203 if node_ptr -> node.stack_indirect 3204 then ons = ons || "stack_indirect "; 3205 if node_ptr -> node.large_address 3206 then ons = ons || "large_address "; 3207 if node_ptr -> node.address_in_base 3208 then ons = ons || "address_in_base "; 3209 if node_ptr -> node.allocate 3210 then ons = ons || "allocate "; 3211 if node_ptr -> node.set 3212 then ons = ons || "set "; 3213 if node_ptr -> node.referenced 3214 then ons = ons || "referenced "; 3215 if node_ptr -> node.passed_as_arg 3216 then ons = ons || "passed_as_arg "; 3217 if node_ptr -> node.dont_update 3218 then ons = ons || "dont_update "; 3219 if node_ptr -> node.not_in_storage 3220 then ons = ons || "not_in_storage "; 3221 if node_ptr -> node.globally_assigned 3222 then ons = ons || "globally_assigned "; 3223 3224 end /* get_addressing_attributes */; 3225 3226 3227 print_common_fields: 3228 procedure (name2); /* prints string and address field */ 3229 3230 dcl name2 char (*); 3231 3232 if ons ^= "" 3233 then call ioa_ ("^/^5xattr: ^a", ons); 3234 else call ioa_ (""); 3235 ons = ""; 3236 3237 if unspec (node_ptr -> node.address) ^= "0"b 3238 then call ioa_ ("^5xaddress: ^wo", unspec (node_ptr -> node.address)); 3239 3240 if node_ptr -> node.units ^= 0 3241 then call ioa_ ("^5xunits: ^a", offset_unit_names (node_ptr -> node.units)); 3242 3243 call ioa_ ("^5xrelocation: ^b (^b)", node_ptr -> node.reloc, node_ptr -> node.reloc_hold); 3244 3245 if node_ptr -> node.addr_hold ^= "0"b 3246 then call ioa_ ("^5xaddr_hold: ^oo", node_ptr -> node.addr_hold); 3247 3248 if node_ptr -> node.next ^= 0 3249 then call ioa_ ("^5xnext: ^oo", node_ptr -> node.next); 3250 3251 if node_ptr -> node.hash_chain ^= 0 3252 then call ioa_ ("^5x^a: ^[^oo^;^d^]", name2, name2 = "hash_chain", node_ptr -> node.hash_chain); 3253 end /* print_common_fields */; 3254 3255 end display_node; 3256 3257 display_quadruples: 3258 proc (start, stop); 3259 3260 dcl (start, stop) fixed bin (18); 3261 dcl last fixed bin (18); 3262 3263 dcl (op, i) fixed bin (18); 3264 dcl o ptr; 3265 3266 last = -1; 3267 3268 do op = start repeat o -> operator.next while (last ^= stop & op > 0); 3269 o = addr (quad (op)); 3270 last = op; 3271 3272 if o -> operator.op_code = stat_op 3273 then do; 3274 stat_start = binary (o -> opt_statement.start, 26); 3275 stat_length = binary (o -> opt_statement.length, 9); 3276 call ioa_ 3277 ( 3278 "^/STAT: ^oo ^a start ^d, length ^d 3279 ^/^a^/ 3280 next ^oo, back ^oo 3281 first_op ^oo, prev_op ^oo, obj ^oo", 3282 op, decode_source_id (op, quadruple_base, "0"b), stat_start, stat_length, 3283 substr (source_segment, stat_start + 1, stat_length), binary (o -> opt_statement.next, 18), 3284 binary (o -> opt_statement.back, 18), binary (o -> opt_statement.first_operator, 18), 3285 binary (o -> opt_statement.prev_operator, 18), binary (o -> opt_statement.location, 18)); 3286 3287 ons = ""; 3288 if o -> opt_statement.put_in_profile 3289 then ons = "put_in_profile "; 3290 else if o -> opt_statement.put_in_map 3291 then ons = "put_in_map "; 3292 3293 if o -> opt_statement.referenced_backwards 3294 then ons = ons || "referenced_backwards "; 3295 3296 if o -> opt_statement.referenced_by_assign 3297 then ons = ons || "referenced_by_assign "; 3298 3299 if o -> opt_statement.moved 3300 then ons = ons || "moved "; 3301 3302 if o -> opt_statement.removable 3303 then ons = ons || "removable "; 3304 3305 call ioa_ ("^5x^a", ons); 3306 3307 if o -> opt_statement.flow_unit ^= null 3308 then call ioa_ ("^5xflow_unit: ^p", o -> opt_statement.flow_unit); 3309 3310 if o -> opt_statement.has_operator_list 3311 then call ioa_ ("^5xoperator_list: ^p", o -> opt_statement.operator_list); 3312 3313 if o -> opt_statement.machine_state ^= 0 3314 then call ioa_ ("^5xmachine_state: ^oo", o -> opt_statement.machine_state); 3315 3316 if o -> opt_statement.label ^= 0 3317 then call display_node ((o -> opt_statement.label), just_name, dont_walk); 3318 end; 3319 3320 else do; 3321 if o -> operator.op_code >= lbound (op_names, 1) & o -> operator.op_code <= hbound (op_names, 1) 3322 then call ioa_ ("^/OPERATOR: ^oo ^a^[ FREED^;^]", op, op_names (o -> operator.op_code), 3323 o -> operator.freed); 3324 else call ioa_ ("^/OPERATOR: ^oo ^d^[ FREED^;^]", op, binary (o -> operator.op_code, 8), 3325 o -> operator.freed); 3326 3327 call display_operand ((o -> operator.output)); 3328 3329 do i = 1 to o -> operator.number; 3330 call display_operand ((o -> operator.operand (i))); 3331 end; 3332 end; 3333 end; 3334 3335 return; 3336 3337 3338 display_operand: 3339 proc (content); 3340 3341 dcl content fixed bin (18); 3342 3343 if content < 0 3344 then call ioa_ ("^/COUNT: ^d", content + bias); 3345 else if content > 0 3346 then call display_node (content, just_name, dont_walk); 3347 else call ioa_ ("^/ZERO"); 3348 3349 end display_operand; 3350 3351 end display_quadruples; 3352 3353 end fort_display; 3354 3355 end fort_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/10/88 1336.8 fort_.pl1 >spec>install>MR12.2-1209>fort_.pl1 121 1 11/10/88 1314.2 fort_nodes.incl.pl1 >spec>install>MR12.2-1209>fort_nodes.incl.pl1 123 2 03/27/82 0424.8 fort_opt_nodes.incl.pl1 >ldd>include>fort_opt_nodes.incl.pl1 125 3 03/27/82 0439.3 fort_listing_nodes.incl.pl1 >ldd>include>fort_listing_nodes.incl.pl1 127 4 08/04/86 2015.0 fort_system_constants.incl.pl1 >ldd>include>fort_system_constants.incl.pl1 130 5 08/04/86 2015.0 fort_shared_vars.incl.pl1 >ldd>include>fort_shared_vars.incl.pl1 133 6 03/27/82 0439.3 fort_parse_vars.incl.pl1 >ldd>include>fort_parse_vars.incl.pl1 136 7 03/27/82 0439.4 fort_cg_vars.incl.pl1 >ldd>include>fort_cg_vars.incl.pl1 137 8 03/27/82 0439.4 fort_message_table_.incl.pl1 >ldd>include>fort_message_table_.incl.pl1 139 9 08/06/87 1153.7 fort_options.incl.pl1 >ldd>include>fort_options.incl.pl1 143 10 03/10/77 1345.4 compiler_source_info.incl.pl1 >ldd>include>compiler_source_info.incl.pl1 145 11 10/30/80 1648.7 relocation_bits.incl.pl1 >ldd>include>relocation_bits.incl.pl1 775 12 03/27/82 0437.1 fort_utilities.incl.pl1 >ldd>include>fort_utilities.incl.pl1 12-11 13 03/27/82 0437.8 fort_create_node.incl.pl1 >ldd>include>fort_create_node.incl.pl1 12-37 14 10/30/80 1648.7 relocation_bits.incl.pl1 >ldd>include>relocation_bits.incl.pl1 1801 15 10/26/88 1255.5 std_descriptor_types.incl.pl1 >ldd>include>std_descriptor_types.incl.pl1 1957 16 03/27/82 0439.4 fort_command_structure.incl.pl1 >ldd>include>fort_command_structure.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. a_base parameter pointer dcl 2372 ref 2369 2378 a_count parameter fixed bin(18,0) dcl 2373 ref 2369 2379 a_data_type 000100 automatic fixed bin(4,0) dcl 12-15 set ref 12-40* 12-43 12-43 12-43 12-45 12-45 12-47 12-65 12-81 a_message_number 000104 automatic fixed bin(18,0) dcl 1049 set ref 1073* 1075 1075 1075 1075 1079* 1085 1112 1117 1160 1172 1207 1207 1216 1260 1321 1322 1332* 1338* 1343* 1362 1368 a_node_ptr parameter pointer dcl 1541 ref 1538 1543 a_node_type 000461 automatic fixed bin(4,0) dcl 1061 in procedure "print_message_op" set ref 1544* 1546 1551 1556 1559 1565 1568 1571 a_node_type 000100 automatic fixed bin(18,0) dcl 2443 in procedure "display_node" set ref 2477* 2479 2479 2479 2482* 2487 a_pathname 000100 automatic varying char(256) dcl 886 set ref 891* a_type 000111 automatic fixed bin(17,0) dcl 987 set ref 1017* 1019 1024 1024 1027 a_value based char dcl 781 in procedure "create_char_constant" set ref 796* 801 804 806 811 812 830 851 877* a_value 000102 automatic bit(72) dcl 12-16 in procedure "create_constant" set ref 12-41* 12-51 12-52 12-54 12-54 12-65 12-85 add_to_lib_list 2 003256 automatic entry variable level 2 dcl 132 set ref 709* add_to_lib_list_entry parameter entry variable dcl 108 set ref 91 287* 292 331 348 add_to_lib_list_run 12 003256 automatic entry variable level 2 dcl 132 set ref 292* 348* 706* 709 addr builtin function dcl 12-18 in procedure "create_constant" ref 12-51 12-52 12-54 12-54 12-63 12-80 12-91 addr builtin function dcl 13-17 in procedure "create_node" ref 13-24 13-25 addr builtin function dcl 147 in procedure "fort_" ref 456 505 505 653 711 711 711 711 720 720 729 729 745 745 745 745 761 761 761 761 771 771 771 771 771 771 796 801 804 806 811 812 828 830 847 851 859 877 897 909 924 928 1036 1276 1280 1314 1314 1324 1465 1465 1507 1510 1516 1530 1561 1612 1614 1686 1816 1816 1984 1986 1989 1995 2006 2021 2024 2058 2061 2066 2088 2115 2115 2140 2140 2147 2161 2165 2181 2191 2193 2205 2263 2274 2291 2329 2350 2350 2475 2644 2644 2874 2875 2977 2977 2986 3269 addr_hold 2(18) based bit(18) level 2 packed packed unaligned dcl 1-63 set ref 3245 3245* addrel builtin function dcl 147 ref 1029 1721 1721 2383 address 1 based structure level 2 dcl 1-63 ref 3237 3237 3237 address_in_base 0(21) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3207 addressing_bits 0(14) based structure level 2 in structure "constant" packed packed unaligned dcl 1-256 in procedure "fort_" addressing_bits 0(14) based structure level 2 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" addressing_bits 0(14) based structure level 2 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" aliasable 2(03) based bit(1) level 2 packed packed unaligned dcl 1-844 ref 2532 alignment 0(30) based structure level 3 packed packed unaligned dcl 1-436 all_fields 002004 constant bit(1) initial dcl 1931 set ref 2635* 2688* 2696* 2822* 2953* allocate 0(25) based bit(1) level 4 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" ref 3209 allocate 0(25) based bit(1) level 4 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" set ref 897* allocate_temp_segs based pointer array dcl 188 set ref 456* 653* allocated 0(17) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3199 an_error_level 000462 automatic fixed bin(4,0) dcl 1061 set ref 1085* 1087 1329 1335 1345 1407 an_offset 000430 automatic fixed bin(18,0) dcl 2305 in procedure "display_int_text" set ref 2310* 2312 2314 2315* 2315 2325 2329 2333 2344* 2344 2350 2350 2350 2353* 2353 2353 2358 an_offset parameter fixed bin(18,0) dcl 2444 in procedure "display_node" ref 2440 2463 2490 2490 ansi_77 11(30) based bit(1) level 3 packed packed unaligned dcl 1-753 ref 2995 arg 1 based structure array level 2 dcl 1-130 arg_char_string based char packed unaligned dcl 1055 ref 1124 1303 arg_desc based structure level 1 dcl 1-130 set ref 2434 arg_desc_node constant fixed bin(4,0) initial dcl 4-87 ref 2432 arg_len 000110 automatic fixed bin(17,0) dcl 987 set ref 1010* 1016* 1027 arg_length 000107 automatic fixed bin(18,0) dcl 1051 set ref 1123* 1124 1302* 1303 arg_list_ptr 000100 automatic pointer dcl 982 set ref 1006* 1017* arg_ptr 000102 automatic pointer dcl 982 set ref 1010* 1011 1016* 1022 1029 1030 arg_string 000114 automatic varying char(256) array dcl 1054 set ref 1290* 1291* 1292* 1303* 1308* 1314* 1362* 1362* 1362* 1367* 1367* 1367* 1387 1387 1387 1393* 1393* 1393* array 1(04) based bit(1) array level 4 packed packed unaligned dcl 1-130 ref 3115 array_ref based structure level 1 dcl 1-155 set ref 1901 array_ref_node constant fixed bin(4,0) initial dcl 4-87 ref 1559 array_size 3 based fixed bin(24,0) level 2 dcl 1-383 set ref 2677* 2680* assign_ 000122 constant entry external dcl 1795 ref 1816 assumed_size 0(28) based bit(1) level 2 packed packed unaligned dcl 1-383 ref 2664 attributes 10 based structure level 2 dcl 1-844 auto 0(09) based bit(1) level 3 packed packed unaligned dcl 1-753 ref 3032 auto_zero 11(29) based bit(1) level 3 packed packed unaligned dcl 1-753 ref 3016 automatic 0(33) based bit(1) level 4 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" ref 2850 automatic 11 based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2583 b_value based char dcl 873 ref 877 back 2(18) based bit(18) level 2 packed packed unaligned dcl 2-176 ref 3276 3276 bad_arg 001575 constant char(12) initial dcl 996 set ref 1035 1036 base_regs 112 based structure array level 3 dcl 1-620 based_bit based bit(1) dcl 1663 ref 1730 based_integer based fixed bin(35,0) dcl 1666 ref 1694 baseno builtin function dcl 147 ref 641 644 begin_statement_errors 003642 automatic fixed bin(18,0) dcl 219 set ref 428* 1133 1135 1139 1140* 1152* 1189 1199 1199* 1199 1211 1211* 1219 1223 1224* 1224 1226 1239 1239* 1239 1247 1249 1250* 1250 1252 1419 1421 1424 begin_subprogram_errors 003641 automatic fixed bin(18,0) dcl 217 set ref 428* 1143 1146 1150 1151* 1191 1201 1201* 1201 1230 1230* 1235 1237 1238* 1238 1242 1427 1429 1432 bias constant fixed bin(19,0) initial dcl 4-56 ref 1081 1308 2317 3343 binary builtin function dcl 147 in procedure "fort_" ref 806 821 1117 1618 1619 1630 1642 1760 1984 2004 2025 2027 2062 2064 2330 2331 2333 2333 2333 2333 2382 2382 3274 3275 3276 3276 3276 3276 3276 3276 3276 3276 3276 3276 3324 3324 binary builtin function dcl 12-19 in procedure "create_constant" ref 12-57 bits 41 based structure array level 4 in structure "machine_state" packed packed unaligned dcl 1-620 in procedure "fort_" bits 4 based structure level 2 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" bits 112 based structure array level 4 in structure "machine_state" packed packed unaligned dcl 1-620 in procedure "fort_" bits 3 based structure level 2 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" bits 0(25) based structure level 2 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" bits 0(25) based structure level 2 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" bits 0(25) based structure level 2 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" bits 0(25) based structure level 2 in structure "label" packed packed unaligned dcl 1-530 in procedure "fort_" bits 0(25) based structure level 2 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" bits 0(25) based structure level 2 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" bits 0(25) based structure level 2 in structure "array_ref" packed packed unaligned dcl 1-155 in procedure "fort_" block_name 10 based char level 2 dcl 1-436 set ref 1571 2094 2832* bool builtin function dcl 147 in procedure "fort_" ref 818 bool builtin function dcl 12-20 in procedure "create_constant" ref 12-54 bp 000100 automatic pointer dcl 2374 set ref 2378* 2382 2382 2382 2383* 2383 branched_to 0(34) based bit(1) level 3 packed packed unaligned dcl 1-530 ref 2802 brief 113(11) 000102 automatic bit(1) level 5 in structure "shared_globals" packed packed unaligned dcl 129 in procedure "fort_" set ref 1207 1216 1362 brief 0(19) based bit(1) level 3 in structure "command_structure" packed packed unaligned dcl 1956 in procedure "fort_display" ref 2090 2094 2114 2139 2160 2164 2180 2191 2262 bucket 0(05) based bit(1) level 5 packed packed unaligned dcl 1956 ref 2268 builtin 10(32) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2567 by_compiler 0(35) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2529 call_probe parameter bit(1) dcl 662 ref 658 674 card 11(05) based bit(1) level 4 packed packed unaligned dcl 1-753 ref 2999 cc_offset 000100 automatic fixed bin(18,0) dcl 782 set ref 826* 827 828 830 836* 841* 843 845 847 857 859 862 864 cc_ptr 000102 automatic pointer dcl 783 set ref 828* 830 830 830 836 845 847* 848 849 850 851 852 853 cg_globals 003274 automatic structure level 1 dcl 135 set ref 745 745 761 761 771 771 chain 000101 automatic fixed bin(18,0) dcl 2445 set ref 2642* 2642* 2644 2644 2644 2644* 2646 2682* 2683* 2685 2687 2688 2691 2693 2695 2696 2699 2701 2701 2704* 2871* 2871* 2874* 2874* 2875 2982* 2984 2986 3081* 3083 3084 3085 3093* 3111* 3115 3117 3119 3122* 3122* 3147* 3148 3148* 3148* 3160* 3161 3161 3161 3161 3161* 3170* 3171 3171 3171 3171 3171 3171* char builtin function dcl 12-21 in procedure "create_constant" ref 12-45 12-45 char builtin function dcl 13-17 in procedure "create_node" ref 13-29 13-29 char_constant based structure level 1 dcl 1-316 set ref 841 841 2423 char_constant_length 000100 automatic fixed bin(18,0) unsigned dcl 1-378 set ref 795* 796 801 804 806 811 812 830 830 841 841 850 851 876* 877 877 2419* 2421* 2423 char_constant_node 002016 constant fixed bin(4,0) initial dcl 4-87 set ref 830 841* 1551 2417 char_mode constant fixed bin(4,0) initial dcl 4-106 ref 12-43 848 char_node_offset 000201 automatic fixed bin(18,0) dcl 888 set ref 896* 897 910 924 char_size 10 based fixed bin(20,0) level 4 packed packed unsigned unaligned dcl 1-844 ref 2552 2570 2576 char_string_varing constant fixed bin(17,0) initial dcl 990 ref 1024 character 0(32) based bit(1) level 4 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" ref 2848 character 10(25) based bit(1) level 5 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2549 character_arg 0(06) based structure level 4 packed packed unaligned dcl 1956 character_operand 1 based fixed bin(18,0) level 2 unsigned dcl 1-605 set ref 910 924* 2191 2974 2974* 2977 2977 character_string constant fixed bin(17,0) initial dcl 990 ref 1024 1027 chars 000100 automatic char(4) array dcl 1668 set ref 1756* 1757* 1757 1760 1761* 1765 1765 1765 1765 chars_per_word constant fixed bin(9,0) initial dcl 4-68 ref 876 1753 1754 1766 1766 check 113(21) 000102 automatic bit(1) level 5 packed packed unaligned dcl 129 set ref 510 cleanup 003462 stack reference condition dcl 151 ref 443 clock_ 000046 constant entry external dcl 253 ref 388 code 000100 automatic fixed bin(35,0) dcl 631 in procedure "clean_up" set ref 636* 639* 647* 653* code parameter fixed bin(35,0) dcl 110 in procedure "fort_" set ref 91 308 331 358* 456* 457 545* 551* 554* code parameter fixed bin(35,0) dcl 887 in procedure "add_to_lib_list" set ref 882 892* code 000102 automatic fixed bin(35,0) dcl 950 in procedure "get_next_temp_segment" set ref 952* 954 code 000105 automatic fixed bin(35,0) dcl 986 in procedure "print_message" set ref 1010* 1016* code 0(09) based fixed bin(9,0) level 2 in structure "pointer" packed packed unsigned unaligned dcl 1-672 in procedure "fort_" set ref 3127* command_structure based structure level 1 dcl 1956 command_structure_ptr parameter pointer dcl 1950 ref 1850 1961 2016 2016 2027 2050 2055 2055 2064 2075 2081 2090 2090 2090 2094 2094 2094 2100 2106 2108 2110 2111 2111 2113 2114 2114 2119 2119 2119 2122 2122 2122 2133 2136 2139 2142 2145 2156 2160 2164 2174 2180 2186 2191 2198 2260 2262 2262 2268 2270 2270 2271 2271 2278 2278 2296 2296 2350 common_chain 2 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3054 3054* compile_only 115(02) 000102 automatic bit(1) level 4 packed packed unaligned dcl 129 set ref 288* 291* 322* 350* 706 compiler_name 001640 constant char(8) initial packed unaligned dcl 7-39 set ref 585* compiler_source_info based structure level 1 dcl 10-6 compiler_source_info_version_2 constant fixed bin(17,0) initial dcl 10-16 ref 355 complex 10(23) based bit(1) level 5 packed packed unaligned dcl 1-844 ref 2545 constant based structure level 1 dcl 1-256 in procedure "fort_" set ref 12-74 12-74 1897 constant 11(05) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2593 constant_count 77 000102 automatic fixed bin(17,0) array level 3 dcl 129 set ref 407* 407 407* 407 407* 407 407* 407 12-87* 12-87 855* 855 constant_info 77 000102 automatic structure array level 2 dcl 129 constant_node 002017 constant fixed bin(4,0) initial dcl 4-87 set ref 12-74* 1546 constant_type constant fixed bin(4,0) initial dcl 4-120 ref 12-82 849 content 000431 automatic fixed bin(18,0) dcl 2305 in procedure "display_int_text" set ref 2314* 2317 2317 2320 2323 2325 2327 2348 2358 2358* 2361 2361 2364* content parameter fixed bin(18,0) dcl 3341 in procedure "display_operand" set ref 3338 3343 3343 3345 3345* convert builtin function dcl 147 ref 1694 coordinate 14(25) based fixed bin(17,0) level 2 packed packed unaligned dcl 1-844 set ref 2652 2652* count 000102 automatic fixed bin(18,0) dcl 2375 in procedure "dump_words" set ref 2379* 2381 2382 2382 count 2 003644 automatic fixed bin(18,0) array level 2 in structure "error_msg" dcl 223 in procedure "fort_" set ref 1169* 1169 1172* 1172 1262* 1449 1471 1474 count 1(18) based fixed bin(18,0) level 2 in structure "pointer" packed packed unsigned unaligned dcl 1-672 in procedure "fort_" set ref 3127* count_array 000100 automatic fixed bin(18,0) array dcl 1855 set ref 2200* 2208* 2208 2212 2212* 2216* 2226* 2226 2230* 2230 2236* 2236 2246* 2246 2252 2252* cpu 003632 automatic fixed bin(52,0) dcl 210 set ref 604* 608 608 create_char_constant 1524 000102 automatic entry variable level 2 dcl 129 set ref 700* 739* 755* create_constant 1520 000102 automatic entry variable level 2 dcl 129 set ref 699* 738* 754* create_constant_block 34 003274 automatic entry variable level 2 dcl 135 set ref 743* 759* cref_base 14 000102 automatic pointer level 2 dcl 129 set ref 472* cs 000102 automatic varying char(256) dcl 1669 in procedure "print_constant_value" set ref 1685* 1690* 1694* 1694 1694 1695 1698* 1702* 1702 1703 1706* 1710* 1710 1711 1714* 1718* 1718 1719* 1719 1720* 1720 1721* 1721 1722* 1722 1723 1726* 1730* 1730 1732* 1732 1733 1743* 1745* 1745 1746* 1746 1751* 1769 1772* 1772 1772 1774* 1775* 1779* 1779 1782* 1782 1782 1784 cs 000404 automatic pointer dcl 1941 in procedure "fort_display" set ref 2021* 2023 2037 2040 2048 2058* 2060 2073 2147* 2148 2149 2274* 2279 2294 csi based structure level 1 dcl 141 cu_$arg_count 000114 constant entry external dcl 978 ref 1001 cu_$arg_list_ptr 000112 constant entry external dcl 977 ref 1006 cu_$arg_ptr 000116 constant entry external dcl 979 ref 1010 1016 cu_$decode_entry_value 000050 constant entry external dcl 254 ref 278 287 cur_listing 22 000102 automatic pointer level 2 dcl 129 set ref 478* 479 482 1504 1506 1507* 1507 1507 1507* 1510 1512 1528 1528 1530 1532 cur_statement 67 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 424* 1133 1155 1166 1168 1263 1350 1963 1965* 1971 1974* 1975 1975 1984 1991 1995 1999* 2000 2000 2009 cur_stmnt 0(08) based bit(1) level 4 packed packed unaligned dcl 1956 ref 1961 cur_subprogram 71 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 424* 1143 1143 1177 1269 1269 1269 1269 1276 1283 1504 1507 1512 1986 1989 currentsize builtin function dcl 2392 ref 2409 2414 2426 2434 data_size 000104 automatic fixed bin(17,0) dcl 12-22 set ref 12-47* 12-49 12-87 12-87 12-89 12-89 12-91 12-93 data_type 1 based fixed bin(4,0) array level 3 in structure "arg_desc" packed packed unsigned unaligned dcl 1-130 in procedure "fort_" ref 3122 data_type parameter fixed bin(4,0) dcl 12-15 in procedure "create_constant" ref 12-13 12-40 data_type 0(05) based fixed bin(4,0) level 2 in structure "char_constant" packed packed unsigned unaligned dcl 1-316 in procedure "fort_" set ref 848* data_type 0(05) based fixed bin(4,0) level 2 in structure "node" packed packed unsigned unaligned dcl 1-63 in procedure "fort_" ref 12-65 1682 1682 1687 2506 2710 2767 2779 2828 2879 2896 data_type 0(05) based fixed bin(4,0) level 2 in structure "constant" packed packed unsigned unaligned dcl 1-256 in procedure "fort_" set ref 12-81* data_type_size 001642 constant fixed bin(17,0) initial array dcl 4-115 ref 12-43 12-47 date_string 005325 automatic char(24) packed unaligned dcl 249 set ref 583* 585* date_time_ 000052 constant entry external dcl 256 ref 583 date_time_compiled 40 003274 automatic fixed bin(71,0) level 2 dcl 135 set ref 388* 583* dcl_name 3 based varying char(256) level 2 dcl 1956 set ref 2090 2094 2100* debugging 113(16) 000102 automatic structure level 4 in structure "shared_globals" packed packed unaligned dcl 129 in procedure "fort_" debugging 11(16) based structure level 3 in structure "subprogram" packed packed unaligned dcl 1-753 in procedure "fort_" decimal builtin function dcl 12-23 ref 12-45 12-45 declaration 0(06) based bit(1) level 5 packed packed unaligned dcl 1956 ref 2081 declared_options 3150 000102 automatic structure level 2 dcl 129 set ref 297* 324* 352* declared_ptr parameter pointer dcl 116 ref 91 297 decode_descriptor_ 000120 constant entry external dcl 980 ref 1017 default_is 0(09) based structure level 2 packed packed unaligned dcl 1-753 descrip 1 000024 external static structure array level 2 packed packed unaligned dcl 8-8 set ref 1075 1079 descriptor 11(10) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2603 dim 5 based structure array level 2 dcl 1-383 dimension 12(25) based fixed bin(18,0) level 2 in structure "symbol" packed packed unsigned unaligned dcl 1-844 in procedure "fort_" set ref 2632 2634* 2635 dimension based structure level 1 dcl 1-383 in procedure "fort_" set ref 2426 dimension_node constant fixed bin(4,0) initial dcl 4-87 ref 2426 dimensioned 10(35) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2581 display 0(03) based bit(1) level 5 packed packed unaligned dcl 1956 ref 2106 display_entries$fdisplay 000036 external static entry variable dcl 161 set ref 374* divide builtin function dcl 147 ref 811 2429 do_rounding 11(28) based bit(1) level 3 packed packed unaligned dcl 1-753 ref 3020 dont_update 0(22) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3217 dont_walk 002005 constant bit(1) initial dcl 1931 set ref 2139* 2160* 2164* 2180* 2191* 2283* 2290* 2361* 2635* 2688* 2696* 2822* 2953* 3316* 3345* double_precision 10(22) based bit(1) level 5 packed packed unaligned dcl 1-844 ref 2543 dtm 2 based fixed bin(71,0) level 2 packed packed unaligned dcl 1-693 set ref 2500* dummy_arg 0(31) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2521 dump 0(07) based bit(1) level 4 packed packed unaligned dcl 1956 ref 2133 dump_sw parameter bit(1) dcl 2446 ref 2440 2464 eaq 2 based structure array level 3 in structure "machine_state" dcl 1-620 in procedure "fort_" eaq 0(15) based bit(1) level 4 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" ref 3195 eaq_names 000032 constant char(8) initial array dcl 2447 set ref 3142* eaq_regs 000026 constant char(4) initial array dcl 2450 set ref 3142* 3155* element_count 2 based fixed bin(24,0) level 2 dcl 1-383 set ref 2674 2674* element_size 15(07) based fixed bin(17,0) level 2 packed packed unaligned dcl 1-844 set ref 2614 2614* end_input_to 10(18) based fixed bin(18,0) level 2 in structure "temporary" packed packed unsigned unaligned dcl 1-1005 in procedure "fort_" set ref 2762 2762* end_input_to 10(18) based fixed bin(18,0) level 2 in structure "array_ref" packed packed unsigned unaligned dcl 1-155 in procedure "fort_" set ref 2950 2950* ends_do_loop 0(35) based bit(1) level 3 packed packed unaligned dcl 1-530 ref 2804 entry parameter fixed bin(18,0) dcl 1444 ref 1441 1449 1452 1462 1465 1465 1471 1474 entry_info 7 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3074 3074* entry_point 10(30) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2563 entry_value 10(27) based bit(1) level 5 packed packed unaligned dcl 1-844 ref 2557 equiv_chain 2(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3054 3054* equivalenced 11(03) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2589 error_level 3 003274 automatic fixed bin(17,0) level 2 dcl 135 set ref 428* 510 543 549 1407* 1407 1409 1411 error_messages 113(11) 000102 automatic structure level 4 packed packed unaligned dcl 129 error_msg 003644 automatic structure array level 1 dcl 223 set ref 1184 1196* 1196 1227* 1227 1243* 1243 1253* 1253 error_table_$translation_aborted 000040 external static fixed bin(35,0) dcl 164 ref 358 545 error_table_$translation_failed 000042 external static fixed bin(35,0) dcl 166 ref 551 error_text based structure level 1 dcl 3-24 set ref 1534 error_text_length 000101 automatic fixed bin(17,0) dcl 3-29 set ref 1393* 1485* 1526 1534 estimated_length parameter fixed bin(18,0) dcl 1500 ref 1497 1518 even 0(30) based bit(1) level 4 packed packed unaligned dcl 1-436 ref 2844 everything 000102 automatic bit(1) dcl 2452 set ref 2464* 2465 2496 2510 2660 2723 2771 2783 2835 2884 2906 2958 2967 2989 3106 executable 0(31) based bit(1) level 4 packed packed unaligned dcl 1-530 ref 2788 expon_char parameter char(1) dcl 1792 ref 1788 1803 1835 ext_code_generator 000104 constant entry external dcl 736 ref 745 ext_listing_generator 000110 constant entry external dcl 768 ref 771 ext_parse 000076 constant entry external dcl 697 ref 711 external 10(31) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2565 file 000122 automatic fixed bin(8,0) level 2 packed packed unsigned unaligned dcl 1606 set ref 1642 file_list 117 000102 automatic structure array level 3 dcl 129 first 6 based fixed bin(18,0) level 3 in structure "subprogram" packed packed unsigned unaligned dcl 1-753 in procedure "fort_" set ref 3071 3071* first 13 based fixed bin(18,0) array level 3 in structure "subprogram" packed packed unsigned unaligned dcl 1-753 in procedure "fort_" ref 2279 3083 first_block_constant defined fixed bin(18,0) dcl 5-153 set ref 407* first_char_constant defined fixed bin(18,0) dcl 5-149 set ref 407* 2174 2177 first_constant 100 000102 automatic fixed bin(18,0) array level 3 dcl 129 set ref 407* 407 407* 407 407* 407 407* 407 12-89 12-89* 857 857* 2159 2159 2163 2163 2167 2167 2167 2167 2174 2174 2177 2177 first_dw_constant defined fixed bin(18,0) dcl 5-145 set ref 407* 2163 2167 first_element 3(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-436 set ref 2865 2865* 2871 first_entry_name 75 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 426* first_error 6 based fixed bin(18,0) level 2 unsigned dcl 3-12 set ref 1528* first_label 4 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3062 3062* first_lib_name 1 003274 automatic fixed bin(18,0) level 2 unsigned dcl 135 set ref 407* 902 904 926* 2186 2189 first_operator 1 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 2-176 ref 3276 3276 first_polish 5 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 2023 3065 3065* first_quad 10 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 2060 2148 3068 3068* first_subprogram 72 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 424* 1269 2020 2057 2145 2260 2273 first_symbol 3 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3059 3059* first_time 000410 automatic bit(1) dcl 1944 set ref 2018* 2023 2045* 2276* 2283 2285* first_word_constant defined fixed bin(18,0) dcl 5-141 set ref 407* 2159 2167 fixed builtin function dcl 147 ref 1075 1321 1322 fixed_bin based fixed bin(18,0) dcl 985 ref 1011 1022 1029 flags_for_message 1 000024 external static structure array level 3 packed packed unaligned dcl 8-8 flow_unit 6 based pointer level 2 packed packed unaligned dcl 2-176 set ref 3307 3307* fold 11(04) based bit(1) level 4 packed packed unaligned dcl 1-753 ref 3003 format 0(30) based bit(1) level 4 packed packed unaligned dcl 1-530 ref 2788 2792 format_var 4 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-530 set ref 2819 2821* 2822 formating_string based char level 2 packed packed unaligned dcl 1064 set ref 1367* 1393 fort_converter 000100 constant entry external dcl 718 ref 720 fort_defaults_$options_string 000054 constant entry external dcl 257 ref 505 fort_message_table$fort_message_table 000024 external static structure level 1 unaligned dcl 8-8 set ref 1324 fort_optimizer 000102 constant entry external dcl 727 ref 729 fort_optimizing_cg 000106 constant entry external dcl 752 ref 761 fortran_declared based structure level 1 dcl 9-91 ref 297 fortran_options based structure level 1 dcl 9-40 ref 364 fortran_severity_ 000044 external static fixed bin(35,0) dcl 229 set ref 1409* fpn_prec 000254 automatic fixed bin(35,0) dcl 1797 set ref 1805* 1811* 1816* fpn_ptr parameter pointer dcl 1793 set ref 1788 1816* fpn_type 000255 automatic fixed bin(17,0) dcl 1798 set ref 1806* 1808* 1812* 1814* 1816 freed 0(10) based bit(1) level 2 packed packed unaligned dcl 2-144 set ref 3321* 3324* frozen_for_do 0(34) based bit(1) level 3 packed packed unaligned dcl 1-1005 ref 2738 ft 000103 automatic fixed bin(18,0) dcl 2453 set ref 3083* 3087 3093* ft_double_dtype constant fixed bin(17,0) initial dcl 15-96 ref 1808 ft_hex_double_dtype constant fixed bin(17,0) initial dcl 15-96 ref 1806 ft_hex_real_dtype constant fixed bin(17,0) initial dcl 15-96 ref 1812 ft_real_dtype constant fixed bin(17,0) initial dcl 15-96 ref 1814 function 10(28) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2559 general 6(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-844 set ref 2620 2620* get_group_id_ 000056 constant entry external dcl 259 ref 394 get_next_source_seg 6 003256 automatic entry variable level 2 dcl 132 set ref 279* 282* 320* 347* get_next_source_seg_entry parameter entry variable dcl 111 set ref 91 278* 282 331 347 get_next_temp_segment 1534 000102 automatic entry variable level 2 dcl 129 set ref 702* get_temp_segment_ 000032 constant entry external dcl 157 ref 952 get_temp_segments_ 000026 constant entry external dcl 153 ref 456 given_ename 1 based varying char(32) level 2 dcl 141 ref 378 380 380 380 380 380 383 384 global 41 based bit(1) array level 5 in structure "machine_state" packed packed unaligned dcl 1-620 in procedure "fort_" set ref 3161* global 112 based bit(1) array level 5 in structure "machine_state" packed packed unaligned dcl 1-620 in procedure "fort_" set ref 3171* globally_assigned 0(24) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3221 has_address 0(35) based bit(1) level 3 packed packed unaligned dcl 1-155 ref 2911 has_array_size 0(24) based bit(1) level 2 packed packed unaligned dcl 1-383 ref 2677 has_constant_value 2(04) based bit(1) level 2 packed packed unaligned dcl 1-844 ref 2534 has_dim_sizes 0(25) based bit(1) level 2 packed packed unaligned dcl 1-383 ref 2701 has_operator_list 4(05) based bit(1) level 3 packed packed unaligned dcl 2-176 ref 3310 has_parameters 0(15) based bit(1) level 2 packed packed unaligned dcl 1-753 ref 3044 has_virtual_origin 0(23) based bit(1) level 2 packed packed unaligned dcl 1-383 ref 2669 hash_chain 2 based fixed bin(18,0) level 2 in structure "pointer" dcl 1-672 in procedure "fort_" set ref 3127* hash_chain 3(18) based fixed bin(18,0) level 2 in structure "node" packed packed unsigned unaligned dcl 1-63 in procedure "fort_" set ref 12-69 12-78* 836 845* 3251 3251* hash_index 000104 automatic fixed bin(18,0) dcl 784 in procedure "create_char_constant" set ref 801* 806* 821* 826 843 843 hash_index 000105 automatic fixed bin(17,0) dcl 12-24 in procedure "create_constant" set ref 12-57* 12-61 12-76 12-76 hash_table based fixed bin(35,0) array dcl 179 in procedure "fort_" set ref 826 843 843* hash_table based fixed bin(35,0) array dcl 12-25 in procedure "create_constant" set ref 12-61 12-76 12-76* hash_table_size 032705 constant fixed bin(17,0) initial dcl 12-26 in procedure "create_constant" ref 12-57 hash_table_size 032705 constant fixed bin(17,0) initial dcl 178 in procedure "fort_" ref 179 12-25 422 821 2085 2110 2136 2204 2358 2469 hbound builtin function dcl 147 in procedure "fort_" ref 577 577 578 579 580 581 592 595 618 1075 1079 1184 1682 2211 2234 2250 2271 2323 2397 2479 3081 3147 3321 hbound builtin function dcl 12-27 in procedure "create_constant" ref 12-43 hcs_$terminate_noname 000070 constant entry external dcl 264 ref 636 hcs_$usage_values 000072 constant entry external dcl 266 ref 371 577 667 header based structure level 1 dcl 1-436 set ref 2414 header_line 000417 automatic varying char(128) dcl 1057 set ref 1331* 1332* 1332 1337* 1338* 1338 1342* 1343* 1343 1344* 1344 1345* 1345 1350* 1350 1357* 1387 1393* 1458* 1460* 1464* 1464 1465* 1465 1466* 1466 1469* 1469 1471* 1471 1474* 1474 1475* 1475 1478* 1483 1485* header_node constant fixed bin(4,0) initial dcl 4-87 ref 1571 2094 2412 hfp 114(04) 000102 automatic bit(1) level 4 packed packed unaligned dcl 129 set ref 1806 1812 i 000102 automatic fixed bin(18,0) dcl 3263 in procedure "display_quadruples" set ref 3329* 3330* i 000105 automatic fixed bin(18,0) dcl 786 in procedure "create_char_constant" set ref 817* 818* i 000107 automatic fixed bin(17,0) dcl 987 in procedure "print_message" set ref 1015* 1016* 1017* 1021 1022 1026 1027 1029 1030 1034 1035 1036* i 003524 automatic fixed bin(18,0) dcl 193 in procedure "fort_" set ref 396* 397 397* 400 595* 599 604 608 608 608 608 608 608 612* i 000114 automatic fixed bin(17,0) dcl 2459 in procedure "display_node" set ref 3140* 3142 3142 3142 3148 3148* i 000101 automatic fixed bin(17,0) dcl 632 in procedure "clean_up" set ref 635* 636* i 000103 automatic fixed bin(18,0) dcl 2375 in procedure "dump_words" set ref 2381* 2382 2382* i 000106 automatic fixed bin(18,0) dcl 1051 in procedure "print_message_op" set ref 1135* 1136* 1146* 1147* 1159* 1160 1160 1166 1168 1169 1169 1172 1172* 1195* 1196 1196* 1226* 1227 1227* 1242* 1243 1243* 1252* 1253 1253* 1296* 1300 1302 1303 1303 1308 1308 1308 1314 1314 1314* 1421* 1422* 1429* 1430* 1435* 1436* 1577 i 000414 automatic fixed bin(18,0) dcl 1952 in procedure "fort_display" set ref 2220* 2221 2223 2224* 2224 2239* 2239 2242* 2242 2242 2250* 2252 2252 2252* 2278* 2279 2286* i 000203 automatic fixed bin(18,0) dcl 1670 in procedure "print_constant_value" set ref 1753* 1754 1756* i 000121 automatic fixed bin(18,0) dcl 1605 in procedure "decode_source_id" set ref 1618* 1619* 1622 1625* 1628* 1630* 1632 1637* 1640* 1642* 1644 1647* id_line 000100 automatic varying char(64) dcl 1604 set ref 1608* 1624* 1624 1625* 1625 1632* 1632 1636* 1636 1637* 1637 1646* 1646 1647* 1647 1653* 1653 1654* 1654 1657 ignore_articulation_blocks 11(26) based bit(1) level 4 packed packed unaligned dcl 1-753 ref 3006 in_clean_up constant fixed bin(17,0) initial dcl 235 set ref 571* in_code_generator constant fixed bin(17,0) initial dcl 235 set ref 527* 533* in_common 11(02) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2587 in_common 0(35) based bit(1) level 4 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" ref 1571 2094 2832 2854 in_converter constant fixed bin(17,0) initial dcl 235 set ref 517* in_equiv_stmnt 11(08) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2599 in_listing_generator constant fixed bin(17,0) initial dcl 235 set ref 564* in_optimizer constant fixed bin(17,0) initial dcl 235 set ref 523* in_parse constant fixed bin(17,0) initial dcl 235 set ref 495* incl_count 116 000102 automatic fixed bin(17,0) level 3 dcl 129 set ref 428* 635 incl_data 116 000102 automatic structure level 2 dcl 129 incl_ptr 121 000102 automatic pointer array level 4 packed packed unaligned dcl 129 set ref 636 increment_polish_op constant fixed bin(18,0) initial dcl 4-197 ref 2242 2348 index builtin function dcl 147 ref 396 index_regs 41 based structure array level 3 dcl 1-620 indicators_valid 37 based fixed bin(18,0) level 3 dcl 1-620 ref 3155 3155 initial 13(07) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-844 set ref 2639 2641* 2642 initial_subprogram 4(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-693 set ref 2500* initialed 0(29) based bit(1) level 4 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" ref 2842 initialed 0(29) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2517 initialization constant fixed bin(17,0) initial dcl 235 ref 362 input_lng 101 based fixed bin(21,0) level 2 dcl 141 ref 2343 2343 3276 3276 input_pointer 102 based pointer level 2 in structure "csi" dcl 141 in procedure "fort_" ref 2343 2343 3276 3276 input_pointer 102 based pointer level 2 in structure "compiler_source_info" dcl 10-6 in procedure "fort_" set ref 939* int_base parameter pointer dcl 1601 ref 1597 1612 integer 10(20) based bit(1) level 5 packed packed unaligned dcl 1-844 ref 2539 intermediate_base 003470 automatic pointer dcl 176 set ref 462* 521* 1350* 1969 invariant 0(31) based bit(1) level 3 in structure "array_ref" packed packed unaligned dcl 1-155 in procedure "fort_" ref 2920 invariant 0(31) based bit(1) level 3 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" ref 2730 ioa_ 000060 constant entry external dcl 260 ref 585 608 618 621 689 1280 1357 1362 1367 1478 1771 1774 1965 1974 1999 2050 2075 2100 2126 2167 2174 2186 2202 2212 2218 2252 2286 2296 2317 2320 2325 2333 2338 2340 2342 2343 2358 2364 2382 2399 2471 2479 2482 2490 2500 2506 2608 2611 2614 2617 2620 2623 2626 2629 2634 2641 2644 2649 2652 2655 2664 2667 2669 2672 2674 2677 2680 2683 2687 2691 2695 2699 2701 2704 2710 2714 2717 2720 2743 2746 2749 2753 2756 2759 2762 2767 2779 2809 2814 2821 2828 2832 2859 2862 2865 2868 2874 2879 2896 2900 2903 2932 2935 2938 2941 2944 2947 2950 2962 2971 2974 2977 2984 2986 2993 3028 3047 3050 3054 3059 3062 3065 3068 3071 3074 3077 3089 3093 3097 3110 3122 3127 3135 3139 3142 3148 3155 3159 3161 3169 3171 3180 3232 3234 3237 3240 3243 3245 3248 3251 3276 3305 3307 3310 3313 3321 3324 3343 3347 ioa_$nnl 000062 constant entry external dcl 261 ref 676 1375 ioa_$rsnp 000064 constant entry external dcl 262 ref 1393 1485 1765 irreducible 0(32) based bit(1) level 3 in structure "array_ref" packed packed unaligned dcl 1-155 in procedure "fort_" ref 2922 irreducible 0(32) based bit(1) level 3 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" ref 2732 is_addressable 0(14) based bit(1) level 3 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" ref 3193 is_addressable 0(14) based bit(1) level 3 in structure "constant" packed packed unaligned dcl 1-256 in procedure "fort_" set ref 12-83* is_addressable 0(14) based bit(1) level 3 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" set ref 852* is_fast 115 000102 automatic bit(1) level 4 packed packed unaligned dcl 129 set ref 301* 323* 351* is_string 6 003274 automatic bit(1) array level 4 dcl 135 set ref 1021* 1026* 1034* 1082* 1120 1300 item 000417 automatic fixed bin(18,0) dcl 1953 set ref 2023* 2023* 2024 2042* 2060* 2060* 2061 2070* j 000106 automatic fixed bin(18,0) dcl 786 in procedure "create_char_constant" set ref 811* 812 814 814 817 j 000204 automatic fixed bin(18,0) dcl 1670 in procedure "print_constant_value" set ref 1759* 1760 1761* just_name 002005 constant bit(1) initial dcl 1931 set ref 2283* 2290* 2361* 3316* 3345* k 000107 automatic fixed bin(18,0) dcl 786 in procedure "create_char_constant" set ref 812* 814 814 k 000205 automatic fixed bin(18,0) dcl 1670 in procedure "print_constant_value" set ref 1760* 1761 1761 1765* 1769 1779 l 000206 automatic fixed bin(18,0) dcl 1670 set ref 1754* 1756 1759 1765 1765 1766 1766 1766 label based structure level 1 dcl 1-530 in procedure "fort_" set ref 1898 label 0(18) based fixed bin(18,0) level 2 in structure "opt_statement" packed packed unsigned unaligned dcl 2-176 in procedure "fort_" ref 3316 3316 label_node constant fixed bin(4,0) initial dcl 4-87 ref 1568 label_value 10(26) based bit(1) level 5 packed packed unaligned dcl 1-844 ref 2555 large_address 0(20) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3205 large_offset 0(34) based bit(1) level 3 packed packed unaligned dcl 1-155 ref 2927 last 13(18) based fixed bin(18,0) array level 3 in structure "subprogram" packed packed unsigned unaligned dcl 1-753 in procedure "fort_" ref 3084 last 000100 automatic fixed bin(18,0) dcl 3261 in procedure "display_quadruples" set ref 3266* 3268 3270* last 6(18) based fixed bin(18,0) level 3 in structure "subprogram" packed packed unsigned unaligned dcl 1-753 in procedure "fort_" set ref 3071 3071* last_block_constant defined fixed bin(18,0) dcl 5-154 set ref 407* last_char_constant defined fixed bin(18,0) dcl 5-150 set ref 407* last_constant 101 000102 automatic fixed bin(18,0) array level 3 dcl 129 set ref 407* 407 407* 407 407* 407 407* 407 12-91 12-93* 859 862* last_dw_constant defined fixed bin(18,0) dcl 5-146 set ref 407* last_dynamic_temp 163 based fixed bin(18,0) level 3 dcl 1-620 set ref 3180 3180* last_element 4 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-436 set ref 2868 2868* last_entry_name 76 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 426* last_error 7 based fixed bin(18,0) level 2 unsigned dcl 3-12 set ref 1528 1530 1532* last_error_statement 003640 automatic fixed bin(18,0) dcl 215 set ref 431* 1133 1155* last_error_subprogram 003637 automatic fixed bin(18,0) dcl 213 set ref 428* 1143 1177* 1269 1283* last_label 4(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3062 3062* last_lib_name 2 003274 automatic fixed bin(18,0) level 2 unsigned dcl 135 set ref 407* 926 928 930* last_phase 003636 automatic fixed bin(18,0) dcl 211 set ref 593* 604 608 612* last_polish 5(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 1986 1989 2037 2040 3065 3065* last_quad 10(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3068 3068* last_subprogram 73 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 424* 1269 last_symbol 3(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3059 3059* last_word_constant defined fixed bin(18,0) dcl 5-142 set ref 407* lbound builtin function dcl 147 ref 2250 3321 length 7 based fixed bin(24,0) level 2 in structure "array_ref" dcl 1-155 in procedure "fort_" set ref 2941 2941* length parameter fixed bin(17,0) dcl 13-12 in procedure "create_node" ref 13-10 13-20 13-23 13-24 length 12 based fixed bin(24,0) level 2 in structure "temporary" dcl 1-1005 in procedure "fort_" set ref 2749 2749* length 2(27) based bit(9) level 2 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 2331 length 6 based fixed bin(24,0) level 2 in structure "header" dcl 1-436 in procedure "fort_" set ref 2859 2859* length 1(09) 000024 external static fixed bin(8,0) array level 3 in structure "fort_message_table$fort_message_table" packed packed unaligned dcl 8-8 in procedure "fort_" set ref 1075 1321 length 3(27) based bit(9) level 2 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 3275 length 1 based fixed bin(17,0) level 2 in structure "error_text" dcl 3-24 in procedure "fort_" set ref 1393 1393 1485 1485 1518* 1526* length 4 based fixed bin(18,0) level 2 in structure "char_constant" packed packed unsigned unaligned dcl 1-316 in procedure "fort_" set ref 830 830 850* 851 1740 1745 1753 1754 1756 2421 2879* length builtin function dcl 147 in procedure "fort_" ref 380 380 380 392 397 795 801 804 811 812 1035 1387 1387 1387 1387 1483 1483 1769 1772 1782 1821 1824 1827 1830 1832 2429 level 1(05) 000024 external static fixed bin(3,0) array level 3 packed packed unaligned dcl 8-8 set ref 1075 1085 1453 library based structure level 1 dcl 1-605 set ref 922 922 1903 library_node 001747 constant fixed bin(4,0) initial dcl 4-87 set ref 922* line 3(08) based bit(14) level 3 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 2064 line 0(08) 000122 automatic bit(14) level 2 in structure "source_id" packed packed unaligned dcl 1606 in procedure "decode_source_id" set ref 1616 1619 1630 line 2(08) based bit(14) level 3 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 2027 list_char_constants 0(15) based bit(1) level 4 packed packed unaligned dcl 1956 ref 2174 list_lib_names 0(16) based bit(1) level 4 packed packed unaligned dcl 1956 ref 2186 list_subprograms 0(09) based bit(1) level 4 packed packed unaligned dcl 1956 ref 2260 list_word_consts 0(13) based bit(1) level 4 packed packed unaligned dcl 1956 ref 2156 listing 113(07) 000102 automatic structure level 4 packed packed unaligned dcl 129 set ref 365 listing_base 20 000102 automatic pointer level 2 dcl 129 set ref 474* 478 1507 1510 1516 1530 listing_info based structure level 1 dcl 3-12 set ref 479* 482 listing_seg based fixed bin(17,0) array dcl 3-22 set ref 1507 1510 1516 1530 location 5 based fixed bin(24,0) level 2 in structure "temporary" dcl 1-1005 in procedure "fort_" set ref 2743 2743* location 1(18) based bit(18) level 2 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 2333 2333 location 5 based bit(18) level 2 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 3276 3276 location 5 based fixed bin(24,0) level 2 in structure "symbol" dcl 1-844 in procedure "fort_" set ref 2608 2608* location 5 based fixed bin(24,0) level 2 in structure "header" dcl 1-436 in procedure "fort_" set ref 2862 2862* location 5 based fixed bin(24,0) level 2 in structure "array_ref" dcl 1-155 in procedure "fort_" set ref 2932 2932* logical 10(24) based bit(1) level 5 packed packed unaligned dcl 1-844 ref 2547 loop_end 5(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-530 set ref 2809 2809* loop_ref_count 4(18) based fixed bin(17,0) level 2 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" set ref 2611 2611* loop_ref_count 4(18) based fixed bin(17,0) level 2 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" set ref 2746 2746* loop_vector_p 55 based pointer level 2 packed packed unaligned dcl 1-753 set ref 3097* lower 0(09) based bit(1) array level 3 packed packed unaligned dcl 1-383 ref 2685 lower_bound 5 based fixed bin(24,0) array level 3 dcl 1-383 set ref 2687* 2688 2691* ls 000104 automatic fixed bin(18,0) dcl 2453 set ref 3084* 3087 3093* ltrim builtin function dcl 12-28 in procedure "create_constant" ref 12-45 12-45 ltrim builtin function dcl 13-17 in procedure "create_node" ref 13-29 13-29 ltrim builtin function dcl 1671 in procedure "print_constant_value" ref 1694 1817 lvl 000504 automatic fixed bin(18,0) dcl 1445 set ref 1453* 1455 1458 1478 machine_state 5(18) based fixed bin(18,0) level 2 in structure "opt_statement" packed packed unsigned unaligned dcl 2-176 in procedure "fort_" set ref 3313 3313* machine_state based structure level 1 dcl 1-620 in procedure "fort_" set ref 1907 map 6 based structure level 2 packed packed unaligned dcl 1-753 mask 001600 constant bit(36) initial array dcl 790 ref 814 max builtin function dcl 147 ref 1407 2110 2111 2270 max_error_level constant fixed bin(17,0) initial dcl 4-64 ref 1335 1411 max_length 003525 automatic fixed bin(19,0) dcl 194 set ref 302* 325* 353* 413 max_operators 56(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3097* max_sym 60 based fixed bin(18,0) level 2 dcl 1-753 set ref 3097* message_length 000112 automatic fixed bin(18,0) dcl 1051 set ref 1321* 1367 1367 1387 1393 message_number 4 003274 automatic fixed bin(18,0) level 3 dcl 135 set ref 1011* 1073 1081 message_offset 000113 automatic fixed bin(18,0) dcl 1051 set ref 1322* 1367 1393 message_printed 005304 automatic bit(550) initial dcl 232 set ref 232* 1362 1368* message_structure 4 003274 automatic structure level 2 dcl 135 meter_info 003532 automatic structure level 1 dcl 200 set ref 369* min builtin function dcl 1672 in procedure "print_constant_value" ref 1754 min builtin function dcl 147 in procedure "fort_" ref 2271 2382 2382 misc_attributes 10(28) based structure level 3 packed packed unaligned dcl 1-844 mod builtin function dcl 147 in procedure "fort_" ref 821 mod builtin function dcl 12-29 in procedure "create_constant" ref 12-57 mod_2_sum 000111 automatic bit(36) dcl 787 in procedure "create_char_constant" set ref 809* 818* 818 821 mod_2_sum 000106 automatic bit(36) dcl 12-30 in procedure "create_constant" set ref 12-51* 12-54* 12-57 mode 10(20) based structure level 4 packed packed unaligned dcl 1-844 mode_bits 10 based structure level 3 packed packed unaligned dcl 1-844 mode_names 000270 constant char(24) initial array packed unaligned dcl 1911 set ref 2506* 2710* 2767* 2779* 2828* 2879* 2896* 3122* moved 4(06) based bit(1) level 3 packed packed unaligned dcl 2-176 ref 3299 ms 2 based structure level 2 dcl 1-620 ms_ref_count 11(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 1-1005 set ref 2717 2717* msg 000505 automatic fixed bin(18,0) dcl 1446 in procedure "print_message_summary" set ref 1452* 1453 1478* 1485* msg parameter char packed unaligned dcl 686 in procedure "abort_compiler" set ref 683 689* msg_table_len 003643 automatic fixed bin(18,0) dcl 221 set ref 428* 1135 1139* 1146 1150* 1159 1184 1184* 1184 1195 1211 1213 1219 1226 1242 1252 1257 1421 1424* 1429 1432* 1435 multiple_entry 0(13) based bit(1) level 2 packed packed unaligned dcl 1-753 ref 3040 must_be 1(04) based structure array level 3 packed packed unaligned dcl 1-130 n 000411 automatic fixed bin(18,0) dcl 1946 set ref 2204* 2204* 2205* 2209 2211* 2212 2212 2212* 2223* 2226 2230 2234 2236 2236 2239 2242 n_args 0(05) based fixed bin(12,0) level 2 packed packed unaligned dcl 1-130 set ref 2434 3110* 3111 n_loops 56 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3097 3097* n_ptr parameter pointer dcl 1673 ref 1660 1680 name 20 based char level 2 in structure "symbol" dcl 1-844 in procedure "fort_" set ref 1280* 1562 1565 2090 2506* 2874* 2986* name 2 based fixed bin(17,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" ref 3142 name 4(18) based fixed bin(17,0) level 2 in structure "label" packed packed unaligned dcl 1-530 in procedure "fort_" set ref 1568 2779* name2 parameter char packed unaligned dcl 3230 set ref 3227 3251* 3251 name_length 4(18) based fixed bin(17,0) level 2 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" ref 1571 2094 2414 2832 2832 name_length 14(07) based fixed bin(17,0) level 2 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 1280 1280 1562 1565 2090 2409 2506 2506 2874 2874 2986 2986 named_constant 11(06) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2595 namelist 10(34) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2579 2642 namelist_used 0(14) based bit(1) level 2 packed packed unaligned dcl 1-753 ref 3042 nargs 000106 automatic fixed bin(17,0) dcl 987 set ref 1001* 1002 1015 ncpu 2 003532 automatic fixed bin(52,0) array level 3 dcl 200 set ref 371* 577* 592 592 599 604 604 667* ndims 000112 automatic fixed bin(17,0) dcl 987 set ref 1017* need_PS 0(11) based bit(1) level 2 packed packed unaligned dcl 1-753 ref 3036 need_hdr parameter bit(1) dcl 1674 ref 1660 1690 1698 1706 1714 1726 1743 1746 need_prologue 0(12) based bit(1) level 2 packed packed unaligned dcl 1-753 ref 3038 needs_descriptors 0(33) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2525 needs_pointer 0(18) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3201 new_induction_var 2(05) based bit(1) level 2 packed packed unaligned dcl 1-844 ref 2536 new_phase parameter fixed bin(17,0) dcl 661 ref 658 680 new_slot 000111 automatic fixed bin(18,0) dcl 1051 set ref 1213* 1219* 1223* 1230 1237* 1249* 1257* 1260 1261 1262 1263 next 2 based bit(18) level 2 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 2004 2062 3276 3276 next 1 based pointer level 2 in structure "machine_state" packed packed unaligned dcl 1-620 in procedure "fort_" set ref 3135 3135* next 1 based fixed bin(18,0) level 2 in structure "listing_info" unsigned dcl 3-12 in procedure "fort_" set ref 1507 1510 next 1 based bit(18) level 2 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 1984 2025 2333 2333 next 3 based fixed bin(18,0) level 2 in structure "node" packed packed unsigned unaligned dcl 1-63 in procedure "fort_" set ref 2291 3248 3248* next 4 based fixed bin(18,0) level 2 in structure "source" packed packed unsigned unaligned dcl 1-693 in procedure "fort_" set ref 2500* next based fixed bin(18,0) level 2 in structure "error_text" unsigned dcl 3-24 in procedure "fort_" set ref 1530* next 1 based fixed bin(18,0) level 2 in structure "operator" packed packed unsigned unaligned dcl 2-144 in procedure "fort_" ref 3333 next_constant 3 based fixed bin(18,0) level 2 in structure "constant" packed packed unsigned unaligned dcl 1-256 in procedure "fort_" set ref 12-91* 2161 2165 next_constant 3 based fixed bin(18,0) level 2 in structure "char_constant" packed packed unsigned unaligned dcl 1-316 in procedure "fort_" set ref 859* 2181 next_free parameter fixed bin(18,0) dcl 947 set ref 943 961* next_free_array_ref 46 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 417* next_free_listing 44 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 482* 1516 1528 1530 1532 1534* 1534 next_free_object 43 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 419* 538 next_free_operand 42 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 422* 579 669 13-20 13-22 13-23* 13-23 2085 2136 2204 2361 2469 next_free_opt 50 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 420* 581 671 next_free_polish 41 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 420* 578 668 1986 2037 2142 2221 next_free_quad 45 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 420* 580 670 next_free_temp 47 000102 automatic fixed bin(18,0) level 2 dcl 129 set ref 417* next_library_node 0(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-605 set ref 912 928* 2193 2971 2971* next_loc 14 based fixed bin(18,0) array level 3 dcl 1-753 ref 3085 next_member 7(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-844 set ref 2626 2626* 2875 next_one 000416 automatic fixed bin(18,0) dcl 1953 set ref 2025* 2035 2046 2062* 2066 2066 2068 2072 next_subprogram 1(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 2048 2073 2149 2263 2294 3050 3050* no_value_stored 0(29) based bit(1) level 3 packed packed unaligned dcl 1-316 ref 1736 2419 2889 node based structure level 1 dcl 1-63 node_names 000350 constant char(24) initial array packed unaligned dcl 1882 set ref 2211 2212* 2479 2479* node_offset 000106 automatic fixed bin(18,0) dcl 2454 in procedure "display_node" set ref 2463* 2469 2469 2471* 2475 2479* 2482* node_offset 003472 automatic fixed bin(18,0) dcl 181 in procedure "fort_" set ref 904* 908 909 912* 922* 924 926 928 930 node_offset 000107 automatic fixed bin(17,0) dcl 12-31 in procedure "create_constant" set ref 12-61* 12-62 12-63 12-65 12-69* 12-74* 12-76 12-78 12-80 12-89 12-91 12-93 12-95 node_ptr 000110 automatic pointer dcl 12-32 in procedure "create_constant" set ref 12-63* 12-65 12-65 12-69 12-78 12-80* 12-81 12-82 12-83 12-84 12-85 node_ptr 000100 automatic pointer dcl 1047 in procedure "print_message_op" set ref 1276* 1277 1280 1506* 1507 1543* 1544 1548* 1553* 1561* 1561 1562 1565 1568 1571 1571 node_ptr 003474 automatic pointer dcl 184 in procedure "fort_" set ref 909* 910 912 2088* 2090 2090 2094 2094 2094 2098* 2205* 2206 2209* 2271 node_ptr 000110 automatic pointer dcl 2455 in procedure "display_node" set ref 2475* 2477 2500 2500 2500 2500 2500 2506 2506 2506 2517 2519 2521 2523 2525 2527 2529 2532 2534 2536 2539 2541 2543 2545 2547 2549 2552 2555 2557 2559 2561 2563 2565 2567 2570 2573 2576 2579 2581 2583 2585 2587 2589 2591 2593 2595 2597 2599 2601 2603 2608 2608 2611 2611 2614 2614 2617 2617 2620 2620 2623 2623 2626 2626 2629 2629 2632 2634 2635 2639 2641 2642 2642 2649 2649 2652 2652 2655 2655 2655 2664 2667 2669 2669 2669 2672 2674 2674 2677 2677 2677 2680 2682 2685 2687 2688 2691 2693 2695 2696 2699 2701 2701 2701 2704 2710 2710 2714 2714 2717 2717 2720 2720 2728 2730 2732 2734 2736 2738 2743 2743 2746 2746 2749 2749 2749 2753 2753 2756 2756 2759 2759 2762 2762 2767 2767 2767* 2779 2779 2779 2788 2788 2792 2796 2798 2800 2802 2804 2809 2809 2812 2814 2815 2815 2819 2821 2822 2828 2828 2832 2832 2842 2844 2846 2848 2850 2852 2854 2859 2859 2862 2862 2865 2865 2868 2868 2871 2879 2879 2879 2879* 2889 2896 2896 2900 2900 2903 2903 2911 2914 2917 2920 2922 2924 2927 2932 2932 2935 2935 2938 2938 2941 2941 2941 2944 2944 2947 2947 2950 2950 2953 2963* 2963* 2963* 2971 2971 2974 2974 2977 2977 2982 2984 2986 2995 2999 3003 3006 3009 3013 3016 3020 3024 3032 3034 3036 3038 3040 3042 3044 3050 3050 3050 3050 3054 3054 3054 3054 3059 3059 3059 3059 3062 3062 3062 3062 3065 3065 3065 3065 3068 3068 3068 3068 3071 3071 3071 3071 3074 3074 3077 3077 3081 3083 3084 3085 3097 3097 3097 3097 3097 3110 3111 3115 3117 3119 3122 3127 3127 3127 3127 3127 3135 3135 3142 3142 3147 3148 3148 3155 3155 3161 3161 3161 3161 3161 3171 3171 3171 3171 3171 3171 3180 3180 3180 3193 3195 3197 3199 3201 3203 3205 3207 3209 3211 3213 3215 3217 3219 3221 3237 3237 3237 3240 3240 3243 3243 3245 3245 3248 3248 3251 3251 node_ptr 000210 automatic pointer dcl 1675 in procedure "print_constant_value" set ref 1680* 1682 1682 1686 1687 1736 1740 1745 1753 1754 1756 node_size 000261 automatic fixed bin(18,0) array dcl 1890 set ref 1892* 1893* 1894* 1895* 1896* 1897* 1898* 1899* 1900* 1901* 1902* 1903* 1904* 1905* 1906* 1907* 2397 2404 2404 node_summary 0(17) based bit(1) level 4 packed packed unaligned dcl 1956 ref 2198 node_type based fixed bin(4,0) level 2 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" set ref 13-25* 830 1544 2090 2094 2206 2395 2477 node_type 000102 automatic fixed bin(18,0) dcl 2391 in procedure "get_node_size" set ref 2395* 2397 2397 2399* 2404 2404 2407 2412 2417 2426 2429 2432 nodetype 000412 automatic fixed bin(18,0) dcl 1946 set ref 2206* 2208 2208 noprds 000110 automatic fixed bin(18,0) dcl 1051 set ref 1294* 1296 1362 1362* not_in_storage 0(23) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3219 not_referencable 0(33) based bit(1) level 3 packed packed unaligned dcl 1-530 ref 2800 npages 003532 automatic fixed bin(17,0) array level 3 dcl 200 set ref 371* 577* 608 608 618 618 667* null builtin function dcl 147 ref 279 288 437 438 490 641 644 654 939 2655 3135 3307 num_of_block_constants defined fixed bin(17,0) dcl 5-152 set ref 407* num_of_char_constants defined fixed bin(17,0) dcl 5-148 set ref 407* num_of_dw_constants defined fixed bin(17,0) dcl 5-144 set ref 407* num_of_lib_names 003274 automatic fixed bin(17,0) level 2 dcl 135 set ref 407* 920* 920 num_of_word_constants defined fixed bin(17,0) dcl 5-140 set ref 407* num_opt_segs 003523 automatic fixed bin(18,0) dcl 191 set ref 411* 491* 621 621* 957* 957 number 3 based fixed bin(17,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3142* number 0(11) based fixed bin(7,0) level 2 in structure "operator" packed packed unsigned unaligned dcl 2-144 in procedure "fort_" ref 3329 number 003644 automatic fixed bin(18,0) array level 2 in structure "error_msg" dcl 223 in procedure "fort_" set ref 1160 1260* 1452 number_arg 0(03) based structure level 4 packed packed unaligned dcl 1956 number_of_crefs 54 000102 automatic fixed bin(17,0) level 2 dcl 129 set ref 481* number_of_dims 0(05) based fixed bin(3,0) level 2 packed packed unaligned dcl 1-383 set ref 2426 2667* 2682 number_of_lines 53 000102 automatic fixed bin(17,0) level 2 dcl 129 set ref 585* number_of_operands 5 003274 automatic fixed bin(17,0) level 3 dcl 135 set ref 1002* 1080* 1294 number_of_temps 003522 automatic fixed bin(18,0) dcl 189 set ref 436* 448* 450* 450 453* 453 456 489 492 650* 650 653 nwords parameter fixed bin(18,0) dcl 870 ref 867 876 nx 000105 automatic fixed bin(18,0) dcl 2453 set ref 3085* 3087 3093* o 000104 automatic pointer dcl 3264 set ref 3269* 3272 3274 3275 3276 3276 3276 3276 3276 3276 3276 3276 3276 3276 3288 3290 3293 3296 3299 3302 3307 3307 3310 3310 3313 3313 3316 3316 3321 3321 3321 3321 3324 3324 3324 3327 3329 3330 3333 object_base 4 000102 automatic pointer level 2 dcl 129 set ref 465* 654* 2126* object_base_ptr parameter pointer dcl 113 ref 91 308 331 465 object_length parameter fixed bin(19,0) dcl 114 set ref 91 308 331 466* 538* 547* 552* object_max_len 36 000102 automatic fixed bin(19,0) level 2 dcl 129 set ref 413* objectname 42 003274 automatic varying char(32) level 2 dcl 135 set ref 378* 380* 383* 384* 585* odd 0(31) based bit(1) level 4 packed packed unaligned dcl 1-436 ref 2846 offset 1 based fixed bin(18,0) level 2 in structure "pointer" packed packed unsigned unaligned dcl 1-672 in procedure "fort_" set ref 3127* offset 1(18) 000024 external static fixed bin(17,0) array level 3 in structure "fort_message_table$fort_message_table" packed packed unaligned dcl 8-8 in procedure "fort_" set ref 1322 offset 000100 automatic fixed bin(18,0) dcl 13-13 in procedure "create_node" set ref 13-22* 13-24 13-25 13-26 offset 116 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3171* offset 17 based fixed bin(24,0) level 2 in structure "symbol" dcl 1-844 in procedure "fort_" set ref 2617 2617* offset 000413 automatic fixed bin(18,0) dcl 1946 in procedure "fort_display" set ref 1984* 1986 1986* 1989* 1991 2004* 2006 2006* 2006 2009 2035* 2037 2037* 2040* 2042 2066* 2068* 2070 2085* 2085* 2088 2090 2094* 2098 2110* 2111 2113 2114 2115* 2115 2115 2115 2136* 2136* 2139* 2140 2140 2140 2159* 2159* 2160* 2161 2163* 2163* 2164* 2165 2177* 2177* 2180* 2181 2189* 2189* 2191* 2193 2260* 2260* 2262* 2263 2279* 2281 2289 2290 2291* 2291 offset_unit_names 000112 constant char(16) initial array packed unaligned dcl 1923 set ref 3240* once_per_stmnt 1(01) 000024 external static bit(1) array level 4 packed packed unaligned dcl 8-8 set ref 1172 1207 once_per_subpgm 1(02) 000024 external static bit(1) array level 4 packed packed unaligned dcl 8-8 set ref 1207 1216 ons 000301 automatic varying char(256) dcl 1937 set ref 2517* 2517 2519* 2519 2521* 2521 2523* 2523 2525* 2525 2527* 2527 2529* 2529 2532* 2532 2534* 2534 2536* 2536 2539* 2539 2541* 2541 2543* 2543 2545* 2545 2547* 2547 2551* 2551 2552* 2552 2553* 2553 2555* 2555 2557* 2557 2559* 2559 2561* 2561 2563* 2563 2565* 2565 2569* 2569 2570* 2570 2571* 2571 2575* 2575 2576* 2576 2577* 2577 2579* 2579 2581* 2581 2583* 2583 2585* 2585 2587* 2587 2589* 2589 2591* 2591 2593* 2593 2595* 2595 2597* 2597 2599* 2599 2601* 2601 2603* 2603 2728* 2728 2730* 2730 2732* 2732 2734* 2734 2736* 2736 2738* 2738 2788* 2788 2791* 2791 2792* 2792 2794* 2794 2796* 2796 2798* 2798 2800* 2800 2802* 2802 2804* 2804 2842* 2842 2844* 2844 2846* 2846 2848* 2848 2850* 2850 2852* 2852 2854* 2854 2889* 2889 2911* 2911 2914* 2914 2917* 2917 2920* 2920 2922* 2922 2924* 2924 2927* 2927 2992* 2995* 2995 2997* 2997 2999* 2999 3001* 3001 3003* 3003 3006* 3006 3009* 3009 3011* 3011 3013* 3013 3016* 3016 3018* 3018 3020* 3020 3022* 3022 3024* 3024 3026* 3026 3028 3028* 3031* 3032* 3032 3034* 3034 3036* 3036 3038* 3038 3040* 3040 3042* 3042 3044* 3044 3047 3047* 3113* 3115* 3115 3117* 3117 3119* 3119 3122* 3191* 3193* 3193 3195* 3195 3197* 3197 3199* 3199 3201* 3201 3203* 3203 3205* 3205 3207* 3207 3209* 3209 3211* 3211 3213* 3213 3215* 3215 3217* 3217 3219* 3219 3221* 3221 3232 3232* 3235* 3287* 3288* 3290* 3293* 3293 3296* 3296 3299* 3299 3302* 3302 3305* op 000101 automatic fixed bin(18,0) dcl 3263 set ref 3268* 3268* 3269 3270 3276* 3276* 3321* 3324* op_code based fixed bin(8,0) level 2 in structure "operator" packed packed unaligned dcl 2-144 in procedure "fort_" ref 3272 3321 3321 3321 3324 3324 op_code based fixed bin(8,0) level 2 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 1997 op_names 000510 constant char(20) initial array dcl 1855 set ref 2234 2250 2250 2252* 2323 2325* 3321 3321 3321* op_ptr 000432 automatic pointer dcl 2308 set ref 2329* 2330 2331 2333 2333 2333 2333 2338 2340 operand 4 based fixed bin(18,0) array level 2 in structure "operator" dcl 2-144 in procedure "fort_" ref 3330 operand based bit(1) level 3 in structure "command_structure" packed packed unaligned dcl 1956 in procedure "fort_display" ref 2108 2136 operand_base 2 000102 automatic pointer level 2 dcl 129 set ref 463* 654* 13-24 13-25 12-61 12-63 12-76 12-76 12-80 12-91 826 828 843 843 847 859 897 909 924 928 1276 1280 1314 1314 1465 1465 1561 1986 1989 2021 2058 2088 2115 2115 2126* 2140 2140 2147 2161 2165 2181 2191 2193 2205 2263 2274 2291 2475 2490 2490 2644 2644 2874 2875 2977 2977 2986 operand_count 5 003532 automatic fixed bin(18,0) array level 3 dcl 200 set ref 579* 608* 669* operand_index 7 003274 automatic fixed bin(18,0) array level 4 dcl 135 set ref 1022* 1081* 1128 1308 1308 1314 1314 1577 operand_max_len 35 000102 automatic fixed bin(19,0) level 2 dcl 129 set ref 413* 13-20 13-29 13-29 operand_names 000152 constant char(24) initial array packed unaligned dcl 1918 set ref 2506* 2710* 2767* 2779* 2828* 2879* 2896* operand_type 0(09) based fixed bin(4,0) level 2 in structure "constant" packed packed unaligned dcl 1-256 in procedure "fort_" set ref 12-82* operand_type 0(09) based fixed bin(4,0) level 2 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" ref 2506 2710 2767 2779 2828 2879 2896 operand_type 0(09) based fixed bin(4,0) level 2 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" set ref 849* operands 6 003274 automatic structure array level 3 dcl 135 operator based structure level 1 dcl 2-144 in procedure "fort_" operator 0(03) based structure level 2 in structure "command_structure" packed packed unaligned dcl 1956 in procedure "fort_display" operator_list 7 based pointer level 2 packed packed unaligned dcl 2-176 set ref 3310* opnd 1 003644 automatic fixed bin(18,0) array level 2 in structure "error_msg" dcl 223 in procedure "fort_" set ref 1160 1261* 1462 1465 1465 opnd 000105 automatic fixed bin(18,0) dcl 1049 in procedure "print_message_op" set ref 1117* 1120 1120 1123 1124* 1124 1128* 1128 1160 1261 opt_base 10 000102 automatic pointer level 2 dcl 129 set ref 438* 489* 490 641 641 644 644 645 646* 654* opt_count 7 003532 automatic fixed bin(18,0) array level 3 dcl 200 set ref 581* 608* 671* opt_max_len 40 000102 automatic fixed bin(19,0) level 2 dcl 129 set ref 415* opt_statement based structure level 1 dcl 2-176 optimize 113(01) 000102 automatic bit(1) level 4 packed packed unaligned dcl 129 set ref 453 487 515 585* 608* optimizing 11(25) based structure level 3 packed packed unaligned dcl 1-753 options 113 000102 automatic structure level 2 in structure "shared_globals" dcl 129 in procedure "fort_" set ref 505 505 options 0(18) based structure level 2 in structure "command_structure" packed packed unaligned dcl 1956 in procedure "fort_display" options 11 based structure level 2 in structure "subprogram" dcl 1-753 in procedure "fort_" options_ptr parameter pointer dcl 115 ref 91 308 331 364 options_string 64 003274 automatic varying char(256) level 2 dcl 135 set ref 505* output 000100 automatic picture(12) packed unaligned dcl 1588 in procedure "binary_to_char" set ref 1590* 1591 1591 output 3 based fixed bin(18,0) level 2 in structure "operator" dcl 2-144 in procedure "fort_" ref 3327 output_by 6(18) based fixed bin(18,0) level 2 in structure "temporary" packed packed unsigned unaligned dcl 1-1005 in procedure "fort_" set ref 2756 2756* output_by 6(18) based fixed bin(18,0) level 2 in structure "array_ref" packed packed unsigned unaligned dcl 1-155 in procedure "fort_" set ref 2944 2944* p parameter pointer dcl 937 in procedure "get_next_source_seg_comp" ref 934 939 p 000100 automatic pointer dcl 2390 in procedure "get_node_size" set ref 2394* 2395 2399* 2409 2414 2419 2421 2426 2429 2434 p 000102 automatic pointer dcl 633 in procedure "clean_up" set ref 645* 646 647* p 003526 automatic pointer dcl 195 in procedure "fort_" set ref 278* 279 287* 288 1393 1485 1516* 1518 1526 p 000100 automatic pointer dcl 949 in procedure "get_next_temp_segment" set ref 952* 959 960 963 packed 000104 automatic bit(1) dcl 984 set ref 1017* packed_ptr based pointer level 2 packed packed unaligned dcl 197 set ref 490* 646 959* packed_ptr_st based structure level 1 dcl 197 parameter 11(04) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2591 parent 7 based fixed bin(18,0) level 2 in structure "symbol" packed packed unsigned unaligned dcl 1-844 in procedure "fort_" set ref 2623 2623* parent 11(18) based fixed bin(18,0) level 2 in structure "array_ref" packed packed unsigned unaligned dcl 1-155 in procedure "fort_" set ref 1561 2935 2935* 2953 parse_globals 003256 automatic structure level 1 dcl 132 set ref 711 711 771 771 passed_as_arg 0(28) based bit(1) level 4 packed packed unaligned dcl 1-63 ref 3215 pathname 5 based varying char(256) level 2 in structure "source" dcl 1-693 in procedure "fort_" set ref 2429 2500* pathname parameter char packed unaligned dcl 885 in procedure "add_to_lib_list" set ref 882 891 896* per_phase_info 003532 automatic structure array level 2 dcl 200 set ref 577 577 578 579 580 581 592 595 618 phase 003473 automatic fixed bin(18,0) dcl 182 set ref 362* 667 667 668 669 670 671 676 680* phase_name 001603 constant char(16) initial array dcl 246 set ref 608* 676* piece 000212 automatic char(24) packed unaligned dcl 1676 set ref 1765* 1766* 1779 pl1_operators_$VLA_words_per_seg_ 000074 external static fixed bin(19,0) dcl 267 set ref 505* pointer based structure level 1 dcl 1-672 set ref 1906 polish 0(01) based bit(1) level 3 packed packed unaligned dcl 1956 ref 2119 2142 polish_base 000102 automatic pointer level 2 dcl 129 set ref 462* 654* 1612 1612 1969 1971 1984 2024 2126* 2223 2242 2314 2329 2333* 2350 2350 2350 2353 2644 2644 2644 2644 2646 polish_count 4 003532 automatic fixed bin(18,0) array level 3 dcl 200 set ref 578* 608* 668* polish_max_len 34 000102 automatic fixed bin(19,0) level 2 dcl 129 set ref 413* polish_region based structure level 1 dcl 171 polish_string based fixed bin(18,0) array level 2 dcl 171 set ref 1612 1971 1984 2024 2223 2242 2314 2329 2350 2350 2350* 2353 2644* 2644* 2644 2644 2646 prev_operator 1(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 2-176 ref 2006 2066 3276 3276 previous_subprogram 1 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-753 set ref 3050 3050* print_message 1530 000102 automatic entry variable level 2 dcl 129 set ref 701* 740* 756* print_message_op 30 003274 automatic entry variable level 2 dcl 135 set ref 742* 758* print_on_terminal 000460 automatic bit(1) dcl 1059 set ref 1087* 1093 1269 1354 print_once 1 000024 external static bit(1) array level 4 packed packed unaligned dcl 8-8 set ref 1112 probe 000066 constant entry external dcl 263 ref 677 1376 produce_listing 005324 automatic bit(1) dcl 233 set ref 365* 450 470 562 571 1093 1382 1455 1481 prt_sw 000112 automatic bit(1) dcl 2456 set ref 3080* 3089 3091* pt parameter pointer dcl 870 in procedure "create_char_constant" ref 867 877 pt parameter pointer dcl 2390 in procedure "get_node_size" ref 2387 2394 ptr builtin function dcl 147 ref 1324 put_in_map 3 based bit(1) level 3 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 2340 put_in_map 4 based bit(1) level 3 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 3290 put_in_profile 4(01) based bit(1) level 3 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 3288 put_in_profile 3(01) based bit(1) level 3 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 2338 put_in_symtab 0(34) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2527 q 003530 automatic pointer dcl 195 set ref 278* 287* quad based fixed bin(18,0) array dcl 174 set ref 1614 1995 2006 2061 2066 3269 quad_max_len 37 000102 automatic fixed bin(19,0) level 2 dcl 129 set ref 413* quadruple 0(02) based bit(1) level 3 packed packed unaligned dcl 1956 ref 2016 2055 2122 2145 quadruple_base 6 000102 automatic pointer level 2 dcl 129 set ref 492* 521 654* 1614 1995 2006 2061 2066 3269 3276* quadruple_count 6 003532 automatic fixed bin(18,0) array level 3 dcl 200 set ref 580* 608* 670* rc_t constant bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" ref 12-84 rc_t constant bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" ref 853 real 10(21) based bit(1) level 5 packed packed unaligned dcl 1-844 ref 2541 real_fixed_bin constant fixed bin(17,0) initial dcl 990 ref 1019 ref_count 6 based fixed bin(17,0) level 2 in structure "array_ref" packed packed unaligned dcl 1-155 in procedure "fort_" set ref 2900 2900* ref_count 6 based fixed bin(17,0) level 2 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" set ref 2714 2714* ref_count_copy 11 based fixed bin(17,0) level 2 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" set ref 2720 2720* ref_count_copy 11 based fixed bin(17,0) level 2 in structure "array_ref" packed packed unaligned dcl 1-155 in procedure "fort_" set ref 2903 2903* referenced 0(27) based bit(1) level 4 packed packed unaligned dcl 1-63 ref 3213 referenced_backwards 4(03) based bit(1) level 3 packed packed unaligned dcl 2-176 ref 3293 referenced_by_assign 4(04) based bit(1) level 3 packed packed unaligned dcl 2-176 ref 3296 referenced_executable 0(29) based bit(1) level 4 packed packed unaligned dcl 1-530 ref 2798 region based structure level 2 packed packed unaligned dcl 1956 rel builtin function dcl 147 ref 2382 2382 release_temp_segment_ 000034 constant entry external dcl 158 ref 647 release_temp_segments_ 000030 constant entry external dcl 154 ref 653 reloc 2(12) based bit(6) level 2 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" set ref 3243* reloc 2(12) based bit(6) level 2 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" set ref 853* reloc 2(12) based bit(6) level 2 in structure "constant" packed packed unaligned dcl 1-256 in procedure "fort_" set ref 12-84* reloc_hold 2(06) based bit(6) level 2 packed packed unaligned dcl 1-63 set ref 3243* relocatable 11(24) based bit(1) level 3 packed packed unaligned dcl 1-753 ref 3024 relocation_base 12 000102 automatic pointer level 2 dcl 129 set ref 464* removable 4(07) based bit(1) level 3 packed packed unaligned dcl 2-176 ref 3302 reserved 41(01) based bit(1) array level 5 in structure "machine_state" packed packed unaligned dcl 1-620 in procedure "fort_" set ref 3161* reserved 112(01) based bit(1) array level 5 in structure "machine_state" packed packed unaligned dcl 1-620 in procedure "fort_" set ref 3171* restore_prs 0(32) based bit(1) level 3 packed packed unaligned dcl 1-530 ref 2796 ret_value 000256 automatic varying char(36) dcl 1799 set ref 1821* 1824* 1827 1827 1827* 1827 1835* 1835 1836* 1836 1838* 1838 1840* 1840 1842* 1842 1846 rtrim builtin function dcl 1677 ref 1817 1821 1824 runtime 7(18) based fixed bin(18,0) level 2 in structure "subprogram" packed packed unsigned unaligned dcl 1-753 in procedure "fort_" set ref 3077 3077* runtime 13(25) based bit(18) level 2 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" set ref 2649 2649* saved_operand 1(03) 000024 external static bit(2) array level 4 packed packed unaligned dcl 8-8 set ref 1117 scalar 1(05) based bit(1) array level 4 packed packed unaligned dcl 1-130 ref 3117 scale 000114 automatic fixed bin(17,0) dcl 987 set ref 1017* secondary 15(25) based pointer level 2 packed packed unaligned dcl 1-844 set ref 2655 2655 2655* seg_base parameter pointer dcl 946 set ref 943 959 960* set 0(26) based bit(1) level 4 packed packed unaligned dcl 1-63 ref 3211 severity 113(12) 000102 automatic fixed bin(3,0) level 5 packed packed unaligned dcl 129 set ref 1087 1455 1478 shared_globals 000102 automatic structure level 1 dcl 129 set ref 274* 321* 349* 711 711 720 720 729 729 745 745 761 761 771 771 size 7 based fixed bin(24,0) array level 3 in structure "dimension" dcl 1-383 in procedure "fort_" set ref 2701* 2704* size builtin function dcl 147 in procedure "fort_" ref 482 841 841 922 922 1534 1896 1897 1898 1901 1903 1904 1906 1907 2239 2344 2423 2429 size 000113 automatic fixed bin(17,0) dcl 987 in procedure "print_message" set ref 1017* size builtin function dcl 12-33 in procedure "create_constant" ref 12-74 12-74 size 7 based fixed bin(24,0) level 2 in structure "temporary" dcl 1-1005 in procedure "fort_" set ref 2753 2753* source based structure level 1 dcl 1-693 set ref 2429 source_file_number 3142 000102 automatic fixed bin(35,0) level 2 dcl 129 set ref 497* 500* 1640 1654 1654 source_format 11(03) based structure level 3 packed packed unaligned dcl 1-753 source_id 2 based structure level 2 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 1612 source_id 000122 automatic structure level 1 packed packed unaligned dcl 1606 in procedure "decode_source_id" set ref 1612* 1614* source_id 3 based structure level 2 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 1614 source_info_ptr parameter pointer dcl 117 in procedure "fort_" set ref 91 308 331 355 378 380 380 380 380 380 383 384 499* 2343 2343 2343 2343 3276 3276 3276 3276 source_info_ptr 003256 automatic pointer level 2 in structure "parse_globals" dcl 132 in procedure "fort_" set ref 704* source_line_base 16 000102 automatic pointer level 2 dcl 129 set ref 473* source_line_number 3143 000102 automatic fixed bin(35,0) level 2 dcl 129 set ref 497* 500* 1619 1628 1653 source_node constant fixed bin(4,0) initial dcl 4-87 ref 2429 source_ptr parameter pointer dcl 696 ref 693 704 source_segment based char packed unaligned dcl 1938 ref 2343 2343 3276 3276 sp 000406 automatic pointer dcl 1942 set ref 1995* 1997 2004 2024* 2025 2027 2061* 2062 2064 stack_extended 162 based bit(1) level 3 dcl 1-620 ref 3180 stack_indirect 0(19) based bit(1) level 3 packed packed unaligned dcl 1-63 ref 3203 standard_bits 0(25) based structure level 3 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" standard_bits 0(25) based structure level 3 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" star_extents 1(07) based bit(1) array level 3 in structure "arg_desc" packed packed unaligned dcl 1-130 in procedure "fort_" ref 3119 star_extents 11(09) based bit(1) level 3 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2601 start parameter fixed bin(18,0) dcl 2307 in procedure "display_int_text" ref 2302 2310 start 4(09) based fixed bin(26,0) level 2 in structure "opt_statement" packed packed unaligned dcl 2-176 in procedure "fort_" ref 3274 start 3(09) based fixed bin(26,0) level 2 in structure "statement" packed packed unaligned dcl 1-721 in procedure "fort_" ref 2330 start parameter fixed bin(18,0) dcl 3260 in procedure "display_quadruples" ref 3257 3268 start_input_to 10 based fixed bin(18,0) level 2 in structure "temporary" packed packed unsigned unaligned dcl 1-1005 in procedure "fort_" set ref 2759 2759* start_input_to 10 based fixed bin(18,0) level 2 in structure "array_ref" packed packed unsigned unaligned dcl 1-155 in procedure "fort_" set ref 2947 2947* starting_offset 1 based fixed bin(18,0) level 2 unsigned dcl 1956 set ref 2027 2050* 2064 2075* 2110 2119 2122 2270* 2270 2278 2296* stat_length 000403 automatic fixed bin(9,0) dcl 1940 set ref 2331* 2333* 2343 2343 3275* 3276* 3276 3276 stat_op constant fixed bin(18,0) initial dcl 4-197 ref 1971 1997 2239 2327 3272 stat_start 000402 automatic fixed bin(27,0) dcl 1939 set ref 2330* 2333* 2343 2343 3274* 3276* 3276 3276 statement 0(22) 000122 automatic bit(5) level 2 in structure "source_id" packed packed unaligned dcl 1606 in procedure "decode_source_id" set ref 1618 statement 5 based fixed bin(18,0) level 2 in structure "label" packed packed unsigned unaligned dcl 1-530 in procedure "fort_" set ref 2812 2814* 2815 2815 statement 3 003644 automatic fixed bin(18,0) array level 2 in structure "error_msg" dcl 223 in procedure "fort_" set ref 1166 1168* 1263* statement based structure level 1 dcl 1-721 in procedure "fort_" ref 2239 2344 static 11(01) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2585 static 0(34) based bit(1) level 4 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" ref 2852 static 0(10) based bit(1) level 3 in structure "subprogram" packed packed unaligned dcl 1-753 in procedure "fort_" ref 3034 static_user_id 000010 internal static varying char(32) initial dcl 251 set ref 392 400* 403 stmnt 0(04) based bit(1) level 5 packed packed unaligned dcl 1956 ref 2016 2055 stmnt_func 10(33) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2573 stmnt_off parameter fixed bin(18,0) dcl 1600 ref 1597 1610 1612 1614 stop parameter fixed bin(18,0) dcl 3260 in procedure "display_quadruples" ref 3257 3268 stop parameter fixed bin(18,0) dcl 2307 in procedure "display_int_text" ref 2302 2312 stop_after_cg 113(22) 000102 automatic bit(1) level 5 packed packed unaligned dcl 129 set ref 564 571 stop_after_parse 113(23) 000102 automatic bit(1) level 5 packed packed unaligned dcl 129 set ref 517 523 527 533 stopping_offset 2 based fixed bin(18,0) level 2 unsigned dcl 1956 set ref 2111* 2111 2113 2119 2122 2271* 2271 2278 2296* storage based fixed bin(17,0) array dcl 13-15 set ref 13-24* storage_class 0(33) based structure level 3 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" storage_class 11 based structure level 3 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" storage_info 0(25) based structure level 3 in structure "header" packed packed unaligned dcl 1-436 in procedure "fort_" storage_info 0(25) based structure level 3 in structure "label" packed packed unaligned dcl 1-530 in procedure "fort_" storage_info 0(25) based structure level 3 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" storage_info 13 based structure array level 2 in structure "subprogram" dcl 1-753 in procedure "fort_" ref 2271 3081 string 2 based char level 2 in structure "error_text" dcl 3-24 in procedure "fort_" set ref 1393* 1485* string builtin function dcl 147 in procedure "fort_" ref 365 1373 2701 string_bit_array 000112 automatic bit(36) array dcl 788 set ref 796 801 804 806 811 812 814* 814 818 830 851 877 string_length 10 003274 automatic fixed bin(17,0) array level 4 dcl 135 set ref 1027* 1029* 1035* 1123 1302 string_ptr 12 003274 automatic pointer array level 4 dcl 135 set ref 1030* 1036* 1124 1303 stringrange 11(17) based bit(1) level 4 packed packed unaligned dcl 1-753 ref 3013 subp 000415 automatic fixed bin(18,0) dcl 1953 set ref 2020* 2020* 2021* 2057* 2057* 2058* 2145* 2145* 2147* 2273* 2273* 2274 2283* subprogram based structure level 1 dcl 1-753 in procedure "fort_" set ref 1904 subprogram based fixed bin(18,0) level 2 in structure "listing_info" unsigned dcl 3-12 in procedure "fort_" set ref 1504 1507 1512 subprogram_type 0(05) based fixed bin(3,0) level 2 packed packed unaligned dcl 1-753 ref 2984 2986 subr_type 000076 constant char(12) initial array packed unaligned dcl 1928 set ref 2984* 2986* subroutine 10(29) based bit(1) level 4 packed packed unaligned dcl 1-844 ref 2561 subscriptrange 11(16) based bit(1) level 4 packed packed unaligned dcl 1-753 ref 3009 substr builtin function dcl 147 set ref 380 380 400 806 821 1362 1368* 1591 1756 1760 1761* 1765 1765 1766* 1772 1779 1782 1821 1821 1824 1827 1830 1832 1836 1838 1838 1840 1840 1842 2343 2343 3276 3276 symbol based structure level 1 dcl 1-844 in procedure "fort_" set ref 2409 symbol 0(18) based fixed bin(18,0) level 2 in structure "subprogram" packed packed unsigned unaligned dcl 1-753 in procedure "fort_" ref 1277 1280 2982 symbol_node constant fixed bin(4,0) initial dcl 4-87 ref 1565 2090 2407 sys_info$max_seg_size 000022 external static fixed bin(18,0) dcl 4-61 ref 302 415 system_debugging 113(22) 000102 automatic structure level 4 packed packed unaligned dcl 129 set ref 1373 system_options 115 000102 automatic structure level 3 dcl 129 table_base 000102 automatic pointer dcl 1047 set ref 1324* 1367 1393 table_overlay based structure level 1 dcl 1064 temp 000270 automatic varying char(36) dcl 1800 set ref 1816 1816 1816 1816 1817* 1817 1821 1821 1821 1824 1824 1830 1830 1832* 1832 1832 1836 1838 1838 1840 1840 1842 temporary based structure level 1 dcl 1-1005 set ref 1896 temporary_node constant fixed bin(4,0) initial dcl 4-87 ref 1556 time 113(02) 000102 automatic bit(1) level 4 packed packed unaligned dcl 129 set ref 367 575 665 total_cpu 003634 automatic fixed bin(52,0) dcl 210 set ref 592* 608 618 tsegp 003476 automatic pointer array dcl 184 set ref 437* 456 462 463 464 472 473 474 489 492 653 type parameter varying char(32) dcl 1447 in procedure "print_message_summary" set ref 1441 1478* 1483 1485* type 113 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3171* type parameter fixed bin(4,0) dcl 13-14 in procedure "create_node" ref 13-10 13-25 type 42 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3161* uid 1 based bit(36) level 2 dcl 1-693 set ref 2500* units 2 based fixed bin(3,0) level 2 packed packed unsigned unaligned dcl 1-63 ref 3240 3240 unrecoverable_error constant fixed bin(17,0) initial dcl 4-64 ref 510 543 549 unspec builtin function dcl 147 in procedure "fort_" set ref 274* 321* 324* 349* 352* 369* 479* 806 1760 1765 1765 2200* 2216* 2655 3237 3237 3237 unspec builtin function dcl 13-17 in procedure "create_node" set ref 13-24* upper 0(10) based bit(1) array level 3 packed packed unaligned dcl 1-383 ref 2693 upper_bound 6 based fixed bin(24,0) array level 3 dcl 1-383 set ref 2695* 2696 2699* usage 0(30) based structure level 3 packed packed unaligned dcl 1-530 use_source_info 3141 000102 automatic bit(1) level 2 in structure "shared_globals" dcl 129 in procedure "fort_" set ref 498* 501* 1350* use_source_info parameter bit(1) dcl 1602 in procedure "decode_source_id" ref 1597 1616 1619 1628 1640 1651 used 44 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3161* used 115 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3171* used_across_loops 0(33) based bit(1) level 3 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" ref 2734 used_across_loops 0(33) based bit(1) level 3 in structure "array_ref" packed packed unaligned dcl 1-155 in procedure "fort_" ref 2924 used_as_subscript 0(35) based bit(1) level 3 packed packed unaligned dcl 1-1005 ref 2736 user_id 005333 automatic char(32) dcl 250 set ref 394* 396 397 400 user_options 113 000102 automatic structure level 3 dcl 129 set ref 364* v_array based bit(36) array dcl 12-34 set ref 12-51 12-52* 12-54 12-54 v_bound 0(09) based structure array level 2 packed packed unaligned dcl 1-383 ref 2701 v_length 6 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-844 set ref 2629 2629* v_offset 4(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-155 set ref 2938 2938* value parameter fixed bin(18,0) dcl 1587 in procedure "binary_to_char" ref 1584 1590 value 4 based bit(72) level 2 in structure "constant" dcl 1-256 in procedure "fort_" set ref 12-65 12-85* 1686 value parameter bit(72) dcl 12-16 in procedure "create_constant" ref 12-13 12-41 value parameter char packed unaligned dcl 780 in procedure "create_char_constant" ref 777 795 796 value 4(18) based char level 2 in structure "char_constant" packed packed unaligned dcl 1-316 in procedure "fort_" set ref 830 851* 1740 1745 1756 value_in 0(15) based structure level 3 packed packed unaligned dcl 1-63 value_ptr 000220 automatic pointer dcl 1678 set ref 1686* 1694 1702* 1710* 1719* 1721 1721 1730 variable 11(07) based bit(1) level 3 in structure "symbol" packed packed unaligned dcl 1-844 in procedure "fort_" ref 2597 variable 0(18) based fixed bin(18,0) level 2 in structure "pointer" packed packed unsigned unaligned dcl 1-672 in procedure "fort_" set ref 3127* variable 43 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3161* variable 114 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3171* variable 4 based fixed bin(18,0) array level 4 in structure "machine_state" dcl 1-620 in procedure "fort_" set ref 3147 3148 3148* variable_arglist 0(30) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2519 variable_array_size 0(27) based bit(1) level 2 packed packed unaligned dcl 1-383 ref 2677 variable_extents 0(32) based bit(1) level 3 packed packed unaligned dcl 1-844 ref 2523 variable_length 0(29) based bit(1) level 3 in structure "array_ref" packed packed unaligned dcl 1-155 in procedure "fort_" set ref 2917 2941* variable_length 0(29) based bit(1) level 3 in structure "temporary" packed packed unaligned dcl 1-1005 in procedure "fort_" set ref 2728 2749* variable_offset 0(30) based bit(1) level 3 packed packed unaligned dcl 1-155 ref 2914 variable_virtual_origin 0(26) based bit(1) level 2 packed packed unaligned dcl 1-383 ref 2669 varying_char_dtype constant fixed bin(17,0) initial dcl 15-25 ref 1816 verify builtin function dcl 147 ref 1591 1740 version based fixed bin(17,0) level 2 dcl 141 ref 355 virtual_origin 1 based fixed bin(24,0) level 2 dcl 1-383 set ref 2669* 2672* vuser_id 53 003274 automatic varying char(32) level 2 dcl 135 set ref 403* w based bit(36) array dcl 2376 set ref 2382* walk 0(18) based bit(1) level 3 packed packed unaligned dcl 1956 ref 2090 2094 2114 2262 2350 walk_chains 000113 automatic bit(1) dcl 2457 set ref 2465* 2635 2642 2688 2696 2815 2822 2871 2953 2977 walk_sw parameter bit(1) dcl 2458 ref 2440 2465 which 000110 automatic fixed bin(18,0) dcl 786 set ref 797* 855 855 857 857 859 862 875* with_argument 0(03) based structure level 3 packed packed unaligned dcl 1956 without_args 0(07) based structure level 3 packed packed unaligned dcl 1956 x 0(16) based bit(1) level 4 in structure "node" packed packed unaligned dcl 1-63 in procedure "fort_" ref 3197 x based fixed bin(35,0) array dcl 12-35 in procedure "create_constant" set ref 12-63 12-80 12-91 x based fixed bin(35,0) array dcl 13-16 in procedure "create_node" set ref 13-24 13-25 x based fixed bin(35,0) array dcl 169 in procedure "fort_" set ref 828 847 859 897 909 924 928 1276 1280 1314 1314 1465 1465 1561 1986 1989 2021 2058 2088 2115 2115 2140 2140 2147 2161 2165 2181 2191 2193 2205 2263 2274 2291 2475 2490 2490* 2644 2644 2874 2875 2977 2977 2986 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. EOS_token internal static bit(9) initial dcl 4-156 add_op internal static fixed bin(18,0) initial dcl 4-197 algol68_array_descriptor_dtype internal static fixed bin(17,0) initial dcl 15-25 algol68_bits_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_bool_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_byte_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_char_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_compl_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_format_dtype internal static fixed bin(17,0) initial dcl 15-25 algol68_int_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_long_compl_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_long_int_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_long_real_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_real_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_short_int_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_straight_dtype internal static fixed bin(17,0) initial dcl 15-25 algol68_struct_struct_bool_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_struct_struct_char_dtype internal static fixed bin(17,0) initial dcl 15-110 algol68_union_dtype internal static fixed bin(17,0) initial dcl 15-25 allocate_symbol_name automatic fixed bin(17,0) dcl 1-525 and internal static bit(9) initial dcl 4-156 and_op internal static fixed bin(18,0) initial dcl 4-197 apostrophe internal static bit(9) initial dcl 4-156 area_dtype internal static fixed bin(17,0) initial dcl 15-25 array_ref_type internal static fixed bin(4,0) initial dcl 4-120 assign internal static bit(9) initial dcl 4-156 assign_label_op internal static fixed bin(18,0) initial dcl 4-197 assign_op internal static fixed bin(18,0) initial dcl 4-197 asterisk internal static bit(9) initial dcl 4-156 backspace_op internal static fixed bin(18,0) initial dcl 4-197 based_double based structure level 1 dcl 1664 based_real based float bin(27) dcl 1667 bif internal static fixed bin(4,0) initial dcl 4-120 bit_dtype internal static fixed bin(17,0) initial dcl 15-25 bit_units internal static fixed bin(3,0) initial dcl 4-136 bits_per_char internal static fixed bin(9,0) initial dcl 4-68 blank_common_name internal static char(8) initial dcl 4-79 block_data internal static fixed bin(9,0) initial dcl 4-68 block_data_op internal static fixed bin(18,0) initial dcl 4-197 block_if_op internal static fixed bin(18,0) initial dcl 4-197 builtin_op internal static fixed bin(18,0) initial dcl 4-197 c_enum_const_dtype internal static fixed bin(17,0) initial dcl 15-25 c_enum_dtype internal static fixed bin(17,0) initial dcl 15-25 c_typeref_dtype internal static fixed bin(17,0) initial dcl 15-25 c_union_dtype internal static fixed bin(17,0) initial dcl 15-25 call_op internal static fixed bin(18,0) initial dcl 4-197 cat_op internal static fixed bin(18,0) initial dcl 4-197 chain based structure level 1 dcl 2-27 chain_op internal static fixed bin(18,0) initial dcl 4-197 char_dtype internal static fixed bin(17,0) initial dcl 15-25 char_string internal static bit(9) initial dcl 4-156 char_units internal static fixed bin(3,0) initial dcl 4-136 chars_per_dw internal static fixed bin(9,0) initial dcl 4-68 close_op internal static fixed bin(18,0) initial dcl 4-197 closefile_op internal static fixed bin(18,0) initial dcl 4-197 cmpx_mode internal static fixed bin(4,0) initial dcl 4-106 cobol_char_string_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_comp_5_ts_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_comp_5_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_comp_6_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_comp_7_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_comp_8_ls_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_comp_8_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_display_ls_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_display_ls_overp_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_display_ts_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_display_ts_overp_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_display_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 cobol_structure_dtype internal static fixed bin(17,0) initial dcl 15-25 colon internal static bit(9) initial dcl 4-156 comma internal static bit(9) initial dcl 4-156 complex_const internal static bit(9) initial dcl 4-156 concat internal static bit(9) initial dcl 4-156 convert_to_cmpx_op internal static fixed bin(18,0) initial dcl 4-197 convert_to_dp_op internal static fixed bin(18,0) initial dcl 4-197 convert_to_int_op internal static fixed bin(18,0) initial dcl 4-197 convert_to_real_op internal static fixed bin(18,0) initial dcl 4-197 count_type internal static fixed bin(4,0) initial dcl 4-120 cplx_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 15-25 cplx_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 15-25 cross_reference based structure array level 1 dcl 3-8 dec_int internal static bit(9) initial dcl 4-156 decode_string_op internal static fixed bin(18,0) initial dcl 4-197 default_main_entry_point_name internal static char(5) initial packed unaligned dcl 4-80 dfast_mask internal static bit(72) initial packed unaligned dcl 9-162 div_op internal static fixed bin(18,0) initial dcl 4-197 do_op internal static fixed bin(18,0) initial dcl 4-197 double_const internal static bit(9) initial dcl 4-156 dp_mode internal static fixed bin(4,0) initial dcl 4-106 dummy internal static fixed bin(4,0) initial dcl 4-120 edge based structure level 1 dcl 2-33 else_if_op internal static fixed bin(18,0) initial dcl 4-197 else_op internal static fixed bin(18,0) initial dcl 4-197 encode_string_op internal static fixed bin(18,0) initial dcl 4-197 end_label_op internal static fixed bin(18,0) initial dcl 4-197 endfile_op internal static fixed bin(18,0) initial dcl 4-197 endunit_op internal static fixed bin(18,0) initial dcl 4-197 entry_dtype internal static fixed bin(17,0) initial dcl 15-25 entry_type internal static fixed bin(4,0) initial dcl 4-120 eol_op internal static fixed bin(18,0) initial dcl 4-197 eq internal static bit(9) initial dcl 4-156 equal_op internal static fixed bin(18,0) initial dcl 4-197 equiv_op internal static fixed bin(18,0) initial dcl 4-197 eqv internal static bit(9) initial dcl 4-156 error internal static fixed bin(4,0) initial dcl 4-120 error_label_op internal static fixed bin(18,0) initial dcl 4-197 exit_op internal static fixed bin(18,0) initial dcl 4-197 expon internal static bit(9) initial dcl 4-156 exponentiation_op internal static fixed bin(18,0) initial dcl 4-197 ext_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 15-125 ext_procedure_runtime_dtype internal static fixed bin(17,0) initial dcl 15-125 external internal static fixed bin(4,0) initial dcl 4-120 false internal static bit(9) initial dcl 4-156 fast_mask internal static bit(72) initial packed unaligned dcl 9-168 file_dtype internal static fixed bin(17,0) initial dcl 15-25 fill_node internal static fixed bin(4,0) initial dcl 4-87 first_auto_loc internal static fixed bin(9,0) initial dcl 4-68 flow_unit based structure level 1 dcl 2-46 form_VLA_packed_ptr_op internal static fixed bin(18,0) initial dcl 4-197 format_op internal static fixed bin(18,0) initial dcl 4-197 fort_version_info$version_name external static varying char(132) dcl 7-36 fort_version_info$version_number external static char(16) packed unaligned dcl 7-37 ft_char_dtype internal static fixed bin(17,0) initial dcl 15-96 ft_complex_double_dtype internal static fixed bin(17,0) initial dcl 15-96 ft_complex_dtype internal static fixed bin(17,0) initial dcl 15-96 ft_external_dtype internal static fixed bin(17,0) initial dcl 15-96 ft_hex_complex_double_dtype internal static fixed bin(17,0) initial dcl 15-96 ft_hex_complex_dtype internal static fixed bin(17,0) initial dcl 15-96 ft_integer_dtype internal static fixed bin(17,0) initial dcl 15-96 ft_logical_dtype internal static fixed bin(17,0) initial dcl 15-96 func_op internal static fixed bin(18,0) initial dcl 4-197 func_ref_op internal static fixed bin(18,0) initial dcl 4-197 function internal static fixed bin(9,0) initial dcl 4-68 gap_value internal static fixed bin(17,0) initial dcl 4-57 ge internal static bit(9) initial dcl 4-156 greater_op internal static fixed bin(18,0) initial dcl 4-197 greater_or_equal_op internal static fixed bin(18,0) initial dcl 4-197 gt internal static bit(9) initial dcl 4-156 halfword_units internal static fixed bin(3,0) initial dcl 4-136 ident internal static bit(9) initial dcl 4-156 input_to based structure level 1 dcl 2-87 inquire_op internal static fixed bin(18,0) initial dcl 4-197 int_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 15-125 int_mode internal static fixed bin(4,0) initial dcl 4-106 iostat_op internal static fixed bin(18,0) initial dcl 4-197 is_arith_constant internal static bit(9) initial dcl 4-147 is_constant internal static bit(9) initial dcl 4-147 is_operand internal static bit(9) initial dcl 4-147 is_operator internal static bit(9) initial dcl 4-147 item_op internal static fixed bin(18,0) initial dcl 4-197 jump_arithmetic_op internal static fixed bin(18,0) initial dcl 4-197 jump_assigned_op internal static fixed bin(18,0) initial dcl 4-197 jump_computed_op internal static fixed bin(18,0) initial dcl 4-197 jump_false_op internal static fixed bin(18,0) initial dcl 4-197 jump_logical_op internal static fixed bin(18,0) initial dcl 4-197 jump_op internal static fixed bin(18,0) initial dcl 4-197 jump_true_op internal static fixed bin(18,0) initial dcl 4-197 label_const internal static bit(9) initial dcl 4-156 label_constant_runtime_dtype internal static fixed bin(17,0) initial dcl 15-125 label_dtype internal static fixed bin(17,0) initial dcl 15-25 label_op internal static fixed bin(18,0) initial dcl 4-197 last_assigned_mode internal static fixed bin(4,0) initial dcl 4-106 last_assigned_op internal static fixed bin(18,0) initial dcl 4-197 lchain based structure level 1 dcl 2-94 le internal static bit(9) initial dcl 4-156 left_parn internal static bit(9) initial dcl 4-156 left_shift_op internal static fixed bin(18,0) initial dcl 4-197 less_op internal static fixed bin(18,0) initial dcl 4-197 less_or_equal_op internal static fixed bin(18,0) initial dcl 4-197 lhs_fld_op internal static fixed bin(18,0) initial dcl 4-197 load_preg_op internal static fixed bin(18,0) initial dcl 4-197 load_xreg_op internal static fixed bin(18,0) initial dcl 4-197 logical_const internal static bit(9) initial dcl 4-156 logical_mode internal static fixed bin(4,0) initial dcl 4-106 loop based structure level 1 dcl 2-100 loop_end_op internal static fixed bin(18,0) initial dcl 4-197 lt internal static bit(9) initial dcl 4-156 machine_state_node internal static fixed bin(4,0) initial dcl 4-87 main_op internal static fixed bin(18,0) initial dcl 4-197 main_program internal static fixed bin(9,0) initial dcl 4-68 margin_op internal static fixed bin(18,0) initial dcl 4-197 max_char_length internal static fixed bin(10,0) initial dcl 4-77 max_fixed_bin_18 internal static fixed bin(18,0) initial dcl 4-58 max_fixed_bin_24 internal static fixed bin(24,0) initial dcl 4-59 max_num_of_rands internal static fixed bin(17,0) initial dcl 4-60 max_prec_single internal static fixed bin(9,0) initial dcl 4-68 minus internal static bit(9) initial dcl 4-156 mult_op internal static fixed bin(18,0) initial dcl 4-197 n_operands automatic fixed bin(17,0) dcl 2-171 namelist_op internal static fixed bin(18,0) initial dcl 4-197 ne internal static bit(9) initial dcl 4-156 neg_storage_add_op internal static fixed bin(18,0) initial dcl 4-197 negate_op internal static fixed bin(18,0) initial dcl 4-197 neqv internal static bit(9) initial dcl 4-156 no_op internal static fixed bin(18,0) initial dcl 4-197 no_token internal static bit(9) initial dcl 4-156 non_executable internal static fixed bin(18,0) initial dcl 4-197 not internal static bit(9) initial dcl 4-156 not_equal_op internal static fixed bin(18,0) initial dcl 4-197 not_equiv_op internal static fixed bin(18,0) initial dcl 4-197 not_op internal static fixed bin(18,0) initial dcl 4-197 num_args automatic fixed bin(17,0) dcl 1-150 num_dims automatic fixed bin(3,0) dcl 1-431 octal_const internal static bit(9) initial dcl 4-156 offset_dtype internal static fixed bin(17,0) initial dcl 15-25 open_op internal static fixed bin(18,0) initial dcl 4-197 openfile_op internal static fixed bin(18,0) initial dcl 4-197 opt_subscript_op internal static fixed bin(18,0) initial dcl 4-197 or internal static bit(9) initial dcl 4-156 or_op internal static fixed bin(18,0) initial dcl 4-197 pascal_boolean_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_char_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_entry_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_enumerated_type_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_enumerated_type_element_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_enumerated_type_instance_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_exportable_procedure_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_imported_procedure_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_integer_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_internal_procedure_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_label_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_parameter_procedure_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_procedure_type_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_real_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_record_file_type_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_record_type_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_set_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_string_type_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_text_file_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_typed_pointer_type_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_user_defined_type_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_user_defined_type_instance_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_value_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 15-132 pascal_variable_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 15-132 pause_op internal static fixed bin(18,0) initial dcl 4-197 picture_runtime_dtype internal static fixed bin(17,0) initial dcl 15-125 plus internal static bit(9) initial dcl 4-156 pointer_dtype internal static fixed bin(17,0) initial dcl 15-25 pointer_node internal static fixed bin(4,0) initial dcl 4-87 primary based structure level 1 dcl 2-234 proc_frame_node internal static fixed bin(4,0) initial dcl 4-87 process_param_list_op internal static fixed bin(18,0) initial dcl 4-197 range based structure level 1 dcl 2-243 rc_a internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_a internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_dp internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_dp internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_e internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_e internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_is15 internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_is15 internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_is18 internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_is18 internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_lb internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_lb internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_lp15 internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_lp15 internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_lp18 internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_lp18 internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_nlb internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_nlb internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_nlp18 internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_nlp18 internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_ns internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_ns internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_nt internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_nt internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_s internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_s internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" rc_sr internal static bit(6) initial packed unaligned dcl 11-6 in procedure "fort_" rc_sr internal static bit(6) initial packed unaligned dcl 14-6 in procedure "create_constant" read_array_op internal static fixed bin(18,0) initial dcl 4-197 read_internal_file_op internal static fixed bin(18,0) initial dcl 4-197 read_namelist_op internal static fixed bin(18,0) initial dcl 4-197 read_op internal static fixed bin(18,0) initial dcl 4-197 read_scalar_op internal static fixed bin(18,0) initial dcl 4-197 read_vector_op internal static fixed bin(18,0) initial dcl 4-197 real_const internal static bit(9) initial dcl 4-156 real_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_bin_1_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_bin_2_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_4bit_bytealigned_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_4bit_ls_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_4bit_ts_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_4bit_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_9bit_ls_overp_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_9bit_ts_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_9bit_ts_overp_dtype internal static fixed bin(17,0) initial dcl 15-25 real_fix_dec_9bit_uns_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_dec_4bit_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 15-25 real_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 15-25 real_mode internal static fixed bin(4,0) initial dcl 4-106 record_number_op internal static fixed bin(18,0) initial dcl 4-197 rel_constant internal static fixed bin(4,0) initial dcl 4-120 return_op internal static fixed bin(18,0) initial dcl 4-197 rewind_op internal static fixed bin(18,0) initial dcl 4-197 right_parn internal static bit(9) initial dcl 4-156 right_shift_op internal static fixed bin(18,0) initial dcl 4-197 sf_def_op internal static fixed bin(18,0) initial dcl 4-197 sf_op internal static fixed bin(18,0) initial dcl 4-197 slash internal static bit(9) initial dcl 4-156 source_list based structure array level 1 dcl 3-31 statement_function internal static fixed bin(4,0) initial dcl 4-120 stop_op internal static fixed bin(18,0) initial dcl 4-197 storage_add_one_op internal static fixed bin(18,0) initial dcl 4-197 storage_add_op internal static fixed bin(18,0) initial dcl 4-197 storage_sub_op internal static fixed bin(18,0) initial dcl 4-197 store_zero_op internal static fixed bin(18,0) initial dcl 4-197 string_length_op internal static fixed bin(18,0) initial dcl 4-197 string_op internal static fixed bin(18,0) initial dcl 4-197 structure_dtype internal static fixed bin(17,0) initial dcl 15-25 sub_index_op internal static fixed bin(18,0) initial dcl 4-197 sub_op internal static fixed bin(18,0) initial dcl 4-197 subprogram_node internal static fixed bin(4,0) initial dcl 4-87 subr_op internal static fixed bin(18,0) initial dcl 4-197 subroutine internal static fixed bin(9,0) initial dcl 4-68 subscript_op internal static fixed bin(18,0) initial dcl 4-197 substr_left_parn internal static bit(9) initial dcl 4-156 substr_op internal static fixed bin(18,0) initial dcl 4-197 temp_type internal static fixed bin(4,0) initial dcl 4-120 terminate_op internal static fixed bin(18,0) initial dcl 4-197 true internal static bit(9) initial dcl 4-156 typeless_mode internal static fixed bin(4,0) initial dcl 4-106 units_per_word internal static fixed bin(6,0) initial array dcl 4-142 unnamed_block_data_subprg_name internal static char(29) initial packed unaligned dcl 4-82 variable_type internal static fixed bin(4,0) initial dcl 4-120 varying_bit_dtype internal static fixed bin(17,0) initial dcl 15-25 word_units internal static fixed bin(3,0) initial dcl 4-136 write_array_op internal static fixed bin(18,0) initial dcl 4-197 write_internal_file_op internal static fixed bin(18,0) initial dcl 4-197 write_namelist_op internal static fixed bin(18,0) initial dcl 4-197 write_op internal static fixed bin(18,0) initial dcl 4-197 write_scalar_op internal static fixed bin(18,0) initial dcl 4-197 write_vector_op internal static fixed bin(18,0) initial dcl 4-197 xmit_array_op internal static fixed bin(18,0) initial dcl 4-197 xmit_scalar_op internal static fixed bin(18,0) initial dcl 4-197 xmit_vector_op internal static fixed bin(18,0) initial dcl 4-197 NAMES DECLARED BY EXPLICIT CONTEXT. BEGIN_COMPILER_PHASE 006371 constant entry internal dcl 658 ref 495 517 523 527 533 564 571 abort_compiler 006465 constant entry internal dcl 683 ref 954 1512 abort_display 017201 constant label dcl 2299 ref 2401 add_to_lib_list 007637 constant entry internal dcl 882 ref 706 binary_to_char 013010 constant entry internal dcl 1584 ref 1308 1332 1338 1343 1345 1474 1568 1577 1625 1637 1647 1653 1654 2552 2570 2576 clean_up 006216 constant entry internal dcl 628 ref 443 573 code_generator 006623 constant entry internal dcl 733 ref 535 compile 004750 constant entry external dcl 308 compile_run 005010 constant entry external dcl 331 converter 006575 constant entry internal dcl 715 ref 519 create_char_constant 007340 constant entry internal dcl 777 ref 700 739 755 896 1124 create_constant 007071 constant entry internal dcl 12-13 ref 699 738 754 create_constant_block 007611 constant entry internal dcl 867 ref 743 759 create_listing_node 012403 constant entry internal dcl 1497 ref 1387 1483 create_node 006743 constant entry internal dcl 13-10 ref 12-74 841 922 decode_source_id 013057 constant entry internal dcl 1597 ref 1350 2333 3276 display_int_text 017202 constant entry internal dcl 2302 ref 1975 1991 2042 2119 2142 display_node 020154 constant entry internal dcl 2440 ref 2090 2094 2114 2139 2160 2164 2180 2191 2262 2283 2290 2361 2635 2688 2696 2822 2953 3316 3345 display_operand 032174 constant entry internal dcl 3338 ref 3327 3330 display_quadruples 031372 constant entry internal dcl 3257 ref 2000 2009 2070 2122 2148 2815 dump_words 017700 constant entry internal dcl 2369 ref 2350 2963 finish_listing_node 012465 constant entry internal dcl 1523 ref 1402 1492 fort_ 004623 constant entry external dcl 91 fort_abort 005623 constant label dcl 545 ref 690 1411 fort_display 014763 constant entry internal dcl 1850 ref 374 get_addressing_attributes 030542 constant entry internal dcl 3188 ref 2513 2726 2774 2786 2838 2887 2909 get_next_source_seg_comp 007767 constant entry internal dcl 934 ref 279 320 get_next_temp_segment 010003 constant entry internal dcl 943 ref 702 get_node_size 017775 constant entry internal dcl 2387 ref 2098 2115 2140 2209 2963 2963 identify_node 012513 constant entry internal dcl 1538 ref 1314 1465 initialize 005054 constant label dcl 355 ref 303 326 join 007366 constant label dcl 801 ref 878 listing_generator 006717 constant entry internal dcl 765 ref 566 optimizer 006610 constant entry internal dcl 724 ref 525 optimizing_cg 006661 constant entry internal dcl 749 ref 529 output_node 000006 constant label array(0:15) dcl 2490 ref 2487 parse_source 006523 constant entry internal dcl 693 ref 499 print_common_fields 031051 constant entry internal dcl 3227 ref 2606 2741 2775 2807 2857 2892 2930 print_constant_value 013502 constant entry internal dcl 1660 ref 1548 1553 2644 2767 2879 2977 print_message 010065 constant entry internal dcl 974 ref 701 740 756 13-29 12-45 print_message_op 010274 constant entry internal dcl 1044 ref 742 758 1040 print_message_op$epilogue 011767 constant entry internal dcl 1416 ref 558 print_message_summary 012073 constant entry internal dcl 1441 ref 1136 1147 1189 1191 1193 1422 1430 1436 print_routine 000000 constant label array(6) dcl 1690 ref 1682 1687 trim_floating 014436 constant entry internal dcl 1788 ref 1702 1710 1719 1721 unknown_node 020265 constant label dcl 2482 in procedure "display_node" unknown_node 020014 constant label dcl 2399 in procedure "get_node_size" ref 2437 NAME DECLARED BY CONTEXT OR IMPLICATION. maxlength builtin function ref 1816 1816 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 33614 33740 32717 33624 Length 34764 32717 124 1010 674 12 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME fort_ 3046 external procedure is an external procedure. on unit on line 443 64 on unit clean_up 92 internal procedure is called by several nonquick procedures. BEGIN_COMPILER_PHASE internal procedure shares stack frame of external procedure fort_. abort_compiler 82 internal procedure is called by several nonquick procedures. parse_source internal procedure shares stack frame of external procedure fort_. converter internal procedure shares stack frame of external procedure fort_. optimizer internal procedure shares stack frame of external procedure fort_. code_generator internal procedure shares stack frame of external procedure fort_. optimizing_cg internal procedure shares stack frame of external procedure fort_. listing_generator internal procedure shares stack frame of external procedure fort_. create_node 94 internal procedure is called by several nonquick procedures. create_constant 100 internal procedure is assigned to an entry variable. create_char_constant 346 internal procedure is called during a stack extension, and is assigned to an entry variable. add_to_lib_list 144 internal procedure is assigned to an entry variable. get_next_source_seg_comp 64 internal procedure is assigned to an entry variable. get_next_temp_segment 92 internal procedure is assigned to an entry variable. print_message 110 internal procedure is called during a stack extension, is assigned to an entry variable, is declared options(non_quick), and is declared options(variable). print_message_op 622 internal procedure is assigned to an entry variable. print_message_summary internal procedure shares stack frame of internal procedure print_message_op. create_listing_node internal procedure shares stack frame of internal procedure print_message_op. finish_listing_node internal procedure shares stack frame of internal procedure print_message_op. identify_node internal procedure shares stack frame of internal procedure print_message_op. binary_to_char 72 internal procedure is called by several nonquick procedures. decode_source_id 98 internal procedure is called by several nonquick procedures. print_constant_value 260 internal procedure is called by several nonquick procedures. trim_floating internal procedure shares stack frame of internal procedure print_constant_value. fort_display 422 internal procedure is assigned to an entry variable. display_int_text internal procedure shares stack frame of internal procedure fort_display. dump_words 94 internal procedure is called by several nonquick procedures. get_node_size 98 internal procedure is called by several nonquick procedures. display_node 302 internal procedure calls itself recursively. get_addressing_attributes internal procedure shares stack frame of internal procedure display_node. print_common_fields internal procedure shares stack frame of internal procedure display_node. display_quadruples 214 internal procedure is called by several nonquick procedures. display_operand internal procedure shares stack frame of internal procedure display_quadruples. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 static_user_id fort_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME add_to_lib_list 000100 a_pathname add_to_lib_list 000201 char_node_offset add_to_lib_list binary_to_char 000100 output binary_to_char clean_up 000100 code clean_up 000101 i clean_up 000102 p clean_up create_char_constant 000100 cc_offset create_char_constant 000102 cc_ptr create_char_constant 000104 hash_index create_char_constant 000105 i create_char_constant 000106 j create_char_constant 000107 k create_char_constant 000110 which create_char_constant 000111 mod_2_sum create_char_constant 000112 string_bit_array create_char_constant create_constant 000100 a_data_type create_constant 000102 a_value create_constant 000104 data_size create_constant 000105 hash_index create_constant 000106 mod_2_sum create_constant 000107 node_offset create_constant 000110 node_ptr create_constant create_node 000100 offset create_node decode_source_id 000100 id_line decode_source_id 000121 i decode_source_id 000122 source_id decode_source_id display_node 000100 a_node_type display_node 000101 chain display_node 000102 everything display_node 000103 ft display_node 000104 ls display_node 000105 nx display_node 000106 node_offset display_node 000110 node_ptr display_node 000112 prt_sw display_node 000113 walk_chains display_node 000114 i display_node display_quadruples 000100 last display_quadruples 000101 op display_quadruples 000102 i display_quadruples 000104 o display_quadruples dump_words 000100 bp dump_words 000102 count dump_words 000103 i dump_words fort_ 000100 char_constant_length fort_ 000101 error_text_length fort_ 000102 shared_globals fort_ 003256 parse_globals fort_ 003274 cg_globals fort_ 003470 intermediate_base fort_ 003472 node_offset fort_ 003473 phase fort_ 003474 node_ptr fort_ 003476 tsegp fort_ 003522 number_of_temps fort_ 003523 num_opt_segs fort_ 003524 i fort_ 003525 max_length fort_ 003526 p fort_ 003530 q fort_ 003532 meter_info fort_ 003632 cpu fort_ 003634 total_cpu fort_ 003636 last_phase fort_ 003637 last_error_subprogram fort_ 003640 last_error_statement fort_ 003641 begin_subprogram_errors fort_ 003642 begin_statement_errors fort_ 003643 msg_table_len fort_ 003644 error_msg fort_ 005304 message_printed fort_ 005324 produce_listing fort_ 005325 date_string fort_ 005333 user_id fort_ fort_display 000100 count_array fort_display 000261 node_size fort_display 000301 ons fort_display 000402 stat_start fort_display 000403 stat_length fort_display 000404 cs fort_display 000406 sp fort_display 000410 first_time fort_display 000411 n fort_display 000412 nodetype fort_display 000413 offset fort_display 000414 i fort_display 000415 subp fort_display 000416 next_one fort_display 000417 item fort_display 000430 an_offset display_int_text 000431 content display_int_text 000432 op_ptr display_int_text get_next_temp_segment 000100 p get_next_temp_segment 000102 code get_next_temp_segment get_node_size 000100 p get_node_size 000102 node_type get_node_size print_constant_value 000100 chars print_constant_value 000102 cs print_constant_value 000203 i print_constant_value 000204 j print_constant_value 000205 k print_constant_value 000206 l print_constant_value 000210 node_ptr print_constant_value 000212 piece print_constant_value 000220 value_ptr print_constant_value 000254 fpn_prec trim_floating 000255 fpn_type trim_floating 000256 ret_value trim_floating 000270 temp trim_floating print_message 000100 arg_list_ptr print_message 000102 arg_ptr print_message 000104 packed print_message 000105 code print_message 000106 nargs print_message 000107 i print_message 000110 arg_len print_message 000111 a_type print_message 000112 ndims print_message 000113 size print_message 000114 scale print_message print_message_op 000100 node_ptr print_message_op 000102 table_base print_message_op 000104 a_message_number print_message_op 000105 opnd print_message_op 000106 i print_message_op 000107 arg_length print_message_op 000110 noprds print_message_op 000111 new_slot print_message_op 000112 message_length print_message_op 000113 message_offset print_message_op 000114 arg_string print_message_op 000417 header_line print_message_op 000460 print_on_terminal print_message_op 000461 a_node_type print_message_op 000462 an_error_level print_message_op 000504 lvl print_message_summary 000505 msg print_message_summary THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as r_le_a alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 mdfx1 signal_op enable_op shorten_stack ext_entry int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_ clock_ cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr cu_$decode_entry_value date_time_ decode_descriptor_ ext_code_generator ext_listing_generator ext_parse fort_converter fort_defaults_$options_string fort_optimizer fort_optimizing_cg get_group_id_ get_temp_segment_ get_temp_segments_ hcs_$terminate_noname hcs_$usage_values ioa_ ioa_$nnl ioa_$rsnp probe release_temp_segment_ release_temp_segments_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. display_entries$fdisplay error_table_$translation_aborted error_table_$translation_failed fort_message_table$fort_message_table fortran_severity_ pl1_operators_$VLA_words_per_seg_ sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 232 004607 91 004614 274 004640 278 004644 279 004657 282 004667 287 004674 288 004707 291 004716 292 004720 297 004725 301 004735 302 004737 303 004742 308 004743 320 004761 321 004764 322 004770 323 004772 324 004774 325 004777 326 005001 331 005002 347 005025 348 005032 349 005037 350 005043 351 005045 352 005047 353 005052 355 005054 358 005061 359 005064 362 005065 364 005067 365 005075 367 005101 369 005104 371 005107 374 005120 378 005125 380 005143 383 005163 384 005171 388 005176 392 005204 394 005207 396 005217 397 005227 400 005232 403 005242 407 005247 411 005266 413 005267 415 005274 417 005276 419 005300 420 005301 422 005305 424 005307 426 005313 428 005315 431 005323 436 005325 437 005326 438 005341 443 005343 448 005365 450 005367 453 005373 456 005400 457 005433 462 005435 463 005440 464 005442 465 005444 466 005450 470 005451 472 005453 473 005455 474 005457 478 005461 479 005462 481 005466 482 005467 487 005471 489 005474 490 005500 491 005503 492 005505 495 005507 497 005513 498 005515 499 005516 500 005525 501 005527 505 005530 510 005545 515 005553 517 005556 519 005564 521 005565 523 005567 525 005575 527 005576 529 005604 530 005605 533 005606 535 005614 538 005615 543 005620 545 005623 547 005626 548 005630 549 005631 551 005632 552 005635 553 005637 554 005640 558 005641 562 005645 564 005647 566 005655 571 005656 573 005670 575 005674 577 005677 578 005710 579 005712 580 005714 581 005716 583 005720 585 005735 592 005777 593 006002 595 006003 599 006011 604 006015 608 006024 612 006127 614 006131 618 006133 621 006171 626 006214 628 006215 635 006223 636 006233 637 006250 639 006252 641 006253 644 006263 645 006274 646 006276 647 006300 648 006323 650 006324 653 006326 654 006361 656 006370 658 006371 665 006373 667 006376 668 006411 669 006416 670 006420 671 006422 674 006424 676 006430 677 006453 680 006460 681 006463 683 006464 689 006500 690 006520 693 006523 699 006525 700 006530 701 006533 702 006536 704 006541 706 006545 709 006553 711 006557 713 006574 715 006575 720 006576 722 006607 724 006610 729 006611 731 006622 733 006623 738 006624 739 006627 740 006632 742 006635 743 006640 745 006643 747 006660 749 006661 754 006662 755 006665 756 006670 758 006673 759 006676 761 006701 763 006716 765 006717 771 006720 773 006741 13 10 006742 13 20 006750 13 22 006756 13 23 006760 13 24 006762 13 25 006772 13 26 006777 13 29 007002 13 30 007063 13 32 007064 12 13 007070 12 40 007076 12 41 007101 12 43 007105 12 45 007114 12 46 007163 12 47 007165 12 49 007167 12 51 007172 12 52 007174 12 53 007175 12 54 007176 12 57 007201 12 61 007205 12 62 007210 12 63 007212 12 65 007215 12 69 007232 12 70 007235 12 74 007236 12 76 007255 12 78 007264 12 80 007267 12 81 007271 12 82 007276 12 83 007302 12 84 007304 12 85 007306 12 87 007311 12 89 007314 12 91 007323 12 93 007332 12 95 007334 777 007337 795 007356 796 007360 797 007364 801 007366 804 007374 806 007376 807 007403 809 007404 811 007405 812 007410 814 007415 817 007423 818 007431 819 007433 821 007435 826 007442 827 007446 828 007450 830 007453 836 007476 837 007501 841 007502 843 007523 845 007532 847 007535 848 007537 849 007543 850 007547 851 007552 852 007557 853 007561 855 007563 857 007566 859 007575 862 007604 864 007606 867 007610 875 007621 876 007623 877 007630 878 007635 882 007636 891 007652 892 007663 896 007664 897 007701 902 007706 904 007711 908 007712 909 007715 910 007717 912 007722 913 007725 920 007726 922 007730 924 007745 926 007752 928 007757 930 007764 932 007765 934 007766 939 007774 941 010001 943 010002 952 010010 954 010032 957 010050 959 010052 960 010056 961 010060 963 010062 974 010064 1001 010072 1002 010100 1006 010104 1010 010113 1011 010132 1015 010135 1016 010145 1017 010162 1019 010205 1021 010210 1022 010214 1023 010217 1024 010220 1026 010224 1027 010231 1029 010241 1030 010246 1031 010250 1034 010251 1035 010256 1036 010261 1038 010263 1040 010265 1042 010272 1044 010273 1073 010301 1075 010304 1079 010320 1080 010322 1081 010324 1082 010327 1085 010330 1087 010335 1093 010343 1112 010346 1117 010351 1120 010355 1123 010363 1124 010365 1127 010412 1128 010414 1133 010416 1135 010424 1136 010433 1137 010442 1139 010444 1140 010450 1143 010451 1146 010457 1147 010467 1148 010476 1150 010500 1151 010504 1152 010505 1155 010506 1159 010510 1160 010517 1166 010531 1168 010534 1169 010535 1170 010536 1172 010537 1177 010545 1178 010547 1180 010550 1184 010552 1189 010560 1191 010575 1193 010612 1195 010623 1196 010633 1197 010643 1199 010645 1201 010652 1207 010656 1211 010700 1213 010704 1214 010706 1216 010707 1219 010713 1223 010720 1224 010721 1226 010722 1227 010731 1228 010741 1230 010743 1232 010750 1235 010751 1237 010753 1238 010754 1239 010755 1242 010760 1243 010767 1244 010777 1245 011001 1247 011002 1249 011004 1250 011005 1252 011006 1253 011015 1254 011025 1255 011027 1257 011030 1260 011032 1261 011040 1262 011042 1263 011043 1269 011045 1276 011057 1277 011061 1280 011064 1283 011122 1290 011125 1291 011126 1292 011127 1294 011130 1296 011132 1300 011141 1302 011146 1303 011150 1304 011166 1308 011167 1314 011221 1317 011244 1321 011246 1322 011254 1324 011260 1329 011263 1331 011267 1332 011273 1333 011316 1335 011317 1337 011321 1338 011326 1339 011351 1342 011352 1343 011356 1344 011401 1345 011413 1350 011440 1354 011472 1357 011474 1362 011513 1365 011562 1367 011563 1368 011612 1373 011617 1375 011623 1376 011642 1382 011647 1387 011652 1393 011663 1402 011746 1407 011750 1409 011756 1411 011760 1413 011765 1416 011766 1419 011774 1421 011777 1422 012007 1423 012016 1424 012020 1427 012024 1429 012026 1430 012035 1431 012044 1432 012046 1435 012052 1436 012061 1437 012070 1438 012072 1441 012073 1449 012075 1452 012104 1453 012107 1455 012114 1458 012124 1460 012135 1462 012142 1464 012144 1465 012156 1466 012175 1469 012204 1471 012216 1474 012241 1475 012265 1478 012277 1481 012327 1483 012332 1485 012342 1492 012401 1494 012402 1497 012403 1504 012405 1506 012411 1507 012413 1510 012430 1512 012435 1516 012454 1518 012461 1519 012464 1523 012465 1526 012466 1528 012472 1530 012500 1532 012504 1534 012505 1535 012512 1538 012513 1543 012515 1544 012520 1546 012523 1548 012525 1551 012552 1553 012554 1556 012601 1559 012612 1561 012614 1562 012620 1565 012647 1568 012665 1571 012714 1574 012735 1577 012744 1584 013007 1590 013015 1591 013026 1597 013056 1608 013064 1610 013065 1612 013070 1614 013105 1616 013114 1618 013130 1619 013134 1622 013143 1624 013146 1625 013160 1628 013203 1630 013213 1632 013217 1636 013234 1637 013246 1640 013271 1642 013301 1644 013304 1646 013305 1647 013317 1650 013342 1651 013343 1653 013346 1654 013416 1656 013470 1657 013471 1660 013501 1680 013507 1682 013513 1685 013531 1686 013532 1687 013534 1690 013536 1694 013547 1695 013604 1698 013613 1702 013624 1703 013642 1706 013652 1710 013663 1711 013701 1714 013711 1718 013722 1719 013731 1720 013747 1721 013761 1722 014002 1723 014011 1726 014021 1730 014032 1732 014047 1733 014061 1736 014070 1740 014103 1743 014124 1745 014135 1746 014147 1748 014160 1751 014161 1753 014165 1754 014206 1756 014217 1757 014223 1759 014225 1760 014233 1761 014242 1763 014252 1765 014254 1766 014323 1769 014340 1771 014344 1772 014360 1774 014366 1775 014377 1779 014403 1780 014415 1782 014420 1784 014426 1788 014436 1803 014440 1805 014444 1806 014446 1808 014455 1809 014457 1811 014460 1812 014462 1814 014471 1816 014473 1817 014527 1821 014563 1824 014613 1827 014636 1830 014652 1832 014657 1835 014664 1836 014675 1838 014704 1840 014724 1842 014743 1846 014752 1850 014762 1892 014770 1893 014772 1894 014773 1895 014774 1896 014775 1897 014777 1898 015001 1899 015002 1900 015003 1901 015004 1902 015006 1903 015010 1904 015012 1905 015014 1906 015015 1907 015017 1961 015021 1963 015026 1965 015031 1966 015050 1969 015051 1971 015055 1974 015061 1975 015100 1976 015106 1984 015107 1986 015114 1989 015127 1991 015130 1992 015136 1995 015137 1997 015142 1999 015146 2000 015165 2001 015201 2004 015202 2006 015205 2009 015213 2016 015227 2018 015237 2020 015241 2021 015246 2023 015251 2024 015260 2025 015263 2027 015266 2035 015276 2037 015301 2040 015314 2042 015315 2045 015323 2046 015324 2048 015327 2050 015334 2055 015357 2057 015365 2058 015372 2060 015375 2061 015402 2062 015405 2064 015410 2066 015420 2068 015430 2070 015431 2072 015445 2073 015450 2075 015455 2081 015500 2085 015505 2088 015514 2090 015516 2094 015562 2098 015631 2100 015645 2106 015670 2108 015675 2110 015700 2111 015706 2113 015712 2114 015720 2115 015744 2116 015762 2117 015763 2119 015764 2122 015777 2126 016020 2133 016047 2136 016054 2139 016066 2140 016110 2142 016127 2145 016145 2147 016156 2148 016161 2149 016175 2156 016202 2159 016207 2160 016214 2161 016236 2163 016245 2164 016252 2165 016274 2167 016303 2174 016324 2177 016354 2180 016360 2181 016402 2186 016411 2189 016441 2191 016444 2193 016471 2198 016500 2200 016505 2202 016510 2204 016527 2205 016536 2206 016540 2208 016543 2209 016544 2211 016557 2212 016563 2214 016613 2216 016615 2218 016620 2220 016634 2221 016636 2223 016642 2224 016644 2226 016645 2230 016651 2234 016654 2236 016656 2239 016657 2242 016665 2244 016673 2246 016674 2248 016675 2250 016676 2252 016703 2254 016733 2260 016735 2262 016750 2263 016776 2268 017005 2270 017012 2271 017020 2273 017025 2274 017032 2276 017035 2278 017037 2279 017051 2281 017056 2283 017057 2285 017075 2286 017076 2289 017117 2290 017122 2291 017135 2292 017143 2293 017144 2294 017146 2296 017153 2299 017201 2302 017202 2310 017204 2312 017206 2314 017212 2315 017215 2317 017216 2320 017246 2323 017263 2325 017265 2327 017316 2329 017321 2330 017326 2331 017332 2333 017335 2338 017426 2340 017452 2342 017475 2343 017511 2344 017545 2346 017551 2348 017552 2350 017554 2353 017576 2356 017603 2358 017604 2361 017636 2364 017654 2365 017675 2367 017676 2369 017677 2378 017705 2379 017711 2381 017713 2382 017721 2383 017765 2384 017770 2385 017773 2387 017774 2394 020002 2395 020006 2397 020011 2399 020014 2401 020040 2404 020043 2407 020050 2409 020053 2412 020063 2414 020065 2417 020075 2419 020077 2421 020105 2423 020111 2426 020117 2429 020130 2432 020142 2434 020144 2437 020152 2440 020153 2463 020161 2464 020164 2465 020167 2469 020175 2471 020204 2472 020223 2475 020224 2477 020226 2479 020231 2482 020265 2484 020312 2487 020313 2490 020315 2493 020344 2496 020345 2500 020347 2503 020411 2506 020412 2510 020461 2513 020463 2517 020464 2519 020502 2521 020520 2523 020536 2525 020554 2527 020572 2529 020610 2532 020626 2534 020645 2536 020663 2539 020701 2541 020717 2543 020735 2545 020753 2547 020771 2549 021007 2551 021012 2552 021025 2553 021055 2555 021067 2557 021106 2559 021124 2561 021142 2563 021160 2565 021176 2567 021214 2569 021217 2570 021232 2571 021261 2573 021273 2575 021277 2576 021312 2577 021341 2579 021353 2581 021372 2583 021410 2585 021426 2587 021444 2589 021462 2591 021500 2593 021516 2595 021534 2597 021552 2599 021570 2601 021606 2603 021624 2606 021642 2608 021652 2611 021700 2614 021732 2617 021764 2620 022012 2623 022043 2626 022072 2629 022120 2632 022147 2634 022155 2635 022202 2639 022225 2641 022232 2642 022257 2644 022274 2646 022357 2649 022365 2652 022417 2655 022452 2657 022512 2660 022513 2664 022515 2667 022534 2669 022561 2672 022614 2674 022640 2677 022663 2680 022713 2682 022737 2683 022751 2685 022774 2687 023003 2688 023030 2690 023051 2691 023052 2693 023101 2695 023110 2696 023135 2698 023156 2699 023157 2701 023203 2704 023243 2706 023272 2707 023274 2710 023275 2714 023332 2717 023361 2720 023413 2723 023442 2726 023444 2728 023445 2730 023463 2732 023501 2734 023517 2736 023535 2738 023553 2741 023571 2743 023602 2746 023630 2749 023662 2753 023713 2756 023741 2759 023767 2762 024016 2764 024047 2767 024050 2771 024131 2774 024133 2775 024134 2776 024144 2779 024145 2783 024211 2786 024213 2788 024214 2791 024236 2792 024252 2794 024271 2796 024304 2798 024321 2800 024336 2802 024353 2804 024370 2807 024405 2809 024415 2812 024446 2814 024452 2815 024475 2819 024515 2821 024521 2822 024541 2825 024562 2828 024563 2832 024620 2835 024655 2838 024657 2842 024660 2844 024676 2846 024714 2848 024732 2850 024750 2852 024766 2854 025004 2857 025022 2859 025027 2862 025055 2865 025103 2868 025134 2871 025160 2874 025170 2875 025230 2876 025240 2879 025241 2884 025327 2887 025331 2889 025332 2892 025350 2893 025360 2896 025361 2900 025416 2903 025445 2906 025474 2909 025476 2911 025477 2914 025515 2917 025533 2920 025551 2922 025567 2924 025605 2927 025623 2930 025641 2932 025652 2935 025700 2938 025731 2941 025762 2944 026016 2947 026044 2950 026073 2953 026124 2955 026145 2958 026146 2962 026150 2963 026161 2964 026203 2967 026204 2971 026206 2974 026233 2977 026256 2979 026325 2982 026326 2984 026331 2986 026362 2989 026430 2992 026432 2993 026434 2995 026445 2997 026465 2999 026500 3001 026516 3003 026530 3006 026545 3009 026562 3011 026600 3013 026612 3016 026627 3018 026645 3020 026657 3022 026675 3024 026707 3026 026725 3028 026737 3031 026767 3032 026771 3034 027006 3036 027023 3038 027040 3040 027055 3042 027072 3044 027107 3047 027124 3050 027152 3054 027206 3059 027242 3062 027276 3065 027335 3068 027371 3071 027430 3074 027467 3077 027516 3080 027547 3081 027551 3083 027557 3084 027565 3085 027570 3087 027572 3089 027600 3091 027616 3093 027617 3095 027650 3097 027652 3103 027713 3106 027714 3110 027716 3111 027740 3113 027751 3115 027753 3117 027770 3119 030006 3122 030023 3123 030060 3124 030062 3127 030063 3132 030127 3135 030130 3139 030155 3140 030173 3142 030201 3147 030237 3148 030245 3151 030303 3153 030305 3155 030307 3159 030332 3160 030346 3161 030353 3167 030414 3169 030416 3170 030435 3171 030441 3178 030505 3180 030507 3185 030541 3188 030542 3191 030543 3193 030545 3195 030562 3197 030577 3199 030614 3201 030631 3203 030646 3205 030663 3207 030700 3209 030715 3211 030732 3213 030747 3215 030764 3217 031001 3219 031016 3221 031033 3224 031050 3227 031051 3232 031062 3234 031114 3235 031125 3237 031127 3240 031157 3243 031210 3245 031243 3248 031271 3251 031316 3253 031370 3257 031371 3266 031377 3268 031401 3269 031412 3270 031416 3272 031417 3274 031424 3275 031431 3276 031434 3287 031571 3288 031574 3290 031606 3293 031616 3296 031633 3299 031650 3302 031665 3305 031702 3307 031721 3310 031750 3313 031774 3316 032025 3318 032044 3321 032045 3324 032105 3327 032140 3329 032145 3330 032157 3331 032164 3333 032166 3335 032173 3338 032174 3343 032176 3345 032226 3347 032243 3349 032256 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved