COMPILATION LISTING OF SEGMENT compile_exp Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1058.20_Tue_mdt Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 /* format: style3 */ 11 12 /* program to compile expressions 13* 14* Initial Version: 9 April 1971 by BLW for Version II 15* Modified: 25 January 1973 by BLW 16* Modified: 16 February 1973 by RAB 17* Modified: 27 June 1973 by RAB for EIS 18* Modified: 10 Sept 1975 by RAB to fix 1417 19* Modified: 25 Sept 1975 by RAB to fix 1423 20* Modified: 5 Oct 1975 for repeat_fun optimization 21* Modified: 1 Feb 1976 by RAB for reverse_fun optimization 22* Modified: 1 Feb 1976 by RAB to fix 1458 23* Modified: 10 Feb 1976 by RAB to fix 1464 24* Modified: 15 June 1976 by RAB to fix 1501 25* Modified: 23 June 1976 by RAB to centralize use of cg_stat$last_call 26* Modified: 7 Dec 1976 by RAB to fix 1559 27* Modified: 23 Dec 1976 by RAB for after,before,ltrim,rtrim 28* Modified: 30 Dec 1976 by RAB for 9-bit translate, search, verify 29* Modified 770619 by PG for clock, vclock, and stacq 30* Modified: 12 July 1977 by RAB to change stacq definition 31* Modified: 7 August 1978 by RAB to partially fix 1731 32* Modified 780828 by PG to fix 1744 and remove pos_diff_fun 33* Modified: 16 July 1979 by RAB to fix 1852 (abs(unal_auto) fails) 34* and to remove use of absfx1_atm for faster code. 35* Modified: 25 July 1979 by PCK to implement rank and byte builtins 36* Modified: 29 August 1979 by PCK to fix bug 1853 37* Modified 791023 by PG to recognize substr(string_const,const,1) in several contexts by inventing 38* is_string_constant. 39* Modified 791023 by PG to fix 1857 in which rank and byte didn't accept expressions. 40* Modified 791026 by PG to use TCT tables in pl1_operators_ when possible. 41* Modified December 1979 by BSG for reverse index, verify, search, 2 char reverse, and reverse bugs. 42* Modified 800218 by PG to have math builtins update machine_state.indicators. 43* Modified: 29 Feb 1980 to fix 1921 44* Modified: 30 March 1980 by RAB for reference.(aligned padded)_for_store_ref. 45* See prepare_operand for details. 46* Modified: 15 August 1980 by M. N. Davidoff to fix 2005. 47* Modified: 16 September 1980 by M. N. Davidoff to fix 1985. 48**/ 49 /* format: style3 */ 50 compile_exp: 51 proc (pt); 52 53 /* parameters */ 54 55 dcl pt ptr; /* points at operator node */ 56 57 /* external static */ 58 59 dcl ( 60 cg_stat$cur_node, 61 cg_stat$temp_ref, 62 cg_stat$eis_temp, 63 cg_stat$complex_ac, 64 cg_stat$text_base 65 ) ptr ext, 66 ( 67 cg_stat$text_pos, 68 cg_stat$offset_null_value 69 ) fixed bin ext, 70 ( 71 cg_stat$save_exp_called, 72 cg_stat$for_test_called, 73 cg_stat$extended_stack 74 ) bit (1) ext; 75 76 dcl ( 77 opcode_info$opcode_info 78 (0:118), 79 opcode_info$last_opcode, 80 opcode_info$table (0:18) 81 ) fixed bin ext; 82 83 /* automatic */ 84 85 dcl ( 86 p, 87 q, 88 pa, 89 ref1, 90 save_cur_node, 91 ref (5), 92 sym (5), 93 rand (5) 94 ) ptr, 95 ( 96 sec, 97 ftc, 98 in_storage, /* Conjecture: means result is in ref1 */ 99 inline, 100 load_it, 101 atom (5), 102 update_long, 103 constant_rands, 104 save_it, 105 scaled, 106 update_ref, 107 atomic, 108 is_string, 109 check_type, 110 check_aligned 111 ) bit (1) aligned, 112 c_offset fixed bin (24), 113 drop bit (1) aligned init ("0"b), 114 op_code bit (9), 115 b3 bit (3) aligned; 116 dcl double bit (72) aligned; 117 dcl (mvt_table, result_string) 118 char (512) aligned, 119 op_class bit (5) defined (op_code) pos (1), 120 op_relative bit (4) defined (op_code) pos (6), 121 ( 122 i, 123 j, 124 k, 125 n, 126 action, 127 op_rel, 128 delta, 129 call_code, 130 code, 131 type (5), 132 bump, 133 orig_count, 134 rlength, 135 scale, 136 array (2) 137 ) fixed bin, 138 (save_l1, save_l2) fixed bin (24), 139 save_mwif bit (1), 140 save_coff fixed bin (24), 141 save_units fixed bin (3), 142 (macro, m) fixed bin (15); 143 144 /* entries */ 145 146 dcl ( 147 load, 148 load$for_test, 149 load$for_save 150 ) entry (ptr, fixed bin), 151 load$long_string entry (ptr), 152 (assign_op, load_size) 153 entry (ptr), 154 aq_man$fix_scale entry (ptr, fixed bin, fixed bin), 155 aq_man$check_strings 156 entry (fixed bin (8)), 157 aq_man$left_shift entry (fixed bin (8), bit (1) aligned), 158 aq_man$right_shift entry (fixed bin (8), bit (1) aligned), 159 min_max entry (ptr), 160 compile_exp entry (ptr), 161 gen_arithmetic_builtin 162 entry (ptr, (5) ptr, (5) bit (1) aligned, fixed bin), 163 gen_arithmetic_call entry (ptr, (5) ptr, (5) aligned bit (1)), 164 xr_man$load_const entry (fixed bin, fixed bin), 165 ( 166 compile_exp$save, 167 compile_exp$save_exp 168 ) entry (ptr) returns (ptr), 169 c_a entry (fixed bin (18), fixed bin) returns (ptr), 170 base_man$load_var entry (fixed bin, ptr, fixed bin), 171 ( 172 base_man$load_a_var, 173 base_man$load_q_var, 174 base_man$load_aq_var 175 ) entry (ptr), 176 base_to_core entry (fixed bin, ptr), 177 expmac entry (fixed bin (15), ptr), 178 expmac$many_eis entry (fixed bin (15), ptr, fixed bin), 179 expmac$conditional entry (fixed bin (15), ptr, (5) ptr, (5) bit (1) aligned), 180 ( 181 expmac$eis, 182 expmac$one_eis 183 ) entry (fixed bin (15), ptr), 184 expmac$two_eis entry (fixed bin (15), ptr, ptr), 185 expmac$abs entry (ptr, fixed bin), 186 long_op$eis_operator 187 entry (ptr, ptr, fixed bin (15)), 188 cg_error entry (fixed bin, fixed bin), 189 prepare_operand entry (ptr, fixed bin, bit (1) aligned) returns (ptr), 190 eval_exp entry (ptr, bit (1) aligned) returns (ptr), 191 (arith_op, decimal_op, exp_op) 192 entry (ptr, (5) ptr, (5) bit (1) aligned), 193 (string_op, cat_op) entry (ptr, (5) ptr, fixed bin), 194 pointer_builtins entry (ptr, bit (1) aligned), 195 get_reference entry returns (ptr), 196 inline_operation entry (ptr, (5) ptr, (5) bit (1) aligned) returns (bit (1) aligned), 197 set_indicators entry (ptr, ptr, ptr, fixed bin) returns (fixed bin), 198 expmac$zero entry (fixed bin (15)), 199 ( 200 store$save_string_temp, 201 store$force, 202 state_man$update_ref 203 ) entry (ptr), 204 state_man$set_aliasables 205 entry (ptr), 206 stack_temp$assign_block 207 entry (ptr, fixed bin), 208 state_man$erase_temps 209 entry, 210 ( 211 long_op, 212 long_op$c_or_b 213 ) entry (ptr, fixed bin, fixed bin (15)); 214 dcl generate_constant$bit_string 215 entry (bit (*) aligned, fixed bin) returns (ptr); 216 dcl generate_constant$real_fix_bin_1 217 entry (fixed bin) returns (ptr), 218 generate_constant$char_string 219 entry (char (*) aligned, fixed bin (24)) returns (ptr), 220 state_man$erase_reg entry (bit (19) aligned), 221 state_man$flush entry, 222 string_temp entry (ptr, ptr, ptr) returns (ptr), 223 aq_man$lock entry (ptr, fixed bin), 224 adjust_ref_count entry (ptr, fixed bin), 225 copy_temp entry (ptr) returns (ptr), 226 share_expression entry (ptr) returns (ptr); 227 228 /* builtins */ 229 230 dcl (addr, addrel, collate9, copy, fixed, hbound, index, length, min, mod, null, rank, string, substr) 231 builtin; 232 233 /* based */ 234 235 dcl 1 bit_table_structure 236 based (addr (mvt_table)) aligned, 237 2 bit_table (0:511) bit (9) unaligned; 238 239 dcl fixed_bin_single fixed bin based, 240 fixed_bin_double fixed bin (71) based, 241 word bit (36) aligned based; 242 243 dcl based_cs char (1) aligned based; 244 dcl based_bs bit (1) aligned based; 245 246 dcl 1 mlr_instruction based aligned, 247 2 fill char (1) unal, /* fill character -- can be set by compile_exp */ 248 2 enablefault bit (1) unal, 249 2 pad1 bit (1) unal, 250 2 mf2 bit (7) unal, 251 2 opcode bit (10) unal, 252 2 inhibit bit (1) unal, 253 2 mf1 bit (7) unal; 254 255 dcl 1 csl_instruction based aligned, 256 2 fill bit (1) unal, 257 2 pad1 bit (4) unal, 258 2 bool bit (4) unal, 259 2 enablefault bit (1) unal, 260 2 pad2 bit (1) unal, 261 2 mf2 bit (7) unal, 262 2 opcode bit (10) unal, 263 2 inhibit bit (1) unal, 264 2 mf1 bit (7) unal; 265 266 dcl bit4 bit (4) based aligned; 267 268 dcl 1 op_info aligned based, 269 2 act1 unal bit (6), 270 2 act2 unal bit (6), 271 2 macro unal bit (18), 272 2 delta unal bit (2), 273 2 call_code unal bit (4); 274 275 /* internal static */ 276 277 278 dcl ( 279 zero_bs init (468), 280 one_bs init (469), 281 blank_cs init (472), 282 inline_verify init (207), 283 inline_search init (199), 284 inline_translate init (111), 285 test_translate init (157), 286 test_translate_rev init (158), 287 verify_ltrim_inline init (712), 288 verify_rtrim_inline init (713), 289 absfx1 init (126), 290 testfx1 init (508), 291 ldfx1 init (7), 292 ldfx2 init (8), 293 als init (134), 294 arl init (245), 295 qrs init (514), 296 anq init (688), 297 ana init (40), 298 llr init (372), 299 scaled_mdfx1 init (549), 300 mdfl1 init (269), 301 mdfl2 init (270), 302 stfl2 init (18), 303 stfx1 init (15), 304 offset_mac_easy init (242), 305 offset_mac_hard init (600), 306 chars_move init (420), 307 move_bits init (99), 308 test_bits init (96), 309 fetch_chars_eis init (588), 310 index_chars (4) init (452, 700, 702, 256), 311 index_chars_1 (4) init (460, 704, 706, 256), 312 index_mac (3, 2) init (460, 462, 704, 708, 706, 709), 313 index_rev_mac (2) init (463, 464), 314 round_fl init (531), 315 atan2_mac init (504), 316 atan2d_mac init (557), 317 a_to_x0 init (306), 318 rank_eis_mac init (740), 319 qrl init (418), 320 trunc_mac (0:1) init (124, 384) 321 ) fixed bin (15) int static options (constant); 322 323 dcl rel_table (4:9 /* op */, 0:1 /* string? */, 0:1 /* reversed? */) fixed bin (15) int static 324 init (159, 161, 160, 162, /* < */ 325 161, 159, 162, 160, /* > */ 326 163, 163, 163, 163, /* = */ 327 164, 164, 164, 164, /* ^= */ 328 165, 167, 166, 168, /* <= */ 329 167, 165, 168, 166); /* >= */ 330 331 dcl exp_table (4, 4) fixed bin (15) int static init (592, 0, 559, 560, 332 /* fb1 */ 333 0, 0, 0, 0, /* fb2 */ 334 591, 0, 565, 562, /* flb1 */ 335 564, 0, 561, 562); /* flb2 */ 336 337 338 /* include files */ 339 1 1 /* BEGIN INCLUDE FILE ... cgsystem.incl.pl1 */ 1 2 1 3 /* Modified: 25 Apr 1979 by PCK to implement 4-bit decimal */ 1 4 1 5 dcl ( bits_per_char init(9), 1 6 bits_per_half init(18), 1 7 bits_per_word init(36), 1 8 bits_per_two_words init(72), 1 9 bits_per_four_words init(144), 1 10 bits_per_words(2) init(36,72), 1 11 packed_digits_per_char init(2), 1 12 chars_per_word init(4), 1 13 packed_digits_per_word init(8), 1 14 1 15 break_even_bits init(216), 1 16 break_even_words init(6), 1 17 1 18 label_size init(4), 1 19 1 20 convert_size(13:14) init(9,1), 1 21 max_offset(13:14) init(27,35), 1 22 max_short_size(13:14) init(8,72), 1 23 1 24 units_per_word(0:5) init(1,36,8,4,2,1), 1 25 1 26 max_dec_scale init(32), 1 27 min_dec_scale init(-31), 1 28 max_p_xreg init(18), 1 29 max_p_fix_bin_1 init(35), 1 30 max_p_flt_bin_1 init(27), 1 31 max_p_fix_dec init(59), 1 32 max_length_p init(24), 1 33 default_fix_bin_p init(17)) fixed bin(8) int static options(constant); 1 34 1 35 dcl (convert_offset(0:5) init(36,1,4.5,9,18,36), 1 36 bits_per_packed_digit init(4.5)) fixed bin(8,1) int static options(constant); 1 37 1 38 dcl max_index_register_value init(262143) fixed bin(31) int static options(constant); 1 39 1 40 /* END INCLUDE FILE ... cgsystem.incl.pl1 */ 1 41 340 2 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 2 2 2 3 dcl 1 reference based aligned, 2 4 2 node_type bit(9) unaligned, 2 5 2 array_ref bit(1) unaligned, 2 6 2 varying_ref bit(1) unaligned, 2 7 2 shared bit(1) unaligned, 2 8 2 put_data_sw bit(1) unaligned, 2 9 2 processed bit(1) unaligned, 2 10 2 units fixed(3) unaligned, 2 11 2 ref_count fixed(17) unaligned, 2 12 2 c_offset fixed(24), 2 13 2 c_length fixed(24), 2 14 2 symbol ptr unaligned, 2 15 2 qualifier ptr unaligned, 2 16 2 offset ptr unaligned, 2 17 2 length ptr unaligned, 2 18 2 subscript_list ptr unaligned, 2 19 /* these fields are used by the 645 code generator */ 2 20 2 address structure unaligned, 2 21 3 base bit(3), 2 22 3 offset bit(15), 2 23 3 op bit(9), 2 24 3 no_address bit(1), 2 25 3 inhibit bit(1), 2 26 3 ext_base bit(1), 2 27 3 tag bit(6), 2 28 2 info structure unaligned, 2 29 3 address_in structure, 2 30 4 b dimension(0:7) bit(1), 2 31 4 storage bit(1), 2 32 3 value_in structure, 2 33 4 a bit(1), 2 34 4 q bit(1), 2 35 4 aq bit(1), 2 36 4 string_aq bit(1), 2 37 4 complex_aq bit(1), 2 38 4 decimal_aq bit(1), 2 39 4 b dimension(0:7) bit(1), 2 40 4 storage bit(1), 2 41 4 indicators bit(1), 2 42 4 x dimension(0:7) bit(1), 2 43 3 other structure, 2 44 4 big_offset bit(1), 2 45 4 big_length bit(1), 2 46 4 modword_in_offset bit(1), 2 47 2 data_type fixed(5) unaligned, 2 48 2 bits structure unaligned, 2 49 3 padded_ref bit(1), 2 50 3 aligned_ref bit(1), 2 51 3 long_ref bit(1), 2 52 3 forward_ref bit(1), 2 53 3 ic_ref bit(1), 2 54 3 temp_ref bit(1), 2 55 3 defined_ref bit(1), 2 56 3 evaluated bit(1), 2 57 3 allocate bit(1), 2 58 3 allocated bit(1), 2 59 3 aliasable bit(1), 2 60 3 even bit(1), 2 61 3 perm_address bit(1), 2 62 3 aggregate bit(1), 2 63 3 hit_zero bit(1), 2 64 3 dont_save bit(1), 2 65 3 fo_in_qual bit(1), 2 66 3 hard_to_load bit(1), 2 67 2 relocation bit(12) unaligned, 2 68 2 more_bits structure unaligned, 2 69 3 substr bit(1), 2 70 3 padded_for_store_ref bit(1), 2 71 3 aligned_for_store_ref bit(1), 2 72 3 mbz bit(15), 2 73 2 store_ins bit(18) unaligned; 2 74 2 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 341 3 1 /* BEGIN INCLUDE FILE ... symbol.incl.pl1 */ 3 2 3 3 dcl 1 symbol based aligned, 3 4 2 node_type bit(9) unal, 3 5 2 source_id structure unal, 3 6 3 file_number bit(8), 3 7 3 line_number bit(14), 3 8 3 statement_number bit(5), 3 9 2 location fixed(18) unal unsigned, 3 10 2 allocated bit(1) unal, 3 11 2 dcl_type bit(3) unal, 3 12 2 reserved bit(6) unal, 3 13 2 pix unal, 3 14 3 pic_fixed bit(1) unal, 3 15 3 pic_float bit(1) unal, 3 16 3 pic_char bit(1) unal, 3 17 3 pic_scale fixed(7) unal, 3 18 3 pic_size fixed(7) unal, 3 19 2 level fixed(8) unal, 3 20 2 boundary fixed(3) unal, 3 21 2 size_units fixed(3) unal, 3 22 2 scale fixed(7) unal, 3 23 2 runtime bit(18) unal, 3 24 2 runtime_offset bit(18) unal, 3 25 2 block_node ptr unal, 3 26 2 token ptr unal, 3 27 2 next ptr unal, 3 28 2 multi_use ptr unal, 3 29 2 cross_references ptr unal, 3 30 2 initial ptr unal, 3 31 2 array ptr unal, 3 32 2 descriptor ptr unal, 3 33 2 equivalence ptr unal, 3 34 2 reference ptr unal, 3 35 2 general ptr unal, 3 36 2 father ptr unal, 3 37 2 brother ptr unal, 3 38 2 son ptr unal, 3 39 2 word_size ptr unal, 3 40 2 bit_size ptr unal, 3 41 2 dcl_size ptr unal, 3 42 2 symtab_size ptr unal, 3 43 2 c_word_size fixed(24), 3 44 2 c_bit_size fixed(24), 3 45 2 c_dcl_size fixed(24), 3 46 3 47 2 attributes structure aligned, 3 48 3 data_type structure unal, 3 49 4 structure bit(1) , 3 50 4 fixed bit(1), 3 51 4 float bit(1), 3 52 4 bit bit(1), 3 53 4 char bit(1), 3 54 4 ptr bit(1), 3 55 4 offset bit(1), 3 56 4 area bit(1), 3 57 4 label bit(1), 3 58 4 entry bit(1), 3 59 4 file bit(1), 3 60 4 arg_descriptor bit(1), 3 61 4 storage_block bit(1), 3 62 4 explicit_packed bit(1), /* options(packed) */ 3 63 4 condition bit(1), 3 64 4 format bit(1), 3 65 4 builtin bit(1), 3 66 4 generic bit(1), 3 67 4 picture bit(1), 3 68 3 69 3 misc_attributes structure unal, 3 70 4 dimensioned bit(1), 3 71 4 initialed bit(1), 3 72 4 aligned bit(1), 3 73 4 unaligned bit(1), 3 74 4 signed bit(1), 3 75 4 unsigned bit(1), 3 76 4 precision bit(1), 3 77 4 varying bit(1), 3 78 4 local bit(1), 3 79 4 decimal bit(1), 3 80 4 binary bit(1), 3 81 4 real bit(1), 3 82 4 complex bit(1), 3 83 4 variable bit(1), 3 84 4 reducible bit(1), 3 85 4 irreducible bit(1), 3 86 4 returns bit(1), 3 87 4 position bit(1), 3 88 4 internal bit(1), 3 89 4 external bit(1), 3 90 4 like bit(1), 3 91 4 member bit(1), 3 92 4 non_varying bit(1), 3 93 4 options bit(1), 3 94 4 variable_arg_list bit(1), /* options(variable) */ 3 95 4 alloc_in_text bit(1), /* options(constant) */ 3 96 3 97 3 storage_class structure unal, 3 98 4 auto bit(1), 3 99 4 based bit(1), 3 100 4 static bit(1), 3 101 4 controlled bit(1), 3 102 4 defined bit(1), 3 103 4 parameter bit(1), 3 104 4 param_desc bit(1), 3 105 4 constant bit(1), 3 106 4 temporary bit(1), 3 107 4 return_value bit(1), 3 108 3 109 3 file_attributes structure unal, 3 110 4 print bit(1), 3 111 4 input bit(1), 3 112 4 output bit(1), 3 113 4 update bit(1), 3 114 4 stream bit(1), 3 115 4 reserved_1 bit(1), 3 116 4 record bit(1), 3 117 4 sequential bit(1), 3 118 4 direct bit(1), 3 119 4 interactive bit(1), /* env(interactive) */ 3 120 4 reserved_2 bit(1), 3 121 4 reserved_3 bit(1), 3 122 4 stringvalue bit(1), /* env(stringvalue) */ 3 123 4 keyed bit(1), 3 124 4 reserved_4 bit(1), 3 125 4 environment bit(1), 3 126 3 127 3 compiler_developed structure unal, 3 128 4 aliasable bit(1), 3 129 4 packed bit(1), 3 130 4 passed_as_arg bit(1), 3 131 4 allocate bit(1), 3 132 4 set bit(1), 3 133 4 exp_extents bit(1), 3 134 4 refer_extents bit(1), 3 135 4 star_extents bit(1), 3 136 4 isub bit(1), 3 137 4 put_in_symtab bit(1), 3 138 4 contiguous bit(1), 3 139 4 put_data bit(1), 3 140 4 overlayed bit(1), 3 141 4 error bit(1), 3 142 4 symtab_processed bit(1), 3 143 4 overlayed_by_builtin bit(1), 3 144 4 defaulted bit(1), 3 145 4 connected bit(1); 3 146 3 147 /* END INCLUDE FILE ... symbol.incl.pl1 */ 342 4 1 /* BEGIN INCLUDE FILE ... operator.incl.pl1 */ 4 2 4 3 /* Modified: 2 Apr 1980 by PCK to add max_number_of_operands */ 4 4 4 5 /* format: style3 */ 4 6 dcl 1 operator based aligned, 4 7 2 node_type bit (9) unaligned, 4 8 2 op_code bit (9) unaligned, 4 9 2 shared bit (1) unaligned, 4 10 2 processed bit (1) unaligned, 4 11 2 optimized bit (1) unaligned, 4 12 2 number fixed (14) unaligned, 4 13 2 operand dimension (n refer (operator.number)) ptr unaligned; 4 14 4 15 dcl max_number_of_operands 4 16 fixed bin (15) int static options (constant) initial (32767); 4 17 4 18 /* END INCLUDE FILE ... operator.incl.pl1 */ 343 5 1 /* BEGIN INCLUDE FILE ... machine_state.incl.pl1 */ 5 2 5 3 dcl cg_static_$m_s_p ptr ext static, 5 4 m_s_p ptr init(cg_static_$m_s_p); 5 5 5 6 dcl 1 machine_state aligned based(m_s_p), 5 7 2 node_type bit(9), 5 8 2 indicators fixed bin, 5 9 2 next ptr unal, 5 10 2 a_reg, 5 11 3 variable(10) ptr unal, 5 12 3 number fixed bin(17), 5 13 3 size fixed bin(8), 5 14 3 length fixed bin(8), 5 15 3 offset fixed bin(8), 5 16 3 constant fixed bin(24), 5 17 3 changed fixed bin(18), 5 18 3 instruction bit(36), 5 19 3 locked bit(1) aligned, 5 20 3 number_h_o fixed bin, 5 21 3 has_offset(3) ptr unal, 5 22 2 q_reg, 5 23 3 variable(10) ptr unal, 5 24 3 number fixed bin(17), 5 25 3 size fixed bin(8), 5 26 3 length fixed bin(8), 5 27 3 offset fixed bin(8), 5 28 3 constant fixed bin(24), 5 29 3 changed fixed bin(18), 5 30 3 instruction bit(36), 5 31 3 locked bit(1) aligned, 5 32 3 number_h_o fixed bin, 5 33 3 has_offset(3) ptr unal, 5 34 2 string_reg, 5 35 3 variable ptr unal, 5 36 3 size fixed bin(8), 5 37 3 offset fixed bin(8), 5 38 2 complex_reg, 5 39 3 variable ptr unal, 5 40 3 size fixed bin(8), 5 41 3 scale fixed bin(8), 5 42 2 decimal_reg, 5 43 3 variable ptr unal, 5 44 3 size fixed bin(8), 5 45 3 scale fixed bin(8), 5 46 2 index_regs(0:7), 5 47 3 variable ptr unal, 5 48 3 constant fixed bin, 5 49 3 type fixed bin(8), 5 50 3 used fixed bin(18), 5 51 3 changed fixed bin(18), 5 52 3 instruction bit(36), 5 53 3 filler fixed bin, 5 54 2 base_regs(0:7), 5 55 3 variable ptr unal, 5 56 3 constant fixed bin, 5 57 3 type fixed bin(8), 5 58 3 pad (12) fixed bin, /* future...room to make 5 element array for variable, constant, type */ 5 59 3 number fixed bin (17), /* future...number of valid elements in array */ 5 60 3 used fixed bin(18), 5 61 3 changed fixed bin(18), 5 62 3 instruction bit(36), 5 63 3 locked fixed bin(2), 5 64 2 indicators_ref(2:3) ptr unal; 5 65 5 66 /* Permissible values for machine_state.indicators. */ 5 67 5 68 dcl ( ind_known_refs init (-2), /* set by comparison of known, nonzero, references */ 5 69 ind_invalid init (-1), 5 70 ind_string_aq init (0), /* logical value in storage */ 5 71 ind_logical init (1), /* logical value in A or AQ */ 5 72 ind_arithmetic init (2), /* arith value in Q, AQ, or EAQ */ 5 73 ind_x (0:7) init (6, 7, 8, 9, 10, 11, 12, 13), 5 74 ind_decimal_reg init (14) 5 75 ) fixed bin internal static options (constant); 5 76 5 77 /* END INCLUDE FILE ... machine_state.incl.pl1 */ 344 6 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 6 2 6 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 6 4 6 5 dcl ( block_node initial("000000001"b), 6 6 statement_node initial("000000010"b), 6 7 operator_node initial("000000011"b), 6 8 reference_node initial("000000100"b), 6 9 token_node initial("000000101"b), 6 10 symbol_node initial("000000110"b), 6 11 context_node initial("000000111"b), 6 12 array_node initial("000001000"b), 6 13 bound_node initial("000001001"b), 6 14 format_value_node initial("000001010"b), 6 15 list_node initial("000001011"b), 6 16 default_node initial("000001100"b), 6 17 machine_state_node initial("000001101"b), 6 18 source_node initial("000001110"b), 6 19 label_node initial("000001111"b), 6 20 cross_reference_node initial("000010000"b), 6 21 sf_par_node initial("000010001"b), 6 22 temporary_node initial("000010010"b), 6 23 label_array_element_node initial("000010011"b), 6 24 by_name_agg_node initial("000010100"b)) 6 25 bit(9) internal static aligned options(constant); 6 26 6 27 dcl 1 node based aligned, 6 28 2 type unal bit(9), 6 29 2 source_id unal structure, 6 30 3 file_number bit(8), 6 31 3 line_number bit(14), 6 32 3 statement_number bit(5); 6 33 6 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 345 7 1 dcl ( real_fix_bin_1 init(1), 7 2 real_fix_bin_2 init(2), 7 3 real_flt_bin_1 init(3), 7 4 real_flt_bin_2 init(4), 7 5 complex_fix_bin_1 init(5), 7 6 complex_fix_bin_2 init(6), 7 7 complex_flt_bin_1 init(7), 7 8 complex_flt_bin_2 init(8), 7 9 real_fix_dec init(9), 7 10 real_flt_dec init(10), 7 11 complex_fix_dec init(11), 7 12 complex_flt_dec init(12), 7 13 char_string init(13), 7 14 bit_string init(14), 7 15 label_constant init(15), 7 16 local_label_variable init(16), 7 17 label_variable init(17), 7 18 entry_variable init(18), 7 19 ext_entry_in init(19), 7 20 ext_entry_out init(20), 7 21 int_entry init(21), 7 22 int_entry_other init(22), 7 23 unpacked_ptr init(23), 7 24 packed_ptr init(24)) fixed bin(15) int static options(constant); 346 8 1 /* BEGIN INCLUDE FILE ... boundary.incl.pl1 */ 8 2 8 3 /* Modified: 26 Apr 1979 by PCK to implement 4-bit decimal */ 8 4 8 5 dcl ( bit_ init(1), 8 6 digit_ init(2), 8 7 character_ init(3), 8 8 half_ init(4), 8 9 word_ init(5), 8 10 mod2_ init(6), 8 11 mod4_ init(7)) fixed bin(3) int static options(constant); 8 12 8 13 /* END INCLUDE FILE ... boundary.incl.pl1 */ 347 9 1 /* BEGIN INCLUDE FILE ... op_codes.incl.pl1 */ 9 2 9 3 /* Modified: 25 Apr 1979 by PCK 4-bit decimal */ 9 4 /* Modified: 6 Jun 1979 by PG to add rank and byte */ 9 5 /* Modified: 26 Dec 1979 by PCK to add assign_by_name */ 9 6 /* Modified: 26 July 82 BIM wordno, segno */ 9 7 9 8 dcl ( add initial("000010001"b), /* opnd(1) <- opnd(2)+opnd(3) */ 9 9 sub initial("000010010"b), /* opnd(1) <- opnd(2)-opnd(3) */ 9 10 mult initial("000010011"b), /* opnd(1) <- opnd(2)*opnd(3) */ 9 11 div initial("000010100"b), /* opnd(1) <- opnd(2)/opnd(3) */ 9 12 negate initial("000010101"b), /* opnd(1) <- -opnd(2) */ 9 13 exp initial("000010110"b), /* opnd(1) <- opnd(2) ** opnd(3) */ 9 14 9 15 and_bits initial("000100001"b), /* opnd(1) <- opnd(2) & opnd(3) */ 9 16 or_bits initial("000100010"b), /* opnd(1) <- opnd(2)|opnd(3) */ 9 17 xor_bits initial("000100011"b), /* opnd(1) <- opnd(2) xor opnd(3) */ 9 18 not_bits initial("000100100"b), /* opnd(1) <- ^opnd(2) */ 9 19 cat_string initial("000100101"b), /* opnd(1) <- opnd(2)||opnd(3) */ 9 20 bool_fun initial("000100110"b), /* opnd(1) <- bool(opnd(2),opnd(3),opnd(4)) */ 9 21 9 22 assign initial("000110001"b), /* opnd(1) <- opnd(2) */ 9 23 assign_size_ck initial("000110010"b), /* opnd(1) <- opnd(2) */ 9 24 assign_zero initial("000110011"b), /* opnd(1) <- 0 */ 9 25 copy_words initial("000110100"b), /* move opnd(2) to opnd(1) by opnd(3) words */ 9 26 copy_string initial("000110101"b), /* move opnd(2) to opnd(1) by opnd(3) units */ 9 27 make_desc initial("000110110"b), /* opnd(1) <- descriptor(opnd(2),opnd(3)) */ 9 28 assign_round initial("000110111"b), /* opnd(1) <- opnd(2) rounded */ 9 29 pack initial("000111000"b), /* opnd(1) <- encode to picture opnd(2) */ 9 30 unpack initial("000111001"b), /* opnd(1) <- decode from picture opnd(2) */ 9 31 9 32 less_than initial("001000100"b), /* opnd(1) <- opnd(2) < opnd(3) */ 9 33 greater_than initial("001000101"b), /* opnd(1) <- opnd(2) > opnd(3) */ 9 34 equal initial("001000110"b), /* opnd(1) <- opnd(2) = opnd(3) */ 9 35 not_equal initial("001000111"b), /* opnd(1) <- opnd(2) ^= opnd(3) */ 9 36 less_or_equal initial("001001000"b), /* opnd(1) <- opnd(2) <= opnd(3) */ 9 37 greater_or_equal initial("001001001"b), /* opnd(1) <- opnd(2) >= opnd(3) */ 9 38 9 39 jump initial("001010001"b), /* go to opnd(1) unconditionally */ 9 40 jump_true initial("001010010"b), /* go to opnd(1) if opnd(2) is not 0 */ 9 41 jump_false initial("001010011"b), /* go to opnd(1) if opnd(2) is all 0 */ 9 42 jump_if_lt initial("001010100"b), /* go to opnd(1) if opnd(2) < opnd(3) */ 9 43 jump_if_gt initial("001010101"b), /* go to opnd(1) if opnd(2) > opnd(3) */ 9 44 jump_if_eq initial("001010110"b), /* go to opnd(1) if opnd(2) = opnd(3) */ 9 45 jump_if_ne initial("001010111"b), /* go to opnd(1) if opnd(2) ^= opnd(3) */ 9 46 jump_if_le initial("001011000"b), /* go to opnd(1) if opnd(2) <= opnd(3) */ 9 47 jump_if_ge initial("001011001"b), /* go to opnd(1) if opnd(2) >= opnd(3) */ 9 48 9 49 std_arg_list initial("001100001"b), /* opnd(1) <- arglist(opnd(2) desclist(opnd(3))) */ 9 50 return_words initial("001100010"b), /* return aggregate opnd(1), opnd(2) is length in words */ 9 51 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 9 52 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 9 53 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 9 54 return_string initial("001100110"b), /* return string opnd(1) */ 9 55 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 9 56 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 9 57 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 9 58 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 9 59 std_return initial("001101011"b), /* return -no arguments- */ 9 60 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 9 61 free_ctl initial("001101101"b), /* free opnd(1) */ 9 62 stop initial("001101110"b), /* stop - terminate run unit */ 9 63 9 64 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 9 65* opnd(2) <- opnd(3) / 36 */ 9 66 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 9 67* opnd(2) <- opnd(3) / 4 */ 9 68 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 9 69* opnd(2) <- opnd(3) / 2 */ 9 70 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 9 71 9 72 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 9 73 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 9 74 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 9 75 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 9 76 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 9 77 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 9 78 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 9 79 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 9 80 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 9 81 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 9 82 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 9 83 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 9 84 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 9 85 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 9 86 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 9 87 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 9 88 9 89 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 9 90 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 9 91 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 9 92 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 9 93 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 9 94 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 9 95 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 9 96 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 9 97 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 9 98 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 9 99 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 9 100 wordno_fun initial("010011011"b), /* opnd(1) <- wordno (opnd(2)) */ 9 101 segno_fun initial("010011100"b), /* opnd(1) <- segno (opnd(2)) */ 9 102 bitno_fun initial("010011101"b), /* opnd(1) <- bitno (opnd(2)) */ 9 103 charno_fun initial("010011110"b), /* opnd(1) <- charno (opnd(2)) */ 9 104 9 105 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 9 106 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 9 107 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 9 108 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 9 109 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 9 110 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 9 111 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 9 112 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 9 113 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 9 114 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 9 115 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 9 116 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 9 117 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 9 118 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 9 119 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 9 120 9 121 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 9 122 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 9 123 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 9 124 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 9 125 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 9 126 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 9 127 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 9 128 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 9 129 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 9 130 setcharno_fun initial("010111001"b), /* opnd(1) <- opnd(2) with charno opnd(3) */ 9 131 addcharno_fun initial("010111010"b), /* opnd(1) <- opnd(2) with charno = charno + opnd(3) */ 9 132 setbitno_fun initial("010111011"b), /* setcharno for bitsno */ 9 133 addbitno_fun initial("010111100"b), /* addcharno for bitno */ 9 134 9 135 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 9 136 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 9 137 9 138 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 9 139 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 9 140 enable_on initial("011010100"b), /* opnd(1) is the cond name 9 141* opnd(2) is the file name 9 142* opnd(3) is the block */ 9 143 revert_on initial("011010101"b), /* opnd(1) is the cond name, 9 144* opnd(2) is the file name */ 9 145 signal_on initial("011010110"b), /* opnd(1) is the cond name 9 146* opnd(2) is the file name */ 9 147 9 148 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 9 149 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 9 150* opnd(3) is old value, (4) is new value. */ 9 151 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 9 152 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 9 153 9 154 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 9 155 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 9 156 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 9 157* opnd(5) is the list */ 9 158 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 9 159 allot_based initial("011100100"b), /* allocate opnd(2) words in opnd(3), set opnd(1) */ 9 160 free_based initial("011100101"b), /* free opnd(1) in opnd(3), length is opnd(2) words */ 9 161 9 162 r_parn initial("011110001"b), /* format op code */ 9 163 l_parn initial("011110010"b), 9 164 r_format initial("011110011"b), 9 165 c_format initial("011110100"b), 9 166 f_format initial("011110101"b), 9 167 e_format initial("011110110"b), 9 168 b_format initial("011110111"b), 9 169 a_format initial("011111000"b), 9 170 x_format initial("011111001"b), 9 171 skip_format initial("011111010"b), 9 172 column_format initial("011111011"b), 9 173 page_format initial("011111100"b), 9 174 line_format initial("011111101"b), 9 175 picture_format initial("011111110"b), 9 176 bn_format initial("011111111"b), /* bit format, length(opnd(2)), radix factor(opnd(3)) */ 9 177 9 178 get_list_trans initial("100000000"b), /* getlist(opnd(2) with desc(opnd(1))) */ 9 179 get_edit_trans initial("100000001"b), /* getedit(opnd(2) with desc(opnd(1))) */ 9 180 get_data_trans initial("100000010"b), /* getdata(opnd(1) to opnd(n)) */ 9 181 put_list_trans initial("100000011"b), /* putlist(opnd(2) with desc(opnd(1))) */ 9 182 put_edit_trans initial("100000100"b), /* putedit(opnd(2) with desc(opnd(1))) */ 9 183 put_data_trans initial("100000101"b), /* putdata(opnd(2)) with subscript-list opnd(1) */ 9 184 terminate_trans initial("100000110"b), /* terminate stream transmission */ 9 185 stream_prep initial("100000111"b), /* initiate stream transmission */ 9 186 record_io initial("100001000"b), /* perform record io operation */ 9 187 fortran_read initial("100001001"b), /* A complete read statement */ 9 188 fortran_write initial("100001010"b), /* A complete write statement */ 9 189 ftn_file_manip initial("100001011"b), /* endfile,backspace,rewind,etc. */ 9 190 ftn_trans_loop initial("100001100"b), /* An implied do in i/o list */ 9 191 put_control initial("100001101"b), /* put control opnd(1) opnd(2) times */ 9 192 put_field initial("100001110"b), /* putlist(opnd(2)) of length(opnd(1)) */ 9 193 put_field_chk initial("100001111"b), /* putlist(op(2)) of len(op(1)) check char index(op(3)) */ 9 194 9 195 /* These operators are produced by the parse but are not used as input to the code generator. */ 9 196 /* They are processed by the semantic translator. */ 9 197 9 198 return_value initial("100010010"b), /* return(opnd(1)) */ 9 199 allot_var initial("100010011"b), /* allot opnd(1) in opnd(2) */ 9 200 free_var initial("100010100"b), /* free opnd(1) out of opnd(2) */ 9 201 get_file initial("100010101"b), /* opnd(1) is filename,opnd(2) is copy */ 9 202 /* opnd(3) is skip, opnd(4) is list */ 9 203 get_string initial("100010110"b), /* opnd(1) is string,opnd(2) is list */ 9 204 put_file initial("100010111"b), /* opnd(1) is filename,opnd(2) is page */ 9 205 /* opnd(3) is skip,opnd(4) is line */ 9 206 put_string initial("100011000"b), /* opnd(1) is string,opnd(2) is list */ 9 207 open_file initial("100011001"b), 9 208 close_file initial("100011010"b), 9 209 read_file initial("100011011"b), 9 210 write_file initial("100011100"b), 9 211 locate_file initial("100011101"b), 9 212 do_fun initial("100011110"b), /* opnd(1) is join of a list */ 9 213 /* opnd(2) is control variable ref */ 9 214 /* opnd(3) is specification operator */ 9 215 do_spec initial("100011111"b), /* opnd(1) to opnd(2) by opnd(3) */ 9 216 /* repeat opnd(4) while opnd(5) */ 9 217 /* opnd(6) is next specification */ 9 218 9 219 rewrite_file initial("100100000"b), 9 220 delete_file initial("100100001"b), 9 221 unlock_file initial("100100010"b), 9 222 lock_file initial("100100011"b), 9 223 refer initial("100100101"b), /* opnd(1) refer(opnd(2)) */ 9 224 prefix_plus initial("100100110"b), /* opnd(1) <- +opnd(2) */ 9 225 nop initial("100100111"b), /* no-op */ 9 226 assign_by_name initial("100101000"b), /* opnd(1) <- opnd(2),by name */ 9 227 9 228 /* These operators are produced by the semantic translator in processing the math 9 229* builtin functions and are used as input to the code generator */ 9 230 9 231 sqrt_fun initial("100110000"b), /* opnd(1) <- sqrt(opnd(2)) */ 9 232 sin_fun initial("100110001"b), /* opnd(1) <- sin(opnd(2)) */ 9 233 sind_fun initial("100110010"b), /* opnd(1) <- sind(opnd(2)) */ 9 234 cos_fun initial("100110011"b), /* opnd(1) <- cos(opnd(2)) */ 9 235 cosd_fun initial("100110100"b), /* opnd(1) <- cosd(opnd(2)) */ 9 236 tan_fun initial("100110101"b), /* opnd(1) <- tan(opnd(2)) */ 9 237 tand_fun initial("100110110"b), /* opnd(1) <- tand(opnd(2)) */ 9 238 asin_fun initial("100110111"b), /* opnd(1) <- asin(opnd(2)) */ 9 239 asind_fun initial("100111000"b), /* opnd(1) <- asind(opnd(2)) */ 9 240 acos_fun initial("100111001"b), /* opnd(1) <- acos(opnd(2)) */ 9 241 acosd_fun initial("100111010"b), /* opnd(1) <- acosd(opnd(2)) */ 9 242 atan_fun initial("100111011"b), /* opnd(1) <- atan(opnd(2)[,opnd(3)]) */ 9 243 atand_fun initial("100111100"b), /* opnd(1) <- atand(opnd(2)[,opnd(3)]) */ 9 244 log2_fun initial("100111101"b), /* opnd(1) <- log2(opnd(2)) */ 9 245 log_fun initial("100111110"b), /* opnd(1) <- log(opnd(2)) */ 9 246 log10_fun initial("100111111"b), /* opnd(1) <- log10(opnd(2)) */ 9 247 9 248 exp_fun initial("101000000"b)) /* opnd(1) <- exp(opnd(2)) */ 9 249 9 250 bit(9) aligned internal static options(constant); 9 251 9 252 /* END INCLUDE FILE ... op_codes.incl.pl1 */ 348 10 1 /* BEGIN INCLUDE FILE ... mask.incl.pl1 */ 10 2 10 3 dcl ( structure_mask init("100000000000000000000000000000000000"b), 10 4 fixed_mask init("010000000000000000000000000000000000"b), 10 5 float_mask init("001000000000000000000000000000000000"b), 10 6 bit_mask init("000100000000000000000000000000000000"b), 10 7 char_mask init("000010000000000000000000000000000000"b), 10 8 ptr_mask init("000001000000000000000000000000000000"b), 10 9 offset_mask init("000000100000000000000000000000000000"b), 10 10 area_mask init("000000010000000000000000000000000000"b), 10 11 label_mask init("000000001000000000000000000000000000"b), 10 12 entry_mask init("000000000100000000000000000000000000"b), 10 13 file_mask init("000000000010000000000000000000000000"b), 10 14 arg_descriptor_mask init("000000000001000000000000000000000000"b), 10 15 storage_block_mask init("000000000000100000000000000000000000"b), 10 16 lock_mask init("000000000000010000000000000000000000"b), 10 17 condition_mask init("000000000000001000000000000000000000"b), 10 18 format_mask init("000000000000000100000000000000000000"b), 10 19 builtin_mask init("000000000000000010000000000000000000"b), 10 20 generic_mask init("000000000000000001000000000000000000"b), 10 21 picture_mask init("000000000000000000100000000000000000"b), 10 22 dimensioned_mask init("000000000000000000010000000000000000"b), 10 23 initialed_mask init("000000000000000000001000000000000000"b), 10 24 aligned_mask init("000000000000000000000100000000000000"b), 10 25 unaligned_mask init("000000000000000000000010000000000000"b), 10 26 signed_mask init("000000000000000000000001000000000000"b), 10 27 unsigned_mask init("000000000000000000000000100000000000"b), 10 28 precision_mask init("000000000000000000000000010000000000"b), 10 29 varying_mask init("000000000000000000000000001000000000"b), 10 30 local_mask init("000000000000000000000000000100000000"b), 10 31 decimal_mask init("000000000000000000000000000010000000"b), 10 32 binary_mask init("000000000000000000000000000001000000"b), 10 33 real_mask init("000000000000000000000000000000100000"b), 10 34 complex_mask init("000000000000000000000000000000010000"b), 10 35 variable_mask init("000000000000000000000000000000001000"b), 10 36 reducible_mask init("000000000000000000000000000000000100"b), 10 37 irreducible_mask init("000000000000000000000000000000000010"b), 10 38 returns_mask init("000000000000000000000000000000000001"b)) bit(36) aligned int static 10 39 options(constant); 10 40 10 41 dcl ( arithmetic_mask init("011000000000000000000000000011110000"b), 10 42 computational_mask init("011110000000000000100000000011110000"b), 10 43 fixed_binary_real_mask init("010000000000000000000000000001100000"b), 10 44 fixed_decimal_real_mask init("010000000000000000000000000010100000"b), 10 45 float_decimal_real_mask init("001000000000000000000000000010100000"b), 10 46 fixed_decimal_complex_mask init("010000000000000000000000000010010000"b), 10 47 float_decimal_complex_mask init("001000000000000000000000000010010000"b), 10 48 string_mask init("000110000000000000000000000000000000"b), 10 49 undesirable_mask init("111111111111111111100111110111110111"b), 10 50 convert_mask init("011111111111111111100111110111111110"b), 10 51 declare_constant_mask init("111111111111111111100000000011110000"b) 10 52 ) bit(36) aligned int static 10 53 options(constant); 10 54 10 55 /* END INCLUDE FILE ... mask.incl.pl1 */ 349 11 1 dcl bases(0:7) bit(3) aligned int static init("000"b, "010"b, "100"b, "001"b, "011"b, "101"b, "111"b,"110"b) 11 2 options(constant); 11 3 11 4 dcl ( ap defined(bases(0)), 11 5 bp defined(bases(1)), 11 6 lp defined(bases(2)), 11 7 sp defined(bases(7))) bit(3) aligned; 11 8 11 9 dcl ( ab defined(bases(3)), 11 10 bb defined(bases(4)), 11 11 lb defined(bases(5)), 11 12 sb defined(bases(6))) bit(3) aligned; 11 13 11 14 dcl which_base(0:7) fixed bin int static init(0,3,1,4,2,5,7,6) options(constant); 350 351 352 /* program */ 353 354 ftc = cg_stat$for_test_called; 355 cg_stat$for_test_called = "0"b; 356 357 start: 358 sec = cg_stat$save_exp_called; 359 cg_stat$save_exp_called = "0"b; 360 361 p = pt; 362 363 if p -> node.type ^= operator_node 364 then do; 365 is_atom: 366 i = p -> reference.data_type; 367 call load (p, fixed (i = char_string | i = bit_string, 1)); 368 save_cur_node = cg_stat$cur_node; 369 goto return_1; 370 end; 371 372 ref (1) = p -> operand (1); 373 if ^ref (1) -> reference.shared 374 then do; 375 376 if ref (1) -> reference.evaluated 377 then do; 378 p = ref (1); 379 goto is_atom; 380 end; 381 382 if ref (1) -> reference.temp_ref & ^ref (1) -> reference.long_ref & ^ref (1) -> reference.aggregate 383 & ref (1) -> reference.data_type ^= complex_flt_bin_1 384 then drop = "1"b; 385 else drop = "0"b; 386 387 end; 388 389 work: 390 save_cur_node = cg_stat$cur_node; 391 cg_stat$cur_node = p; 392 393 save_it = cg_stat$save_exp_called; 394 update_ref = "1"b; 395 396 update_long, in_storage = "0"b; 397 op_code = p -> operator.op_code; 398 399 do i = 1 to min (p -> operator.number, hbound (rand, 1)); 400 rand (i) = p -> operand (i); 401 end; 402 403 op_rel = fixed (op_relative, 4); 404 k = opcode_info$table (fixed (op_class, 5)) + op_rel; 405 if k > opcode_info$last_opcode 406 then goto not_yet; 407 408 q = addr (opcode_info$opcode_info (k)); 409 action = fixed (q -> op_info.act1, 6); 410 411 goto switch_a (action); 412 413 /* assignment and picture operators */ 414 415 switch_a (1): 416 call assign_op (pt); 417 ref1 = cg_stat$temp_ref; 418 goto return; 419 420 /* min and max builtins */ 421 422 switch_a (2): 423 call min_max (pt); 424 ref1 = cg_stat$temp_ref; 425 426 if ref1 -> reference.symbol -> symbol.decimal 427 then goto return; 428 429 inline = "1"b; 430 goto done_1; 431 432 /* error conditions */ 433 434 switch_a (4): 435 call cg_error (300, fixed (op_code, 9)); /* operator in wrong context */ 436 goto return; 437 438 switch_a (5): 439 not_yet: 440 call cg_error (301, fixed (op_code, 9)); /* operator not yet implemented */ 441 goto return; 442 443 /* pointer valued builtin functions */ 444 445 switch_a (6): 446 call pointer_builtins (p, ^drop); 447 448 /* This used to avoid references that were shared. Now that shared */ 449 /* temps are no longer permitted on the output side of pointer expressions, */ 450 /* we set evaluated. This sets evaluated for non-tems in particular */ 451 /* So any non-temp, or any non-shared temp is set evaluated */ 452 453 ref1 = p -> operator.operand (1); 454 if ^ref1 -> reference.temp_ref | ^ref1 -> reference.shared 455 then ref1 -> reference.evaluated = "1"b; 456 457 goto return; 458 459 /* most op codes come here */ 460 461 switch_a (3): 462 action = fixed (q -> op_info.act2, 6); 463 macro = fixed (q -> op_info.macro, 18); 464 delta = fixed (q -> op_info.delta, 2); 465 call_code = fixed (q -> op_info.call_code, 4); 466 467 n = p -> operator.number; 468 do i = n by -1 to 2; 469 q = prepare_operand (rand (i), 1, atom (i)); 470 ref (i) = q; 471 sym (i) = q -> reference.symbol; 472 type (i) = q -> reference.data_type; 473 end; 474 475 /* There appears to be a convention that the size expression must be evaluated 476* before m_a is called. So, we evaluate the size expression here for those 477* optimizations that would otherwise call m_a before evaluating the size 478* expression. This fixes 1985. */ 479 480 /* This fix referenced ref (2) for operators with only one operand. oops */ 481 482 if op_code = repeat_fun 483 then if ref (2) -> reference.c_length = 1 & is_string_constant (2) 484 then ref1 = prepare_operand (rand (1), 1, atom (1)); 485 else go to prepare_minus_1; 486 else 487 prepare_minus_1: 488 ref1 = prepare_operand (rand (1), -1, atom (1)); 489 490 ref (1) = ref1; 491 sym (1) = ref (1) -> reference.symbol; 492 type (1) = ref (1) -> reference.data_type; 493 494 /* we can't use the "for_test" code sequences if result is needed elsewhere */ 495 496 cg_stat$for_test_called = cg_stat$for_test_called & ref1 -> reference.ref_count <= 1; 497 498 if sym (1) -> symbol.decimal 499 then inline = "0"b; 500 501 else if sym (1) -> symbol.complex | action = 7 | action = 30 502 then inline = inline_operation (p, ref, atom); 503 504 else /* operations with real results are done inline */ 505 inline = "1"b; 506 507 /* compute context code */ 508 509 if n = 2 510 then code = fixed (atom (2), 1); 511 else if n = 3 512 then code = fixed (atom (2) || atom (3), 2); 513 514 if sym (1) -> symbol.complex & inline 515 then do; 516 517 if ^ref (1) -> reference.allocate 518 then do; 519 520 use_cpx: 521 q = get_reference (); 522 q -> reference = ref (1) -> reference; 523 ref (1) = q; 524 525 ref (1) -> reference.offset, ref (1) -> reference.qualifier = null; 526 string (ref (1) -> reference.address) = string (cg_stat$complex_ac -> reference.address); 527 ref (1) -> reference.relocation = cg_stat$complex_ac -> reference.relocation; 528 ref (1) -> reference.perm_address = "1"b; 529 goto branch; 530 end; 531 532 else if ref (1) -> reference.temp_ref 533 then do; 534 ref (1) -> reference.value_in.storage = "1"b; 535 if ^cg_stat$save_exp_called 536 then do; 537 save_it = "1"b; 538 ref (1) -> reference.ref_count = ref (1) -> reference.ref_count + 1; 539 end; 540 end; 541 542 if op_code = mult 543 then if min (type (2), type (3)) = complex_flt_bin_1 544 then goto use_cpx; 545 else ; 546 else if op_code = div 547 then if type (3) = complex_flt_bin_1 548 then goto use_cpx; 549 550 if ref (1) -> reference.offset ^= null 551 then goto use_cpx; 552 553 q = ref (1) -> reference.symbol; 554 if q -> symbol.static & q -> symbol.external 555 then goto use_cpx; 556 if q -> symbol.parameter 557 then goto use_cpx; 558 559 in_storage = "1"b; 560 update_ref = "0"b; 561 end; 562 563 branch: 564 goto switch_b (action); 565 566 /* arithmetic operators */ 567 568 switch_b (1): 569 if ^inline 570 then if sym (1) -> symbol.decimal 571 then call decimal_op (pt, ref, atom); 572 573 /* cannot do arithmetic operation inline, generate procedure call */ 574 575 else call gen_arithmetic_call (p, ref, atom); 576 577 else call arith_op (pt, ref, atom); 578 579 /* check to see if result should be stored */ 580 581 done: 582 cg_stat$temp_ref = ref1; 583 584 done_1: 585 if ^ref1 -> reference.shared 586 then ref1 -> reference.evaluated = "1"b; 587 588 if ^inline 589 then goto return; 590 591 if cg_stat$for_test_called 592 then goto return; 593 594 if update_ref & (^ref1 -> reference.long_ref | update_long) 595 then do; 596 k = ref1 -> reference.c_offset; 597 ref1 -> reference.c_offset = 0; 598 599 call state_man$update_ref (ref1); 600 601 ref1 -> reference.c_offset = k; 602 end; 603 604 if ref1 -> reference.allocate 605 then do; 606 607 if ref1 -> reference.temp_ref 608 then if ^save_it 609 then if ^ref1 -> reference.aggregate 610 then go to return; 611 612 if ref1 -> reference.long_ref 613 then do; 614 if ref1 -> reference.temp_ref & ^ref1 -> reference.aggregate 615 then if ref1 -> reference.address_in.storage 616 then call store$save_string_temp (ref1); 617 else ; 618 else if ref1 ^= cg_stat$eis_temp 619 then call expmac$two_eis (chars_move + type (1) - char_string, ref1, cg_stat$eis_temp); 620 goto return; 621 end; 622 623 if in_storage 624 then goto return; 625 626 if ref1 -> reference.data_type = complex_flt_bin_1 627 then call expmac ((ldfx2), cg_stat$complex_ac); 628 629 call store$force (ref1); 630 end; 631 632 return: 633 if cg_stat$save_exp_called 634 then do; 635 ref_pt = cg_stat$temp_ref; 636 ref_pt -> reference.ref_count = orig_count; 637 end; 638 else if drop 639 then call adjust_ref_count (ref1, -1); 640 641 return_1: 642 cg_stat$save_exp_called = sec; 643 cg_stat$for_test_called = ftc; 644 cg_stat$cur_node = save_cur_node; 645 return; 646 647 /* exponentiation operator */ 648 649 switch_b (2): 650 if type (3) = real_fix_bin_1 651 then if is_constant (3) 652 then if sym (3) -> symbol.initial -> fixed_bin_single > 1 653 then do; 654 call exp_op (pt, ref, atom); 655 go to done; 656 end; 657 else if sym (3) -> symbol.initial -> fixed_bin_single = 1 658 then go to switch_a (1); 659 660 check_type = "0"b; 661 macro = exp_table (type (2), type (3)); 662 call math_op; 663 goto done; 664 665 /* string operators */ 666 667 switch_b (3): 668 cg_stat$for_test_called = cg_stat$for_test_called & ref1 -> reference.ref_count <= 1; 669 670 call string_op (pt, ref, code); 671 672 goto done; 673 674 /* relational operators */ 675 676 switch_b (4): 677 call state_man$erase_temps; 678 k = set_indicators (pt, ref (2), ref (3), code); 679 680 if type (2) <= real_flt_bin_2 681 then j = 0; 682 else do; 683 q = ref (2) -> reference.symbol; 684 j = fixed (q -> symbol.bit | q -> symbol.char, 1); 685 end; 686 687 call expmac$zero ((rel_table (op_rel, j, k))); 688 a_reg.size = 1; 689 goto bnf1; 690 691 /* rel, baseno, wordno, charno, bitno, (set, add)x(word bit char)no */ 692 693 694 declare charno_mac fixed bin (15) init (691) int static options (constant); 695 declare bitno_mac fixed bin (15) init (692) int static options (constant); 696 declare baseno_mac fixed bin (15) init (241) int static options (constant); 697 declare segno_mac fixed bin (15) init (240) int static options (constant); 698 declare packed_pointer bit (1) aligned; 699 700 switch_b (5): 701 if ref (2) -> reference.data_type = packed_ptr 702 then do; 703 packed_pointer = "1"b; 704 if ^ref (2) -> reference.value_in.storage 705 /* if it happens to be in a PR from use, use it there! */ 706 then if ^ref (2) -> reference.value_in.q/* in a PR */ 707 then if string (ref (2) -> reference.value_in.b) ^= ""b 708 then packed_pointer = "0"b; /* treat as unpacked */ 709 end; 710 else do; 711 packed_pointer = "0"b; 712 713 if ^atom (2) /* first operand (other than output) */ 714 then if rand (2) -> node.type = operator_node 715 /* certain packed pointers can be ^atom */ 716 then do; /* must be turned into a pointer */ 717 call pointer_builtins (rand (2), "0"b); 718 ref (2) = rand (2) -> operand (1); 719 if ^ref (2) -> reference.shared 720 then ref (2) -> reference.evaluated = "1"b; 721 end; 722 end; 723 724 if packed_pointer 725 then go to PACKED_POINTER_BIFS (macro); 726 else go to POINTER_BIFS (macro); /* macro contains 1...highest of these */ 727 728 729 PACKED_POINTER_BIFS (1): /* rel */ 730 PACKED_POINTER_BIFS (10): /* baseno */ 731 ref (2) -> reference.data_type = bit_string; 732 go to LOAD_PP_COMMON; 733 PACKED_POINTER_BIFS (2): /* wordno */ 734 PACKED_POINTER_BIFS (3): 735 PACKED_POINTER_BIFS (4): 736 PACKED_POINTER_BIFS (9): /* segno */ 737 ref (2) -> reference.data_type = real_fix_bin_1; 738 739 LOAD_PP_COMMON: 740 call load (ref (2), 0); 741 ref (2) -> reference.data_type = packed_ptr; 742 743 go to PACKED_POINTER_BIFS_2 (macro); /* do the work */ 744 745 PACKED_POINTER_BIFS_2 (1): /* rel */ 746 q = c_a ((bits_per_half), 1); /* no MOD */ 747 call expmac (als, q); 748 go to RETURN_18_BITS; 749 750 PACKED_POINTER_BIFS_2 (2): /* wordno */ 751 q = c_a (-1, 2); /* DL */ 752 call expmac (anq, q); 753 go to done; 754 755 declare charno_packed_mac init (377) fixed bin (15) int static options (constant); 756 PACKED_POINTER_BIFS_2 (3): /* charno */ 757 call expmac$zero (charno_packed_mac); /* uses table */ 758 go to done; 759 760 PACKED_POINTER_BIFS_2 (4): /* bitno */ 761 q = c_a (12 + 18, 1); /* top 6 bits */ 762 call expmac (qrl, q); /* are the bit number */ 763 go to done; 764 765 declare baseno_mask init (4095) fixed bin (18) static options (constant); 766 767 PACKED_POINTER_BIFS_2 (9): /* segno */ 768 q = c_a ((bits_per_half), 1); 769 call expmac (qrl, q); 770 q = c_a (baseno_mask, 2); /* DL */ 771 call expmac (anq, q); 772 go to done; 773 774 PACKED_POINTER_BIFS_2 (10): /* baseno */ 775 q = c_a (baseno_mask, 3); /* DU */ 776 call expmac (ana, q); 777 go to RETURN_18_BITS; 778 779 780 POINTER_BIFS (1): /* rel */ 781 call base_man$load_a_var (ref (2)); 782 go to RETURN_18_BITS; 783 784 785 POINTER_BIFS (2): /* wordno */ 786 call base_man$load_q_var (ref (2)); 787 macro = qrl; /* to QL */ 788 q = c_a ((bits_per_half), 1); /* NO MOD */ 789 call expmac (macro, q); 790 go to done; 791 792 793 POINTER_BIFS (3): /* charno */ 794 call base_man$load_aq_var (ref (2)); 795 call expmac$zero (charno_mac); 796 go to done; 797 798 POINTER_BIFS (4): /* bitno */ 799 call base_man$load_aq_var (ref (2)); 800 call expmac$zero (bitno_mac); 801 go to done; 802 803 804 POINTER_BIFS (9): /* segno */ 805 POINTER_BIFS (10): /* baseno */ 806 call base_man$load_aq_var (ref (2)); 807 if op_code = segno_fun 808 then do; 809 call expmac$zero (segno_mac); 810 go to done; 811 end; 812 call expmac$zero (baseno_mac); /* fall through */ 813 814 RETURN_18_BITS: 815 l9a: 816 a_reg.size = bits_per_half; 817 818 bnf1: 819 a_reg.length = bits_per_word; 820 a_reg.offset = 0; 821 goto done; 822 823 824 /* bit_to_char, bit_to_word, char_to_word, half_to_word, word_to_mod2, word_to_mod4, word_to_mod8 operators */ 825 826 switch_b (6): 827 if ^inline 828 then goto ext_call; 829 830 l2: 831 if atom (2) 832 then call load (ref (2), 0); 833 else call compile_exp (rand (2)); 834 835 if delta = 1 836 then macro = macro + fixed (type (1) ^= real_fix_bin_1, 1); 837 838 switch_b (23): /* not used by opcode_info */ 839 l2a: 840 if macro ^= 0 841 then call expmac$zero (macro); 842 goto done; 843 844 /* abs function */ 845 846 switch_b (7): 847 if ^inline 848 then do; 849 850 ext_call: 851 load_it = "0"b; 852 if ref (1) -> reference.temp_ref & ^cg_stat$save_exp_called 853 then do; 854 if sym (1) -> symbol.binary & sym (1) -> symbol.real 855 then if sym (2) -> symbol.decimal 856 then do; 857 load_it = "0"b; 858 bump = 0; 859 inline = "1"b; 860 end; 861 else do; 862 load_it = "1"b; 863 bump = 2; 864 end; 865 else bump = 1; 866 867 if ^ref (1) -> reference.shared 868 then ref (1) -> reference.ref_count = ref (1) -> reference.ref_count + bump; 869 end; 870 871 if sym (2) -> symbol.decimal 872 then call decimal_op (p, ref, atom); 873 else call gen_arithmetic_builtin (p, ref, atom, call_code); 874 875 if load_it 876 then call load (ref (1), 0); 877 878 goto done; 879 end; 880 881 if atom (2) 882 then call load$for_test (ref (2), 0); 883 else call compile_exp_and_set_indicators (rand (2), type (2)); 884 885 macro = absfx1 - real_fix_bin_1 + type (2); 886 goto l2a; 887 888 /* trunc function */ 889 890 switch_b (8): 891 if ^inline 892 then goto ext_call; 893 894 if sym (2) -> symbol.float 895 then do; 896 macro = trunc_mac (fixed (type (1) ^= real_fix_bin_1, 1)); 897 goto l2; 898 end; 899 900 /* the operation has no meaning for non-positive scales */ 901 902 l7: 903 if sym (2) -> symbol.scale <= 0 904 then do; 905 macro = 0; 906 goto l2; 907 end; 908 909 scale = sym (2) -> symbol.scale; 910 if atom (2) 911 then call load (ref (2), 0); 912 else call compile_exp (rand (2)); 913 914 k = type (2) - real_fix_bin_1; 915 macro = macro + k; 916 917 call xr_man$load_const (scale, 2); 918 919 if k > 0 920 then if action ^= 8 921 then call xr_man$load_const (-2 * scale, 3); 922 goto l2a; 923 924 /* trans_sign and mod functions */ 925 926 switch_b (9): 927 if ^atom (3) 928 then ref (3) = compile_exp$save (rand (3)); 929 if atom (2) 930 then call load (ref (2), 0); 931 else call compile_exp (rand (2)); 932 933 if delta = 1 934 then macro = macro + fixed (type (1) ^= real_fix_bin_1, 1); 935 936 call expmac (macro, ref (3)); 937 938 if action = 21 939 then if scaled 940 then do; 941 array (1) = sym (2) -> symbol.scale; 942 array (2) = sym (3) -> symbol.scale; 943 call expmac$abs (addr (array), 2); 944 end; 945 goto done; 946 947 /* bound_ck and range_ck operators */ 948 949 switch_b (10): 950 call expmac$conditional (macro, pt, ref, atom); 951 goto done; 952 953 /* concatenation operator */ 954 955 switch_b (14): 956 cg_stat$for_test_called = "0"b; 957 call cat_op (pt, ref, code); 958 goto done; 959 960 /* index operator */ 961 962 switch_b (15): 963 if op_code = index_fun 964 then m = 1; 965 else if op_code = index_before_fun 966 then m = 2; 967 else m = 3; 968 969 if type (2) = char_string 970 then do; 971 rlength = ref (3) -> reference.c_length; 972 if rlength = 1 | rlength = 2 973 then do; 974 if op_code = index_rev_fun 975 then macro = index_rev_mac (rlength); 976 else macro = index_mac (m, rlength); 977 if ^atom (2) 978 then ref (2) = compile_exp$save_exp (rand (2)); 979 if ^atom (3) 980 then ref (3) = compile_exp$save_exp (rand (3)); 981 call expmac$two_eis (macro, ref (2), ref (3)); 982 go to done; 983 end; 984 else if op_code = index_rev_fun 985 then m = 4; 986 end; 987 988 else if ref (3) -> reference.c_length = 1 /* Must be bit string */ 989 then do; 990 if ^atom (2) 991 then if rand (2) -> node.type = operator_node 992 then if rand (2) -> operator.op_code = reverse_fun 993 then goto ind0; 994 else ref (2) = compile_exp$save (rand (2)); 995 996 call compile_exp (rand (3)); 997 998 /* protect rand(3) in a, if necessary by getting ref(2)'s address early */ 999 1000 if ref (2) -> reference.big_offset 1001 then do; 1002 call aq_man$lock (null, 1); 1003 if ^ref (2) -> reference.shared 1004 then ref (2) -> reference.ref_count = ref (2) -> reference.ref_count + 1; 1005 call base_man$load_var (2, ref (2), 1); 1006 end; 1007 1008 call long_op$c_or_b (ref (2), 0, (index_chars_1 (m))); 1009 goto done; 1010 end; 1011 1012 /* not single char|bit case */ 1013 1014 ind0: 1015 if ^atom (3) 1016 then ref (3) = compile_exp$save_exp (rand (3)); 1017 1018 if ^atom (2) 1019 then call compile_string; 1020 1021 call load$long_string (ref (2)); 1022 call long_op$c_or_b (ref (3), 0, (index_chars (m))); 1023 goto done; 1024 1025 /* length function as top operand of tree */ 1026 1027 switch_b (16): 1028 call load_size (ref (2)); 1029 if ^ref (2) -> reference.shared 1030 then call adjust_ref_count (ref (2), -1); 1031 goto done; 1032 1033 /* offset function */ 1034 1035 switch_b (17): 1036 if ^atom (2) 1037 then ref (2) = compile_exp$save (rand (2)); 1038 1039 pa = ref (2) -> reference.symbol; 1040 if pa -> symbol.constant 1041 then do; 1042 1043 /* must be null pointer on right */ 1044 1045 call load (generate_constant$real_fix_bin_1 (cg_stat$offset_null_value), 0); 1046 goto done; 1047 end; 1048 1049 call check_ptr; 1050 1051 call load (ref (2), 0); 1052 k = ref (2) -> reference.data_type - unpacked_ptr; 1053 1054 pa = ref (3) -> reference.symbol; 1055 if pa -> symbol.internal & (pa -> symbol.auto | pa -> symbol.static) 1056 then macro = offset_mac_easy; 1057 else macro = offset_mac_hard; 1058 1059 call expmac (macro + k, ref (3)); 1060 goto done; 1061 1062 /* assign_zero and stack_ptr operators */ 1063 1064 switch_b (18): 1065 call expmac (macro, ref (1)); 1066 cg_stat$temp_ref = ref (1); 1067 goto return; 1068 1069 /* desc_size operator */ 1070 1071 switch_b (19): 1072 call expmac (macro, ref (2)); 1073 goto done; 1074 1075 /* floor and ceiling functions */ 1076 1077 switch_b (20): 1078 if ^inline 1079 then goto ext_call; 1080 1081 if sym (2) -> symbol.float 1082 then do; 1083 macro = macro + 2; 1084 goto l2; 1085 end; 1086 1087 goto l7; 1088 1089 /* pl1 mod function */ 1090 1091 switch_b (21): 1092 if ^inline 1093 then goto ext_call; 1094 1095 scaled = "0"b; 1096 1097 if sym (1) -> symbol.float 1098 then do; 1099 if type (1) = real_flt_bin_1 1100 then macro = mdfl1; 1101 else do; 1102 macro = mdfl2; 1103 1104 if type (3) = real_flt_bin_1 1105 then do; 1106 1107 if atom (3) & is_constant (3) 1108 then do; 1109 double = sym (3) -> symbol.initial -> word; 1110 ref (3) = generate_constant$bit_string (double, (bits_per_two_words)); 1111 ref (3) -> reference.symbol -> symbol.boundary = mod2_; 1112 end; 1113 else do; 1114 call compile_exp (rand (3)); 1115 call save_ref_3; 1116 end; 1117 1118 atom (3) = "1"b; 1119 end; 1120 end; 1121 1122 goto switch_b (9); 1123 end; 1124 1125 k = 2 * type (2) + type (3) - 3; 1126 1127 if sym (2) -> symbol.scale = 0 & sym (3) -> symbol.scale = 0 1128 then macro = macro + k; 1129 else do; 1130 macro = scaled_mdfx1 + k; 1131 scaled = "1"b; 1132 end; 1133 1134 go to switch_b (9); 1135 1136 /* round function */ 1137 1138 switch_b (22): 1139 if ^inline 1140 then goto ext_call; 1141 if sym (1) -> symbol.complex 1142 then goto ext_call; 1143 1144 if atom (2) 1145 then call load (ref (2), 0); 1146 else call compile_exp (rand (2)); 1147 1148 if type (3) = real_fix_bin_1 1149 then k = sym (3) -> symbol.initial -> fixed_bin_single; 1150 else k = sym (3) -> symbol.initial -> fixed_bin_double; 1151 1152 if sym (2) -> symbol.float 1153 then do; 1154 call expmac ((round_fl), c_a ((k), 1)); 1155 goto done; 1156 end; 1157 1158 macro = macro + type (2) - real_fix_bin_1; 1159 1160 j = sym (2) -> symbol.scale - k; 1161 1162 if j > 0 1163 then do; 1164 call xr_man$load_const (j, 7); 1165 goto l2a; 1166 end; 1167 else do; 1168 call aq_man$fix_scale (ref (2), k, type (1)); 1169 go to done; 1170 end; 1171 1172 /* repeat and reverse operator */ 1173 1174 switch_b (24): 1175 if (op_code = repeat_fun) & (ref (2) -> reference.c_length = 1) & is_string_constant (2) 1176 then do; 1177 1178 /* we can just emit an mlr or csl with fill to compile this operator 1179* 1180* NOTE: For this optimization, prepare_operand was called on rand (1) to 1181* evaluate the size expression as well as the offset expression. This 1182* ensures that the size expression is evaluated before m_a gets called. It 1183* gets called during the call to expmac$one_eis. This fixes 1985. */ 1184 1185 cg_stat$for_test_called = "0"b; 1186 1187 call adjust_ref_count (rand (3), -1); 1188 1189 ref (1) = string_temp (p, ref (2), null); 1190 1191 if type (1) = char_string 1192 then macro = blank_cs; 1193 else do; 1194 if ref (2) -> reference.units = word_ 1195 then c_offset = ref (2) -> reference.c_offset * bits_per_word; 1196 else c_offset = ref (2) -> reference.c_offset; 1197 /* must be in bits already */ 1198 1199 if substr (sym (2) -> symbol.initial -> based_bs, c_offset + 1, 1) 1200 then macro = one_bs; 1201 else macro = zero_bs; 1202 end; 1203 1204 call expmac$one_eis (macro, ref (1)); 1205 1206 if type (1) = char_string 1207 then do; 1208 if ref (2) -> reference.units = word_ 1209 then c_offset = ref (2) -> reference.c_offset * chars_per_word; 1210 else c_offset = ref (2) -> reference.c_offset; 1211 /* units must already be chars */ 1212 1213 addrel (cg_stat$text_base, cg_stat$text_pos - 3) -> mlr_instruction.fill = 1214 substr (sym (2) -> symbol.initial -> based_cs, c_offset + 1, 1); 1215 end; 1216 1217 go to eis_done; 1218 end; 1219 1220 if op_code = reverse_fun 1221 then if ref (2) -> reference.c_length = 2 1222 then if ref1 -> reference.temp_ref & ^ref1 -> reference.aggregate 1223 then do; 1224 1225 /* reverse 2 chars- to make better code for reverse index */ 1226 1227 if type (1) = char_string 1228 then macro = chars_move; 1229 else macro = move_bits; 1230 call adjust_ref_count (ref (2), 1); 1231 /* Gonna use twice */ 1232 if ^atom (2) 1233 then ref (2) = compile_exp$save_exp (rand (2)); 1234 ref (1) = string_temp (p, ref (2), null); 1235 if ^(^ref (1) -> reference.aggregate & ref (1) -> reference.temp_ref) 1236 then call adjust_ref_count (ref (1), 1); 1237 save_l1 = ref (1) -> reference.c_length; 1238 save_l2 = ref (2) -> reference.c_length; 1239 ref (1) -> reference.c_length, ref (2) -> reference.c_length = 1; 1240 call adjust_c_offset (ref (1), +1); 1241 call expmac$two_eis (macro, ref (1), ref (2)); 1242 call restore_c_offset (ref (1)); 1243 call adjust_c_offset (ref (2), +1); 1244 call expmac$two_eis (macro, ref (1), ref (2)); 1245 call restore_c_offset (ref (2)); 1246 ref (1) -> reference.c_length = save_l1; 1247 ref (2) -> reference.c_length = save_l2; 1248 1249 goto eis_done; 1250 end; 1251 1252 if atom (2) 1253 then do; 1254 l10: 1255 call load$long_string (ref (2)); 1256 1257 if op_code = repeat_fun 1258 then if atom (3) 1259 then call load (ref (3), 0); 1260 else call compile_exp (rand (3)); 1261 else macro = macro + type (1) - char_string; 1262 1263 call expmac$zero (macro); 1264 1265 if type (1) = bit_string 1266 then do; 1267 machine_state.indicators = ind_invalid; 1268 cg_stat$for_test_called = "0"b; 1269 end; 1270 1271 l10a: 1272 if ref (1) -> reference.length ^= null 1273 then do; 1274 1275 /* for reverse or repeat the length may be considered 1276* evaluated and in the q reg; for translate the length 1277* is either already evaluated or is the length_fun op 1278* which needs processing */ 1279 1280 if action = 24 1281 then do; 1282 pa = prepare_operand ((ref (1) -> reference.length), 0, atomic); 1283 1284 if atomic 1285 then if ^pa -> reference.temp_ref 1286 then ref (1) -> reference.length = pa; 1287 else ; 1288 else do; 1289 if pa -> reference.shared 1290 then pa, ref (1) -> reference.length -> operand (1) = copy_temp (pa); 1291 pa -> reference.evaluated = "1"b; 1292 end; 1293 1294 call state_man$update_ref (pa); 1295 end; 1296 else ref (1) -> reference.length = eval_exp ((ref (1) -> reference.length), "1"b); 1297 end; 1298 else if ref (1) -> reference.c_length <= max_short_size (type (1)) 1299 then call expmac$zero (fetch_chars_eis - char_string + type (1)); 1300 1301 if ref (1) -> reference.long_ref 1302 then do; 1303 update_long = ref (1) -> reference.temp_ref & ^ref (1) -> reference.aggregate; 1304 if update_long 1305 then if ref (1) -> reference.length = null 1306 then if ref (1) -> reference.ref_count - fixed (cg_stat$save_exp_called, 1) > 1 1307 then do; 1308 update_long = "0"b; 1309 q = copy_temp (ref (1)); 1310 call state_man$update_ref (q); 1311 call expmac$two_eis (chars_move + type (1) - char_string, ref (1), q); 1312 end; 1313 else ; 1314 else ; 1315 else do; 1316 q, cg_stat$eis_temp = COPY (ref (1)); 1317 if ref (1) -> reference.length ^= null 1318 then q -> reference.length = share_expression ((ref (1) -> reference.length)); 1319 q -> reference.ref_count = 1; 1320 call state_man$update_ref (q); 1321 end; 1322 end; 1323 1324 cg_stat$extended_stack = "1"b; 1325 1326 goto done; 1327 end; 1328 1329 call compile_string; 1330 goto l10; 1331 1332 /* verify and search functions */ 1333 1334 switch_b (25): 1335 if ^atom (3) 1336 then ref (3) = compile_exp$save_exp (rand (3)); 1337 1338 if ref (2) -> reference.c_length = 1 1339 then do; 1340 if ^atom (2) 1341 then call compile_string; 1342 if op_code = verify_fun | op_code = verify_rev_fun 1343 then macro = inline_verify; 1344 else macro = inline_search; 1345 call expmac$two_eis (macro, ref (2), ref (3)); 1346 end; 1347 1348 else if is_constant (3) 1349 then do; 1350 if op_code = verify_ltrim_fun 1351 then macro = verify_ltrim_inline; 1352 else if op_code = verify_rtrim_fun 1353 then macro = verify_rtrim_inline; 1354 else if op_code = verify_rev_fun | op_code = search_rev_fun 1355 then macro = test_translate_rev; 1356 else macro = test_translate; 1357 if ^atom (2) 1358 then ref (2) = compile_exp$save_exp (rand (2)); 1359 if op_code = search_rev_fun 1360 then op_code = search_fun; /* Make tests below easier */ 1361 q = sym (3) -> symbol.initial; 1362 1363 if (ref (3) -> reference.c_length = 1) & (op_code ^= search_fun) 1364 then q = c_a (rank (substr (q -> based_cs, 1, 1)), 16); 1365 /* use the table in pl1_operators_ */ 1366 else do; 1367 string (bit_table) = "0"b; 1368 do i = 1 to ref (3) -> reference.c_length; 1369 j = rank (substr (q -> based_cs, i, 1)); 1370 bit_table (j) = "777"b3; 1371 end; 1372 1373 if op_code ^= search_fun 1374 then string (bit_table) = ^string (bit_table); 1375 1376 q = generate_constant$char_string (mvt_table, length (mvt_table)); 1377 end; 1378 1379 call expmac$two_eis (macro, ref (2), q); 1380 end; 1381 1382 else do; 1383 if ^atom (2) 1384 then call compile_string; 1385 call long_op$eis_operator (ref (2), ref (3), macro); 1386 end; 1387 1388 go to done; 1389 1390 /* translate function */ 1391 1392 switch_b (26): 1393 if n = 4 1394 then macro = macro + 1; 1395 1396 constant_rands = "1"b; 1397 1398 do i = 3 to n; 1399 if ^atom (i) 1400 then do; 1401 ref (i) = compile_exp$save_exp (rand (i)); 1402 constant_rands = "0"b; 1403 end; 1404 else constant_rands = constant_rands & is_constant (i); 1405 end; 1406 1407 if constant_rands 1408 then do; 1409 1410 /* The second and third args to the translate bif are constant, so we 1411* can generate an inline translate sequence */ 1412 1413 if ^atom (2) 1414 then ref (2) = compile_exp$save_exp (rand (2)); 1415 if ref (2) -> reference.value_in.string_aq 1416 /* We must make sure string_temp */ 1417 then call state_man$erase_reg ("001"b); /* doesn't attempt to reuse space used foor ref(2) */ 1418 1419 ref (1) = string_temp (p, ref (2), null); 1420 1421 /* We must generate a translate table for use with an mvt instruction */ 1422 1423 mvt_table = collate9 (); 1424 1425 q = sym (3) -> symbol.initial; 1426 1427 if n = 3 1428 then mvt_table = substr (q -> based_cs, 1, ref (3) -> reference.c_length); 1429 else do; 1430 result_string = substr (q -> based_cs, 1, ref (3) -> reference.c_length); 1431 q = sym (4) -> symbol.initial; 1432 do i = ref (4) -> reference.c_length to 1 by -1; 1433 j = rank (substr (q -> based_cs, i, 1)); 1434 substr (mvt_table, j + 1, 1) = substr (result_string, i, 1); 1435 end; 1436 end; 1437 1438 ref (3) = generate_constant$char_string (mvt_table, length (mvt_table)); 1439 1440 call expmac$many_eis ((inline_translate), addr (ref), 3); 1441 eis_done: 1442 if ^ref (1) -> reference.long_ref 1443 then if ^cg_stat$for_test_called 1444 then do; 1445 update_ref = "0"b; 1446 in_storage = ref1 = ref (1); 1447 if ^(cg_stat$save_exp_called & in_storage) & ref (1) -> reference.temp_ref 1448 & ^ref (1) -> reference.aggregate 1449 then do; 1450 if in_storage 1451 then if ^ref (1) -> reference.shared 1452 then ref (1) -> reference.ref_count = 1453 ref (1) -> reference.ref_count + 1; 1454 call load (ref (1), 1); 1455 end; 1456 end; 1457 go to done; 1458 end; 1459 1460 else do; 1461 1462 /* generate operator call */ 1463 1464 if ^atom (2) 1465 then call compile_string; 1466 1467 call load$long_string (ref (2)); 1468 1469 if n = 3 1470 then call long_op (ref (3), 0, macro); 1471 else call long_op$eis_operator (ref (3), ref (4), macro); 1472 1473 /* Since operator allocates own temp, we must branch for special handling */ 1474 1475 go to l10a; 1476 end; 1477 1478 /* lock_fun (stac) function */ 1479 1480 switch_b (27): 1481 if ^atom (2) 1482 then ref (2) = compile_exp$save (rand (2)); 1483 1484 call compile_exp (rand (3)); 1485 1486 call base_man$load_var (1, ref (2), 1); 1487 call state_man$set_aliasables (null); 1488 call expmac$zero (macro); 1489 1490 a_reg.size = 1; 1491 goto bnf1; 1492 1493 switch_b (29): /* complex and conjg functions */ 1494 switch_b (30): /* real and imag functions */ 1495 if inline 1496 then goto switch_b (10); 1497 else goto ext_call; 1498 1499 /* sign function */ 1500 1501 switch_b (31): 1502 if sym (2) -> symbol.decimal 1503 then go to ext_call; 1504 1505 if atom (2) 1506 then call load$for_test (ref (2), 0); 1507 else call compile_exp_and_set_indicators (rand (2), type (2)); 1508 1509 goto l2a; 1510 1511 /* allocation function */ 1512 1513 switch_b (32): 1514 if sym (2) -> symbol.internal 1515 then n = 13; 1516 else n = 9; 1517 1518 ref (2) = c_a ((sym (2) -> symbol.location), n); 1519 goto switch_b (19); 1520 1521 /* bool function */ 1522 1523 switch_b (33): 1524 if ^atom (2) 1525 then ref (2) = compile_exp$save_exp (rand (2)); 1526 1527 if ^atom (3) 1528 then if rand (3) -> node.type = operator_node 1529 then if ref (3) -> reference.long_ref & atom (4) 1530 then call compile_exp (rand (3)); 1531 else ref (3) = compile_exp$save (rand (3)); 1532 1533 cg_stat$for_test_called = 1534 cg_stat$for_test_called & is_constant (4) & ref (2) -> reference.length = ref (3) -> reference.length 1535 & ref (2) -> reference.c_length <= ref (3) -> reference.c_length; 1536 1537 ref (1) = string_temp (p, ref (3), ref (2)); 1538 1539 if is_constant (4) 1540 then do; 1541 if cg_stat$for_test_called 1542 then m = test_bits; 1543 else m = move_bits; 1544 call expmac$eis (m, ref (2)); 1545 addrel (cg_stat$text_base, cg_stat$text_pos - 3) -> csl_instruction.bool = 1546 sym (4) -> symbol.initial -> bit4; 1547 end; 1548 1549 else do; 1550 call compile_exp (rand (4)); 1551 call state_man$erase_reg ("1"b); 1552 call expmac ((arl), c_a (32, 1)); 1553 1554 if need_areg () 1555 then do; 1556 call expmac$zero ((a_to_x0)); 1557 macro = macro + 1; 1558 end; 1559 else call aq_man$lock (null, 1); 1560 1561 call expmac$eis (macro, ref (2)); 1562 end; 1563 1564 go to eis_done; 1565 1566 /* math builtins */ 1567 1568 switch_b (34): 1569 if n = 3 1570 then do; 1571 check_type = "1"b; 1572 if op_code = atan_fun 1573 then macro = atan2_mac; 1574 else macro = atan2d_mac; 1575 end; 1576 1577 if type (1) = real_flt_bin_2 1578 then macro = macro + 1; 1579 1580 call math_op; 1581 go to done; 1582 1583 /* stacq function. we will generate the following code: 1584* lda ref3 1585* epp2 ref2 1586* ldq ref4 1587* tsx0 ap|stacq_op */ 1588 1589 switch_b (35): 1590 if ^atom (2) 1591 then ref (2) = compile_exp$save (rand (2)); 1592 1593 if ^atom (4) 1594 then ref (4) = compile_exp$save (rand (4)); 1595 1596 call compile_exp (rand (3)); 1597 call base_man$load_var (2, ref (2), 1 /* pr2 */); 1598 if ref (2) -> reference.aliasable 1599 then call state_man$set_aliasables (ref (2)); 1600 call expmac (macro, ref (4)); 1601 a_reg.size = 1; 1602 go to bnf1; 1603 1604 /* clock and vclock functions. we will generate the following code: 1605* tsx0 ap|clock_op 1606* or tsx0 ap|vclock_op */ 1607 1608 switch_b (36): 1609 call state_man$erase_reg ((18)"0"b || "1"b); /* erase pr7 */ 1610 call expmac$zero (macro); 1611 go to done; 1612 1613 /* byte builtin function. we generate the following code: 1614* ldq ref2 1615* lls 63 */ 1616 1617 switch_b (37): 1618 if ^atom (2) 1619 then call compile_exp (rand (2)); 1620 else call load (ref (2), 0); 1621 1622 call aq_man$check_strings (0); 1623 a_reg.offset = 63; 1624 a_reg.length = 9; 1625 a_reg.size = 72; 1626 call aq_man$left_shift (63, "1"b); 1627 go to done; 1628 1629 /* rank builtin function. we generate the following code: 1630* hard_to_load case: 1631* mrl (...),(pr),fill(000) 1632* desc9a ref2,1 1633* desc9a sp|46,4 1634* ldq sp|46 1635* 1636* everything else: 1637* lda ref2 1638* lrl 63 */ 1639 1640 switch_b (38): 1641 if ref (2) -> reference.hard_to_load 1642 then do; 1643 1644 /* hard_to_load implies operand is a reference, not an expression */ 1645 1646 if ^ref (1) -> reference.temp_ref | ref (1) -> reference.ref_count > 1 1647 then q = ref (1); 1648 else q = c_a (46, 4); /* sp|46 (double temp) */ 1649 1650 if q -> reference.temp_ref 1651 then q -> reference.value_in.storage = "1"b; 1652 1653 call expmac$two_eis (rank_eis_mac, q, ref (2)); 1654 in_storage = "1"b; 1655 1656 if ^save_it & ref (1) -> reference.temp_ref 1657 then do; 1658 if ^ref (1) -> reference.shared 1659 then ref (1) -> reference.ref_count = ref (1) -> reference.ref_count + 1; 1660 1661 call expmac (ldfx1, q); 1662 end; 1663 else update_ref = "0"b; 1664 end; 1665 else do; 1666 if atom (2) 1667 then call load (ref (2), 1); 1668 else call compile_exp (rand (2)); 1669 1670 call aq_man$right_shift (63, "1"b); 1671 a_reg.offset, a_reg.size, a_reg.length = 0; 1672 end; 1673 go to done; 1674 1675 compile_exp$for_test: 1676 entry (pt); 1677 1678 ftc = cg_stat$for_test_called; 1679 cg_stat$for_test_called = "1"b; 1680 goto start; 1681 1682 compile_exp$save: 1683 entry (pt, ref_pt); 1684 1685 dcl ref_pt ptr; /* will be set to reference node for result */ 1686 1687 p = pt; 1688 if p -> node.type ^= operator_node 1689 then do; 1690 1691 if ^p -> reference.aligned_ref 1692 then do; 1693 1694 l4: 1695 i = p -> reference.data_type; 1696 is_string = i = char_string | i = bit_string; 1697 1698 if p -> reference.hard_to_load 1699 then if substr (string (p -> reference.value_in), 1, 2) = "00"b 1700 /* not in a or q */ 1701 then if p -> reference.ref_count > 0 1702 then do; 1703 if is_string | mod (p -> reference.c_length, bits_per_word) = 0 1704 then do; 1705 call load$for_save (p, 0); 1706 go to l5; 1707 end; 1708 end; 1709 1710 call load (p, fixed (is_string, 1)); 1711 1712 /* if the reference is now aligned, it was converted to a temporary 1713* because its ref_count was greater than one */ 1714 1715 if p -> reference.aligned_ref 1716 then p -> reference.ref_count = p -> reference.ref_count + 2; 1717 else p = COPY (p); 1718 1719 call store$force (p); 1720 end; 1721 1722 l5: 1723 ref_pt = p; 1724 return; 1725 end; 1726 1727 check_aligned = "1"b; 1728 1729 l6: 1730 ref (1) = p -> operand (1); 1731 if ref (1) -> reference.evaluated 1732 then do; 1733 if check_aligned 1734 then if ^ref (1) -> reference.aligned_ref 1735 then if ^ref (1) -> reference.long_ref 1736 then if ^ref (1) -> reference.varying_ref 1737 then if ^ref (1) -> reference.symbol -> symbol.decimal 1738 then do; 1739 p = ref (1); 1740 go to l4; 1741 end; 1742 ref_pt = ref (1); 1743 return; 1744 end; 1745 1746 if ^ref (1) -> reference.allocate 1747 then do; 1748 1749 p -> operand (1) = copy_temp (ref (1)); 1750 orig_count = 1; 1751 p -> operand (1) -> reference.ref_count = 2; 1752 end; 1753 else if ^ref (1) -> reference.shared 1754 then do; 1755 orig_count = ref (1) -> reference.ref_count; 1756 ref (1) -> reference.ref_count = orig_count + 1; 1757 end; 1758 1759 ftc = cg_stat$for_test_called; 1760 cg_stat$for_test_called = "0"b; 1761 1762 sec = cg_stat$save_exp_called; 1763 cg_stat$save_exp_called = "1"b; 1764 1765 goto work; 1766 1767 compile_exp$save_exp: 1768 entry (pt, ref_pt); 1769 1770 p = pt; 1771 if p -> node.type ^= operator_node 1772 then goto l5; 1773 1774 check_aligned = "0"b; 1775 goto l6; 1776 1777 compile_exp$save_fix_scaled: 1778 entry (pt, target_scale, targ_type) returns (ptr); 1779 1780 dcl target_scale fixed bin, 1781 target_type fixed bin, 1782 targ_type fixed bin; 1783 1784 target_type = targ_type; 1785 save_join: 1786 p = pt; 1787 if p -> node.type ^= operator_node 1788 then call load (p, 0); 1789 else do; 1790 call compile_exp (p); 1791 p = p -> operand (1); 1792 end; 1793 1794 if target_type <= real_fix_bin_2 1795 then call aq_man$fix_scale (p, target_scale, target_type); 1796 1797 q = COPY (p); 1798 q -> reference.data_type = target_type; 1799 1800 call stack_temp$assign_block (q, min (target_type, 2)); 1801 /* NOTE: size = type for real_fix_bin_1 or 2 */ 1802 1803 call expmac (stfx1 - real_fix_bin_1 + target_type, q); 1804 1805 q -> reference.value_in.storage = "1"b; 1806 1807 return (q); 1808 1809 compile_exp$save_float_2: 1810 entry (pt) returns (ptr); 1811 1812 target_type = real_flt_bin_2; 1813 goto save_join; 1814 1815 /* INTERNAL PROCEDURES */ 1816 1817 COPY: 1818 proc (pt) returns (ptr); 1819 1820 dcl (pt, p) ptr; 1821 1822 p = copy_temp (pt); 1823 p -> reference.units = word_; 1824 p -> reference.aligned_ref, p -> reference.padded_ref, p -> reference.aligned_for_store_ref, 1825 p -> reference.padded_for_store_ref = "1"b; 1826 p -> reference.aggregate = "0"b; 1827 p -> reference.c_offset = 0; 1828 p -> reference.ref_count = 2; 1829 p -> reference.length, p -> reference.offset, p -> reference.qualifier = null; 1830 return (p); 1831 1832 end; 1833 1834 check_ptr: 1835 proc; 1836 1837 if ref (2) -> reference.temp_ref 1838 then if ^ref (2) -> reference.value_in.storage 1839 then if ^ref (2) -> reference.value_in.q 1840 then do; 1841 i = index (string (ref (2) -> reference.value_in.b), "1"b) - 1; 1842 if i >= 0 1843 then do; 1844 ref (2) -> reference.ref_count = ref (2) -> reference.ref_count + 1; 1845 call base_to_core (i, ref (2)); 1846 end; 1847 end; 1848 1849 end; 1850 1851 compile_exp_and_set_indicators: 1852 procedure (bv_ref, bv_type); 1853 1854 /* compiles an ARITHMETIC expression and sets the indicators for testing */ 1855 1856 /* parameters */ 1857 1858 dcl ( 1859 bv_ref ptr, 1860 bv_type fixed bin 1861 ) parameter; 1862 1863 /* program */ 1864 1865 call compile_exp (bv_ref); 1866 if (machine_state.indicators ^= ind_arithmetic) 1867 then do; 1868 call expmac$zero (testfx1 - real_fix_bin_1 + bv_type); 1869 machine_state.indicators = ind_arithmetic; 1870 end; 1871 1872 end /* compile_exp_and_set_indicators */; 1873 1874 compile_string: 1875 proc; 1876 1877 if rand (2) -> node.type = operator_node 1878 then if ref (2) -> reference.long_ref 1879 then call compile_exp (rand (2)); 1880 else ref (2) = compile_exp$save (rand (2)); 1881 1882 end; 1883 1884 need_areg: 1885 proc returns (bit (1) aligned); 1886 1887 if ref (1) -> reference.big_length 1888 then if ref (3) -> reference.big_length 1889 then if ref (1) -> reference.length ^= ref (3) -> reference.length 1890 | ref (1) -> reference.c_length ^= ref (3) -> reference.c_length 1891 then return ("1"b); 1892 1893 return ("0"b); 1894 end; 1895 1896 is_constant: 1897 proc (i) reducible returns (bit (1) aligned); 1898 1899 dcl i fixed bin; 1900 1901 if sym (i) -> symbol.constant 1902 then if ^ref (i) -> reference.varying_ref 1903 then if ref (i) -> reference.offset = null 1904 then if ref (i) -> reference.c_offset = 0 1905 then if ref (i) -> reference.length = null 1906 then return ("1"b); 1907 1908 return ("0"b); 1909 end; 1910 1911 is_string_constant: 1912 proc (i) reducible returns (bit (1) aligned); 1913 1914 dcl i fixed bin; 1915 1916 if sym (i) -> symbol.constant 1917 then if ^ref (i) -> reference.varying_ref 1918 then if ref (i) -> reference.offset = null 1919 then if ref (i) -> reference.length = null 1920 then return ("1"b); 1921 1922 return ("0"b); 1923 end /* is_string_constant */; 1924 1925 save_ref_3: 1926 proc; 1927 1928 ref (3) = c_a (2, 12); 1929 ref (3) -> reference.ref_count = 2; 1930 call expmac ((stfl2), ref (3)); 1931 1932 end; 1933 1934 1935 math_op: 1936 proc; 1937 1938 /* procedure to issue calls to math operators */ 1939 1940 dcl adjust bit (1) aligned; 1941 1942 adjust = "0"b; 1943 1944 if n = 3 1945 then if type (1) > type (3) & check_type 1946 then ref (3) = compile_exp$save_float_2 (rand (3)); 1947 else if ^atom (3) 1948 then ref (3) = compile_exp$save (rand (3)); 1949 1950 /* load operand 2 into the q */ 1951 1952 if atom (2) 1953 then call load (ref (2), 0); 1954 else call compile_exp (rand (2)); 1955 1956 if n = 3 1957 then do; 1958 if ref (3) -> reference.temp_ref 1959 then do; 1960 1961 /* protect operand(3) from being clobbered when temps are saved */ 1962 1963 adjust = "1"b; 1964 ref (3) -> reference.ref_count = ref (3) -> reference.ref_count + 1; 1965 end; 1966 1967 /* get a ptr to operand(3) into the ab */ 1968 1969 call base_man$load_var (2, ref (3), 3); 1970 end; 1971 1972 /* get a ptr to the workspace into the bp */ 1973 1974 q = c_a (32, 12); 1975 q -> reference.ref_count = 2; 1976 call base_man$load_var (2, q, 1); 1977 1978 /* we must flush all the registers because the math operators can make external calls */ 1979 1980 call state_man$flush; 1981 1982 call expmac$zero (macro); 1983 machine_state.indicators = ind_arithmetic; 1984 1985 if adjust 1986 then call adjust_ref_count (ref (3), -1); 1987 call adjust_ref_count (q, -1); 1988 1989 end; 1990 1991 adjust_c_offset: 1992 proc (p, delta); 1993 1994 dcl p ptr, 1995 delta fixed bin; 1996 1997 save_mwif = p -> reference.modword_in_offset; 1998 save_coff = p -> reference.c_offset; 1999 save_units = p -> reference.units; 2000 if save_mwif 2001 then p -> reference.c_offset = save_coff + delta; 2002 else if save_units < word_ 2003 then p -> reference.c_offset = save_coff + delta; 2004 else do; 2005 p -> reference.modword_in_offset = "1"b; 2006 if p -> reference.data_type = bit_string 2007 then do; 2008 p -> reference.units = bit_; 2009 p -> reference.c_offset = save_coff * bits_per_word + delta; 2010 end; 2011 else do; 2012 p -> reference.units = character_; 2013 p -> reference.c_offset = save_coff * chars_per_word + delta; 2014 end; 2015 end; 2016 end; 2017 2018 restore_c_offset: 2019 proc (p); 2020 2021 dcl p ptr; 2022 2023 p -> reference.c_offset = save_coff; 2024 p -> reference.modword_in_offset = save_mwif; 2025 p -> reference.units = save_units; 2026 end; 2027 2028 2029 end compile_exp; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1058.2 compile_exp.pl1 >udd>sm>ds>w>ml>compile_exp.pl1 340 1 10/25/79 1745.8 cgsystem.incl.pl1 >ldd>incl>cgsystem.incl.pl1 341 2 07/21/80 1646.3 reference.incl.pl1 >ldd>incl>reference.incl.pl1 342 3 12/07/83 1801.7 symbol.incl.pl1 >ldd>incl>symbol.incl.pl1 343 4 07/21/80 1646.3 operator.incl.pl1 >ldd>incl>operator.incl.pl1 344 5 11/13/79 1115.8 machine_state.incl.pl1 >ldd>incl>machine_state.incl.pl1 345 6 07/21/80 1646.3 nodes.incl.pl1 >ldd>incl>nodes.incl.pl1 346 7 05/03/76 1420.4 data_types.incl.pl1 >ldd>incl>data_types.incl.pl1 347 8 10/25/79 1745.8 boundary.incl.pl1 >ldd>incl>boundary.incl.pl1 348 9 04/07/83 1735.0 op_codes.incl.pl1 >ldd>incl>op_codes.incl.pl1 349 10 11/30/78 1327.5 mask.incl.pl1 >ldd>incl>mask.incl.pl1 350 11 05/03/76 1420.8 bases.incl.pl1 >ldd>incl>bases.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_reg 3 based structure level 2 dcl 5-6 a_to_x0 constant fixed bin(15,0) initial dcl 278 ref 1556 absfx1 constant fixed bin(15,0) initial dcl 278 ref 885 act1 based bit(6) level 2 packed packed unaligned dcl 268 ref 409 act2 0(06) based bit(6) level 2 packed packed unaligned dcl 268 ref 461 action 000604 automatic fixed bin(17,0) dcl 117 set ref 409* 411 461* 501 501 563 919 938 1280 addr builtin function dcl 230 ref 408 943 943 1367 1370 1373 1373 1440 1440 addrel builtin function dcl 230 ref 1213 1545 address 10 based structure level 2 packed packed unaligned dcl 2-3 set ref 526* 526 address_in 11 based structure level 3 packed packed unaligned dcl 2-3 adjust 000740 automatic bit(1) dcl 1940 set ref 1942* 1963* 1985 adjust_ref_count 000230 constant entry external dcl 216 ref 638 1029 1187 1230 1235 1985 1987 aggregate 12(19) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 382 607 614 1220 1235 1303 1447 1826* aliasable 12(16) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 1598 aligned_for_store_ref 13(02) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 1824* aligned_ref 12(07) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 1691 1715 1733 1824* allocate 12(14) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 517 604 1746 als 000220 constant fixed bin(15,0) initial dcl 278 set ref 747* ana 000216 constant fixed bin(15,0) initial dcl 278 set ref 776* anq 000217 constant fixed bin(15,0) initial dcl 278 set ref 752* 771* aq_man$check_strings 000060 constant entry external dcl 146 ref 1622 aq_man$fix_scale 000056 constant entry external dcl 146 ref 1168 1794 aq_man$left_shift 000062 constant entry external dcl 146 ref 1626 aq_man$lock 000226 constant entry external dcl 216 ref 1002 1559 aq_man$right_shift 000064 constant entry external dcl 146 ref 1670 arith_op 000146 constant entry external dcl 146 ref 577 arl constant fixed bin(15,0) initial dcl 278 ref 1552 array 000622 automatic fixed bin(17,0) array dcl 117 set ref 941* 942* 943 943 assign_op 000052 constant entry external dcl 146 ref 415 atan2_mac constant fixed bin(15,0) initial dcl 278 ref 1572 atan2d_mac constant fixed bin(15,0) initial dcl 278 ref 1574 atan_fun constant bit(9) initial dcl 9-8 ref 1572 atom 000155 automatic bit(1) array dcl 85 set ref 469* 482* 486* 501* 509 511 511 568* 575* 577* 654* 713 830 871* 873* 881 910 926 929 949* 977 979 990 1014 1018 1035 1107 1118* 1144 1232 1252 1257 1334 1340 1357 1383 1399 1413 1464 1480 1505 1523 1527 1527 1589 1593 1617 1666 1947 1952 atomic 000167 automatic bit(1) dcl 85 set ref 1282* 1284 attributes 31 based structure level 2 dcl 3-3 auto 32(09) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 1055 b 11(15) based bit(1) array level 4 packed packed unaligned dcl 2-3 set ref 704 1841 base_man$load_a_var 000110 constant entry external dcl 146 ref 780 base_man$load_aq_var 000114 constant entry external dcl 146 ref 793 798 804 base_man$load_q_var 000112 constant entry external dcl 146 ref 785 base_man$load_var 000106 constant entry external dcl 146 ref 1005 1486 1597 1969 1976 base_to_core 000116 constant entry external dcl 146 ref 1845 based_bs based bit(1) dcl 244 ref 1199 based_cs based char(1) dcl 243 ref 1213 1363 1363 1369 1427 1430 1433 baseno_mac 000115 constant fixed bin(15,0) initial dcl 696 set ref 812* baseno_mask 000112 constant fixed bin(18,0) initial dcl 765 set ref 770* 774* big_length 11(34) based bit(1) level 4 packed packed unaligned dcl 2-3 set ref 1887 1887 big_offset 11(33) based bit(1) level 4 packed packed unaligned dcl 2-3 set ref 1000 binary 31(29) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 854 bit 31(03) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 684 bit4 based bit(4) dcl 266 ref 1545 bit_ constant fixed bin(3,0) initial dcl 8-5 ref 2008 bit_string constant fixed bin(15,0) initial dcl 7-1 ref 367 367 729 1265 1696 2006 bit_table based bit(9) array level 2 packed packed unaligned dcl 235 set ref 1367* 1370* 1373* 1373 bit_table_structure based structure level 1 dcl 235 bitno_mac 000116 constant fixed bin(15,0) initial dcl 695 set ref 800* bits 12(06) based structure level 2 packed packed unaligned dcl 2-3 bits_per_half constant fixed bin(8,0) initial dcl 1-5 ref 745 767 788 814 bits_per_two_words constant fixed bin(8,0) initial dcl 1-5 ref 1110 bits_per_word 011001 constant fixed bin(8,0) initial dcl 1-5 ref 818 1194 1703 2009 blank_cs constant fixed bin(15,0) initial dcl 278 ref 1191 bool 0(05) based bit(4) level 2 packed packed unaligned dcl 255 set ref 1545* boundary 2(20) based fixed bin(3,0) level 2 packed packed unaligned dcl 3-3 set ref 1111* bump 000616 automatic fixed bin(17,0) dcl 117 set ref 858* 863* 865* 867 bv_ref parameter pointer dcl 1858 set ref 1851 1865* bv_type parameter fixed bin(17,0) dcl 1858 ref 1851 1868 c_a 000104 constant entry external dcl 146 ref 745 750 760 767 770 774 788 1154 1154 1363 1518 1552 1552 1648 1928 1974 c_length 2 based fixed bin(24,0) level 2 dcl 2-3 set ref 482 971 988 1174 1220 1237 1238 1239* 1239* 1246* 1247* 1298 1338 1363 1368 1427 1430 1432 1533 1533 1703 1887 1887 c_offset 000173 automatic fixed bin(24,0) dcl 85 in procedure "compile_exp" set ref 1194* 1196* 1199 1208* 1210* 1213 c_offset 1 based fixed bin(24,0) level 2 in structure "reference" dcl 2-3 in procedure "compile_exp" set ref 596 597* 601* 1194 1196 1208 1210 1827* 1901 1998 2000* 2002* 2009* 2013* 2023* call_code 0(32) based bit(4) level 2 in structure "op_info" packed packed unaligned dcl 268 in procedure "compile_exp" ref 465 call_code 000607 automatic fixed bin(17,0) dcl 117 in procedure "compile_exp" set ref 465* 873* cat_op 000156 constant entry external dcl 146 ref 957 cg_error 000140 constant entry external dcl 146 ref 434 438 cg_stat$complex_ac 000016 external static pointer dcl 59 set ref 526 527 626* cg_stat$cur_node 000010 external static pointer dcl 59 set ref 368 389 391* 644* cg_stat$eis_temp 000014 external static pointer dcl 59 set ref 618 618* 1316* cg_stat$extended_stack 000032 external static bit(1) packed unaligned dcl 59 set ref 1324* cg_stat$for_test_called 000030 external static bit(1) packed unaligned dcl 59 set ref 354 355* 496* 496 591 643* 667* 667 955* 1185* 1268* 1441 1533* 1533 1541 1678 1679* 1759 1760* cg_stat$offset_null_value 000024 external static fixed bin(17,0) dcl 59 set ref 1045* 1045* cg_stat$save_exp_called 000026 external static bit(1) packed unaligned dcl 59 set ref 357 359* 393 535 632 641* 852 1304 1447 1762 1763* cg_stat$temp_ref 000012 external static pointer dcl 59 set ref 417 424 581* 635 1066* cg_stat$text_base 000020 external static pointer dcl 59 ref 1213 1545 cg_stat$text_pos 000022 external static fixed bin(17,0) dcl 59 ref 1213 1545 cg_static_$m_s_p 000236 external static pointer dcl 5-3 ref 5-3 char 31(04) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 684 char_string constant fixed bin(15,0) initial dcl 7-1 ref 367 367 618 969 1191 1206 1227 1261 1298 1311 1696 character_ constant fixed bin(3,0) initial dcl 8-5 ref 2012 charno_mac 000117 constant fixed bin(15,0) initial dcl 694 set ref 795* charno_packed_mac 000113 constant fixed bin(15,0) initial dcl 755 set ref 756* chars_move constant fixed bin(15,0) initial dcl 278 ref 618 1227 1311 chars_per_word constant fixed bin(8,0) initial dcl 1-5 ref 1208 2013 check_aligned 000172 automatic bit(1) dcl 85 set ref 1727* 1733 1774* check_type 000171 automatic bit(1) dcl 85 set ref 660* 1571* 1944 code 000610 automatic fixed bin(17,0) dcl 117 set ref 509* 511* 670* 678* 957* collate9 builtin function dcl 230 ref 1423 compile_exp 000070 constant entry external dcl 146 ref 833 912 931 996 1114 1146 1260 1484 1527 1550 1596 1617 1668 1790 1865 1877 1954 compile_exp$save 000100 constant entry external dcl 146 ref 926 994 1035 1480 1531 1589 1593 1880 1947 compile_exp$save_exp 000102 constant entry external dcl 146 ref 977 979 1014 1232 1334 1357 1401 1413 1523 complex 31(31) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 501 514 1141 complex_flt_bin_1 constant fixed bin(15,0) initial dcl 7-1 ref 382 542 546 626 constant 32(16) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 1040 1901 1916 constant_rands 000163 automatic bit(1) dcl 85 set ref 1396* 1402* 1404* 1404 1407 copy_temp 000232 constant entry external dcl 216 ref 1289 1309 1749 1822 csl_instruction based structure level 1 dcl 255 data_type 31 based structure level 3 in structure "symbol" packed packed unaligned dcl 3-3 in procedure "compile_exp" data_type 12 based fixed bin(5,0) level 2 in structure "reference" packed packed unaligned dcl 2-3 in procedure "compile_exp" set ref 365 382 472 492 626 700 729* 733* 741* 1052 1694 1798* 2006 decimal 31(28) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 426 498 568 854 871 1501 1733 decimal_op 000150 constant entry external dcl 146 ref 568 871 delta parameter fixed bin(17,0) dcl 1994 in procedure "adjust_c_offset" ref 1991 2000 2002 2009 2013 delta 000606 automatic fixed bin(17,0) dcl 117 in procedure "compile_exp" set ref 464* 835 933 delta 0(30) based bit(2) level 2 in structure "op_info" packed packed unaligned dcl 268 in procedure "compile_exp" ref 464 div constant bit(9) initial dcl 9-8 ref 546 double 000176 automatic bit(72) dcl 116 set ref 1109* 1110* drop 000174 automatic bit(1) initial dcl 85 set ref 85* 382* 385* 445 638 eval_exp 000144 constant entry external dcl 146 ref 1296 evaluated 12(13) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 376 454* 584* 719* 1291* 1731 exp_op 000152 constant entry external dcl 146 ref 654 exp_table 000122 constant fixed bin(15,0) initial array dcl 331 ref 661 expmac 000120 constant entry external dcl 146 ref 626 747 752 762 769 771 776 789 936 1059 1064 1071 1154 1552 1600 1661 1803 1930 expmac$abs 000134 constant entry external dcl 146 ref 943 expmac$conditional 000124 constant entry external dcl 146 ref 949 expmac$eis 000126 constant entry external dcl 146 ref 1544 1561 expmac$many_eis 000122 constant entry external dcl 146 ref 1440 expmac$one_eis 000130 constant entry external dcl 146 ref 1204 expmac$two_eis 000132 constant entry external dcl 146 ref 618 981 1241 1244 1311 1345 1379 1653 expmac$zero 000170 constant entry external dcl 146 ref 687 756 795 800 809 812 838 1263 1298 1488 1556 1610 1868 1982 external 32(02) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 554 fetch_chars_eis constant fixed bin(15,0) initial dcl 278 ref 1298 fill based char(1) level 2 packed packed unaligned dcl 246 set ref 1213* fixed builtin function dcl 230 ref 367 367 403 404 409 434 434 438 438 461 463 464 465 509 511 684 835 896 933 1304 1710 1710 fixed_bin_double based fixed bin(71,0) dcl 239 ref 1150 fixed_bin_single based fixed bin(17,0) dcl 239 ref 649 657 1148 float 31(02) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 894 1081 1097 1152 ftc 000151 automatic bit(1) dcl 85 set ref 354* 643 1678* 1759* gen_arithmetic_builtin 000072 constant entry external dcl 146 ref 873 gen_arithmetic_call 000074 constant entry external dcl 146 ref 575 generate_constant$bit_string 000212 constant entry external dcl 214 ref 1110 generate_constant$char_string 000216 constant entry external dcl 216 ref 1376 1438 generate_constant$real_fix_bin_1 000214 constant entry external dcl 216 ref 1045 1045 get_reference 000162 constant entry external dcl 146 ref 520 hard_to_load 12(23) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 1640 1698 hbound builtin function dcl 230 ref 399 i parameter fixed bin(17,0) dcl 1914 in procedure "is_string_constant" ref 1911 1916 1916 1916 1916 i 000600 automatic fixed bin(17,0) dcl 117 in procedure "compile_exp" set ref 365* 367 367 367 367 399* 400 400* 468* 469 469 470 471 472* 1368* 1369* 1398* 1399 1401 1401 1404* 1432* 1433 1434* 1694* 1696 1696 1841* 1842 1845* i parameter fixed bin(17,0) dcl 1899 in procedure "is_constant" ref 1896 1901 1901 1901 1901 1901 in_storage 000152 automatic bit(1) dcl 85 set ref 396* 559* 623 1446* 1447 1450 1654* ind_arithmetic constant fixed bin(17,0) initial dcl 5-68 ref 1866 1869 1983 ind_invalid constant fixed bin(17,0) initial dcl 5-68 ref 1267 index builtin function dcl 230 ref 1841 index_before_fun constant bit(9) initial dcl 9-8 ref 965 index_chars 000212 constant fixed bin(15,0) initial array dcl 278 ref 1022 index_chars_1 000206 constant fixed bin(15,0) initial array dcl 278 ref 1008 index_fun constant bit(9) initial dcl 9-8 ref 962 index_mac 000200 constant fixed bin(15,0) initial array dcl 278 ref 976 index_rev_fun constant bit(9) initial dcl 9-8 ref 974 984 index_rev_mac 000176 constant fixed bin(15,0) initial array dcl 278 ref 974 indicators 1 based fixed bin(17,0) level 2 dcl 5-6 set ref 1267* 1866 1869* 1983* info 11 based structure level 2 packed packed unaligned dcl 2-3 initial 11 based pointer level 2 packed packed unaligned dcl 3-3 ref 649 657 1109 1148 1150 1199 1213 1361 1425 1431 1545 inline 000153 automatic bit(1) dcl 85 set ref 429* 498* 501* 504* 514 568 588 826 846 859* 890 1077 1091 1138 1493 inline_operation 000164 constant entry external dcl 146 ref 501 inline_search constant fixed bin(15,0) initial dcl 278 ref 1344 inline_translate constant fixed bin(15,0) initial dcl 278 ref 1440 inline_verify constant fixed bin(15,0) initial dcl 278 ref 1342 internal 32(01) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 1055 1513 is_string 000170 automatic bit(1) dcl 85 set ref 1696* 1703 1710 1710 j 000601 automatic fixed bin(17,0) dcl 117 set ref 680* 684* 687 1160* 1162 1164* 1369* 1370 1433* 1434 k 000602 automatic fixed bin(17,0) dcl 117 set ref 404* 405 408 596* 601 678* 687 914* 915 919 1052* 1059 1125* 1127 1130 1148* 1150* 1154 1154 1160 1168* ldfx1 000224 constant fixed bin(15,0) initial dcl 278 set ref 1661* ldfx2 constant fixed bin(15,0) initial dcl 278 ref 626 length 17 based fixed bin(8,0) level 3 in structure "machine_state" dcl 5-6 in procedure "compile_exp" set ref 818* 1624* 1671* length builtin function dcl 230 in procedure "compile_exp" ref 1376 1376 1438 1438 length 6 based pointer level 2 in structure "reference" packed packed unaligned dcl 2-3 in procedure "compile_exp" set ref 1271 1282 1284* 1289 1296* 1296 1304 1317 1317* 1317 1533 1533 1829* 1887 1887 1901 1916 load 000042 constant entry external dcl 146 ref 367 739 830 875 910 929 1045 1051 1144 1257 1454 1620 1666 1710 1787 1952 load$for_save 000046 constant entry external dcl 146 ref 1705 load$for_test 000044 constant entry external dcl 146 ref 881 1505 load$long_string 000050 constant entry external dcl 146 ref 1021 1254 1467 load_it 000154 automatic bit(1) dcl 85 set ref 850* 857* 862* 875 load_size 000054 constant entry external dcl 146 ref 1027 location 1 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 3-3 ref 1518 long_op 000206 constant entry external dcl 146 ref 1469 long_op$c_or_b 000210 constant entry external dcl 146 ref 1008 1022 long_op$eis_operator 000136 constant entry external dcl 146 ref 1385 1471 long_ref 12(08) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 382 594 612 1301 1441 1527 1733 1877 m 000632 automatic fixed bin(15,0) dcl 117 set ref 962* 965* 967* 976 984* 1008 1022 1541* 1543* 1544* m_s_p 000634 automatic pointer initial dcl 5-3 set ref 688 814 818 820 1267 1490 1601 1623 1624 1625 1671 1671 1671 5-3* 1866 1869 1983 machine_state based structure level 1 dcl 5-6 macro 0(12) based bit(18) level 2 in structure "op_info" packed packed unaligned dcl 268 in procedure "compile_exp" ref 463 macro 000631 automatic fixed bin(15,0) dcl 117 in procedure "compile_exp" set ref 463* 661* 724 726 743 787* 789* 835* 835 838 838* 885* 896* 905* 915* 915 933* 933 936* 949* 974* 976* 981* 1055* 1057* 1059 1064* 1071* 1083* 1083 1099* 1102* 1127* 1127 1130* 1158* 1158 1191* 1199* 1201* 1204* 1227* 1229* 1241* 1244* 1261* 1261 1263* 1342* 1344* 1345* 1350* 1352* 1354* 1356* 1379* 1385* 1392* 1392 1469* 1471* 1488* 1557* 1557 1561* 1572* 1574* 1577* 1577 1600* 1610* 1982* max_short_size 000120 constant fixed bin(8,0) initial array dcl 1-5 ref 1298 mdfl1 constant fixed bin(15,0) initial dcl 278 ref 1099 mdfl2 constant fixed bin(15,0) initial dcl 278 ref 1102 min builtin function dcl 230 ref 399 542 1800 1800 min_max 000066 constant entry external dcl 146 ref 422 misc_attributes 31(19) based structure level 3 packed packed unaligned dcl 3-3 mlr_instruction based structure level 1 dcl 246 mod builtin function dcl 230 ref 1703 mod2_ constant fixed bin(3,0) initial dcl 8-5 ref 1111 modword_in_offset 11(35) based bit(1) level 4 packed packed unaligned dcl 2-3 set ref 1997 2005* 2024* more_bits 13 based structure level 2 packed packed unaligned dcl 2-3 move_bits constant fixed bin(15,0) initial dcl 278 ref 1229 1543 mult constant bit(9) initial dcl 9-8 ref 542 mvt_table 000200 automatic char(512) dcl 117 set ref 1367 1370 1373 1373 1376* 1376 1376 1423* 1427* 1434* 1438* 1438 1438 n 000603 automatic fixed bin(17,0) dcl 117 set ref 467* 468 509 511 1392 1398 1427 1469 1513* 1516* 1518* 1568 1944 1956 node based structure level 1 dcl 6-27 null builtin function dcl 230 ref 525 550 1002 1002 1189 1189 1234 1234 1271 1304 1317 1419 1419 1487 1487 1559 1559 1829 1901 1901 1916 1916 number 0(21) based fixed bin(14,0) level 2 packed packed unaligned dcl 4-6 ref 399 467 offset 20 based fixed bin(8,0) level 3 in structure "machine_state" dcl 5-6 in procedure "compile_exp" set ref 820* 1623* 1671* offset 5 based pointer level 2 in structure "reference" packed packed unaligned dcl 2-3 in procedure "compile_exp" set ref 525* 550 1829* 1901 1916 offset_mac_easy constant fixed bin(15,0) initial dcl 278 ref 1055 offset_mac_hard constant fixed bin(15,0) initial dcl 278 ref 1057 one_bs constant fixed bin(15,0) initial dcl 278 ref 1199 op_class defined bit(5) packed unaligned dcl 117 ref 404 op_code 0(09) based bit(9) level 2 in structure "operator" packed packed unaligned dcl 4-6 in procedure "compile_exp" ref 397 990 op_code 000175 automatic bit(9) packed unaligned dcl 85 in procedure "compile_exp" set ref 397* 403 403 404 404 434 434 438 438 482 542 546 807 962 965 974 984 1174 1220 1257 1342 1342 1350 1352 1354 1354 1359 1359* 1363 1373 1572 op_info based structure level 1 dcl 268 op_rel 000605 automatic fixed bin(17,0) dcl 117 set ref 403* 404 687 op_relative defined bit(4) packed unaligned dcl 117 ref 403 opcode_info$last_opcode 000036 external static fixed bin(17,0) dcl 76 ref 405 opcode_info$opcode_info 000034 external static fixed bin(17,0) array dcl 76 set ref 408 opcode_info$table 000040 external static fixed bin(17,0) array dcl 76 ref 404 operand 1 based pointer array level 2 packed packed unaligned dcl 4-6 set ref 372 400 453 718 1289* 1729 1749* 1751 1791 operator based structure level 1 dcl 4-6 operator_node constant bit(9) initial dcl 6-5 ref 363 713 990 1527 1688 1771 1787 1877 orig_count 000617 automatic fixed bin(17,0) dcl 117 set ref 636 1750* 1755* 1756 other 11(33) based structure level 3 packed packed unaligned dcl 2-3 p 000100 automatic pointer dcl 85 in procedure "compile_exp" set ref 361* 363 365 367* 372 378* 391 397 399 400 445* 453 467 501* 575* 871* 873* 1189* 1234* 1419* 1537* 1687* 1688 1691 1694 1698 1698 1698 1703 1705* 1710* 1715 1715 1715 1717* 1717* 1719* 1722 1729 1739* 1749 1751 1770* 1771 1785* 1787 1787* 1790* 1791* 1791 1794* 1797* p 000656 automatic pointer dcl 1820 in procedure "COPY" set ref 1822* 1823 1824 1824 1824 1824 1826 1827 1828 1829 1829 1829 1830 p parameter pointer dcl 2021 in procedure "restore_c_offset" ref 2018 2023 2024 2025 p parameter pointer dcl 1994 in procedure "adjust_c_offset" ref 1991 1997 1998 1999 2000 2002 2005 2006 2008 2009 2012 2013 pa 000104 automatic pointer dcl 85 set ref 1039* 1040 1054* 1055 1055 1055 1282* 1284 1284 1289 1289* 1289* 1291 1294* packed_pointer 000636 automatic bit(1) dcl 698 set ref 703* 704* 711* 724 packed_ptr constant fixed bin(15,0) initial dcl 7-1 ref 700 741 padded_for_store_ref 13(01) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 1824* padded_ref 12(06) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 1824* parameter 32(14) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 556 perm_address 12(18) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 528* pointer_builtins 000160 constant entry external dcl 146 ref 445 717 prepare_operand 000142 constant entry external dcl 146 ref 469 482 486 1282 pt parameter pointer dcl 1820 in procedure "COPY" set ref 1817 1822* pt parameter pointer dcl 55 in procedure "compile_exp" set ref 50 361 415* 422* 568* 577* 654* 670* 678* 949* 957* 1675 1682 1687 1767 1770 1777 1785 1809 q 000102 automatic pointer dcl 85 in procedure "compile_exp" set ref 408* 409 461 463 464 465 469* 470 471 472 520* 522 523 553* 554 554 556 683* 684 684 745* 747* 750* 752* 760* 762* 767* 769* 770* 771* 774* 776* 788* 789* 1309* 1310* 1311* 1316* 1317 1319 1320* 1361* 1363* 1363 1363 1369 1376* 1379* 1425* 1427 1430 1431* 1433 1646* 1648* 1650 1650 1653* 1661* 1797* 1798 1800* 1803* 1805 1807 1974* 1975 1976* 1987* q 11(10) based bit(1) level 4 in structure "reference" packed packed unaligned dcl 2-3 in procedure "compile_exp" set ref 704 1837 qrl 000174 constant fixed bin(15,0) initial dcl 278 set ref 762* 769* 787 qualifier 4 based pointer level 2 packed packed unaligned dcl 2-3 set ref 525* 1829* rand 000136 automatic pointer array dcl 85 set ref 399 400* 469* 482* 486* 713 717* 718 833* 883* 912* 926* 931* 977* 979* 990 990 994* 996* 1014* 1035* 1114* 1146* 1187* 1232* 1260* 1334* 1357* 1401* 1413* 1480* 1484* 1507* 1523* 1527 1527* 1531* 1550* 1589* 1593* 1596* 1617* 1668* 1877 1877* 1880* 1944* 1947* 1954* rank builtin function dcl 230 ref 1363 1363 1369 1433 rank_eis_mac 000175 constant fixed bin(15,0) initial dcl 278 set ref 1653* real 31(30) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 854 real_fix_bin_1 constant fixed bin(15,0) initial dcl 7-1 ref 649 733 835 885 896 914 933 1148 1158 1803 1868 real_fix_bin_2 constant fixed bin(15,0) initial dcl 7-1 ref 1794 real_flt_bin_1 constant fixed bin(15,0) initial dcl 7-1 ref 1099 1104 real_flt_bin_2 constant fixed bin(15,0) initial dcl 7-1 ref 680 1577 1812 ref 000112 automatic pointer array dcl 85 set ref 372* 373 376 378 382 382 382 382 470* 482 490* 491 492 501* 517 522 523* 525 525 526 527 528 532 534 538 538 550 553 568* 575* 577* 654* 670* 678* 678* 683 700 704 704 704 718* 719 719 729 733 739* 741 780* 785* 793* 798* 804* 830* 852 867 867 867 871* 873* 875* 881* 910* 926* 929* 936* 949* 957* 971 977* 979* 981* 981* 988 994* 1000 1003 1003 1003 1005* 1008* 1014* 1021* 1022* 1027* 1029 1029* 1035* 1039 1051* 1052 1054 1059* 1064* 1066 1071* 1110* 1111 1144* 1168* 1174 1189* 1189* 1194 1194 1196 1204* 1208 1208 1210 1220 1230* 1232* 1234* 1234* 1235 1235 1235* 1237 1238 1239 1239 1240* 1241* 1241* 1242* 1243* 1244* 1244* 1245* 1246 1247 1254* 1257* 1271 1282 1284 1289 1296 1296 1298 1301 1303 1303 1304 1304 1309* 1311* 1316* 1317 1317 1334* 1338 1345* 1345* 1357* 1363 1368 1379* 1385* 1385* 1401* 1413* 1415 1419* 1419* 1427 1430 1432 1438* 1440 1440 1441 1446 1447 1447 1450 1450 1450 1454* 1467* 1469* 1471* 1471* 1480* 1486* 1505* 1518* 1523* 1527 1531* 1533 1533 1533 1533 1537* 1537* 1537* 1544* 1561* 1589* 1593* 1597* 1598 1598* 1600* 1620* 1640 1646 1646 1646 1653* 1656 1658 1658 1658 1666* 1729* 1731 1733 1733 1733 1733 1739 1742 1746 1749* 1753 1755 1756 1837 1837 1837 1841 1844 1844 1845* 1877 1880* 1887 1887 1887 1887 1887 1887 1901 1901 1901 1901 1916 1916 1916 1928* 1929 1930* 1944* 1947* 1952* 1958 1964 1964 1969* 1985* ref1 000106 automatic pointer dcl 85 set ref 417* 424* 426 453* 454 454 454 482* 486* 490 496 581 584 584 594 596 597 599* 601 604 607 607 612 614 614 614 614* 618 618* 626 629* 638* 667 1220 1220 1446 ref_count 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 2-3 set ref 496 538* 538 636* 667 867* 867 1003* 1003 1304 1319* 1450* 1450 1646 1658* 1658 1698 1715* 1715 1751* 1755 1756* 1828* 1844* 1844 1929* 1964* 1964 1975* ref_pt parameter pointer dcl 1685 set ref 635* 636 1682 1722* 1742* 1767 reference based structure level 1 dcl 2-3 set ref 522* 522 rel_table 000142 constant fixed bin(15,0) initial array dcl 323 ref 687 relocation 12(24) based bit(12) level 2 packed packed unaligned dcl 2-3 set ref 527* 527 repeat_fun constant bit(9) initial dcl 9-8 ref 482 1174 1257 result_string 000400 automatic char(512) dcl 117 set ref 1430* 1434 reverse_fun constant bit(9) initial dcl 9-8 ref 990 1220 rlength 000620 automatic fixed bin(17,0) dcl 117 set ref 971* 972 972 974 976 round_fl constant fixed bin(15,0) initial dcl 278 ref 1154 save_coff 000627 automatic fixed bin(24,0) dcl 117 set ref 1998* 2000 2002 2009 2013 2023 save_cur_node 000110 automatic pointer dcl 85 set ref 368* 389* 644 save_it 000164 automatic bit(1) dcl 85 set ref 393* 537* 607 1656 save_l1 000624 automatic fixed bin(24,0) dcl 117 set ref 1237* 1246 save_l2 000625 automatic fixed bin(24,0) dcl 117 set ref 1238* 1247 save_mwif 000626 automatic bit(1) packed unaligned dcl 117 set ref 1997* 2000 2024 save_units 000630 automatic fixed bin(3,0) dcl 117 set ref 1999* 2002 2025 scale 2(28) based fixed bin(7,0) level 2 in structure "symbol" packed packed unaligned dcl 3-3 in procedure "compile_exp" ref 902 909 941 942 1127 1127 1160 scale 000621 automatic fixed bin(17,0) dcl 117 in procedure "compile_exp" set ref 909* 917* 919 scaled 000165 automatic bit(1) dcl 85 set ref 938 1095* 1131* scaled_mdfx1 constant fixed bin(15,0) initial dcl 278 ref 1130 search_fun constant bit(9) initial dcl 9-8 ref 1359 1363 1373 search_rev_fun constant bit(9) initial dcl 9-8 ref 1354 1359 sec 000150 automatic bit(1) dcl 85 set ref 357* 641 1762* segno_fun constant bit(9) initial dcl 9-8 ref 807 segno_mac 000114 constant fixed bin(15,0) initial dcl 697 set ref 809* set_indicators 000166 constant entry external dcl 146 ref 678 share_expression 000234 constant entry external dcl 216 ref 1317 shared 0(11) based bit(1) level 2 packed packed unaligned dcl 2-3 set ref 373 454 584 719 867 1003 1029 1289 1450 1658 1753 size 16 based fixed bin(8,0) level 3 dcl 5-6 set ref 688* 814* 1490* 1601* 1625* 1671* stack_temp$assign_block 000202 constant entry external dcl 146 ref 1800 state_man$erase_reg 000220 constant entry external dcl 216 ref 1415 1551 1608 state_man$erase_temps 000204 constant entry external dcl 146 ref 676 state_man$flush 000222 constant entry external dcl 216 ref 1980 state_man$set_aliasables 000200 constant entry external dcl 146 ref 1487 1598 state_man$update_ref 000176 constant entry external dcl 146 ref 599 1294 1310 1320 static 32(11) based bit(1) level 4 packed packed unaligned dcl 3-3 ref 554 1055 stfl2 constant fixed bin(15,0) initial dcl 278 ref 1930 stfx1 constant fixed bin(15,0) initial dcl 278 ref 1803 storage 11(23) based bit(1) level 4 in structure "reference" packed packed unaligned dcl 2-3 in procedure "compile_exp" set ref 534* 704 1650* 1805* 1837 storage 11(08) based bit(1) level 4 in structure "reference" packed packed unaligned dcl 2-3 in procedure "compile_exp" set ref 614 storage_class 32(09) based structure level 3 packed packed unaligned dcl 3-3 store$force 000174 constant entry external dcl 146 ref 629 1719 store$save_string_temp 000172 constant entry external dcl 146 ref 614 string builtin function dcl 230 set ref 526* 526 704 1367* 1373* 1373 1698 1841 string_aq 11(12) based bit(1) level 4 packed packed unaligned dcl 2-3 set ref 1415 string_op 000154 constant entry external dcl 146 ref 670 string_temp 000224 constant entry external dcl 216 ref 1189 1234 1419 1537 substr builtin function dcl 230 set ref 1199 1213 1363 1363 1369 1427 1430 1433 1434* 1434 1698 sym 000124 automatic pointer array dcl 85 set ref 471* 491* 498 501 514 568 649 657 854 854 854 871 894 902 909 941 942 1081 1097 1109 1127 1127 1141 1148 1150 1152 1160 1199 1213 1361 1425 1431 1501 1513 1518 1545 1901 1916 symbol based structure level 1 dcl 3-3 in procedure "compile_exp" symbol 3 based pointer level 2 in structure "reference" packed packed unaligned dcl 2-3 in procedure "compile_exp" set ref 426 471 491 553 683 1039 1054 1111 1733 targ_type parameter fixed bin(17,0) dcl 1780 ref 1777 1784 target_scale parameter fixed bin(17,0) dcl 1780 set ref 1777 1794* target_type 000637 automatic fixed bin(17,0) dcl 1780 set ref 1784* 1794 1794* 1798 1800 1800 1803 1812* temp_ref 12(11) based bit(1) level 3 packed packed unaligned dcl 2-3 set ref 382 454 532 607 614 852 1220 1235 1284 1303 1447 1646 1650 1656 1837 1958 test_bits constant fixed bin(15,0) initial dcl 278 ref 1541 test_translate constant fixed bin(15,0) initial dcl 278 ref 1356 test_translate_rev constant fixed bin(15,0) initial dcl 278 ref 1354 testfx1 constant fixed bin(15,0) initial dcl 278 ref 1868 trunc_mac 000172 constant fixed bin(15,0) initial array dcl 278 ref 896 type 000611 automatic fixed bin(17,0) array dcl 117 in procedure "compile_exp" set ref 472* 492* 542 542 546 618 649 661 661 680 835 883* 885 896 914 933 969 1099 1104 1125 1125 1148 1158 1168* 1191 1206 1227 1261 1265 1298 1298 1311 1507* 1577 1944 1944 type based bit(9) level 2 in structure "node" packed packed unaligned dcl 6-27 in procedure "compile_exp" ref 363 713 990 1527 1688 1771 1787 1877 units 0(14) based fixed bin(3,0) level 2 packed packed unaligned dcl 2-3 set ref 1194 1208 1823* 1999 2008* 2012* 2025* unpacked_ptr constant fixed bin(15,0) initial dcl 7-1 ref 1052 update_long 000162 automatic bit(1) dcl 85 set ref 396* 594 1303* 1304 1308* update_ref 000166 automatic bit(1) dcl 85 set ref 394* 560* 594 1445* 1663* value_in 11(09) based structure level 3 packed packed unaligned dcl 2-3 set ref 1698 varying_ref 0(10) based bit(1) level 2 packed packed unaligned dcl 2-3 set ref 1733 1901 1916 verify_fun constant bit(9) initial dcl 9-8 ref 1342 verify_ltrim_fun constant bit(9) initial dcl 9-8 ref 1350 verify_ltrim_inline constant fixed bin(15,0) initial dcl 278 ref 1350 verify_rev_fun constant bit(9) initial dcl 9-8 ref 1342 1354 verify_rtrim_fun constant bit(9) initial dcl 9-8 ref 1352 verify_rtrim_inline constant fixed bin(15,0) initial dcl 278 ref 1352 word based bit(36) dcl 239 ref 1109 word_ constant fixed bin(3,0) initial dcl 8-5 ref 1194 1208 1823 2002 xr_man$load_const 000076 constant entry external dcl 146 ref 917 919 1164 zero_bs constant fixed bin(15,0) initial dcl 278 ref 1201 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_format internal static bit(9) initial dcl 9-8 ab defined bit(3) dcl 11-9 abs_fun internal static bit(9) initial dcl 9-8 acos_fun internal static bit(9) initial dcl 9-8 acosd_fun internal static bit(9) initial dcl 9-8 add internal static bit(9) initial dcl 9-8 addbitno_fun internal static bit(9) initial dcl 9-8 addcharno_fun internal static bit(9) initial dcl 9-8 addr_fun internal static bit(9) initial dcl 9-8 addr_fun_bits internal static bit(9) initial dcl 9-8 addrel_fun internal static bit(9) initial dcl 9-8 aligned_mask internal static bit(36) initial dcl 10-3 allocation_fun internal static bit(9) initial dcl 9-8 allot_auto internal static bit(9) initial dcl 9-8 allot_based internal static bit(9) initial dcl 9-8 allot_ctl internal static bit(9) initial dcl 9-8 allot_var internal static bit(9) initial dcl 9-8 and_bits internal static bit(9) initial dcl 9-8 ap defined bit(3) dcl 11-4 area_mask internal static bit(36) initial dcl 10-3 arg_descriptor_mask internal static bit(36) initial dcl 10-3 arithmetic_mask internal static bit(36) initial dcl 10-41 array_node internal static bit(9) initial dcl 6-5 asin_fun internal static bit(9) initial dcl 9-8 asind_fun internal static bit(9) initial dcl 9-8 assign internal static bit(9) initial dcl 9-8 assign_by_name internal static bit(9) initial dcl 9-8 assign_round internal static bit(9) initial dcl 9-8 assign_size_ck internal static bit(9) initial dcl 9-8 assign_zero internal static bit(9) initial dcl 9-8 atand_fun internal static bit(9) initial dcl 9-8 b3 automatic bit(3) dcl 85 b_format internal static bit(9) initial dcl 9-8 baseno_fun internal static bit(9) initial dcl 9-8 baseptr_fun internal static bit(9) initial dcl 9-8 bases internal static bit(3) initial array dcl 11-1 bb defined bit(3) dcl 11-9 binary_mask internal static bit(36) initial dcl 10-3 bit_mask internal static bit(36) initial dcl 10-3 bit_pointer internal static bit(9) initial dcl 9-8 bit_to_char internal static bit(9) initial dcl 9-8 bit_to_word internal static bit(9) initial dcl 9-8 bitno_fun internal static bit(9) initial dcl 9-8 bits_per_char internal static fixed bin(8,0) initial dcl 1-5 bits_per_four_words internal static fixed bin(8,0) initial dcl 1-5 bits_per_packed_digit internal static fixed bin(8,1) initial dcl 1-35 bits_per_words internal static fixed bin(8,0) initial array dcl 1-5 block_node internal static bit(9) initial dcl 6-5 bn_format internal static bit(9) initial dcl 9-8 bool_fun internal static bit(9) initial dcl 9-8 bound_ck internal static bit(9) initial dcl 9-8 bound_node internal static bit(9) initial dcl 6-5 bp defined bit(3) dcl 11-4 break_even_bits internal static fixed bin(8,0) initial dcl 1-5 break_even_words internal static fixed bin(8,0) initial dcl 1-5 builtin_mask internal static bit(36) initial dcl 10-3 by_name_agg_node internal static bit(9) initial dcl 6-5 byte_fun internal static bit(9) initial dcl 9-8 c_format internal static bit(9) initial dcl 9-8 cat_string internal static bit(9) initial dcl 9-8 ceil_fun internal static bit(9) initial dcl 9-8 char_mask internal static bit(36) initial dcl 10-3 char_to_word internal static bit(9) initial dcl 9-8 charno_fun internal static bit(9) initial dcl 9-8 clock_fun internal static bit(9) initial dcl 9-8 close_file internal static bit(9) initial dcl 9-8 codeptr_fun internal static bit(9) initial dcl 9-8 column_format internal static bit(9) initial dcl 9-8 complex_fix_bin_1 internal static fixed bin(15,0) initial dcl 7-1 complex_fix_bin_2 internal static fixed bin(15,0) initial dcl 7-1 complex_fix_dec internal static fixed bin(15,0) initial dcl 7-1 complex_flt_bin_2 internal static fixed bin(15,0) initial dcl 7-1 complex_flt_dec internal static fixed bin(15,0) initial dcl 7-1 complex_fun internal static bit(9) initial dcl 9-8 complex_mask internal static bit(36) initial dcl 10-3 computational_mask internal static bit(36) initial dcl 10-41 condition_mask internal static bit(36) initial dcl 10-3 conjg_fun internal static bit(9) initial dcl 9-8 context_node internal static bit(9) initial dcl 6-5 convert_mask internal static bit(36) initial dcl 10-41 convert_offset internal static fixed bin(8,1) initial array dcl 1-35 convert_size internal static fixed bin(8,0) initial array dcl 1-5 copy builtin function dcl 230 copy_string internal static bit(9) initial dcl 9-8 copy_words internal static bit(9) initial dcl 9-8 cos_fun internal static bit(9) initial dcl 9-8 cosd_fun internal static bit(9) initial dcl 9-8 cross_reference_node internal static bit(9) initial dcl 6-5 decimal_mask internal static bit(36) initial dcl 10-3 declare_constant_mask internal static bit(36) initial dcl 10-41 default_fix_bin_p internal static fixed bin(8,0) initial dcl 1-5 default_node internal static bit(9) initial dcl 6-5 delete_file internal static bit(9) initial dcl 9-8 desc_size internal static bit(9) initial dcl 9-8 digit_ internal static fixed bin(3,0) initial dcl 8-5 digit_to_bit internal static bit(9) initial dcl 9-8 dimensioned_mask internal static bit(36) initial dcl 10-3 do_fun internal static bit(9) initial dcl 9-8 do_spec internal static bit(9) initial dcl 9-8 e_format internal static bit(9) initial dcl 9-8 empty_area internal static bit(9) initial dcl 9-8 enable_on internal static bit(9) initial dcl 9-8 entry_mask internal static bit(36) initial dcl 10-3 entry_variable internal static fixed bin(15,0) initial dcl 7-1 environmentptr_fun internal static bit(9) initial dcl 9-8 equal internal static bit(9) initial dcl 9-8 ex_prologue internal static bit(9) initial dcl 9-8 exp internal static bit(9) initial dcl 9-8 exp_fun internal static bit(9) initial dcl 9-8 ext_entry_in internal static fixed bin(15,0) initial dcl 7-1 ext_entry_out internal static fixed bin(15,0) initial dcl 7-1 f_format internal static bit(9) initial dcl 9-8 file_mask internal static bit(36) initial dcl 10-3 fixed_binary_real_mask internal static bit(36) initial dcl 10-41 fixed_decimal_complex_mask internal static bit(36) initial dcl 10-41 fixed_decimal_real_mask internal static bit(36) initial dcl 10-41 fixed_mask internal static bit(36) initial dcl 10-3 float_decimal_complex_mask internal static bit(36) initial dcl 10-41 float_decimal_real_mask internal static bit(36) initial dcl 10-41 float_mask internal static bit(36) initial dcl 10-3 floor_fun internal static bit(9) initial dcl 9-8 format_mask internal static bit(36) initial dcl 10-3 format_value_node internal static bit(9) initial dcl 6-5 fortran_read internal static bit(9) initial dcl 9-8 fortran_write internal static bit(9) initial dcl 9-8 free_based internal static bit(9) initial dcl 9-8 free_ctl internal static bit(9) initial dcl 9-8 free_var internal static bit(9) initial dcl 9-8 ftn_file_manip internal static bit(9) initial dcl 9-8 ftn_trans_loop internal static bit(9) initial dcl 9-8 generic_mask internal static bit(36) initial dcl 10-3 get_data_trans internal static bit(9) initial dcl 9-8 get_edit_trans internal static bit(9) initial dcl 9-8 get_file internal static bit(9) initial dcl 9-8 get_list_trans internal static bit(9) initial dcl 9-8 get_string internal static bit(9) initial dcl 9-8 greater_or_equal internal static bit(9) initial dcl 9-8 greater_than internal static bit(9) initial dcl 9-8 half_ internal static fixed bin(3,0) initial dcl 8-5 half_to_word internal static bit(9) initial dcl 9-8 imag_fun internal static bit(9) initial dcl 9-8 ind_decimal_reg internal static fixed bin(17,0) initial dcl 5-68 ind_known_refs internal static fixed bin(17,0) initial dcl 5-68 ind_logical internal static fixed bin(17,0) initial dcl 5-68 ind_string_aq internal static fixed bin(17,0) initial dcl 5-68 ind_x internal static fixed bin(17,0) initial array dcl 5-68 index_after_fun internal static bit(9) initial dcl 9-8 initialed_mask internal static bit(36) initial dcl 10-3 int_entry internal static fixed bin(15,0) initial dcl 7-1 int_entry_other internal static fixed bin(15,0) initial dcl 7-1 irreducible_mask internal static bit(36) initial dcl 10-3 join internal static bit(9) initial dcl 9-8 jump internal static bit(9) initial dcl 9-8 jump_false internal static bit(9) initial dcl 9-8 jump_if_eq internal static bit(9) initial dcl 9-8 jump_if_ge internal static bit(9) initial dcl 9-8 jump_if_gt internal static bit(9) initial dcl 9-8 jump_if_le internal static bit(9) initial dcl 9-8 jump_if_lt internal static bit(9) initial dcl 9-8 jump_if_ne internal static bit(9) initial dcl 9-8 jump_true internal static bit(9) initial dcl 9-8 l_parn internal static bit(9) initial dcl 9-8 label_array_element_node internal static bit(9) initial dcl 6-5 label_constant internal static fixed bin(15,0) initial dcl 7-1 label_mask internal static bit(36) initial dcl 10-3 label_node internal static bit(9) initial dcl 6-5 label_size internal static fixed bin(8,0) initial dcl 1-5 label_variable internal static fixed bin(15,0) initial dcl 7-1 lb defined bit(3) dcl 11-9 length_fun internal static bit(9) initial dcl 9-8 less_or_equal internal static bit(9) initial dcl 9-8 less_than internal static bit(9) initial dcl 9-8 line_format internal static bit(9) initial dcl 9-8 list_node internal static bit(9) initial dcl 6-5 llr internal static fixed bin(15,0) initial dcl 278 local_label_variable internal static fixed bin(15,0) initial dcl 7-1 local_mask internal static bit(36) initial dcl 10-3 locate_file internal static bit(9) initial dcl 9-8 lock_file internal static bit(9) initial dcl 9-8 lock_fun internal static bit(9) initial dcl 9-8 lock_mask internal static bit(36) initial dcl 10-3 log10_fun internal static bit(9) initial dcl 9-8 log2_fun internal static bit(9) initial dcl 9-8 log_fun internal static bit(9) initial dcl 9-8 loop internal static bit(9) initial dcl 9-8 lp defined bit(3) dcl 11-4 machine_state_node internal static bit(9) initial dcl 6-5 make_desc internal static bit(9) initial dcl 9-8 max_dec_scale internal static fixed bin(8,0) initial dcl 1-5 max_fun internal static bit(9) initial dcl 9-8 max_index_register_value internal static fixed bin(31,0) initial dcl 1-38 max_length_p internal static fixed bin(8,0) initial dcl 1-5 max_number_of_operands internal static fixed bin(15,0) initial dcl 4-15 max_offset internal static fixed bin(8,0) initial array dcl 1-5 max_p_fix_bin_1 internal static fixed bin(8,0) initial dcl 1-5 max_p_fix_dec internal static fixed bin(8,0) initial dcl 1-5 max_p_flt_bin_1 internal static fixed bin(8,0) initial dcl 1-5 max_p_xreg internal static fixed bin(8,0) initial dcl 1-5 min_dec_scale internal static fixed bin(8,0) initial dcl 1-5 min_fun internal static bit(9) initial dcl 9-8 mod4_ internal static fixed bin(3,0) initial dcl 8-5 mod_bit internal static bit(9) initial dcl 9-8 mod_byte internal static bit(9) initial dcl 9-8 mod_fun internal static bit(9) initial dcl 9-8 mod_half internal static bit(9) initial dcl 9-8 mod_word internal static bit(9) initial dcl 9-8 negate internal static bit(9) initial dcl 9-8 nop internal static bit(9) initial dcl 9-8 not_bits internal static bit(9) initial dcl 9-8 not_equal internal static bit(9) initial dcl 9-8 off_fun internal static bit(9) initial dcl 9-8 offset_mask internal static bit(36) initial dcl 10-3 open_file internal static bit(9) initial dcl 9-8 or_bits internal static bit(9) initial dcl 9-8 pack internal static bit(9) initial dcl 9-8 packed_digits_per_char internal static fixed bin(8,0) initial dcl 1-5 packed_digits_per_word internal static fixed bin(8,0) initial dcl 1-5 page_format internal static bit(9) initial dcl 9-8 param_desc_ptr internal static bit(9) initial dcl 9-8 param_ptr internal static bit(9) initial dcl 9-8 picture_format internal static bit(9) initial dcl 9-8 picture_mask internal static bit(36) initial dcl 10-3 pl1_mod_fun internal static bit(9) initial dcl 9-8 precision_mask internal static bit(36) initial dcl 10-3 prefix_plus internal static bit(9) initial dcl 9-8 ptr_fun internal static bit(9) initial dcl 9-8 ptr_mask internal static bit(36) initial dcl 10-3 put_control internal static bit(9) initial dcl 9-8 put_data_trans internal static bit(9) initial dcl 9-8 put_edit_trans internal static bit(9) initial dcl 9-8 put_field internal static bit(9) initial dcl 9-8 put_field_chk internal static bit(9) initial dcl 9-8 put_file internal static bit(9) initial dcl 9-8 put_list_trans internal static bit(9) initial dcl 9-8 put_string internal static bit(9) initial dcl 9-8 qrs internal static fixed bin(15,0) initial dcl 278 r_format internal static bit(9) initial dcl 9-8 r_parn internal static bit(9) initial dcl 9-8 range_ck internal static bit(9) initial dcl 9-8 rank_fun internal static bit(9) initial dcl 9-8 read_file internal static bit(9) initial dcl 9-8 real_fix_dec internal static fixed bin(15,0) initial dcl 7-1 real_flt_dec internal static fixed bin(15,0) initial dcl 7-1 real_fun internal static bit(9) initial dcl 9-8 real_mask internal static bit(36) initial dcl 10-3 record_io internal static bit(9) initial dcl 9-8 reducible_mask internal static bit(36) initial dcl 10-3 refer internal static bit(9) initial dcl 9-8 reference_node internal static bit(9) initial dcl 6-5 rel_fun internal static bit(9) initial dcl 9-8 return_bits internal static bit(9) initial dcl 9-8 return_string internal static bit(9) initial dcl 9-8 return_value internal static bit(9) initial dcl 9-8 return_words internal static bit(9) initial dcl 9-8 returns_mask internal static bit(36) initial dcl 10-3 revert_on internal static bit(9) initial dcl 9-8 rewrite_file internal static bit(9) initial dcl 9-8 round_fun internal static bit(9) initial dcl 9-8 sb defined bit(3) dcl 11-9 setbitno_fun internal static bit(9) initial dcl 9-8 setcharno_fun internal static bit(9) initial dcl 9-8 sf_par_node internal static bit(9) initial dcl 6-5 sign_fun internal static bit(9) initial dcl 9-8 signal_on internal static bit(9) initial dcl 9-8 signed_mask internal static bit(36) initial dcl 10-3 sin_fun internal static bit(9) initial dcl 9-8 sind_fun internal static bit(9) initial dcl 9-8 skip_format internal static bit(9) initial dcl 9-8 source_node internal static bit(9) initial dcl 6-5 sp defined bit(3) dcl 11-4 sqrt_fun internal static bit(9) initial dcl 9-8 stack_ptr internal static bit(9) initial dcl 9-8 stackbaseptr_fun internal static bit(9) initial dcl 9-8 stackframeptr_fun internal static bit(9) initial dcl 9-8 stacq_fun internal static bit(9) initial dcl 9-8 statement_node internal static bit(9) initial dcl 6-5 std_arg_list internal static bit(9) initial dcl 9-8 std_call internal static bit(9) initial dcl 9-8 std_entry internal static bit(9) initial dcl 9-8 std_return internal static bit(9) initial dcl 9-8 stop internal static bit(9) initial dcl 9-8 storage_block_mask internal static bit(36) initial dcl 10-3 stream_prep internal static bit(9) initial dcl 9-8 string_mask internal static bit(36) initial dcl 10-41 structure_mask internal static bit(36) initial dcl 10-3 sub internal static bit(9) initial dcl 9-8 symbol_node internal static bit(9) initial dcl 6-5 tan_fun internal static bit(9) initial dcl 9-8 tand_fun internal static bit(9) initial dcl 9-8 temporary_node internal static bit(9) initial dcl 6-5 terminate_trans internal static bit(9) initial dcl 9-8 token_node internal static bit(9) initial dcl 6-5 translate_fun internal static bit(9) initial dcl 9-8 trunc_fun internal static bit(9) initial dcl 9-8 unaligned_mask internal static bit(36) initial dcl 10-3 undesirable_mask internal static bit(36) initial dcl 10-41 units_per_word internal static fixed bin(8,0) initial array dcl 1-5 unlock_file internal static bit(9) initial dcl 9-8 unpack internal static bit(9) initial dcl 9-8 unsigned_mask internal static bit(36) initial dcl 10-3 variable_mask internal static bit(36) initial dcl 10-3 varying_mask internal static bit(36) initial dcl 10-3 vclock_fun internal static bit(9) initial dcl 9-8 which_base internal static fixed bin(17,0) initial array dcl 11-14 word_to_mod2 internal static bit(9) initial dcl 9-8 word_to_mod4 internal static bit(9) initial dcl 9-8 word_to_mod8 internal static bit(9) initial dcl 9-8 wordno_fun internal static bit(9) initial dcl 9-8 write_file internal static bit(9) initial dcl 9-8 x_format internal static bit(9) initial dcl 9-8 xor_bits internal static bit(9) initial dcl 9-8 NAMES DECLARED BY EXPLICIT CONTEXT. COPY 007747 constant entry internal dcl 1817 ref 1316 1717 1797 LOAD_PP_COMMON 002140 constant label dcl 739 ref 732 PACKED_POINTER_BIFS 000054 constant label array(10) dcl 729 ref 724 PACKED_POINTER_BIFS_2 000066 constant label array(10) dcl 745 ref 743 POINTER_BIFS 000100 constant label array(10) dcl 780 ref 726 RETURN_18_BITS 002551 constant label dcl 814 ref 748 777 782 adjust_c_offset 010545 constant entry internal dcl 1991 ref 1240 1243 bnf1 002554 constant label dcl 818 ref 689 1491 1602 branch 001357 constant label dcl 563 ref 529 check_ptr 010013 constant entry internal dcl 1834 ref 1049 compile_exp 000453 constant entry external dcl 50 compile_exp$for_test 007235 constant entry external dcl 1675 compile_exp$save 007257 constant entry external dcl 1682 compile_exp$save_exp 007535 constant entry external dcl 1767 compile_exp$save_fix_scaled 007564 constant entry external dcl 1777 compile_exp$save_float_2 007732 constant entry external dcl 1809 ref 1944 compile_exp_and_set_indicators 010056 constant entry internal dcl 1851 ref 883 1507 compile_string 010112 constant entry internal dcl 1874 ref 1018 1329 1340 1383 1464 done 001435 constant label dcl 581 ref 655 663 672 753 758 763 772 790 796 801 810 821 842 878 945 951 958 982 1009 1023 1031 1046 1060 1073 1155 1169 1326 1388 1457 1581 1611 1627 1673 done_1 001440 constant label dcl 584 ref 430 eis_done 006026 constant label dcl 1441 ref 1217 1249 1564 ext_call 002636 constant label dcl 850 ref 826 890 1077 1091 1138 1141 1497 1501 ind0 003536 constant label dcl 1014 ref 990 is_atom 000503 constant label dcl 365 set ref 379 is_constant 010172 constant entry internal dcl 1896 ref 649 1107 1348 1404 1533 1539 is_string_constant 010224 constant entry internal dcl 1911 ref 482 1174 l10 004706 constant label dcl 1254 ref 1330 l10a 004771 constant label dcl 1271 ref 1475 l2 002564 constant label dcl 830 ref 897 906 1084 l2a 002621 constant label dcl 838 ref 886 922 1165 1509 l4 007302 constant label dcl 1694 ref 1740 l5 007407 constant label dcl 1722 ref 1706 1771 l6 007423 constant label dcl 1729 ref 1775 l7 003016 constant label dcl 902 ref 1087 l9a 002551 constant label dcl 814 math_op 010313 constant entry internal dcl 1935 ref 662 1580 need_areg 010145 constant entry internal dcl 1884 ref 1554 not_yet 000727 constant label dcl 438 ref 405 prepare_minus_1 001120 constant label dcl 486 ref 482 restore_c_offset 010626 constant entry internal dcl 2018 ref 1242 1245 return 001614 constant label dcl 632 ref 418 426 436 441 457 588 591 607 620 623 1067 return_1 001644 constant label dcl 641 ref 369 save_join 007601 constant label dcl 1785 ref 1813 save_ref_3 010254 constant entry internal dcl 1925 ref 1115 start 000467 constant label dcl 357 ref 1680 switch_a 000000 constant label array(6) dcl 415 ref 411 657 switch_b 000006 constant label array(38) dcl 568 ref 563 1122 1134 1493 1519 use_cpx 001247 constant label dcl 520 ref 542 546 550 554 556 work 000565 constant label dcl 389 ref 1765 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 12102 12342 11003 12112 Length 13234 11003 240 655 1076 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME compile_exp 610 external procedure is an external procedure. COPY internal procedure shares stack frame of external procedure compile_exp. check_ptr internal procedure shares stack frame of external procedure compile_exp. compile_exp_and_set_indicators internal procedure shares stack frame of external procedure compile_exp. compile_string internal procedure shares stack frame of external procedure compile_exp. need_areg internal procedure shares stack frame of external procedure compile_exp. is_constant internal procedure shares stack frame of external procedure compile_exp. is_string_constant internal procedure shares stack frame of external procedure compile_exp. save_ref_3 internal procedure shares stack frame of external procedure compile_exp. math_op internal procedure shares stack frame of external procedure compile_exp. adjust_c_offset internal procedure shares stack frame of external procedure compile_exp. restore_c_offset internal procedure shares stack frame of external procedure compile_exp. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME compile_exp 000100 p compile_exp 000102 q compile_exp 000104 pa compile_exp 000106 ref1 compile_exp 000110 save_cur_node compile_exp 000112 ref compile_exp 000124 sym compile_exp 000136 rand compile_exp 000150 sec compile_exp 000151 ftc compile_exp 000152 in_storage compile_exp 000153 inline compile_exp 000154 load_it compile_exp 000155 atom compile_exp 000162 update_long compile_exp 000163 constant_rands compile_exp 000164 save_it compile_exp 000165 scaled compile_exp 000166 update_ref compile_exp 000167 atomic compile_exp 000170 is_string compile_exp 000171 check_type compile_exp 000172 check_aligned compile_exp 000173 c_offset compile_exp 000174 drop compile_exp 000175 op_code compile_exp 000176 double compile_exp 000200 mvt_table compile_exp 000400 result_string compile_exp 000600 i compile_exp 000601 j compile_exp 000602 k compile_exp 000603 n compile_exp 000604 action compile_exp 000605 op_rel compile_exp 000606 delta compile_exp 000607 call_code compile_exp 000610 code compile_exp 000611 type compile_exp 000616 bump compile_exp 000617 orig_count compile_exp 000620 rlength compile_exp 000621 scale compile_exp 000622 array compile_exp 000624 save_l1 compile_exp 000625 save_l2 compile_exp 000626 save_mwif compile_exp 000627 save_coff compile_exp 000630 save_units compile_exp 000631 macro compile_exp 000632 m compile_exp 000634 m_s_p compile_exp 000636 packed_pointer compile_exp 000637 target_type compile_exp 000656 p COPY 000740 adjust math_op THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as r_le_a alloc_bit_temp call_ext_in call_ext_out_desc call_ext_out return_mac mdfx1 signal_op shorten_stack ext_entry index_bs_1_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. adjust_ref_count aq_man$check_strings aq_man$fix_scale aq_man$left_shift aq_man$lock aq_man$right_shift arith_op assign_op base_man$load_a_var base_man$load_aq_var base_man$load_q_var base_man$load_var base_to_core c_a cat_op cg_error compile_exp compile_exp$save compile_exp$save_exp copy_temp decimal_op eval_exp exp_op expmac expmac$abs expmac$conditional expmac$eis expmac$many_eis expmac$one_eis expmac$two_eis expmac$zero gen_arithmetic_builtin gen_arithmetic_call generate_constant$bit_string generate_constant$char_string generate_constant$real_fix_bin_1 get_reference inline_operation load load$for_save load$for_test load$long_string load_size long_op long_op$c_or_b long_op$eis_operator min_max pointer_builtins prepare_operand set_indicators share_expression stack_temp$assign_block state_man$erase_reg state_man$erase_temps state_man$flush state_man$set_aliasables state_man$update_ref store$force store$save_string_temp string_op string_temp xr_man$load_const THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cg_stat$complex_ac cg_stat$cur_node cg_stat$eis_temp cg_stat$extended_stack cg_stat$for_test_called cg_stat$offset_null_value cg_stat$save_exp_called cg_stat$temp_ref cg_stat$text_base cg_stat$text_pos cg_static_$m_s_p opcode_info$last_opcode opcode_info$opcode_info opcode_info$table LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 85 000441 5 3 000442 50 000450 354 000463 355 000466 357 000467 359 000472 361 000473 363 000477 365 000503 367 000507 368 000530 369 000534 372 000535 373 000537 376 000542 378 000545 379 000546 382 000547 385 000564 389 000565 391 000571 393 000573 394 000575 396 000577 397 000601 399 000605 400 000621 401 000625 403 000627 404 000633 405 000641 408 000643 409 000645 411 000650 415 000651 417 000661 418 000665 422 000666 424 000675 426 000701 429 000706 430 000710 434 000711 436 000726 438 000727 441 000744 445 000745 453 000760 454 000763 457 000773 461 000774 463 001000 464 001004 465 001010 467 001013 468 001017 469 001023 470 001046 471 001051 472 001053 473 001057 482 001062 486 001120 490 001137 491 001141 492 001144 496 001147 498 001156 501 001163 504 001210 509 001212 511 001221 514 001234 517 001243 520 001247 522 001256 523 001263 525 001264 526 001270 527 001275 528 001277 529 001301 532 001302 534 001305 535 001307 537 001312 538 001314 542 001321 545 001332 546 001333 550 001340 553 001343 554 001345 556 001351 559 001354 560 001356 563 001357 568 001361 575 001405 577 001421 581 001435 584 001440 588 001446 591 001451 594 001453 596 001463 597 001465 599 001466 601 001474 604 001477 607 001503 612 001515 614 001520 617 001537 618 001540 620 001563 623 001564 626 001566 629 001605 632 001614 635 001617 636 001623 637 001627 638 001630 641 001644 643 001647 644 001651 645 001653 649 001662 654 001702 655 001716 657 001717 660 001720 661 001721 662 001726 663 001727 667 001730 670 001737 672 001752 676 001753 678 001760 680 002000 683 002005 684 002010 687 002022 688 002042 689 002045 700 002046 703 002053 704 002055 709 002067 711 002070 713 002071 717 002100 718 002113 719 002116 724 002123 726 002127 729 002131 732 002134 733 002135 739 002140 741 002152 743 002155 745 002157 747 002176 748 002207 750 002210 752 002227 753 002240 756 002241 758 002250 760 002251 762 002270 763 002301 767 002302 769 002321 770 002332 771 002347 772 002360 774 002361 776 002376 777 002407 780 002410 782 002417 785 002420 787 002427 788 002431 789 002450 790 002461 793 002462 795 002471 796 002500 798 002501 800 002510 801 002517 804 002520 807 002527 809 002532 810 002541 812 002542 814 002551 818 002554 820 002557 821 002560 826 002561 830 002564 833 002602 835 002611 838 002621 842 002632 846 002633 850 002636 852 002637 854 002646 858 002657 859 002660 860 002662 862 002663 863 002665 864 002667 865 002670 867 002672 871 002702 873 002722 875 002737 878 002753 881 002754 883 002772 885 002774 886 002777 890 003000 894 003003 896 003007 897 003015 902 003016 905 003024 906 003025 909 003026 910 003027 912 003045 914 003054 915 003057 917 003060 919 003073 922 003116 926 003117 929 003133 931 003151 933 003160 936 003170 938 003201 941 003206 942 003213 943 003220 945 003235 949 003236 951 003254 955 003255 957 003257 958 003272 962 003273 965 003301 967 003306 969 003310 971 003313 972 003316 974 003322 976 003327 977 003334 979 003350 981 003364 982 003377 984 003400 986 003404 988 003405 990 003411 994 003425 996 003436 1000 003445 1002 003451 1003 003466 1005 003477 1008 003516 1009 003535 1014 003536 1018 003552 1021 003556 1022 003565 1023 003604 1027 003605 1029 003614 1031 003632 1035 003633 1039 003647 1040 003652 1045 003655 1046 003700 1049 003701 1051 003702 1052 003714 1054 003721 1055 003724 1057 003735 1059 003737 1060 003752 1064 003753 1066 003764 1067 003767 1071 003770 1073 004001 1077 004002 1081 004005 1083 004011 1084 004013 1087 004014 1091 004015 1095 004020 1097 004021 1099 004025 1102 004033 1104 004035 1107 004040 1109 004052 1110 004057 1111 004102 1112 004110 1114 004111 1115 004120 1118 004121 1122 004123 1125 004124 1127 004131 1130 004146 1131 004151 1134 004153 1138 004154 1141 004157 1144 004163 1146 004201 1148 004210 1150 004220 1152 004224 1154 004230 1155 004262 1158 004263 1160 004267 1162 004274 1164 004275 1165 004310 1168 004311 1169 004324 1174 004325 1185 004343 1187 004345 1189 004357 1191 004376 1194 004404 1196 004416 1199 004421 1201 004433 1204 004435 1206 004446 1208 004451 1210 004463 1213 004466 1217 004502 1220 004503 1227 004521 1229 004527 1230 004531 1232 004544 1234 004560 1235 004577 1237 004621 1238 004624 1239 004627 1240 004632 1241 004636 1242 004651 1243 004653 1244 004657 1245 004672 1246 004674 1247 004677 1249 004702 1252 004703 1254 004706 1257 004715 1260 004736 1261 004746 1263 004752 1265 004761 1267 004764 1268 004767 1271 004771 1280 004775 1282 005000 1284 005020 1287 005031 1289 005032 1291 005053 1294 005056 1295 005065 1296 005066 1297 005110 1298 005111 1301 005127 1303 005133 1304 005145 1308 005163 1309 005164 1310 005174 1311 005203 1314 005222 1316 005223 1317 005231 1319 005252 1320 005255 1324 005264 1326 005267 1329 005270 1330 005271 1334 005272 1338 005306 1340 005312 1342 005316 1344 005326 1345 005330 1346 005343 1348 005344 1350 005353 1352 005361 1354 005366 1356 005375 1357 005377 1359 005413 1361 005420 1363 005423 1367 005452 1368 005455 1369 005463 1370 005471 1371 005475 1373 005477 1376 005512 1379 005536 1380 005551 1383 005552 1385 005556 1388 005571 1392 005572 1396 005576 1398 005600 1399 005607 1401 005612 1402 005624 1403 005625 1404 005626 1405 005633 1407 005635 1413 005637 1415 005653 1419 005670 1423 005707 1425 005712 1427 005715 1430 005726 1431 005733 1432 005736 1433 005745 1434 005753 1435 005757 1438 005762 1440 006005 1441 006026 1445 006035 1446 006036 1447 006043 1450 006054 1454 006066 1457 006100 1464 006101 1467 006105 1469 006114 1471 006134 1475 006147 1480 006150 1484 006164 1486 006173 1487 006211 1488 006222 1490 006231 1491 006234 1493 006235 1497 006240 1501 006241 1505 006245 1507 006263 1509 006265 1513 006266 1516 006275 1518 006277 1519 006315 1523 006316 1527 006332 1531 006360 1533 006371 1537 006417 1539 006433 1541 006435 1543 006443 1544 006445 1545 006455 1547 006472 1550 006473 1551 006502 1552 006513 1554 006545 1556 006552 1557 006563 1558 006564 1559 006565 1561 006602 1564 006613 1568 006614 1571 006617 1572 006621 1574 006627 1577 006631 1580 006635 1581 006636 1589 006637 1593 006653 1596 006667 1597 006676 1598 006715 1600 006730 1601 006741 1602 006744 1608 006745 1610 006756 1611 006765 1617 006766 1620 007001 1622 007013 1623 007023 1624 007026 1625 007030 1626 007032 1627 007047 1640 007050 1646 007054 1648 007067 1650 007106 1653 007114 1654 007127 1656 007131 1658 007137 1661 007147 1662 007160 1663 007161 1664 007162 1666 007163 1668 007202 1670 007211 1671 007226 1673 007232 1675 007233 1678 007245 1679 007250 1680 007252 1682 007253 1687 007267 1688 007273 1691 007277 1694 007302 1696 007306 1698 007315 1703 007327 1705 007335 1706 007347 1710 007350 1715 007364 1717 007376 1719 007400 1722 007407 1724 007412 1727 007421 1729 007423 1731 007426 1733 007431 1739 007451 1740 007452 1742 007453 1743 007455 1746 007464 1749 007467 1750 007503 1751 007505 1752 007510 1753 007511 1755 007514 1756 007520 1759 007522 1760 007525 1762 007526 1763 007530 1765 007532 1767 007533 1770 007545 1771 007551 1774 007555 1775 007556 1777 007557 1784 007576 1785 007601 1787 007605 1790 007624 1791 007633 1794 007636 1797 007655 1798 007657 1800 007663 1803 007701 1805 007715 1807 007720 1809 007730 1812 007744 1813 007746 1817 007747 1822 007751 1823 007762 1824 007766 1826 007777 1827 010001 1828 010002 1829 010004 1830 010010 1834 010013 1837 010014 1841 010026 1842 010036 1844 010037 1845 010044 1849 010055 1851 010056 1865 010060 1866 010067 1868 010073 1869 010106 1872 010111 1874 010112 1877 010113 1880 010133 1882 010144 1884 010145 1887 010147 1893 010170 1896 010172 1901 010174 1908 010222 1911 010224 1916 010226 1922 010252 1925 010254 1928 010255 1929 010274 1930 010277 1932 010312 1935 010313 1942 010314 1944 010315 1947 010336 1952 010352 1954 010370 1956 010377 1958 010402 1963 010406 1964 010410 1969 010415 1974 010434 1975 010453 1976 010456 1980 010475 1982 010502 1983 010511 1985 010514 1987 010531 1989 010544 1991 010545 1997 010547 1998 010554 1999 010556 2000 010562 2002 010570 2005 010576 2006 010600 2008 010604 2009 010610 2010 010614 2012 010615 2013 010621 2016 010625 2018 010626 2023 010630 2024 010634 2025 010641 2026 010646 ----------------------------------------------------------- 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