COMPILATION LISTING OF SEGMENT assign_op Compiled by: Multics PL/I Compiler, Release 32d, of September 19, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 09/22/89 1358.9 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-21,RWaters), approve(89-04-21,MCR8101), audit(89-04-27,Huen), 17* install(89-06-16,MR12.3-1059): 18* Reset the indicators after a call to size_check_fx1/size_check_uns_fx1. 19* 2) change(89-07-10,RWaters), approve(89-07-10,MCR8121), audit(89-08-09,Vu), 20* install(89-09-22,MR12.3-1073): 21* Print warning when constants occure on LHS of assignment stmt. 22* END HISTORY COMMENTS */ 23 24 25 /* format: style2,^indattr,ifthendo,ifthen,^indnoniterdo,^elsestmt,dclind9 */ 26 /* This procedure is called to process the assign operator 27*%page; 28* Initial Version: 15 September 1971 by BLW 29* Modified: 12 February 1973 by BLW 30* Modified: 16 February 1973 by RAB 31* Modified: 18 June 1973 by RAB for EIS 32* Modified: 26 November 1974 by RAB for opt of const bit assmt 33* Modified: 26 May 1975 by RAB for assign_round 34* Modified: 21 August 1975 by RAB to fix 1399 35* Modified: 16 October 1976 by RAB to improve vs = vs || char1; 36* Modified: 10 November 1976 by RAB to fix 1549 37* Modified: 25 February 1977 by RAB to fix 1585 38* Modified: 9 March 1977 by RAB to fix 1593 39* Modified: 19 March 1977 by RAB for aq_man$left_shift 40* and aq_man$right_shift 41* Modified: 6 May 1977 by RAB to fix 1617 and use load for A(5)'s all_zeros case 42* Modified: 15 May 1977 by RAB to fix 1621 43* Modified: 1 September 1977 by RAB to fix 1664 by calling state_man$flush_sym 44* Modified: 14 September 1977 by RAB to fix 1653 45* Modified: 10 November 1977 by RAB to make minor string assignment improvement 46* Modified: 2 December 1977 by RAB to fix 1692 47* Modified: 16 July 1978 by PCK for unsigned binary 48* Modified: 11 August 1978 by RAB to fix 1729 & 1754 49* Modified: 30 November 1978 by RAB to fix 1799 (vs = substr(a,length(vs),b)) 50* Modified: 18 Dec 1978 by RAB to fix 1805 (vs = vs ||vsfun(); for stack frames > 16k) 51* Modified: 79/04/23 by PCK to implement fixed decimal 52* Modified: 28 May 1979 by RAB to fix 1827 (vs = substr(a,length(vs)+1)) 53* Modified: 30 March 1980 by RAB for reference.(padded aligned)_for_store_ref. 54* See prepare_operand for details. 55* Modified 830118 BIM to copy_temp ptr temps on the LHS. See 56* pointer_builtins for more explanation. 57* Modified 890304 by RWaters to reset the indicators after a call 58* to size_check_fx1, and size_check_uns_fx1. 59* Modified 890715 by RWaters reformatted; print a warning message when 60* an options(constant) occures on the LHS of an assignment. 61**/ 62 63 assign_op: 64 proc (pt); 65 66 /* parameters */ 67 dcl pt ptr parameter; /* points at operator node */ 68 69 /* automatic */ 70 dcl (p, p1, p2, s1, s2, b2, q, q1, q2) ptr; 71 dcl exp_pt ptr; 72 dcl arg (3) ptr; 73 dcl top ptr; 74 dcl (a, b, i, type1, type2, k, size1, size2) fixed bin; 75 dcl (length1, length2, aq_used, scale1, scale2) fixed bin; 76 dcl (prec1, prec2, ds, d, dt, cfo, orig_count, units_per_wrd) fixed bin; 77 dcl (atomic, all_blanks, all_ones, all_zeros, all_same) bit (1) aligned; 78 dcl (loaded, last_macro, hard1, hard2, here_before) bit (1) aligned; 79 dcl (load_it, right_constant, check_size, no_store) bit (1) aligned; 80 dcl (pack_char_pic, always_round, refs_are_same) bit (1) aligned; 81 dcl base bit (3) aligned; 82 dcl tag bit (4) aligned; 83 dcl op_code bit (9) aligned; 84 dcl full_word bit (36) aligned; 85 dcl c_length fixed bin (24); 86 dcl word bit (36) aligned based; 87 dcl double_string bit (72) aligned; 88 dcl (m1, m2, macro, bump_mac, size_ck_macro) fixed bin (15); 89 90 /* external */ 91 dcl cg_stat$cur_level fixed bin external; 92 dcl cg_stat$cur_statement ptr external; 93 dcl cg_stat$cur_tree ptr ext; 94 dcl cg_stat$null_value bit (72) aligned external; 95 dcl cg_stat$packed_null_value fixed bin external; 96 dcl cg_stat$save_exp_called bit (1) external; 97 dcl cg_stat$temp_ref ptr external; 98 dcl cg_stat$text_base ptr external; 99 dcl cg_stat$text_pos fixed bin external; 100 101 /* entries */ 102 dcl adjust_ref_count entry (ptr, fixed bin); 103 104 dcl aq_man$check_strings entry (fixed bin); 105 dcl aq_man$left_shift entry (fixed bin (8), bit (1) aligned); 106 dcl aq_man$lock entry (ptr, fixed bin); 107 dcl aq_man$right_shift entry (fixed bin (8), bit (1) aligned); 108 dcl aq_man$trim_aq entry (fixed bin); 109 110 dcl base_to_core entry (fixed bin, ptr); 111 dcl base_man$load_any_var entry (fixed bin, ptr) returns (bit (3) aligned); 112 dcl base_man$load_packed entry (ptr, fixed bin); 113 dcl base_man$load_var entry (fixed bin, ptr, fixed bin); 114 dcl base_man$store_ptr_to entry (ptr, ptr); 115 dcl base_man$update_base entry (fixed bin, ptr, fixed bin); 116 117 dcl compile_exp entry (ptr); 118 dcl compile_exp$save entry (ptr) returns (ptr); 119 dcl compile_exp$save_exp entry (ptr) returns (ptr); 120 dcl copy_temp entry (ptr) returns (ptr); 121 dcl compare_expression entry (ptr, ptr) reducible returns (bit (1) aligned); 122 dcl convert_chars entry (ptr, ptr, bit (1) aligned, bit (1) aligned); 123 dcl convert_arithmetic entry (ptr, ptr, bit (1) aligned, bit (1) aligned); 124 dcl c_a entry (fixed bin, fixed bin) returns (ptr); 125 dcl decimal_op$get_float_temp entry (fixed bin (24), bit (1) aligned) returns (ptr); 126 dcl error entry (fixed bin, ptr, ptr); 127 dcl expmac entry (fixed bin (15), ptr); 128 dcl expmac$one entry (fixed bin (15), ptr, fixed bin); 129 dcl expmac$zero entry (fixed bin (15)); 130 dcl expmac$many entry (fixed bin (15), ptr, fixed bin); 131 dcl expmac$many_eis entry (fixed bin (15), ptr, fixed bin); 132 dcl expmac$one_eis entry (fixed bin (15), ptr); 133 dcl expmac$two_eis entry (fixed bin (15), ptr, ptr); 134 135 dcl fixed_to_float entry (ptr); 136 dcl float_to_fixed entry (ptr); 137 dcl generate_constant entry (bit (*) aligned, fixed bin) returns (ptr); 138 dcl generate_constant$real_fix_bin_1 entry (fixed bin) returns (ptr); 139 dcl generate_constant$bit_string entry (bit (*) aligned, fixed bin) returns (ptr); 140 dcl generate_constant$char_string entry (char (*) aligned, fixed bin) returns (ptr); 141 dcl get_imaginary entry (ptr) returns (ptr); 142 dcl get_single_ref entry (ptr) returns (ptr); 143 dcl load entry (ptr, fixed bin); 144 dcl load$for_store entry (ptr, fixed bin); 145 dcl load$long_string entry (ptr); 146 dcl load$short_string entry (ptr, fixed bin); 147 dcl load_prog entry (ptr, fixed bin) variable; 148 dcl load_size entry (ptr); 149 dcl load_size$xr_or_aq entry (ptr, bit (4) aligned); 150 dcl long_op$one_eis entry (ptr, fixed bin, fixed bin (15)); 151 dcl long_op$extend_stack entry (ptr, fixed bin (15)); 152 dcl make_n_addressable entry (ptr, fixed bin); 153 dcl m_a entry (ptr, bit (2) aligned); 154 dcl make_both_addressable entry (ptr, ptr, bit (1) aligned); 155 dcl need_temp entry (ptr, bit (2) aligned); 156 dcl move_data$move_block entry (ptr, ptr, fixed bin); 157 dcl picture_op entry (ptr); 158 dcl prepare_operand entry (ptr, fixed bin, bit (1) aligned) returns (ptr); 159 dcl stack_temp$assign_temp entry (ptr); 160 dcl state_man$erase_reg entry (bit (19) aligned); 161 dcl state_man$flush_ref entry (ptr); 162 dcl state_man$flush_sym entry (ptr); 163 dcl store entry (ptr); 164 dcl store$all_ones entry (ptr); 165 dcl store$force entry (ptr); 166 dcl store$save_string_temp entry (ptr); 167 dcl xr_man$load_const entry (fixed bin, fixed bin); 168 169 /* builtins */ 170 dcl (abs, addr, addrel, bit, divide, fixed, max, min, mod, null, string, substr, verify) builtin; 171 172 /* other stuff */ 173 dcl assign_info$assign_info (14, 14) fixed bin ext, 174 1 assign_info aligned based, /* image of ext structure */ 175 2 act_a unal bit (6), 176 2 act_b unal bit (6), 177 2 macro_1 unal bit (12), 178 2 macro_2 unal bit (12); 179 180 dcl ( 181 assign_label_to_int init (379), 182 rflb1_to_cflb1 init (390), 183 set_label_const (2) init (315, 285), 184 ldfl1 init (9), 185 alloc_char_temp init (89), 186 chars_move init (420), 187 chars_move_vt init (444), 188 cat_move_chars init (218), 189 sbfx1 init (22), 190 aos_mac init (309), 191 incr_mac init (310), 192 lda init (1), 193 ansa init (43), 194 longbs_to_fx2 init (132), 195 cpfx1 init (136), 196 lrl init (62), 197 lrs init (492), 198 lls init (63), 199 move_chars init (98), 200 oraq init (48), 201 stfx1 init (15), 202 sta init (4), 203 fx1_to_bs init (293), 204 blank_cs init (472), 205 zero_bs init (468), 206 one_bs init (469), 207 zero_cs init (419), 208 one_cs init (484), 209 zero_cs_q init (479), 210 b2c_mac init (108), 211 size_check_fx1 init (553), 212 chars_move_ck init (555), 213 signal_stringsize init (563), 214 size_ck_varying init (566), 215 size_ck_suffix init (567), 216 size_ck_decimal init (582), 217 cmp_suffix_1 init (220), 218 size_ck_suffix_1 init (698), 219 left_shift (2) init (515, 63), 220 truncate (2) init (520, 521), 221 min_fx1 init (247), 222 zero_mac init (308), 223 zero_mac_p_1 init (307), 224 move_decimal init (438), 225 multiply_decimal init (450), 226 make_lv init (173), 227 store_lv init (174), 228 size_check_uns_fx1 init (731), 229 uns_fx1_to_bs init (733) 230 ) fixed bin (15) int static options (constant); 231 232 dcl ptr_convert (23:24, 23:24) fixed bin (15) int static init (0, 407, 408, 0); 233 234 dcl based_bs bit (size2) aligned based, 235 based_cs char (length2) aligned based; 236 237 dcl 1 instruction based aligned, /* layout of first word of EIS instruction */ 238 2 fill char (1) unal, /* fill character -- can be set by assign_op */ 239 2 enablefault bit (1) unal, 240 2 pad1 bit (1) unal, 241 2 mf2 bit (7) unal, 242 2 opcode bit (10) unal, 243 2 inhibit bit (1) unal, 244 2 mf1 bit (7) unal; 245 246 dcl 1 exponent aligned, /* layout of floating decimal exponent character */ 247 2 pad bit (1) unal, 248 2 value fixed bin (7) unal; 249 250 dcl exponent_char char (1) based (addr (exponent)) aligned; 251 252 /* CONSTANTS */ 253 254 dcl TRUE bit (1) aligned int static options (constant) init ("1"b); 255 dcl FALSE bit (1) aligned int static options (constant) init ("0"b); 256 257 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 258 259 2 1 /* *********************************************************** 2 2* * * 2 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 2 4* * * 2 5* *********************************************************** */ 2 6 /* BEGIN INCLUDE FILE ... statement.incl.pl1 */ 2 7 /* Internal interface of the PL/I compiler */ 2 8 2 9 dcl 1 statement based aligned, 2 10 2 node_type bit(9) unaligned, 2 11 2 source_id structure unaligned, 2 12 3 file_number bit(8), 2 13 3 line_number bit(14), 2 14 3 statement_number bit(5), 2 15 2 next ptr unaligned, 2 16 2 back ptr unaligned, 2 17 2 root ptr unaligned, 2 18 2 labels ptr unaligned, 2 19 2 reference_list ptr unaligned, 2 20 2 state_list ptr unaligned, 2 21 2 reference_count fixed(17) unaligned, 2 22 2 ref_count_copy fixed(17) unaligned, 2 23 2 object structure unaligned, 2 24 3 start fixed(17), 2 25 3 finish fixed(17), 2 26 2 source structure unaligned, 2 27 3 segment fixed(11), 2 28 3 start fixed(23), 2 29 3 length fixed(11), 2 30 2 prefix bit(12) unaligned, 2 31 2 optimized bit(1) unaligned, 2 32 2 free_temps bit(1) unaligned, 2 33 2 LHS_in_RHS bit(1) unaligned, 2 34 2 statement_type bit(9) unaligned, 2 35 2 bits structure unaligned, 2 36 3 processed bit(1) unaligned, 2 37 3 put_in_profile bit(1) unaligned, 2 38 3 generated bit(1) unaligned, 2 39 3 snap bit(1) unaligned, 2 40 3 system bit(1) unaligned, 2 41 3 irreducible bit(1) unaligned, 2 42 3 checked bit(1) unaligned, 2 43 3 save_temps bit(1) unaligned, 2 44 3 suppress_warnings bit(1) unaligned, 2 45 3 force_nonquick bit(1) unaligned, 2 46 3 expanded_by_name bit(1) unaligned, 2 47 3 begins_loop bit(1) unaligned, 2 48 3 pad bit(24) unaligned; 2 49 2 50 /* END INCLUDE FILE ... statement.incl.pl1 */ 260 261 3 1 /* BEGIN INCLUDE FILE ... operator.incl.pl1 */ 3 2 3 3 /* Modified: 2 Apr 1980 by PCK to add max_number_of_operands */ 3 4 3 5 /* format: style3 */ 3 6 dcl 1 operator based aligned, 3 7 2 node_type bit (9) unaligned, 3 8 2 op_code bit (9) unaligned, 3 9 2 shared bit (1) unaligned, 3 10 2 processed bit (1) unaligned, 3 11 2 optimized bit (1) unaligned, 3 12 2 number fixed (14) unaligned, 3 13 2 operand dimension (n refer (operator.number)) ptr unaligned; 3 14 3 15 dcl max_number_of_operands 3 16 fixed bin (15) int static options (constant) initial (32767); 3 17 3 18 /* END INCLUDE FILE ... operator.incl.pl1 */ 262 263 4 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 4 2 4 3 dcl 1 reference based aligned, 4 4 2 node_type bit(9) unaligned, 4 5 2 array_ref bit(1) unaligned, 4 6 2 varying_ref bit(1) unaligned, 4 7 2 shared bit(1) unaligned, 4 8 2 put_data_sw bit(1) unaligned, 4 9 2 processed bit(1) unaligned, 4 10 2 units fixed(3) unaligned, 4 11 2 ref_count fixed(17) unaligned, 4 12 2 c_offset fixed(24), 4 13 2 c_length fixed(24), 4 14 2 symbol ptr unaligned, 4 15 2 qualifier ptr unaligned, 4 16 2 offset ptr unaligned, 4 17 2 length ptr unaligned, 4 18 2 subscript_list ptr unaligned, 4 19 /* these fields are used by the 645 code generator */ 4 20 2 address structure unaligned, 4 21 3 base bit(3), 4 22 3 offset bit(15), 4 23 3 op bit(9), 4 24 3 no_address bit(1), 4 25 3 inhibit bit(1), 4 26 3 ext_base bit(1), 4 27 3 tag bit(6), 4 28 2 info structure unaligned, 4 29 3 address_in structure, 4 30 4 b dimension(0:7) bit(1), 4 31 4 storage bit(1), 4 32 3 value_in structure, 4 33 4 a bit(1), 4 34 4 q bit(1), 4 35 4 aq bit(1), 4 36 4 string_aq bit(1), 4 37 4 complex_aq bit(1), 4 38 4 decimal_aq bit(1), 4 39 4 b dimension(0:7) bit(1), 4 40 4 storage bit(1), 4 41 4 indicators bit(1), 4 42 4 x dimension(0:7) bit(1), 4 43 3 other structure, 4 44 4 big_offset bit(1), 4 45 4 big_length bit(1), 4 46 4 modword_in_offset bit(1), 4 47 2 data_type fixed(5) unaligned, 4 48 2 bits structure unaligned, 4 49 3 padded_ref bit(1), 4 50 3 aligned_ref bit(1), 4 51 3 long_ref bit(1), 4 52 3 forward_ref bit(1), 4 53 3 ic_ref bit(1), 4 54 3 temp_ref bit(1), 4 55 3 defined_ref bit(1), 4 56 3 evaluated bit(1), 4 57 3 allocate bit(1), 4 58 3 allocated bit(1), 4 59 3 aliasable bit(1), 4 60 3 even bit(1), 4 61 3 perm_address bit(1), 4 62 3 aggregate bit(1), 4 63 3 hit_zero bit(1), 4 64 3 dont_save bit(1), 4 65 3 fo_in_qual bit(1), 4 66 3 hard_to_load bit(1), 4 67 2 relocation bit(12) unaligned, 4 68 2 more_bits structure unaligned, 4 69 3 substr bit(1), 4 70 3 padded_for_store_ref bit(1), 4 71 3 aligned_for_store_ref bit(1), 4 72 3 mbz bit(15), 4 73 2 store_ins bit(18) unaligned; 4 74 4 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 264 265 5 1 /* BEGIN INCLUDE FILE ... symbol.incl.pl1 */ 5 2 5 3 dcl 1 symbol based aligned, 5 4 2 node_type bit(9) unal, 5 5 2 source_id structure unal, 5 6 3 file_number bit(8), 5 7 3 line_number bit(14), 5 8 3 statement_number bit(5), 5 9 2 location fixed(18) unal unsigned, 5 10 2 allocated bit(1) unal, 5 11 2 dcl_type bit(3) unal, 5 12 2 reserved bit(6) unal, 5 13 2 pix unal, 5 14 3 pic_fixed bit(1) unal, 5 15 3 pic_float bit(1) unal, 5 16 3 pic_char bit(1) unal, 5 17 3 pic_scale fixed(7) unal, 5 18 3 pic_size fixed(7) unal, 5 19 2 level fixed(8) unal, 5 20 2 boundary fixed(3) unal, 5 21 2 size_units fixed(3) unal, 5 22 2 scale fixed(7) unal, 5 23 2 runtime bit(18) unal, 5 24 2 runtime_offset bit(18) unal, 5 25 2 block_node ptr unal, 5 26 2 token ptr unal, 5 27 2 next ptr unal, 5 28 2 multi_use ptr unal, 5 29 2 cross_references ptr unal, 5 30 2 initial ptr unal, 5 31 2 array ptr unal, 5 32 2 descriptor ptr unal, 5 33 2 equivalence ptr unal, 5 34 2 reference ptr unal, 5 35 2 general ptr unal, 5 36 2 father ptr unal, 5 37 2 brother ptr unal, 5 38 2 son ptr unal, 5 39 2 word_size ptr unal, 5 40 2 bit_size ptr unal, 5 41 2 dcl_size ptr unal, 5 42 2 symtab_size ptr unal, 5 43 2 c_word_size fixed(24), 5 44 2 c_bit_size fixed(24), 5 45 2 c_dcl_size fixed(24), 5 46 5 47 2 attributes structure aligned, 5 48 3 data_type structure unal, 5 49 4 structure bit(1) , 5 50 4 fixed bit(1), 5 51 4 float bit(1), 5 52 4 bit bit(1), 5 53 4 char bit(1), 5 54 4 ptr bit(1), 5 55 4 offset bit(1), 5 56 4 area bit(1), 5 57 4 label bit(1), 5 58 4 entry bit(1), 5 59 4 file bit(1), 5 60 4 arg_descriptor bit(1), 5 61 4 storage_block bit(1), 5 62 4 explicit_packed bit(1), /* options(packed) */ 5 63 4 condition bit(1), 5 64 4 format bit(1), 5 65 4 builtin bit(1), 5 66 4 generic bit(1), 5 67 4 picture bit(1), 5 68 5 69 3 misc_attributes structure unal, 5 70 4 dimensioned bit(1), 5 71 4 initialed bit(1), 5 72 4 aligned bit(1), 5 73 4 unaligned bit(1), 5 74 4 signed bit(1), 5 75 4 unsigned bit(1), 5 76 4 precision bit(1), 5 77 4 varying bit(1), 5 78 4 local bit(1), 5 79 4 decimal bit(1), 5 80 4 binary bit(1), 5 81 4 real bit(1), 5 82 4 complex bit(1), 5 83 4 variable bit(1), 5 84 4 reducible bit(1), 5 85 4 irreducible bit(1), 5 86 4 returns bit(1), 5 87 4 position bit(1), 5 88 4 internal bit(1), 5 89 4 external bit(1), 5 90 4 like bit(1), 5 91 4 member bit(1), 5 92 4 non_varying bit(1), 5 93 4 options bit(1), 5 94 4 variable_arg_list bit(1), /* options(variable) */ 5 95 4 alloc_in_text bit(1), /* options(constant) */ 5 96 5 97 3 storage_class structure unal, 5 98 4 auto bit(1), 5 99 4 based bit(1), 5 100 4 static bit(1), 5 101 4 controlled bit(1), 5 102 4 defined bit(1), 5 103 4 parameter bit(1), 5 104 4 param_desc bit(1), 5 105 4 constant bit(1), 5 106 4 temporary bit(1), 5 107 4 return_value bit(1), 5 108 5 109 3 file_attributes structure unal, 5 110 4 print bit(1), 5 111 4 input bit(1), 5 112 4 output bit(1), 5 113 4 update bit(1), 5 114 4 stream bit(1), 5 115 4 reserved_1 bit(1), 5 116 4 record bit(1), 5 117 4 sequential bit(1), 5 118 4 direct bit(1), 5 119 4 interactive bit(1), /* env(interactive) */ 5 120 4 reserved_2 bit(1), 5 121 4 reserved_3 bit(1), 5 122 4 stringvalue bit(1), /* env(stringvalue) */ 5 123 4 keyed bit(1), 5 124 4 reserved_4 bit(1), 5 125 4 environment bit(1), 5 126 5 127 3 compiler_developed structure unal, 5 128 4 aliasable bit(1), 5 129 4 packed bit(1), 5 130 4 passed_as_arg bit(1), 5 131 4 allocate bit(1), 5 132 4 set bit(1), 5 133 4 exp_extents bit(1), 5 134 4 refer_extents bit(1), 5 135 4 star_extents bit(1), 5 136 4 isub bit(1), 5 137 4 put_in_symtab bit(1), 5 138 4 contiguous bit(1), 5 139 4 put_data bit(1), 5 140 4 overlayed bit(1), 5 141 4 error bit(1), 5 142 4 symtab_processed bit(1), 5 143 4 overlayed_by_builtin bit(1), 5 144 4 defaulted bit(1), 5 145 4 connected bit(1); 5 146 5 147 /* END INCLUDE FILE ... symbol.incl.pl1 */ 266 267 6 1 /* BEGIN INCLUDE FILE ... block.incl.pl1 */ 6 2 /* Modified 22 Ocober 1980 by M. N. Davidoff to increase max block.number to 511 */ 6 3 /* format: style3,idind30 */ 6 4 6 5 declare 1 block aligned based, 6 6 2 node_type bit (9) unaligned, 6 7 2 source_id structure unaligned, 6 8 3 file_number bit (8), 6 9 3 line_number bit (14), 6 10 3 statement_number bit (5), 6 11 2 father ptr unaligned, 6 12 2 brother ptr unaligned, 6 13 2 son ptr unaligned, 6 14 2 declaration ptr unaligned, 6 15 2 end_declaration ptr unaligned, 6 16 2 default ptr unaligned, 6 17 2 end_default ptr unaligned, 6 18 2 context ptr unaligned, 6 19 2 prologue ptr unaligned, 6 20 2 end_prologue ptr unaligned, 6 21 2 main ptr unaligned, 6 22 2 end_main ptr unaligned, 6 23 2 return_values ptr unaligned, 6 24 2 return_count ptr unaligned, 6 25 2 plio_ps ptr unaligned, 6 26 2 plio_fa ptr unaligned, 6 27 2 plio_ffsb ptr unaligned, 6 28 2 plio_ssl ptr unaligned, 6 29 2 plio_fab2 ptr unaligned, 6 30 2 block_type bit (9) unaligned, 6 31 2 prefix bit (12) unaligned, 6 32 2 like_attribute bit (1) unaligned, 6 33 2 no_stack bit (1) unaligned, 6 34 2 get_data bit (1) unaligned, 6 35 2 flush_at_call bit (1) unaligned, 6 36 2 processed bit (1) unaligned, 6 37 2 text_displayed bit (1) unaligned, 6 38 2 number fixed bin (9) unsigned unaligned, 6 39 2 free_temps dimension (3) ptr, /* these fields are used by the code generator */ 6 40 2 temp_list ptr, 6 41 2 entry_list ptr, 6 42 2 o_and_s ptr, 6 43 2 why_nonquick aligned, 6 44 3 auto_adjustable_storage bit (1) unaligned, 6 45 3 returns_star_extents bit (1) unaligned, 6 46 3 stack_extended_by_args bit (1) unaligned, 6 47 3 invoked_by_format bit (1) unaligned, 6 48 3 format_statement bit (1) unaligned, 6 49 3 io_statements bit (1) unaligned, 6 50 3 assigned_to_entry_var bit (1) unaligned, 6 51 3 condition_statements bit (1) unaligned, 6 52 3 no_owner bit (1) unaligned, 6 53 3 recursive_call bit (1) unaligned, 6 54 3 options_non_quick bit (1) unaligned, 6 55 3 options_variable bit (1) unaligned, 6 56 3 never_referenced bit (1) unaligned, 6 57 3 pad_nonquick bit (5) unaligned, 6 58 2 prologue_flag bit (1) unaligned, 6 59 2 options_main bit (1) unaligned, 6 60 2 pad bit (16) unaligned, 6 61 2 number_of_entries fixed bin (17), 6 62 2 level fixed bin (17), 6 63 2 last_auto_loc fixed bin (17), 6 64 2 symbol_block fixed bin (17), 6 65 2 entry_info fixed bin (18), 6 66 2 enter structure unaligned, 6 67 3 start fixed bin (17), 6 68 3 end fixed bin (17), 6 69 2 leave structure unaligned, 6 70 3 start fixed bin (17), 6 71 3 end fixed bin (17), 6 72 2 owner ptr; 6 73 6 74 declare max_block_number fixed bin internal static options (constant) initial (511); 6 75 6 76 /* END INCLUDE FILE ... block.incl.pl1 */ 268 269 7 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 7 2 7 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 7 4 7 5 dcl ( block_node initial("000000001"b), 7 6 statement_node initial("000000010"b), 7 7 operator_node initial("000000011"b), 7 8 reference_node initial("000000100"b), 7 9 token_node initial("000000101"b), 7 10 symbol_node initial("000000110"b), 7 11 context_node initial("000000111"b), 7 12 array_node initial("000001000"b), 7 13 bound_node initial("000001001"b), 7 14 format_value_node initial("000001010"b), 7 15 list_node initial("000001011"b), 7 16 default_node initial("000001100"b), 7 17 machine_state_node initial("000001101"b), 7 18 source_node initial("000001110"b), 7 19 label_node initial("000001111"b), 7 20 cross_reference_node initial("000010000"b), 7 21 sf_par_node initial("000010001"b), 7 22 temporary_node initial("000010010"b), 7 23 label_array_element_node initial("000010011"b), 7 24 by_name_agg_node initial("000010100"b)) 7 25 bit(9) internal static aligned options(constant); 7 26 7 27 dcl 1 node based aligned, 7 28 2 type unal bit(9), 7 29 2 source_id unal structure, 7 30 3 file_number bit(8), 7 31 3 line_number bit(14), 7 32 3 statement_number bit(5); 7 33 7 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 270 271 8 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) 8 2 options(constant); 8 3 8 4 dcl ( ap defined(bases(0)), 8 5 bp defined(bases(1)), 8 6 lp defined(bases(2)), 8 7 sp defined(bases(7))) bit(3) aligned; 8 8 8 9 dcl ( ab defined(bases(3)), 8 10 bb defined(bases(4)), 8 11 lb defined(bases(5)), 8 12 sb defined(bases(6))) bit(3) aligned; 8 13 8 14 dcl which_base(0:7) fixed bin int static init(0,3,1,4,2,5,7,6) options(constant); 272 273 9 1 dcl ( real_fix_bin_1 init(1), 9 2 real_fix_bin_2 init(2), 9 3 real_flt_bin_1 init(3), 9 4 real_flt_bin_2 init(4), 9 5 complex_fix_bin_1 init(5), 9 6 complex_fix_bin_2 init(6), 9 7 complex_flt_bin_1 init(7), 9 8 complex_flt_bin_2 init(8), 9 9 real_fix_dec init(9), 9 10 real_flt_dec init(10), 9 11 complex_fix_dec init(11), 9 12 complex_flt_dec init(12), 9 13 char_string init(13), 9 14 bit_string init(14), 9 15 label_constant init(15), 9 16 local_label_variable init(16), 9 17 label_variable init(17), 9 18 entry_variable init(18), 9 19 ext_entry_in init(19), 9 20 ext_entry_out init(20), 9 21 int_entry init(21), 9 22 int_entry_other init(22), 9 23 unpacked_ptr init(23), 9 24 packed_ptr init(24)) fixed bin(15) int static options(constant); 274 275 10 1 /* BEGIN INCLUDE FILE ... machine_state.incl.pl1 */ 10 2 10 3 dcl cg_static_$m_s_p ptr ext static, 10 4 m_s_p ptr init(cg_static_$m_s_p); 10 5 10 6 dcl 1 machine_state aligned based(m_s_p), 10 7 2 node_type bit(9), 10 8 2 indicators fixed bin, 10 9 2 next ptr unal, 10 10 2 a_reg, 10 11 3 variable(10) ptr unal, 10 12 3 number fixed bin(17), 10 13 3 size fixed bin(8), 10 14 3 length fixed bin(8), 10 15 3 offset fixed bin(8), 10 16 3 constant fixed bin(24), 10 17 3 changed fixed bin(18), 10 18 3 instruction bit(36), 10 19 3 locked bit(1) aligned, 10 20 3 number_h_o fixed bin, 10 21 3 has_offset(3) ptr unal, 10 22 2 q_reg, 10 23 3 variable(10) ptr unal, 10 24 3 number fixed bin(17), 10 25 3 size fixed bin(8), 10 26 3 length fixed bin(8), 10 27 3 offset fixed bin(8), 10 28 3 constant fixed bin(24), 10 29 3 changed fixed bin(18), 10 30 3 instruction bit(36), 10 31 3 locked bit(1) aligned, 10 32 3 number_h_o fixed bin, 10 33 3 has_offset(3) ptr unal, 10 34 2 string_reg, 10 35 3 variable ptr unal, 10 36 3 size fixed bin(8), 10 37 3 offset fixed bin(8), 10 38 2 complex_reg, 10 39 3 variable ptr unal, 10 40 3 size fixed bin(8), 10 41 3 scale fixed bin(8), 10 42 2 decimal_reg, 10 43 3 variable ptr unal, 10 44 3 size fixed bin(8), 10 45 3 scale fixed bin(8), 10 46 2 index_regs(0:7), 10 47 3 variable ptr unal, 10 48 3 constant fixed bin, 10 49 3 type fixed bin(8), 10 50 3 used fixed bin(18), 10 51 3 changed fixed bin(18), 10 52 3 instruction bit(36), 10 53 3 filler fixed bin, 10 54 2 base_regs(0:7), 10 55 3 variable ptr unal, 10 56 3 constant fixed bin, 10 57 3 type fixed bin(8), 10 58 3 pad (12) fixed bin, /* future...room to make 5 element array for variable, constant, type */ 10 59 3 number fixed bin (17), /* future...number of valid elements in array */ 10 60 3 used fixed bin(18), 10 61 3 changed fixed bin(18), 10 62 3 instruction bit(36), 10 63 3 locked fixed bin(2), 10 64 2 indicators_ref(2:3) ptr unal; 10 65 10 66 /* Permissible values for machine_state.indicators. */ 10 67 10 68 dcl ( ind_known_refs init (-2), /* set by comparison of known, nonzero, references */ 10 69 ind_invalid init (-1), 10 70 ind_string_aq init (0), /* logical value in storage */ 10 71 ind_logical init (1), /* logical value in A or AQ */ 10 72 ind_arithmetic init (2), /* arith value in Q, AQ, or EAQ */ 10 73 ind_x (0:7) init (6, 7, 8, 9, 10, 11, 12, 13), 10 74 ind_decimal_reg init (14) 10 75 ) fixed bin internal static options (constant); 10 76 10 77 /* END INCLUDE FILE ... machine_state.incl.pl1 */ 276 277 11 1 /* BEGIN INCLUDE FILE ... op_codes.incl.pl1 */ 11 2 11 3 /* Modified: 25 Apr 1979 by PCK 4-bit decimal */ 11 4 /* Modified: 6 Jun 1979 by PG to add rank and byte */ 11 5 /* Modified: 26 Dec 1979 by PCK to add assign_by_name */ 11 6 /* Modified: 26 July 82 BIM wordno, segno */ 11 7 11 8 dcl ( add initial("000010001"b), /* opnd(1) <- opnd(2)+opnd(3) */ 11 9 sub initial("000010010"b), /* opnd(1) <- opnd(2)-opnd(3) */ 11 10 mult initial("000010011"b), /* opnd(1) <- opnd(2)*opnd(3) */ 11 11 div initial("000010100"b), /* opnd(1) <- opnd(2)/opnd(3) */ 11 12 negate initial("000010101"b), /* opnd(1) <- -opnd(2) */ 11 13 exp initial("000010110"b), /* opnd(1) <- opnd(2) ** opnd(3) */ 11 14 11 15 and_bits initial("000100001"b), /* opnd(1) <- opnd(2) & opnd(3) */ 11 16 or_bits initial("000100010"b), /* opnd(1) <- opnd(2)|opnd(3) */ 11 17 xor_bits initial("000100011"b), /* opnd(1) <- opnd(2) xor opnd(3) */ 11 18 not_bits initial("000100100"b), /* opnd(1) <- ^opnd(2) */ 11 19 cat_string initial("000100101"b), /* opnd(1) <- opnd(2)||opnd(3) */ 11 20 bool_fun initial("000100110"b), /* opnd(1) <- bool(opnd(2),opnd(3),opnd(4)) */ 11 21 11 22 assign initial("000110001"b), /* opnd(1) <- opnd(2) */ 11 23 assign_size_ck initial("000110010"b), /* opnd(1) <- opnd(2) */ 11 24 assign_zero initial("000110011"b), /* opnd(1) <- 0 */ 11 25 copy_words initial("000110100"b), /* move opnd(2) to opnd(1) by opnd(3) words */ 11 26 copy_string initial("000110101"b), /* move opnd(2) to opnd(1) by opnd(3) units */ 11 27 make_desc initial("000110110"b), /* opnd(1) <- descriptor(opnd(2),opnd(3)) */ 11 28 assign_round initial("000110111"b), /* opnd(1) <- opnd(2) rounded */ 11 29 pack initial("000111000"b), /* opnd(1) <- encode to picture opnd(2) */ 11 30 unpack initial("000111001"b), /* opnd(1) <- decode from picture opnd(2) */ 11 31 11 32 less_than initial("001000100"b), /* opnd(1) <- opnd(2) < opnd(3) */ 11 33 greater_than initial("001000101"b), /* opnd(1) <- opnd(2) > opnd(3) */ 11 34 equal initial("001000110"b), /* opnd(1) <- opnd(2) = opnd(3) */ 11 35 not_equal initial("001000111"b), /* opnd(1) <- opnd(2) ^= opnd(3) */ 11 36 less_or_equal initial("001001000"b), /* opnd(1) <- opnd(2) <= opnd(3) */ 11 37 greater_or_equal initial("001001001"b), /* opnd(1) <- opnd(2) >= opnd(3) */ 11 38 11 39 jump initial("001010001"b), /* go to opnd(1) unconditionally */ 11 40 jump_true initial("001010010"b), /* go to opnd(1) if opnd(2) is not 0 */ 11 41 jump_false initial("001010011"b), /* go to opnd(1) if opnd(2) is all 0 */ 11 42 jump_if_lt initial("001010100"b), /* go to opnd(1) if opnd(2) < opnd(3) */ 11 43 jump_if_gt initial("001010101"b), /* go to opnd(1) if opnd(2) > opnd(3) */ 11 44 jump_if_eq initial("001010110"b), /* go to opnd(1) if opnd(2) = opnd(3) */ 11 45 jump_if_ne initial("001010111"b), /* go to opnd(1) if opnd(2) ^= opnd(3) */ 11 46 jump_if_le initial("001011000"b), /* go to opnd(1) if opnd(2) <= opnd(3) */ 11 47 jump_if_ge initial("001011001"b), /* go to opnd(1) if opnd(2) >= opnd(3) */ 11 48 11 49 std_arg_list initial("001100001"b), /* opnd(1) <- arglist(opnd(2) desclist(opnd(3))) */ 11 50 return_words initial("001100010"b), /* return aggregate opnd(1), opnd(2) is length in words */ 11 51 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 11 52 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 11 53 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 11 54 return_string initial("001100110"b), /* return string opnd(1) */ 11 55 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 11 56 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 11 57 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 11 58 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 11 59 std_return initial("001101011"b), /* return -no arguments- */ 11 60 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 11 61 free_ctl initial("001101101"b), /* free opnd(1) */ 11 62 stop initial("001101110"b), /* stop - terminate run unit */ 11 63 11 64 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 11 65* opnd(2) <- opnd(3) / 36 */ 11 66 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 11 67* opnd(2) <- opnd(3) / 4 */ 11 68 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 11 69* opnd(2) <- opnd(3) / 2 */ 11 70 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 11 71 11 72 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 11 73 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 11 74 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 11 75 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 11 76 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 11 77 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 11 78 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 11 79 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 11 80 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 11 81 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 11 82 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 11 83 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 11 84 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 11 85 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 11 86 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 11 87 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 11 88 11 89 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 11 90 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 11 91 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 11 92 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 11 93 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 11 94 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 11 95 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 11 96 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 11 97 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 11 98 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 11 99 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 11 100 wordno_fun initial("010011011"b), /* opnd(1) <- wordno (opnd(2)) */ 11 101 segno_fun initial("010011100"b), /* opnd(1) <- segno (opnd(2)) */ 11 102 bitno_fun initial("010011101"b), /* opnd(1) <- bitno (opnd(2)) */ 11 103 charno_fun initial("010011110"b), /* opnd(1) <- charno (opnd(2)) */ 11 104 11 105 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 11 106 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 11 107 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 11 108 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 11 109 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 11 110 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 11 111 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 11 112 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 11 113 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 11 114 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 11 115 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 11 116 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 11 117 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 11 118 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 11 119 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 11 120 11 121 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 11 122 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 11 123 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 11 124 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 11 125 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 11 126 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 11 127 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 11 128 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 11 129 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 11 130 setcharno_fun initial("010111001"b), /* opnd(1) <- opnd(2) with charno opnd(3) */ 11 131 addcharno_fun initial("010111010"b), /* opnd(1) <- opnd(2) with charno = charno + opnd(3) */ 11 132 setbitno_fun initial("010111011"b), /* setcharno for bitsno */ 11 133 addbitno_fun initial("010111100"b), /* addcharno for bitno */ 11 134 11 135 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 11 136 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 11 137 11 138 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 11 139 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 11 140 enable_on initial("011010100"b), /* opnd(1) is the cond name 11 141* opnd(2) is the file name 11 142* opnd(3) is the block */ 11 143 revert_on initial("011010101"b), /* opnd(1) is the cond name, 11 144* opnd(2) is the file name */ 11 145 signal_on initial("011010110"b), /* opnd(1) is the cond name 11 146* opnd(2) is the file name */ 11 147 11 148 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 11 149 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 11 150* opnd(3) is old value, (4) is new value. */ 11 151 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 11 152 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 11 153 11 154 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 11 155 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 11 156 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 11 157* opnd(5) is the list */ 11 158 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 11 159 allot_based initial("011100100"b), /* allocate opnd(2) words in opnd(3), set opnd(1) */ 11 160 free_based initial("011100101"b), /* free opnd(1) in opnd(3), length is opnd(2) words */ 11 161 11 162 r_parn initial("011110001"b), /* format op code */ 11 163 l_parn initial("011110010"b), 11 164 r_format initial("011110011"b), 11 165 c_format initial("011110100"b), 11 166 f_format initial("011110101"b), 11 167 e_format initial("011110110"b), 11 168 b_format initial("011110111"b), 11 169 a_format initial("011111000"b), 11 170 x_format initial("011111001"b), 11 171 skip_format initial("011111010"b), 11 172 column_format initial("011111011"b), 11 173 page_format initial("011111100"b), 11 174 line_format initial("011111101"b), 11 175 picture_format initial("011111110"b), 11 176 bn_format initial("011111111"b), /* bit format, length(opnd(2)), radix factor(opnd(3)) */ 11 177 11 178 get_list_trans initial("100000000"b), /* getlist(opnd(2) with desc(opnd(1))) */ 11 179 get_edit_trans initial("100000001"b), /* getedit(opnd(2) with desc(opnd(1))) */ 11 180 get_data_trans initial("100000010"b), /* getdata(opnd(1) to opnd(n)) */ 11 181 put_list_trans initial("100000011"b), /* putlist(opnd(2) with desc(opnd(1))) */ 11 182 put_edit_trans initial("100000100"b), /* putedit(opnd(2) with desc(opnd(1))) */ 11 183 put_data_trans initial("100000101"b), /* putdata(opnd(2)) with subscript-list opnd(1) */ 11 184 terminate_trans initial("100000110"b), /* terminate stream transmission */ 11 185 stream_prep initial("100000111"b), /* initiate stream transmission */ 11 186 record_io initial("100001000"b), /* perform record io operation */ 11 187 fortran_read initial("100001001"b), /* A complete read statement */ 11 188 fortran_write initial("100001010"b), /* A complete write statement */ 11 189 ftn_file_manip initial("100001011"b), /* endfile,backspace,rewind,etc. */ 11 190 ftn_trans_loop initial("100001100"b), /* An implied do in i/o list */ 11 191 put_control initial("100001101"b), /* put control opnd(1) opnd(2) times */ 11 192 put_field initial("100001110"b), /* putlist(opnd(2)) of length(opnd(1)) */ 11 193 put_field_chk initial("100001111"b), /* putlist(op(2)) of len(op(1)) check char index(op(3)) */ 11 194 11 195 /* These operators are produced by the parse but are not used as input to the code generator. */ 11 196 /* They are processed by the semantic translator. */ 11 197 11 198 return_value initial("100010010"b), /* return(opnd(1)) */ 11 199 allot_var initial("100010011"b), /* allot opnd(1) in opnd(2) */ 11 200 free_var initial("100010100"b), /* free opnd(1) out of opnd(2) */ 11 201 get_file initial("100010101"b), /* opnd(1) is filename,opnd(2) is copy */ 11 202 /* opnd(3) is skip, opnd(4) is list */ 11 203 get_string initial("100010110"b), /* opnd(1) is string,opnd(2) is list */ 11 204 put_file initial("100010111"b), /* opnd(1) is filename,opnd(2) is page */ 11 205 /* opnd(3) is skip,opnd(4) is line */ 11 206 put_string initial("100011000"b), /* opnd(1) is string,opnd(2) is list */ 11 207 open_file initial("100011001"b), 11 208 close_file initial("100011010"b), 11 209 read_file initial("100011011"b), 11 210 write_file initial("100011100"b), 11 211 locate_file initial("100011101"b), 11 212 do_fun initial("100011110"b), /* opnd(1) is join of a list */ 11 213 /* opnd(2) is control variable ref */ 11 214 /* opnd(3) is specification operator */ 11 215 do_spec initial("100011111"b), /* opnd(1) to opnd(2) by opnd(3) */ 11 216 /* repeat opnd(4) while opnd(5) */ 11 217 /* opnd(6) is next specification */ 11 218 11 219 rewrite_file initial("100100000"b), 11 220 delete_file initial("100100001"b), 11 221 unlock_file initial("100100010"b), 11 222 lock_file initial("100100011"b), 11 223 refer initial("100100101"b), /* opnd(1) refer(opnd(2)) */ 11 224 prefix_plus initial("100100110"b), /* opnd(1) <- +opnd(2) */ 11 225 nop initial("100100111"b), /* no-op */ 11 226 assign_by_name initial("100101000"b), /* opnd(1) <- opnd(2),by name */ 11 227 11 228 /* These operators are produced by the semantic translator in processing the math 11 229* builtin functions and are used as input to the code generator */ 11 230 11 231 sqrt_fun initial("100110000"b), /* opnd(1) <- sqrt(opnd(2)) */ 11 232 sin_fun initial("100110001"b), /* opnd(1) <- sin(opnd(2)) */ 11 233 sind_fun initial("100110010"b), /* opnd(1) <- sind(opnd(2)) */ 11 234 cos_fun initial("100110011"b), /* opnd(1) <- cos(opnd(2)) */ 11 235 cosd_fun initial("100110100"b), /* opnd(1) <- cosd(opnd(2)) */ 11 236 tan_fun initial("100110101"b), /* opnd(1) <- tan(opnd(2)) */ 11 237 tand_fun initial("100110110"b), /* opnd(1) <- tand(opnd(2)) */ 11 238 asin_fun initial("100110111"b), /* opnd(1) <- asin(opnd(2)) */ 11 239 asind_fun initial("100111000"b), /* opnd(1) <- asind(opnd(2)) */ 11 240 acos_fun initial("100111001"b), /* opnd(1) <- acos(opnd(2)) */ 11 241 acosd_fun initial("100111010"b), /* opnd(1) <- acosd(opnd(2)) */ 11 242 atan_fun initial("100111011"b), /* opnd(1) <- atan(opnd(2)[,opnd(3)]) */ 11 243 atand_fun initial("100111100"b), /* opnd(1) <- atand(opnd(2)[,opnd(3)]) */ 11 244 log2_fun initial("100111101"b), /* opnd(1) <- log2(opnd(2)) */ 11 245 log_fun initial("100111110"b), /* opnd(1) <- log(opnd(2)) */ 11 246 log10_fun initial("100111111"b), /* opnd(1) <- log10(opnd(2)) */ 11 247 11 248 exp_fun initial("101000000"b)) /* opnd(1) <- exp(opnd(2)) */ 11 249 11 250 bit(9) aligned internal static options(constant); 11 251 11 252 /* END INCLUDE FILE ... op_codes.incl.pl1 */ 278 279 12 1 /* BEGIN INCLUDE FILE ... boundary.incl.pl1 */ 12 2 12 3 /* Modified: 26 Apr 1979 by PCK to implement 4-bit decimal */ 12 4 12 5 dcl ( bit_ init(1), 12 6 digit_ init(2), 12 7 character_ init(3), 12 8 half_ init(4), 12 9 word_ init(5), 12 10 mod2_ init(6), 12 11 mod4_ init(7)) fixed bin(3) int static options(constant); 12 12 12 13 /* END INCLUDE FILE ... boundary.incl.pl1 */ 280 281 282 /* program */ 283 284 load_prog = load$for_store; 285 286 all_blanks, all_ones, all_zeros, all_same, loaded, here_before, full_word, no_store, pack_char_pic, last_macro = 287 FALSE; 288 289 p = pt; 290 op_code = p -> operator.op_code; 291 check_size = (op_code = assign_size_ck); 292 always_round = (op_code = assign_round); 293 294 p1 = prepare_operand ((p -> operand (1)), 1, atomic); 295 orig_count = p1 -> reference.ref_count; 296 297 exp_pt, p2 = p -> operand (2); 298 if p2 -> node.type = operator_node | p2 -> node.type = label_node | ^p2 -> reference.temp_ref then 299 p2 = prepare_operand (p2, 1, atomic); 300 else 301 atomic = TRUE; 302 303 gt: 304 s1 = p1 -> reference.symbol; 305 s2 = p2 -> reference.symbol; 306 307 scale1 = s1 -> symbol.scale; 308 prec1 = s1 -> symbol.c_dcl_size; 309 310 right_constant = FALSE; 311 312 type2 = p2 -> reference.data_type; 313 314 if s2 -> node.type = label_node then do; 315 type1 = p1 -> reference.data_type; 316 goto lab_or_ent; 317 end; 318 319 scale2 = s2 -> symbol.scale; 320 prec2 = s2 -> symbol.c_dcl_size; 321 322 if s1 -> symbol.storage_block & ^here_before then do; 323 type1, p1 -> reference.data_type = type2; 324 p1 -> reference.c_length = p2 -> reference.c_length; 325 if type1 = char_string | type2 = bit_string then 326 p1 -> reference.long_ref = p1 -> reference.c_length * convert_size (type1) > bits_per_two_words; 327 end; 328 else 329 type1 = p1 -> reference.data_type; 330 331 here_before = TRUE; 332 333 dt = type1 - char_string; 334 335 if type2 ^= bit_string then 336 if type2 ^= char_string then 337 goto chk_temp; 338 339 length2 = p2 -> reference.c_length; 340 size2 = length2 * convert_size (type2); 341 342 if op_code = pack then 343 if type2 = char_string then 344 if substr (cg_stat$cur_statement -> statement.prefix, 5, 1) then 345 pack_char_pic = TRUE; 346 347 if atomic then do; 348 if ^s2 -> symbol.constant then 349 goto chk_temp; 350 if s2 -> symbol.varying then 351 goto chk_temp; 352 if s2 -> symbol.dimensioned then 353 goto chk_temp; 354 if p2 -> reference.offset ^= null then 355 goto chk_temp; 356 if p2 -> reference.length ^= null then 357 goto chk_temp; 358 if p2 -> reference.c_offset ^= 0 then 359 goto chk_temp; 360 if p2 -> reference.temp_ref then 361 goto chk_temp; 362 363 right_constant = TRUE; 364 365 q = s2 -> symbol.initial; 366 367 if type2 = char_string then do; 368 if length2 > 0 then do; 369 all_same = verify (q -> based_cs, substr (q -> based_cs, 1, 1)) = 0; 370 if all_same then 371 all_blanks = substr (q -> based_cs, 1, 1) = " "; 372 end; 373 else 374 all_same, all_blanks = TRUE; 375 end; 376 else do; 377 all_ones = (^q -> based_bs = FALSE); 378 all_zeros = (q -> based_bs = FALSE); 379 end; 380 end; 381 382 chk_temp: 383 if ^p1 -> reference.temp_ref then 384 goto get_info; 385 if p1 -> reference.defined_ref then 386 goto get_info; 387 if p1 -> reference.aggregate then 388 goto get_info; 389 390 /* have temporary on left of assignment */ 391 392 if p1 -> reference.length = null then do; 393 394 load_prog = load; 395 396 if p1 -> reference.allocate then do; 397 if ^p1 -> reference.allocated then 398 call stack_temp$assign_temp (p1); 399 if p1 -> reference.ref_count = 1 then 400 p1 -> reference.ref_count = 2; 401 goto get_info; 402 end; 403 404 if ^p1 -> reference.long_ref then do; 405 no_store = TRUE; 406 goto get_info; 407 end; 408 409 end; 410 411 /* have long (string) temp = something */ 412 413 if type1 ^= type2 then do; 414 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 415 call long_op$extend_stack (p1, alloc_char_temp + dt); 416 call store$save_string_temp (p1); 417 goto get_info; 418 end; 419 420 if ^atomic then 421 p2 = compile_exp$save (exp_pt); 422 423 call long_op$extend_stack (p1, alloc_char_temp + dt); 424 if cg_stat$save_exp_called then 425 call store$save_string_temp (p1); 426 call expmac$two_eis (move_chars + dt, p1, p2); 427 428 goto done; 429 430 get_info: 431 if atomic then 432 goto gi; 433 434 if type2 <= real_flt_bin_2 then 435 k = 1; 436 else do; 437 if type2 ^= type1 then 438 goto gi; 439 if type2 < char_string then 440 goto gi; 441 if type2 > bit_string then 442 goto gi; 443 444 if pack_char_pic then 445 goto gi; 446 if p1 -> reference.varying_ref then 447 goto gi; 448 if p1 -> reference.length ^= null then 449 goto gi; 450 451 k = 0; 452 end; 453 454 /* if the right hand side is another assign operator which only changes the 455* * precision of its operand(2) (case k = 1) or another assignment to a 456* * string temporary (case k = 0) we'll try to eliminate the extra assign 457* */ 458 459 if exp_pt -> node.type ^= operator_node then 460 goto gi; 461 if exp_pt -> operator.op_code ^= assign then 462 goto gi; 463 if exp_pt -> operator.operand (1) -> reference.ref_count > 1 then 464 goto gi; 465 466 if k = 0 then do; 467 if p2 -> reference.varying_ref then 468 goto gi; 469 if p2 -> reference.length ^= null then 470 goto gi; 471 472 /* we can eliminate assignment if length of right side temporary 473* * is equal to length of left side temp 474* */ 475 if p1 -> reference.c_length = p2 -> reference.c_length then 476 goto elim; 477 end; 478 479 /* we have to restore the original value of the data type field 480* * of operand(2) if it is a reference because if we dont, prepare_operand 481* * will get confused and not evaluate the offset expression (if any) 482* */ 483 484 q2 = exp_pt -> operand (2); 485 if q2 -> node.type = operator_node then 486 q2 = q2 -> operand (1); 487 488 m1 = q2 -> reference.data_type; 489 490 q2 = prepare_operand (q2, 0, atomic); 491 492 m2 = q2 -> reference.data_type; 493 q2 -> reference.data_type = m1; 494 495 if k = 0 then do; 496 if p1 -> reference.c_length < p2 -> reference.c_length then 497 if type2 ^= m2 then 498 goto repair; 499 else 500 goto elim; 501 502 /* must have p1 -> c_length > p2 -> c_length */ 503 504 /* q2 -> reference.c_length won't be in the same units as for p2, 505* * but it still gives a reasonable indication of safety unless q2 506* * is decimal. This fixes 1653 507* */ 508 if type2 ^= m2 then 509 if m2 >= real_fix_dec & m2 <= complex_flt_dec then 510 goto repair; 511 512 if q2 -> reference.varying_ref then 513 goto repair; 514 if q2 -> reference.length ^= null then 515 goto repair; 516 517 if p2 -> reference.c_length < q2 -> reference.c_length then 518 goto repair; 519 520 /* eliminate the assignment */ 521 522 elim: 523 p2, exp_pt = exp_pt -> operand (2); 524 if k = 0 then do; 525 p2 = prepare_operand (p2, 1, atomic); 526 goto gt; 527 end; 528 p2 = prepare_operand (p2, 1, atomic); 529 goto gi; 530 end; 531 532 /* k = 1 at this point */ 533 534 if type2 = m2 then 535 goto elim; 536 537 repair: 538 atomic = FALSE; 539 540 gi: 541 if type2 > bit_string then 542 goto LABEL_ENTRY_OR_PTR; 543 544 q = addr (assign_info$assign_info (type1, type2)); 545 a = fixed (q -> assign_info.act_a, 6); 546 b = fixed (q -> assign_info.act_b, 6); 547 m1 = fixed (q -> assign_info.macro_1, 12); 548 m2 = fixed (q -> assign_info.macro_2, 12); 549 550 if pack_char_pic then do; 551 a = 2; 552 b = 2; 553 end; 554 555 /* MR12.3: print a sev 2 warning about assignments to an 556* * options(constant) variable 557* */ 558 if p1 -> reference.symbol -> symbol.alloc_in_text then 559 call error (134, cg_stat$cur_statement, null); 560 561 goto A (a); 562 563 /* unimplemented conversion */ 564 565 A (0): 566 call error (331, cg_stat$cur_statement, null); 567 goto done; 568 569 /* ordinary arithmetic assignment */ 570 571 A (1): 572 if p1 -> reference.aligned_for_store_ref then do; 573 A1a: 574 if atomic then 575 call load_prog (p2, 0); 576 else 577 call compile_exp (exp_pt); 578 goto B (b); 579 end; 580 581 /* have assignment to packed arithmetic value */ 582 583 if type1 ^= type2 then 584 goto A1a; 585 586 if ^atomic then 587 if exp_pt -> node.type = operator_node then 588 goto A1a; 589 590 if p2 -> reference.ref_count > 1 then 591 goto A1a; 592 593 if check_size then 594 if type1 = real_fix_bin_1 then 595 if prec1 < prec2 then 596 goto A1a; 597 598 /* have atom on right */ 599 600 size1 = p1 -> reference.c_length; 601 602 if type1 = real_fix_bin_1 then do; 603 604 if s2 -> symbol.constant then do; 605 606 if s2 -> symbol.packed & ^p2 -> reference.aligned_ref then 607 goto fake_bit; 608 609 if p2 -> reference.offset ^= null then 610 goto A1b; 611 if p2 -> reference.c_offset ^= 0 then 612 goto A1b; 613 614 p2 = generate_constant$bit_string ( 615 substr (s2 -> symbol.initial -> word, bits_per_word - size1 + 1, size1), size1); 616 617 /* now treat assignment as if we were assigning bit strings */ 618 619 fake_bit: 620 check_size = FALSE; 621 622 if prec1 = prec2 then 623 if s1 -> symbol.unsigned = s2 -> symbol.unsigned then 624 if p1 -> reference.hard_to_load | p2 -> reference.hard_to_load then do; 625 dt = 1; 626 goto short_eis; 627 end; 628 629 call load$for_store (p2, 0); 630 631 aq_used = a_reg.offset + a_reg.size; 632 633 k = size1 - a_reg.size; 634 if k < 0 then do; /* right side is larger than we need */ 635 call aq_man$check_strings (aq_used + k); 636 a_reg.offset = a_reg.offset - k; 637 end; 638 else if k > 0 then do; /* right side has less precision than we need */ 639 if a_reg.offset > 0 then 640 call aq_man$left_shift (a_reg.offset, "0"b); 641 642 if s2 -> symbol.unsigned then 643 macro = lrl; 644 else 645 macro = lrs; 646 647 call expmac (macro, c_a (k, 1)); 648 649 end; 650 651 a_reg.size = size1; 652 p1 -> reference.data_type = bit_string; 653 goto l1; 654 end; 655 656 A1b: 657 if p2 -> reference.aligned_ref then 658 goto A1a; 659 if p2 -> reference.value_in.q then 660 goto A1a; 661 662 if scale1 ^= scale2 then 663 goto A1a; 664 665 /* have packed fixed single on right, too */ 666 667 p2 -> reference.data_type = bit_string; 668 goto fake_bit; 669 end; 670 671 if p2 -> reference.value_in.q then 672 goto A1a; 673 674 if type1 = real_flt_bin_1 | type1 = real_flt_bin_2 then do; 675 type1, p1 -> reference.data_type, p2 -> reference.data_type = bit_string; 676 677 call load_prog (p2, type2 - real_flt_bin_1); 678 679 size2 = p2 -> reference.c_length; 680 goto string_store_check; 681 end; 682 683 goto A1a; 684 685 /* char string and decimal conversion */ 686 687 A (2): 688 if ^atomic then 689 p2 = compile_exp$save_exp (exp_pt); 690 goto B (b); 691 692 /* left side is complex */ 693 694 A (3): 695 if atomic then do; 696 call expmac (m2, p2); 697 goto l1; 698 end; 699 700 call compile_exp (exp_pt); 701 m2 = 0; 702 goto B (b); 703 704 /* right side is complex float single binary */ 705 706 A (4): 707 if ^atomic then do; 708 p2 = compile_exp$save_exp (exp_pt); 709 if exp_pt -> node.type ^= operator_node then 710 goto B (4); 711 end; 712 713 if type1 = complex_flt_bin_1 then do; 714 call load_prog (p2, 0); 715 goto l1; 716 end; 717 718 call expmac ((ldfl1), p2); 719 loaded = TRUE; 720 if scale1 ^= 0 then 721 b = 7; 722 goto B (b); 723 724 /* have string = string */ 725 726 A (5): 727 length1 = p1 -> reference.c_length; 728 size1 = length1 * convert_size (type1); 729 d = fixed (size1 > bits_per_word, 1); 730 731 all_same = all_same & ((length1 = length2 & p1 -> reference.length = null) | all_blanks); 732 all_ones = all_ones & (length1 = length2 & p1 -> reference.length = null); 733 734 hard1 = p1 -> reference.hard_to_load; 735 hard2 = p2 -> reference.hard_to_load; 736 if ^hard2 then 737 if p2 -> reference.long_ref then 738 if p2 -> reference.units < word_ then 739 hard2 = size1 > bits_per_word; 740 741 if ^check_size then 742 goto A5a; 743 if p1 -> reference.length ^= null then 744 goto A5a; 745 if p2 -> reference.length ^= null then 746 goto A5a; 747 748 call check_stringsize; 749 750 /* the following code tries to improve string assignments by using 751* * an MLR or ldaq-staq seq 752* */ 753 754 A5a: 755 if p1 -> reference.varying_ref then 756 goto A5c; 757 if p1 -> reference.length ^= null then 758 goto A5c; 759 if ^p1 -> reference.aligned_for_store_ref then 760 goto A5c; 761 762 if no_store then 763 goto A5c; 764 765 if ^p2 -> reference.aligned_ref then 766 goto A5c; 767 if p2 -> reference.varying_ref then 768 goto A5c; 769 if p2 -> reference.length ^= null then 770 goto A5c; 771 if ^p2 -> reference.long_ref then 772 goto A5c; 773 774 if all_same | all_ones | all_zeros then 775 if size1 > break_even_bits then 776 goto A5c; 777 778 if length1 > length2 then 779 goto A5c; 780 781 if ^(mod (size1, bits_per_word) = 0 | p1 -> reference.long_ref) then 782 goto A5c; 783 784 if mod (size1, bits_per_word) = 0 | p1 -> reference.padded_for_store_ref then do; 785 786 if ^atomic then 787 call compile_exp (exp_pt); 788 789 call move_data$move_block (p1, p2, divide (size1 + bits_per_word - 1, bits_per_word, 17, 0)); 790 goto done; 791 end; 792 793 A5c: 794 if atomic then do; 795 796 A5ca: 797 if ^p1 -> reference.varying_ref then 798 goto chk; 799 800 /* have varying string on left */ 801 802 if p2 -> reference.length ^= null then 803 goto l9; 804 if p2 -> reference.varying_ref then 805 goto l9; 806 807 if length2 = 0 then do; 808 p1 -> reference.c_offset = p1 -> reference.c_offset - 1; 809 call expmac ((zero_mac), p1); 810 p1 -> reference.c_offset = p1 -> reference.c_offset + 1; 811 call state_man$flush_ref (p1); /* p1 might have been in indicators */ 812 goto done; 813 end; 814 815 if p1 -> reference.length ^= null then 816 goto l9; 817 818 load_prog = load; 819 820 if ^hard2 then do; 821 if ^p2 -> reference.long_ref then do; 822 call load_prog (p2, d); 823 goto string_store_work; 824 end; 825 826 if ^p1 -> reference.long_ref then do; 827 call load$short_string (p2, d); 828 goto string_store_work; 829 end; 830 end; 831 832 goto l9; 833 834 chk: 835 if p1 -> reference.long_ref then do; 836 837 l9: 838 lg: 839 if ^p1 -> reference.varying_ref then do; 840 call state_man$flush_sym ((p1 -> reference.symbol)); 841 call eis_move; 842 goto done; 843 end; 844 845 /* have varying string on left, must set cur length */ 846 847 if p1 -> reference.length ^= p2 -> reference.length then 848 arg (1) = get_length_in_storage (p1); 849 else 850 arg (1) = get_length (p1); 851 852 if p2 -> reference.varying_ref then do; 853 854 call load_size (p2); 855 856 if arg (1) = null then 857 if s2 -> symbol.c_dcl_size <= length1 & s2 -> symbol.dcl_size = null then 858 goto l11; 859 else 860 arg (1) = generate_constant$real_fix_bin_1 (length1); 861 862 goto l10; 863 end; 864 865 arg (2) = get_length (p2); 866 867 if arg (1) = null then 868 if arg (2) = null then do; 869 call load (generate_constant$real_fix_bin_1 (min (length1, length2)), 0); 870 goto l11; 871 end; 872 else 873 arg (1) = generate_constant$real_fix_bin_1 (length1); 874 else if arg (2) = null then 875 arg (2) = generate_constant$real_fix_bin_1 (length2); 876 877 call load (arg (2), 0); 878 879 if arg (1) = arg (2) then do; 880 if ^arg (1) -> reference.shared then 881 arg (1) -> reference.ref_count = arg (1) -> reference.ref_count - 1; 882 goto l11; 883 end; 884 885 l10: 886 if p2 -> reference.ref_count = 1 then 887 call need_temp (p2, "01"b); 888 if check_size then 889 macro = size_ck_varying; 890 else 891 macro = min_fx1; 892 if arg (1) -> reference.data_type = real_fix_bin_2 then 893 arg (1) = get_single_ref (arg (1)); 894 call expmac (macro, arg (1)); 895 896 l11: 897 refs_are_same = compare_refs (p1, p2); 898 899 if ^refs_are_same & p2 -> reference.offset ^= null then do; 900 901 /* the offset of p2 may be length(p1) (either as a 902* * reference node or as an operator node), so we 903* * should be careful to see that it is loaded before 904* * the length(p1) is changed. We use aq_man$lock 905* * and make_n_addressable to ensure that registers 906* * stay locked. Fixes 1799 and 1827. 907* */ 908 909 call aq_man$lock (null, 2); 910 arg (1) = p2; 911 call make_n_addressable (addr (arg), 1); 912 end; 913 914 call expmac_length_of_varying (stfx1, p1); 915 916 if ^refs_are_same then 917 call expmac$two_eis (chars_move_vt + dt, p1, p2); 918 else do; 919 if ^p2 -> reference.shared then 920 call adjust_ref_count (p2, -1); 921 if ^p1 -> reference.shared then 922 call adjust_ref_count (p1, -1); 923 end; 924 925 goto done; 926 end; 927 928 /* string on left is short */ 929 930 if p2 -> reference.varying_ref then 931 goto short_eis; 932 933 if hard1 | hard2 then 934 goto short_eis; 935 936 if p2 -> reference.long_ref then 937 if p2 -> reference.length = null then 938 call load$short_string (p2, d); 939 else do; 940 short_eis: 941 if no_store then 942 p1 = copy_temp (p1); 943 944 if p1 -> reference.aligned_for_store_ref then 945 if mod (size1, bits_per_word) ^= 0 then do; 946 if size1 < bits_per_word then 947 macro = zero_mac; 948 else 949 macro = zero_mac_p_1; 950 if ^p1 -> reference.shared then 951 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 952 call expmac (macro, p1); 953 end; 954 955 call state_man$flush_sym ((p1 -> reference.symbol)); 956 957 call eis_move; 958 959 if p1 -> reference.temp_ref then 960 if cg_stat$save_exp_called then 961 call adjust_ref_count (p1, -1); 962 else if cg_stat$cur_tree ^= p then do; 963 if ^no_store then 964 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 965 call load (p1, d); 966 end; 967 968 goto done; 969 end; 970 else if all_zeros then do; 971 972 if p1 -> reference.temp_ref then do; 973 call load_prog (p2, d); 974 goto string_store_work; 975 end; 976 977 if p1 -> reference.aligned_for_store_ref then 978 if size1 <= bits_per_word then 979 goto zm; 980 else do; 981 call load_prog (p2, d); 982 goto string_store_work; 983 end; 984 985 /* we'll zero the string by generating an and to storage 986* * macro using a mask with 0's in the field occupied 987* * by the string 988* */ 989 990 call state_man$flush_ref (p1); 991 double_string = (72)"1"b; 992 cfo = mod (p1 -> reference.c_offset * convert_offset (p1 -> reference.units), bits_per_word); 993 substr (double_string, cfo + 1, size1) = "0"b; 994 995 d = fixed (cfo + size1 > bits_per_word, 1); 996 p2 = generate_constant (double_string, d + 1); 997 call load (p2, d); 998 call expmac$one ((ansa), p1, d); 999 goto done; 1000 end; 1001 else if right_constant then do; 1002 if p1 -> reference.aligned_for_store_ref then do; 1003 call load_prog (p2, d); 1004 goto string_store_work; 1005 end; 1006 1007 /* we have a string constant being assigned to a variable 1008* * with a non-zero offset, we'll generate another constant 1009* * which is already shifted 1010* */ 1011 1012 cfo = mod (p1 -> reference.c_offset * convert_offset (p1 -> reference.units), bits_per_word); 1013 if cfo + size1 > bits_per_two_words then do; 1014 call load_prog (p2, d); 1015 goto string_store_work; 1016 end; 1017 1018 double_string = (72)"0"b; 1019 substr (double_string, cfo + 1, size1) = s2 -> symbol.initial -> based_bs; 1020 d = fixed (cfo + size1 > bits_per_word, 1); 1021 p2 = generate_constant (double_string, d + 1); 1022 1023 call expmac$one ((lda), p2, d); 1024 a_reg.offset = cfo; 1025 a_reg.size = size2; 1026 a_reg.length = bits_per_word * (d + 1); 1027 goto string_store_work; 1028 end; 1029 else do; 1030 call load_prog (p2, d); 1031 goto string_store_work; 1032 end; 1033 1034 goto string_store_work; 1035 end; 1036 1037 if exp_pt -> node.type ^= operator_node then 1038 goto A5ca; 1039 1040 /* string on right is not atomic */ 1041 1042 if ^p1 -> reference.varying_ref then 1043 goto l4; 1044 1045 /* following code looks for the case 1046* * vs = vs || something 1047* * where vs is a varying string. note that we can't use 1048* * compare_expression directly because ref node for 1049* * vs on LHS has a length field and ref node on RHS has 1050* * 0 length field 1051* */ 1052 1053 if exp_pt -> operator.op_code ^= cat_string then 1054 goto l4; 1055 1056 q = exp_pt -> operand (2); 1057 if q -> reference.c_length ^= 0 then 1058 goto l4; 1059 if q -> reference.length ^= null then 1060 goto l4; 1061 1062 if ^compare_refs (p1, q) then 1063 goto l4; 1064 1065 /* We have the case 1066* * vs = vs || something; 1067* * so we can move something to the end of vs 1068* */ 1069 1070 q = prepare_operand (q, -1, atomic); 1071 1072 q1 = prepare_operand ((exp_pt -> operand (3)), 1, atomic); 1073 if ^atomic then 1074 if q1 -> reference.long_ref then 1075 call compile_exp ((exp_pt -> operand (3))); 1076 else 1077 q1 = compile_exp$save_exp ((exp_pt -> operand (3))); 1078 1079 /* We should bump down some reference counts for unneeded temps 1080* * associated with result of cat_string operator 1081* */ 1082 1083 call adjust_suff_temp ((exp_pt -> operand (1))); 1084 1085 /* get a ptr to the operand to be used in the subsequent compare. 1086* * We make the call now because this operand may need to be unpacked 1087* * which would emit code. This fixes 1754 1088* */ 1089 1090 if q1 -> reference.c_length ^= 1 then 1091 q2 = get_suffix_length (q1); 1092 else 1093 q2 = get_suffix_length (p1); 1094 1095 /* make the varying string addressable without a tag */ 1096 1097 call m_a (p1, "10"b); 1098 1099 if p1 -> address.tag then do; 1100 if ^p1 -> reference.shared then 1101 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 1102 base = base_man$load_any_var (2, p1); 1103 if p1 -> reference.ref_count = 1 then 1104 call need_temp (p1, "10"b); 1105 end; 1106 1107 /* erase and lock the q register and force both operands to be addressable, 1108* * erase and locking the involved registers 1109* */ 1110 1111 call state_man$erase_reg ("01"b); 1112 call aq_man$lock (null, 2); 1113 arg (1) = p1; 1114 arg (2) = q1; 1115 p1 -> reference.perm_address = TRUE; 1116 call make_n_addressable (addr (arg), 2); 1117 p1 -> reference.perm_address = FALSE; 1118 1119 if q1 -> reference.c_length ^= 1 then do; /* get the room left in the varying string for the move */ 1120 call load_size (p1); 1121 call expmac_length_of_varying ((sbfx1), p1); 1122 1123 /* compare the 2 lengths to decide how much we will move in ( result in q reg ) */ 1124 1125 if check_size then 1126 macro = size_ck_suffix; 1127 else 1128 macro = min_fx1; 1129 if q1 -> reference.varying_ref then 1130 call expmac_length_of_varying (macro, q1); 1131 else 1132 call expmac (macro, q2); 1133 1134 /* load present size of varying string into a register other than q */ 1135 1136 call load_size$xr_or_aq (q, tag); 1137 1138 bump_mac = incr_mac; 1139 macro = chars_move_vt + dt; 1140 end; 1141 else do; /* compare present size with max length of target */ 1142 1143 call load_size (q); 1144 1145 if check_size then 1146 macro = size_ck_suffix_1; 1147 else 1148 macro = cmp_suffix_1; 1149 1150 call expmac (macro, q2); 1151 1152 tag = "0110"b; /* ql */ 1153 1154 bump_mac = aos_mac; 1155 macro = cat_move_chars + dt; 1156 end; 1157 1158 if ^q -> reference.shared then 1159 call adjust_ref_count (q, -1); 1160 1161 /* update length field of varying string */ 1162 1163 call expmac_length_of_varying (bump_mac, p1); 1164 1165 /* Use old size of varying string as the offset in the string for the target of the move */ 1166 1167 p1 -> address.tag = "00"b || tag; 1168 p1 -> reference.perm_address = TRUE; 1169 q1 -> reference.perm_address = TRUE; 1170 call expmac$two_eis (macro, p1, q1); 1171 1172 if dt > 0 then 1173 machine_state.indicators = ind_invalid; 1174 goto done; 1175 1176 /* Have expression, will compile */ 1177 1178 l4: 1179 if ^p2 -> reference.long_ref & ^(p1 -> reference.varying_ref & p1 -> reference.length = null) 1180 & (p1 -> reference.long_ref | hard1) then 1181 p2 = compile_exp$save (exp_pt); 1182 else 1183 call compile_exp (exp_pt); 1184 1185 if p1 -> reference.varying_ref then do; 1186 if p1 -> reference.length ^= null then 1187 goto lg; 1188 1189 if p2 -> reference.length = null then do; 1190 if ^p2 -> reference.long_ref then 1191 goto string_store_work; 1192 end; 1193 else 1194 goto lg; 1195 end; 1196 1197 if p1 -> reference.long_ref then 1198 goto lg; 1199 1200 /* string on left is short */ 1201 1202 if hard1 then 1203 goto short_eis; 1204 1205 if p2 -> reference.long_ref then do; 1206 1207 if check_size then 1208 goto short_eis; 1209 1210 if p2 -> reference.length ^= null | size2 < bits_per_two_words then 1211 goto short_eis; 1212 1213 p2 -> reference.value_in.storage = TRUE; 1214 1215 call load$short_string (p2, d); 1216 size2 = bits_per_word * (d + 1); 1217 end; 1218 1219 /* we have size2 <= a_reg.size */ 1220 1221 string_store_work: 1222 if p1 -> reference.varying_ref then do; 1223 1224 if ^p1 -> reference.shared then 1225 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 1226 1227 call expmac$one ((sta), p1, fixed (min (size1, size2) > bits_per_word, 1)); 1228 p2 = generate_constant$real_fix_bin_1 (min (length1, length2)); 1229 1230 if p1 -> address.tag = "000110"b then do; /* ql */ 1231 call expmac ((lda), p2); 1232 m2 = sta; 1233 end; 1234 else do; 1235 call load (p2, 0); 1236 m2 = stfx1; 1237 end; 1238 1239 last_macro = TRUE; 1240 call expmac_length_of_varying (m2, p1); 1241 1242 goto done; 1243 end; 1244 1245 string_store_check: 1246 if size1 = a_reg.size then 1247 goto st; 1248 1249 if size1 < a_reg.size then do; 1250 if no_store then 1251 call aq_man$trim_aq (size1); 1252 goto st; 1253 end; 1254 1255 /* have size2 <= a_reg.size < size1 */ 1256 1257 aq_used = a_reg.size + a_reg.offset; 1258 1259 if type1 = bit_string then 1260 if a_reg.length = bits_per_two_words | a_reg.length - a_reg.offset >= size1 then 1261 goto st; 1262 else 1263 goto pad; 1264 1265 /* we must pad the char string, check to see if new length 1266* * will fit with current offset 1267* */ 1268 1269 if size1 > bits_per_two_words - a_reg.offset then do; 1270 1271 /* we can't extend far enough without shifting string 1272* * back to left end of aq 1273* */ 1274 call aq_man$left_shift (a_reg.offset, "1"b); 1275 aq_used = a_reg.size; 1276 end; 1277 1278 if size1 <= bits_per_word then 1279 k = size1 + a_reg.offset; 1280 else 1281 k = bits_per_two_words; 1282 1283 if a_reg.length < k then do; 1284 pad: 1285 call aq_man$trim_aq (aq_used); 1286 a_reg.length = 72; 1287 end; 1288 1289 if type1 = bit_string then 1290 goto st; 1291 1292 call expmac ((oraq), c_a (aq_used, 6)); 1293 1294 if mod (k, bits_per_word) ^= 0 then do; 1295 call aq_man$trim_aq (k); 1296 a_reg.length = bits_per_two_words; 1297 end; 1298 1299 a_reg.size = k - a_reg.offset; 1300 1301 st: 1302 if (size1 = size2) & all_ones then 1303 call store$all_ones (p1); 1304 else 1305 call store (p1); 1306 1307 if a_reg.size + a_reg.offset > bits_per_two_words then 1308 a_reg.size = bits_per_two_words - a_reg.offset; 1309 1310 goto done; 1311 1312 /* something (not char string) = bit string */ 1313 1314 A (6): 1315 if p2 -> reference.long_ref | p2 -> reference.varying_ref then do; 1316 1317 if ^atomic then 1318 call compile_exp (exp_pt); 1319 call load$long_string (p2); 1320 1321 call expmac$zero ((longbs_to_fx2)); 1322 1323 /* now have real_fix_bin_2 in aq register */ 1324 1325 now_fx2: 1326 type2 = real_fix_bin_2; 1327 1328 q = addr (assign_info$assign_info (type1, type2)); 1329 m1 = fixed (q -> assign_info.macro_1, 12); 1330 m2 = fixed (q -> assign_info.macro_2, 12); 1331 goto B (fixed (q -> assign_info.act_b, 6)); 1332 end; 1333 1334 if all_zeros then 1335 if type1 = real_fix_bin_1 & ^p1 -> reference.temp_ref & p1 -> reference.aligned_for_store_ref then do; 1336 zm: 1337 call state_man$flush_ref (p1); 1338 call expmac ((zero_mac), p1); 1339 goto done; 1340 end; 1341 1342 if atomic then 1343 call load (p2, 1); 1344 else 1345 call compile_exp (exp_pt); 1346 1347 dt = a_reg.offset; 1348 if a_reg.number ^= 0 then do; 1349 q = a_reg.variable (1); 1350 if q -> reference.temp_ref & q -> reference.ref_count > 0 then 1351 call state_man$erase_reg ("1"b); 1352 end; 1353 1354 if size2 < bits_per_two_words then do; 1355 k = bits_per_two_words - size2; 1356 if k > dt then 1357 call aq_man$right_shift (k - dt, "1"b); 1358 end; 1359 1360 if scale1 ^= 0 then 1361 call state_man$erase_reg ("1"b); 1362 1363 goto now_fx2; 1364 1365 /* bit_string = arithmetic */ 1366 1367 A (7): 1368 if ^atomic then do; 1369 call compile_exp (exp_pt); 1370 1371 loaded = TRUE; 1372 end; 1373 1374 goto B (b); 1375 1376 /* ordinary arithmetic assignment */ 1377 1378 B (1): 1379 if m1 ^= 0 then 1380 call expmac$zero (m1); 1381 1382 l0: 1383 if m2 ^= 0 then 1384 call expmac$zero (m2); 1385 1386 l1: 1387 if check_size & s1 -> symbol.fixed then do; 1388 if type1 > real_fix_bin_1 then 1389 dt = 1; 1390 else if type2 > real_fix_bin_1 then 1391 dt = 1; 1392 else 1393 dt = 0; 1394 call xr_man$load_const (-s1 -> symbol.c_dcl_size * (dt + 1), 7); 1395 1396 if s1 -> symbol.unsigned then 1397 size_ck_macro = size_check_uns_fx1 + dt; 1398 else 1399 size_ck_macro = size_check_fx1 + dt; 1400 1401 call expmac$zero (size_ck_macro); 1402 1403 /* RW 89 1404* * The above load_const destroyed the indicators we needed. 1405* */ 1406 machine_state.indicators = ind_invalid; 1407 1408 end; 1409 1410 call store (p1); 1411 1412 done: 1413 cg_stat$temp_ref = p1; 1414 1415 if p1 -> reference.temp_ref then 1416 p1 -> reference.ref_count = min (p1 -> reference.ref_count, orig_count); 1417 1418 if ^p1 -> reference.shared then 1419 p1 -> reference.evaluated = TRUE; 1420 1421 return; 1422 1423 /* have conversion to or from char string */ 1424 1425 B (2): 1426 if p1 -> reference.temp_ref & p1 -> reference.shared & p1 -> reference.length = null then do; 1427 p1, p -> operand (1) = copy_temp (p1); 1428 orig_count = 1; 1429 end; 1430 1431 load_it = 1432 p1 -> reference.temp_ref & ^cg_stat$save_exp_called & cg_stat$cur_tree ^= p & ^p1 -> reference.long_ref 1433 & ^s1 -> symbol.decimal; 1434 1435 if op_code = pack | op_code = unpack then 1436 call picture_op (p); 1437 else do; 1438 call convert_chars (p1, p2, check_size, always_round); 1439 1440 if p2 ^= null then do; /* conversion was done into temp which we must still assign */ 1441 atomic = TRUE; 1442 length2 = p2 -> reference.c_length; 1443 size2 = bits_per_char * length2; 1444 type2 = char_string; 1445 goto A (5); 1446 end; 1447 end; 1448 1449 B2b: 1450 if type1 = bit_string then 1451 machine_state.indicators = ind_invalid; 1452 1453 if load_it then do; 1454 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 1455 call load (p1, fixed (type1 >= char_string, 1)); 1456 end; 1457 goto done; 1458 1459 /* have bit string = arithmetic */ 1460 1461 B (3): 1462 size1, length1 = p1 -> reference.c_length; 1463 1464 if type2 <= real_fix_bin_2 & scale2 ^= 0 then do; 1465 if ^loaded then 1466 call load (p2, 0); 1467 1468 call scaler (-scale2, type2); 1469 1470 prec2 = max (prec2 - scale2, 0); 1471 goto B3b; 1472 end; 1473 1474 if ^loaded then 1475 if type2 > real_fix_bin_2 | ^p2 -> reference.aligned_ref then 1476 call load (p2, 0); 1477 else do; 1478 d = type2 - real_fix_bin_1; 1479 k = bits_per_word * (d + 1); 1480 1481 arg (1) = p2; 1482 arg (2) = c_a (k - prec2, 1); 1483 1484 if s2 -> symbol.unsigned then 1485 macro = uns_fx1_to_bs; 1486 else 1487 macro = fx1_to_bs; 1488 1489 call expmac$many (macro + d, addr (arg), 2); 1490 1491 a_reg.length = k; 1492 goto B3a; 1493 end; 1494 1495 B3b: 1496 if ^s2 -> symbol.unsigned then do; 1497 if machine_state.indicators ^= ind_arithmetic then do; 1498 call expmac (cpfx1 - real_fix_bin_1 + type2, c_a (0, 5)); 1499 machine_state.indicators = ind_arithmetic; 1500 end; 1501 1502 if m1 ^= 0 then 1503 call expmac$zero (m1); 1504 if m2 ^= 0 then 1505 call expmac$zero (m2); 1506 end; 1507 1508 call expmac ((lls), c_a (bits_per_two_words - prec2, 1)); 1509 1510 a_reg.length = bits_per_two_words; 1511 1512 B3a: 1513 a_reg.size, size2, length2 = prec2; 1514 a_reg.offset = 0; 1515 1516 if p1 -> reference.long_ref & ^(p1 -> reference.varying_ref & p1 -> reference.length = null) then do; 1517 p2 = c_a (46, 4); /* store in double_temp */ 1518 p2 -> reference.c_length = length2; 1519 p2 -> reference.temp_ref = TRUE; 1520 p2 -> reference.data_type = bit_string; 1521 p2 -> reference.ref_count = 2; 1522 p2 -> reference.value_in.storage = TRUE; 1523 call expmac$one ((sta), p2, fixed (length2 > bits_per_word, 1)); 1524 goto lg; 1525 end; 1526 else do; 1527 if check_size then 1528 call check_stringsize; 1529 goto string_store_work; 1530 end; 1531 1532 LABEL_ENTRY_OR_PTR: 1533 orig_count = p1 -> reference.ref_count; 1534 if type2 < unpacked_ptr then 1535 goto lab_or_ent; 1536 1537 /* following check allows for initialization of file constants */ 1538 1539 if type1 = local_label_variable then 1540 type1, p1 -> reference.data_type = unpacked_ptr; 1541 1542 if type2 = unpacked_ptr then do; 1543 1544 /* NOTE: All assignments of unpacked ptrs must be done through the pointer 1545* * registers in order to validate the pointers' ring numbers 1546* */ 1547 1548 if ^atomic then do; 1549 if type1 = unpacked_ptr then 1550 if ^p2 -> reference.allocate then do; 1551 /* slide the LHS in as the target of the operator */ 1552 exp_pt -> operand (1) = p1; 1553 call compile_exp (exp_pt); /* and compile */ 1554 goto done; 1555 end; 1556 1557 1558 call compile_exp (exp_pt); /* leave the temp in the machine state */ 1559 p2 = exp_pt -> operator.operand (1); /* and use it */ 1560 goto CONVERT_UNPACKED_PTR_TO_SOMETHING; 1561 end; 1562 1563 if s2 -> symbol.constant then do; 1564 1565 /* right side of assignment is a constant, it must be null ptr. 1566* * if left side is packed ptr, use packed representation of null 1567* */ 1568 if type1 = packed_ptr then do; 1569 p2, p -> operand (2) = generate_constant$real_fix_bin_1 (cg_stat$packed_null_value); 1570 type2, p2 -> reference.data_type = packed_ptr; 1571 end; 1572 end; 1573 end; 1574 1575 if p2 -> reference.temp_ref then 1576 if ^p1 -> reference.temp_ref then 1577 do i = 1 to 6; 1578 if p2 -> reference.value_in.b (i) then do; 1579 if p1 -> reference.aligned_for_store_ref then 1580 if ^p2 -> reference.shared then 1581 call adjust_ref_count (p2, -1); 1582 1583 call base_to_core (i, p1); 1584 1585 /* have to decrement count after base_to_core rather 1586* * than before for unaligned refs so that temp can 1587* * be used for intermediate saving by base_to_core 1588* */ 1589 1590 if ^p1 -> reference.aligned_for_store_ref then 1591 if ^p2 -> reference.shared then 1592 call adjust_ref_count (p2, -1); 1593 goto done; 1594 end; 1595 end; 1596 1597 CONVERT_UNPACKED_PTR_TO_SOMETHING: 1598 if type1 < type2 | (type2 = packed_ptr & p1 -> reference.temp_ref) then do; 1599 call base_man$load_packed (p, i); 1600 if ^p1 -> reference.temp_ref | p1 -> reference.aggregate | cg_stat$save_exp_called then 1601 call base_to_core (i, p1); 1602 goto done; 1603 end; 1604 else if type2 = unpacked_ptr then 1605 if p1 -> reference.temp_ref | ^s2 -> symbol.constant then 1606 if p1 -> reference.aligned_for_store_ref | p1 -> reference.hard_to_load then do; 1607 if ^p2 -> reference.shared & p2 -> reference.temp_ref then 1608 call adjust_ref_count (p2, +1); 1609 /* base man will hit ref count even though the reference is evaluated already, potentially */ 1610 base = base_man$load_any_var (1, p2); 1611 i = which_base (fixed (base, 3)); 1612 if ^p1 -> reference.temp_ref | p1 -> reference.aggregate | cg_stat$save_exp_called then 1613 call base_to_core (i, p1); 1614 else 1615 call base_man$update_base (1, p1, i); 1616 goto done; 1617 end; 1618 1619 call load (p2, 0); 1620 1621 m2 = ptr_convert (type2, type1); 1622 goto l0; 1623 1624 /* have conversion to or from decimal or complex */ 1625 1626 B (4): 1627 if s1 -> symbol.complex ^= s2 -> symbol.complex then 1628 goto B4b; 1629 if type1 ^= type2 then 1630 goto B4a; 1631 if scale1 ^= scale2 then 1632 goto B4a; 1633 if p1 -> reference.c_length ^= p2 -> reference.c_length then 1634 goto B4a; 1635 1636 if p1 -> reference.aligned_for_store_ref & p2 -> reference.aligned_ref 1637 & s1 -> symbol.unaligned = s2 -> symbol.unaligned then do; 1638 if s2 -> symbol.decimal then 1639 if s2 -> symbol.unaligned then do; 1640 units_per_wrd = packed_digits_per_word; 1641 if s2 -> symbol.complex then 1642 c_length = 1643 p2 -> reference.c_length + 2 * mod (divide (p2 -> reference.c_length, 2, 24, 0), 2); 1644 else 1645 c_length = p2 -> reference.c_length; 1646 end; 1647 else do; 1648 units_per_wrd = chars_per_word; 1649 c_length = p2 -> reference.c_length; 1650 end; 1651 else do; 1652 units_per_wrd = bits_per_word; 1653 c_length = p2 -> reference.c_length; 1654 end; 1655 1656 call move_data$move_block (p1, p2, divide (c_length + units_per_wrd - 1, units_per_wrd, 17, 0)); 1657 goto done; 1658 end; 1659 1660 B4a: 1661 if s1 -> symbol.decimal then 1662 if s2 -> symbol.decimal then do; 1663 macro = move_decimal; 1664 1665 if max (scale1, scale2) <= max_dec_scale & min (scale1, scale2) >= min_dec_scale then 1666 call assign_decimal; 1667 1668 else if type1 = type2 then do; 1669 if abs (scale1 - scale2) <= max_dec_scale - min_dec_scale then do; 1670 if scale1 > scale2 then 1671 i = min_dec_scale; 1672 else 1673 i = max_dec_scale; 1674 s1 -> symbol.scale = i + (scale1 - scale2); 1675 s2 -> symbol.scale = i; 1676 end; 1677 else do; 1678 macro = multiply_decimal; 1679 exponent.pad = "0"b; 1680 exponent.value = scale1 - scale2; 1681 s1 -> symbol.scale = 0; 1682 s2 -> symbol.scale = 0; 1683 end; 1684 1685 call assign_decimal; 1686 1687 s1 -> symbol.scale = scale1; 1688 s2 -> symbol.scale = scale2; 1689 end; 1690 else do; 1691 macro = multiply_decimal; 1692 exponent.pad = "0"b; 1693 1694 if scale1 > max_dec_scale | scale1 < min_dec_scale then 1695 exponent.value = scale1; 1696 else 1697 exponent.value = -scale2; 1698 1699 call assign_decimal; 1700 end; 1701 1702 goto done; 1703 end; 1704 1705 B4b: 1706 if p1 -> reference.temp_ref & p1 -> reference.shared then do; 1707 p1, p -> operand (1) = copy_temp (p1); 1708 orig_count = 1; 1709 end; 1710 1711 load_it = 1712 p1 -> reference.temp_ref & ^cg_stat$save_exp_called & cg_stat$cur_tree ^= p 1713 & ^(s1 -> symbol.decimal | s1 -> symbol.complex); 1714 1715 call convert_arithmetic (p1, p2, check_size, always_round); 1716 1717 goto B2b; 1718 1719 /* have fixed binary = fixed binary */ 1720 1721 B (5): 1722 if m1 ^= 0 then 1723 call expmac$zero (m1); 1724 1725 ds = scale1 - scale2; 1726 1727 if ds ^= 0 then do; 1728 k = max (type1, type2); 1729 call scaler (ds, k); 1730 end; 1731 1732 goto l1; 1733 1734 /* have float binary = fixed binary */ 1735 1736 B (6): 1737 if scale2 = 0 then 1738 goto B (1); 1739 1740 call fixed_to_float (p2); 1741 if type1 = complex_flt_bin_1 then 1742 call expmac$zero (rflb1_to_cflb1); 1743 goto l1; 1744 1745 /* have fixed binary = float binary */ 1746 1747 B (7): 1748 if scale1 = 0 then 1749 goto B (1); 1750 1751 call float_to_fixed (p1); 1752 goto l1; 1753 1754 lab_or_ent: 1755 if p1 -> reference.temp_ref & ^cg_stat$save_exp_called then 1756 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 1757 1758 if type1 = real_fix_bin_1 then do; 1759 arg (1) = p1; 1760 arg (2) = p2; 1761 call expmac$many ((assign_label_to_int), addr (arg), 2); 1762 goto done; 1763 end; 1764 1765 if type1 = unpacked_ptr then do; 1766 call base_man$store_ptr_to (p2, p1); 1767 goto done; 1768 end; 1769 1770 if type2 = ext_entry_in | type2 = ext_entry_out then do; 1771 call base_man$load_var (2, p2, 1); 1772 1773 if ^p1 -> reference.shared then 1774 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 1775 1776 p1 -> reference.data_type = unpacked_ptr; 1777 call base_to_core (1, p1); 1778 1779 p2 = generate_constant$bit_string (cg_stat$null_value, (bits_per_two_words)); 1780 p2 -> reference.data_type = unpacked_ptr; 1781 call load (p2, 0); 1782 call m_a (p1, "1"b); /* can't have indirection in address */ 1783 p1 -> reference.perm_address = TRUE; 1784 1785 p1 -> address.offset = bit (fixed (fixed (p1 -> address.offset, 15) + 2, 15), 15); 1786 call store$force (p1); 1787 p1 -> reference.perm_address = FALSE; 1788 p1 -> reference.data_type = type1; 1789 goto done; 1790 end; 1791 1792 b2 = s2 -> symbol.block_node; 1793 1794 if type2 ^= label_constant then 1795 if type2 ^= int_entry then 1796 goto le_1; 1797 1798 if b2 -> block.level ^= cg_stat$cur_level then 1799 goto le_2; 1800 1801 call m_a (p1, "1"b); 1802 p1 -> reference.perm_address = TRUE; 1803 k = 1 + fixed (p1 -> address.base = bp, 1); 1804 call base_man$load_var (2, p2, k); 1805 call expmac ((set_label_const (k)), p1); 1806 goto done; 1807 1808 le_1: 1809 if type2 > entry_variable then do; 1810 le_2: 1811 arg (1) = p2; 1812 arg (2) = c_a (cg_stat$cur_level - b2 -> block.level, 2); 1813 call expmac$many ((make_lv), addr (arg), 2); 1814 1815 call m_a (p1, "0"b); 1816 p1 -> reference.perm_address = TRUE; 1817 call expmac ((store_lv), p1); 1818 end; 1819 1820 else do; 1821 if ^p1 -> reference.shared then 1822 p1 -> reference.ref_count = p1 -> reference.ref_count + 1; 1823 if ^p2 -> reference.shared then 1824 p2 -> reference.ref_count = p2 -> reference.ref_count + 1; 1825 call base_man$update_base (0, null, 1); 1826 call make_both_addressable (p1, p2, "1"b); 1827 1828 do i = 1 to 2; 1829 p1 -> reference.perm_address = TRUE; 1830 p2 -> reference.perm_address = TRUE; 1831 call base_man$load_var (1, p2, 1); 1832 call base_to_core (1, p1); 1833 call state_man$flush_ref (p2); 1834 if i = 1 then do; 1835 p1 -> address.offset = bit (fixed (fixed (p1 -> address.offset, 15) + 2, 15), 15); 1836 substr (p2 -> address.tag, 1, 2) = "00"b; 1837 p2 -> address.offset = bit (fixed (fixed (p2 -> address.offset, 15) + 2, 15), 15); 1838 end; 1839 end; 1840 1841 p1 -> reference.perm_address = FALSE; 1842 p2 -> reference.perm_address = FALSE; 1843 end; 1844 1845 goto done; 1846 1847 /* 1848* * 1849* */ 1850 assign_op$length_of_varying: 1851 entry (pt, source); 1852 1853 dcl source ptr parameter; 1854 1855 last_macro = FALSE; 1856 call load (source, 0); 1857 call expmac_length_of_varying ((stfx1), pt); 1858 return; 1859 1860 /* 1861* * entry to convert fixed decimal scaled input whose scale is out 1862* * of range to float decimal output 1863* */ 1864 assign_op$fix_dec_scaled: 1865 entry (pt); 1866 1867 always_round, check_size = FALSE; 1868 p2 = pt; 1869 s2 = p2 -> reference.symbol; 1870 p1 = decimal_op$get_float_temp (s2 -> symbol.c_dcl_size, (s2 -> symbol.complex)); 1871 s1 = p1 -> reference.symbol; 1872 macro = multiply_decimal; 1873 exponent.pad = "0"b; 1874 exponent.value = -s2 -> symbol.scale; 1875 call assign_decimal; 1876 pt = p1; 1877 return; 1878 1879 /* 1880* * entry to convert float decimal input to fixed decimal scaled output 1881* * whose scale is out of hardware range 1882* */ 1883 assign_op$to_dec_scaled: 1884 entry (pt, source); 1885 1886 always_round, check_size = FALSE; 1887 p2 = source; 1888 p1 = pt; 1889 s1 = p1 -> reference.symbol; 1890 s2 = p2 -> reference.symbol; 1891 macro = multiply_decimal; 1892 exponent.pad = "0"b; 1893 exponent.value = s1 -> symbol.scale; 1894 call assign_decimal; 1895 if ^p1 -> reference.shared then 1896 p1 -> reference.evaluated = TRUE; 1897 return; 1898 1899 /* 1900* * procedure to generate assignment macro for strings 1901* */ 1902 eis_move: 1903 proc; 1904 1905 if p1 -> reference.temp_ref then 1906 p1 -> reference.value_in.storage = TRUE; 1907 1908 if ^(check_size & p1 -> reference.length ^= null) then do; 1909 if all_same then do; 1910 call expmac$one_eis ((blank_cs), p1); 1911 if length2 > 0 then 1912 addrel (cg_stat$text_base, cg_stat$text_pos - 3) -> instruction.fill = 1913 substr (s2 -> symbol.initial -> based_cs, 1, 1); 1914 return; 1915 end; 1916 1917 if all_ones then do; 1918 if p1 -> reference.aligned_for_store_ref then 1919 if mod (size1, bits_per_char) = 0 then do; 1920 m1 = one_cs; 1921 call long_op$one_eis (p1, divide (size1 + bits_per_char - 1, bits_per_char, 17, 0), m1); 1922 return; 1923 end; 1924 1925 m1 = one_bs; 1926 call expmac$one_eis (m1, p1); 1927 return; 1928 end; 1929 1930 if all_zeros then do; 1931 if p1 -> reference.aligned_for_store_ref then 1932 if p1 -> reference.length = null then do; 1933 if p1 -> reference.padded_for_store_ref | mod (size1, bits_per_char) = 0 then do; 1934 m1 = zero_cs; 1935 call long_op$one_eis (p1, divide (size1 + bits_per_char - 1, bits_per_char, 17, 0), m1) 1936 ; 1937 return; 1938 end; 1939 end; 1940 else if p1 -> reference.padded_for_store_ref then do; 1941 call load_size (p1); 1942 if p1 -> reference.ref_count = 1 then 1943 call need_temp (p1, "01"b); 1944 call expmac$zero ((b2c_mac)); 1945 call expmac$one_eis ((zero_cs_q), p1); 1946 return; 1947 end; 1948 1949 m1 = zero_bs; 1950 call expmac$one_eis (m1, p1); 1951 return; 1952 end; 1953 end; 1954 1955 if check_size then 1956 macro = chars_move_ck; 1957 else 1958 macro = chars_move; 1959 1960 call expmac$two_eis (macro + dt, p1, p2); 1961 end eis_move; 1962 1963 /* 1964* * this procedure gets the length expression of a string and increments 1965* * reference count preparatory to its use in a macro 1966* */ 1967 get_length: 1968 proc (pt) returns (ptr); 1969 1970 dcl pt ptr parameter; 1971 dcl (q, q1) ptr; 1972 1973 q = pt -> reference.length; 1974 1975 if q ^= null then do; 1976 if q -> node.type = operator_node then do; 1977 q1 = q -> operand (1); 1978 if q1 -> reference.shared then 1979 q -> operand (1) = copy_temp (q1); 1980 q = q -> operand (1); 1981 end; 1982 1983 if ^q -> reference.shared then 1984 q -> reference.ref_count = q -> reference.ref_count + 1; 1985 end; 1986 1987 return (q); 1988 end get_length; 1989 1990 /* 1991* * this procedure gets the length of a reference such that it can be 1992* * used in storage by a fullword instruction. This routine may emit code. 1993* * This routine was written to fix 1754. 1994* */ 1995 get_length_in_storage: 1996 proc (pt) returns (ptr); 1997 1998 dcl pt ptr parameter; 1999 dcl p ptr; 2000 2001 p = get_length ((pt)); 2002 2003 if p ^= null then 2004 if ^p -> reference.aligned_ref then 2005 p = compile_exp$save (p); 2006 2007 return (p); 2008 2009 end get_length_in_storage; 2010 2011 /* 2012* * this procedure gets the length needed by the section that handles 2013* * vs = vs || expr; 2014* * this MAY emit code. 2015* */ 2016 get_suffix_length: 2017 proc (pt) returns (ptr); 2018 2019 dcl pt ptr parameter; 2020 dcl (p, q) ptr; 2021 2022 p = pt; 2023 2024 q = get_length_in_storage (p); 2025 2026 if q = null then do; 2027 if p -> reference.c_length ^= 0 | ^p -> reference.varying_ref then 2028 q = generate_constant$real_fix_bin_1 ((p -> reference.c_length)); 2029 end; 2030 else if q -> reference.data_type = real_fix_bin_2 then 2031 q = get_single_ref (q); 2032 2033 return (q); 2034 2035 end get_suffix_length; 2036 2037 /* 2038* * this procedure executes a macro on the length word of a varying string 2039* */ 2040 expmac_length_of_varying: 2041 proc (macro, pt); 2042 2043 dcl macro fixed bin (15) parameter; 2044 dcl pt ptr parameter; 2045 2046 dcl p ptr; 2047 dcl addr_hold bit (36) aligned; 2048 dcl reloc_hold bit (12) aligned; 2049 2050 p = pt; 2051 2052 if string (p -> reference.address_in.b) ^= "0"b & ^p -> reference.temp_ref then do; 2053 /* same restriction on temp_ref as in m_a */ 2054 if p -> address.offset ^= (15)"0"b | p -> reference.no_address then 2055 call m_a (p, "00"b); 2056 p -> address.offset = (15)"1"b; 2057 end; 2058 else do; 2059 addr_hold = string (p -> reference.address); 2060 reloc_hold = p -> reference.relocation; 2061 p -> reference.c_offset = p -> reference.c_offset - 1; 2062 call m_a (p, "00"b); 2063 p -> reference.c_offset = p -> reference.c_offset + 1; 2064 end; 2065 2066 p -> reference.perm_address = TRUE; 2067 2068 if ^last_macro then 2069 if ^p -> reference.shared then 2070 p -> reference.ref_count = p -> reference.ref_count + 1; 2071 2072 call expmac (macro, p); 2073 2074 p -> reference.perm_address = FALSE; 2075 2076 if string (p -> reference.address_in.b) ^= "0"b & ^p -> reference.temp_ref then 2077 p -> address.offset = (15)"0"b; 2078 else do; 2079 string (p -> reference.address) = addr_hold; 2080 p -> reference.relocation = reloc_hold; 2081 end; 2082 2083 end expmac_length_of_varying; 2084 2085 /* 2086* * 2087* */ 2088 scaler: 2089 proc (amt, type); 2090 2091 dcl (amt, type) fixed bin parameter; 2092 2093 if amt < 0 then do; 2094 call xr_man$load_const (abs (amt), 2); 2095 call expmac$zero ((truncate (type))); 2096 end; 2097 else 2098 call expmac ((left_shift (type)), c_a (amt, 1)); 2099 2100 end scaler; 2101 2102 /* 2103* * this procedure compares two references ignoring the two length fields 2104* */ 2105 compare_refs: 2106 proc (p1, p2) reducible returns (bit (1) aligned); 2107 2108 dcl (p1, p2) ptr parameter; 2109 2110 if p1 -> reference.symbol ^= p2 -> reference.symbol then 2111 return (FALSE); 2112 else if p1 -> reference.c_offset ^= p2 -> reference.c_offset then 2113 return (FALSE); 2114 else if ^compare_expression ((p1 -> reference.offset), (p2 -> reference.offset)) then 2115 return (FALSE); 2116 else if ^compare_expression ((p1 -> reference.qualifier), (p2 -> reference.qualifier)) then 2117 return (FALSE); 2118 else 2119 return (TRUE); 2120 2121 end compare_refs; 2122 2123 /* 2124* * 2125* */ 2126 adjust_suff_temp: 2127 proc (pt); 2128 2129 dcl pt ptr parameter; 2130 dcl p ptr; 2131 2132 p = pt; 2133 top = p -> reference.length; 2134 call adjust_suff_op (top); 2135 call adjust_ref_count (p, -1); 2136 2137 end adjust_suff_temp; 2138 2139 /* 2140* * 2141* */ 2142 adjust_suff_op: 2143 proc (pt); 2144 2145 dcl pt ptr parameter; 2146 dcl (p, q) ptr; 2147 dcl i fixed bin; 2148 2149 p = pt; 2150 2151 if p -> node.type = operator_node then do; 2152 q = p -> operand (1); 2153 if ^q -> reference.evaluated then 2154 if q -> reference.ref_count <= 1 then 2155 do i = 2 to p -> operator.number; 2156 if p -> operand (i) ^= null then 2157 call adjust_suff_op ((p -> operand (i))); 2158 end; 2159 end; 2160 else 2161 q = p; 2162 2163 if p ^= top then 2164 if q -> node.type = reference_node then 2165 if ^q -> reference.shared then 2166 call adjust_ref_count (q, -1); 2167 2168 return; 2169 2170 end adjust_suff_op; 2171 2172 /* 2173* * this issues macro(s) to effect the assignment of a decimal variable 2174* */ 2175 assign_decimal: 2176 proc; 2177 2178 dcl (mac, ninst) fixed bin (15); 2179 dcl arg (2, 3) ptr; 2180 2181 mac = macro + fixed (s1 -> symbol.float | always_round, 1); 2182 2183 if macro = multiply_decimal then do; 2184 arg (1, 3), arg (2, 3) = generate_constant$char_string ("+1" || exponent_char, 3); 2185 k = 3; 2186 end; 2187 else 2188 k = 2; 2189 2190 ninst = fixed (s1 -> symbol.complex, 1) + 1; 2191 2192 arg (1, 1) = p1; 2193 arg (1, 2) = p2; 2194 2195 if ninst > 1 then do; 2196 arg (2, 1) = get_imaginary (p1); 2197 arg (2, 2) = get_imaginary (p2); 2198 end; 2199 2200 do i = 1 to ninst; 2201 call expmac$many_eis (mac, addr (arg (i, 1)), k); 2202 2203 if check_size then 2204 if s1 -> symbol.fixed then 2205 call expmac$zero ((size_ck_decimal)); 2206 end; 2207 2208 end assign_decimal; 2209 2210 /* 2211* * this issues warning about stringsize occuring at runtime 2212* * and generates unconditional signal of stringsize 2213* */ 2214 check_stringsize: 2215 proc; 2216 2217 if length1 < length2 then do; 2218 if ^cg_stat$cur_statement -> statement.suppress_warnings then 2219 call error (319, cg_stat$cur_statement, null); 2220 call expmac$zero ((signal_stringsize)); 2221 end; 2222 2223 end check_stringsize; 2224 end assign_op; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/22/89 1359.0 assign_op.pl1 >spec>install>1073>assign_op.pl1 258 1 10/25/79 1645.8 cgsystem.incl.pl1 >ldd>include>cgsystem.incl.pl1 260 2 04/07/83 1635.0 statement.incl.pl1 >ldd>include>statement.incl.pl1 262 3 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 264 4 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 266 5 12/07/83 1701.7 symbol.incl.pl1 >ldd>include>symbol.incl.pl1 268 6 08/13/81 2043.5 block.incl.pl1 >ldd>include>block.incl.pl1 270 7 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.incl.pl1 272 8 05/03/76 1320.8 bases.incl.pl1 >ldd>include>bases.incl.pl1 274 9 05/03/76 1320.4 data_types.incl.pl1 >ldd>include>data_types.incl.pl1 276 10 11/13/79 1015.8 machine_state.incl.pl1 >ldd>include>machine_state.incl.pl1 278 11 04/07/83 1635.0 op_codes.incl.pl1 >ldd>include>op_codes.incl.pl1 280 12 10/25/79 1645.8 boundary.incl.pl1 >ldd>include>boundary.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. FALSE constant bit(1) initial dcl 255 ref 286 310 377 378 537 619 1117 1787 1841 1842 1855 1867 1886 2074 2110 2112 2114 2116 TRUE constant bit(1) initial dcl 254 ref 300 331 342 363 373 405 719 1115 1168 1169 1213 1239 1371 1418 1441 1519 1522 1783 1802 1816 1829 1830 1895 1905 2066 2118 a 000134 automatic fixed bin(17,0) dcl 74 set ref 545* 551* 561 a_reg 3 based structure level 2 dcl 10-6 abs builtin function dcl 170 ref 1669 2094 2094 act_a based bit(6) level 2 packed packed unaligned dcl 173 ref 545 act_b 0(06) based bit(6) level 2 packed packed unaligned dcl 173 ref 546 1331 addr builtin function dcl 170 ref 544 911 911 1116 1116 1328 1489 1489 1761 1761 1813 1813 2184 2201 2201 addr_hold 000302 automatic bit(36) dcl 2047 set ref 2059* 2079 addrel builtin function dcl 170 ref 1911 address 10 based structure level 2 packed packed unaligned dcl 4-3 set ref 2059 2079* address_in 11 based structure level 3 packed packed unaligned dcl 4-3 adjust_ref_count 000032 constant entry external dcl 102 ref 919 921 959 1158 1579 1590 1607 2135 2163 aggregate 12(19) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 387 1600 1612 aligned_for_store_ref 13(02) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 571 759 944 977 1002 1334 1579 1590 1604 1636 1918 1931 aligned_ref 12(07) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 606 656 765 1474 1636 2003 all_blanks 000162 automatic bit(1) dcl 77 set ref 286* 370* 373* 731 all_ones 000163 automatic bit(1) dcl 77 set ref 286* 377* 732* 732 774 1301 1917 all_same 000165 automatic bit(1) dcl 77 set ref 286* 369* 370 373* 731* 731 774 1909 all_zeros 000164 automatic bit(1) dcl 77 set ref 286* 378* 774 970 1334 1930 alloc_char_temp constant fixed bin(15,0) initial dcl 180 ref 415 423 alloc_in_text 32(08) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 558 allocate 12(14) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 396 1549 allocated 12(15) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 397 always_round 000200 automatic bit(1) dcl 80 set ref 292* 1438* 1715* 1867* 1886* 2181 amt parameter fixed bin(17,0) dcl 2091 set ref 2088 2093 2094 2094 2097* 2097* ansa constant fixed bin(15,0) initial dcl 180 ref 998 aos_mac constant fixed bin(15,0) initial dcl 180 ref 1154 aq_man$check_strings 000034 constant entry external dcl 104 ref 635 aq_man$left_shift 000036 constant entry external dcl 105 ref 639 1274 aq_man$lock 000040 constant entry external dcl 106 ref 909 1112 aq_man$right_shift 000042 constant entry external dcl 107 ref 1356 aq_man$trim_aq 000044 constant entry external dcl 108 ref 1250 1284 1295 aq_used 000146 automatic fixed bin(17,0) dcl 75 set ref 631* 635 1257* 1275* 1284* 1292* 1292* arg 000124 automatic pointer array dcl 72 in procedure "assign_op" set ref 847* 849* 856 859* 865* 867 867 872* 874 874* 877* 879 879 880 880 880 892 892* 892* 894* 910* 911 911 1113* 1114* 1116 1116 1481* 1482* 1489 1489 1759* 1760* 1761 1761 1810* 1812* 1813 1813 arg 000340 automatic pointer array dcl 2179 in procedure "assign_decimal" set ref 2184* 2184* 2192* 2193* 2196* 2197* 2201 2201 assign constant bit(9) initial dcl 11-8 ref 461 assign_info based structure level 1 dcl 173 assign_info$assign_info 000224 external static fixed bin(17,0) array dcl 173 set ref 544 1328 assign_label_to_int constant fixed bin(15,0) initial dcl 180 ref 1761 assign_round constant bit(9) initial dcl 11-8 ref 292 assign_size_ck constant bit(9) initial dcl 11-8 ref 291 atomic 000161 automatic bit(1) dcl 77 set ref 294* 298* 300* 347 420 430 490* 525* 528* 537* 573 586 687 694 706 786 793 1070* 1072* 1073 1317 1342 1367 1441* 1548 attributes 31 based structure level 2 dcl 5-3 b 11 based bit(1) array level 4 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" ref 2052 2076 b 11(15) based bit(1) array level 4 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" ref 1578 b 000135 automatic fixed bin(17,0) dcl 74 in procedure "assign_op" set ref 546* 552* 578 690 702 720* 722 1374 b2 000112 automatic pointer dcl 70 set ref 1792* 1798 1812 b2c_mac constant fixed bin(15,0) initial dcl 180 ref 1944 base 000202 automatic bit(3) dcl 81 in procedure "assign_op" set ref 1102* 1610* 1611 base 10 based bit(3) level 3 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" set ref 1803 base_man$load_any_var 000050 constant entry external dcl 111 ref 1102 1610 base_man$load_packed 000052 constant entry external dcl 112 ref 1599 base_man$load_var 000054 constant entry external dcl 113 ref 1771 1804 1831 base_man$store_ptr_to 000056 constant entry external dcl 114 ref 1766 base_man$update_base 000060 constant entry external dcl 115 ref 1614 1825 base_to_core 000046 constant entry external dcl 110 ref 1583 1600 1612 1777 1832 based_bs based bit dcl 234 ref 377 378 1019 based_cs based char dcl 234 ref 369 369 370 1911 bases 000027 constant bit(3) initial array dcl 8-1 ref 1803 1803 bit builtin function dcl 170 ref 1785 1835 1837 bit_string constant fixed bin(15,0) initial dcl 9-1 ref 325 335 441 540 652 667 675 1259 1289 1449 1520 bits 13 based structure level 2 in structure "statement" packed packed unaligned dcl 2-9 in procedure "assign_op" bits 12(06) based structure level 2 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" bits_per_char 011760 constant fixed bin(8,0) initial dcl 1-5 ref 1443 1918 1921 1921 1921 1921 1933 1935 1935 1935 1935 bits_per_two_words constant fixed bin(8,0) initial dcl 1-5 ref 325 1013 1210 1259 1269 1280 1296 1307 1307 1354 1355 1508 1508 1510 1779 bits_per_word 011757 constant fixed bin(8,0) initial dcl 1-5 ref 614 614 729 736 781 784 789 789 789 789 944 946 977 992 995 1012 1020 1026 1216 1227 1227 1278 1294 1479 1523 1523 1652 blank_cs constant fixed bin(15,0) initial dcl 180 ref 1910 block based structure level 1 dcl 6-5 block_node 4 based pointer level 2 packed packed unaligned dcl 5-3 ref 1792 bp defined bit(3) dcl 8-4 ref 1803 break_even_bits constant fixed bin(8,0) initial dcl 1-5 ref 774 bump_mac 000215 automatic fixed bin(15,0) dcl 88 set ref 1138* 1154* 1163* c_a 000100 constant entry external dcl 124 ref 647 647 1292 1292 1482 1498 1498 1508 1508 1517 1812 2097 2097 c_dcl_size 30 based fixed bin(24,0) level 2 dcl 5-3 set ref 308 320 856 1394 1870* c_length 000206 automatic fixed bin(24,0) dcl 85 in procedure "assign_op" set ref 1641* 1644* 1649* 1653* 1656 1656 c_length 2 based fixed bin(24,0) level 2 in structure "reference" dcl 4-3 in procedure "assign_op" set ref 324* 324 325 339 475 475 496 496 517 517 600 679 726 1057 1090 1119 1442 1461 1518* 1633 1633 1641 1641 1644 1649 1653 2027 2027 c_offset 1 based fixed bin(24,0) level 2 dcl 4-3 set ref 358 611 808* 808 810* 810 992 1012 2061* 2061 2063* 2063 2112 2112 cat_move_chars constant fixed bin(15,0) initial dcl 180 ref 1155 cat_string constant bit(9) initial dcl 11-8 ref 1053 cfo 000156 automatic fixed bin(17,0) dcl 76 set ref 992* 993 995 1012* 1013 1019 1020 1024 cg_stat$cur_level 000010 external static fixed bin(17,0) dcl 91 ref 1798 1812 cg_stat$cur_statement 000012 external static pointer dcl 92 set ref 342 558* 565* 2218 2218* cg_stat$cur_tree 000014 external static pointer dcl 93 ref 962 1431 1711 cg_stat$null_value 000016 external static bit(72) dcl 94 set ref 1779* cg_stat$packed_null_value 000020 external static fixed bin(17,0) dcl 95 set ref 1569* cg_stat$save_exp_called 000022 external static bit(1) packed unaligned dcl 96 ref 424 959 1431 1600 1612 1711 1754 cg_stat$temp_ref 000024 external static pointer dcl 97 set ref 1412* cg_stat$text_base 000026 external static pointer dcl 98 ref 1911 cg_stat$text_pos 000030 external static fixed bin(17,0) dcl 99 ref 1911 cg_static_$m_s_p 000226 external static pointer dcl 10-3 ref 10-3 char_string constant fixed bin(15,0) initial dcl 9-1 ref 325 333 335 342 367 439 1444 1455 1455 chars_move constant fixed bin(15,0) initial dcl 180 ref 1957 chars_move_ck constant fixed bin(15,0) initial dcl 180 ref 1955 chars_move_vt constant fixed bin(15,0) initial dcl 180 ref 916 1139 chars_per_word constant fixed bin(8,0) initial dcl 1-5 ref 1648 check_size 000175 automatic bit(1) dcl 79 set ref 291* 593 619* 741 888 1125 1145 1207 1386 1438* 1527 1715* 1867* 1886* 1908 1955 2203 cmp_suffix_1 constant fixed bin(15,0) initial dcl 180 ref 1147 compare_expression 000072 constant entry external dcl 121 ref 2114 2116 compile_exp 000062 constant entry external dcl 117 ref 576 700 786 1073 1182 1317 1344 1369 1553 1558 compile_exp$save 000064 constant entry external dcl 118 ref 420 1178 2003 compile_exp$save_exp 000066 constant entry external dcl 119 ref 687 708 1076 compiler_developed 32(35) based structure level 3 packed packed unaligned dcl 5-3 complex 31(31) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 1626 1626 1641 1711 1870 2190 complex_flt_bin_1 constant fixed bin(15,0) initial dcl 9-1 ref 713 1741 complex_flt_dec constant fixed bin(15,0) initial dcl 9-1 ref 508 constant 32(16) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 348 604 1563 1604 convert_arithmetic 000076 constant entry external dcl 123 ref 1715 convert_chars 000074 constant entry external dcl 122 ref 1438 convert_offset 000037 constant fixed bin(8,1) initial array dcl 1-35 ref 992 1012 convert_size 000046 constant fixed bin(8,0) initial array dcl 1-5 ref 325 340 728 copy_temp 000070 constant entry external dcl 120 ref 940 1427 1707 1978 cpfx1 constant fixed bin(15,0) initial dcl 180 ref 1498 d 000154 automatic fixed bin(17,0) dcl 76 set ref 729* 822* 827* 936* 965* 973* 981* 995* 996 997* 998* 1003* 1014* 1020* 1021 1023* 1026 1030* 1215* 1216 1478* 1479 1489 data_type 12 based fixed bin(5,0) level 2 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" set ref 312 315 323* 328 488 492 493* 652* 667* 675* 675* 892 1520* 1539* 1570* 1776* 1780* 1788* 2030 data_type 31 based structure level 3 in structure "symbol" packed packed unaligned dcl 5-3 in procedure "assign_op" dcl_size 24 based pointer level 2 packed packed unaligned dcl 5-3 ref 856 decimal 31(28) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 1431 1638 1660 1660 1711 decimal_op$get_float_temp 000102 constant entry external dcl 125 ref 1870 defined_ref 12(12) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 385 dimensioned 31(19) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 352 divide builtin function dcl 170 ref 789 789 1641 1656 1656 1921 1921 1935 1935 double_string 000210 automatic bit(72) dcl 87 set ref 991* 993* 996* 1018* 1019* 1021* ds 000153 automatic fixed bin(17,0) dcl 76 set ref 1725* 1727 1729* dt 000155 automatic fixed bin(17,0) dcl 76 set ref 333* 415 423 426 625* 916 1139 1155 1172 1347* 1356 1356 1388* 1390* 1392* 1394 1396 1398 1960 entry_variable constant fixed bin(15,0) initial dcl 9-1 ref 1808 error 000104 constant entry external dcl 126 ref 558 565 2218 evaluated 12(13) based bit(1) level 3 packed packed unaligned dcl 4-3 set ref 1418* 1895* 2153 exp_pt 000122 automatic pointer dcl 71 set ref 297* 420* 459 461 463 484 522 522* 576* 586 687* 700* 708* 709 786* 1037 1053 1056 1072 1073 1076 1083 1178* 1182* 1317* 1344* 1369* 1552 1553* 1558* 1559 expmac 000106 constant entry external dcl 127 ref 647 696 718 809 894 952 1131 1150 1231 1292 1338 1498 1508 1805 1817 2072 2097 expmac$many 000114 constant entry external dcl 130 ref 1489 1761 1813 expmac$many_eis 000116 constant entry external dcl 131 ref 2201 expmac$one 000110 constant entry external dcl 128 ref 998 1023 1227 1523 expmac$one_eis 000120 constant entry external dcl 132 ref 1910 1926 1945 1950 expmac$two_eis 000122 constant entry external dcl 133 ref 426 916 1170 1960 expmac$zero 000112 constant entry external dcl 129 ref 1321 1378 1382 1401 1502 1504 1721 1741 1944 2095 2203 2220 exponent 000224 automatic structure level 1 dcl 246 set ref 2184 exponent_char based char(1) dcl 250 ref 2184 ext_entry_in constant fixed bin(15,0) initial dcl 9-1 ref 1770 ext_entry_out constant fixed bin(15,0) initial dcl 9-1 ref 1770 fill based char(1) level 2 packed packed unaligned dcl 237 set ref 1911* fixed 31(01) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 5-3 in procedure "assign_op" ref 1386 2203 fixed builtin function dcl 170 in procedure "assign_op" ref 545 546 547 548 729 995 1020 1227 1227 1329 1330 1331 1455 1455 1523 1523 1611 1785 1785 1803 1835 1835 1837 1837 2181 2190 fixed_to_float 000124 constant entry external dcl 135 ref 1740 float 31(02) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 2181 float_to_fixed 000126 constant entry external dcl 136 ref 1751 full_word 000205 automatic bit(36) dcl 84 set ref 286* fx1_to_bs constant fixed bin(15,0) initial dcl 180 ref 1486 generate_constant 000130 constant entry external dcl 137 ref 996 1021 generate_constant$bit_string 000134 constant entry external dcl 139 ref 614 1779 generate_constant$char_string 000136 constant entry external dcl 140 ref 2184 generate_constant$real_fix_bin_1 000132 constant entry external dcl 138 ref 859 869 869 872 874 1228 1569 2027 get_imaginary 000140 constant entry external dcl 141 ref 2196 2197 get_single_ref 000142 constant entry external dcl 142 ref 892 2030 hard1 000170 automatic bit(1) dcl 78 set ref 734* 933 1178 1202 hard2 000171 automatic bit(1) dcl 78 set ref 735* 736 736* 820 933 hard_to_load 12(23) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 622 622 734 735 1604 here_before 000172 automatic bit(1) dcl 78 set ref 286* 322 331* i 000104 automatic fixed bin(17,0) dcl 2147 in procedure "adjust_suff_op" set ref 2153* 2156 2156* i 000136 automatic fixed bin(17,0) dcl 74 in procedure "assign_op" set ref 1575* 1578 1583* 1599* 1600* 1611* 1612* 1614* 1670* 1672* 1674 1675 1828* 1834* 2200* 2201 2201* incr_mac constant fixed bin(15,0) initial dcl 180 ref 1138 ind_arithmetic constant fixed bin(17,0) initial dcl 10-68 ref 1497 1499 ind_invalid constant fixed bin(17,0) initial dcl 10-68 ref 1172 1406 1449 indicators 1 based fixed bin(17,0) level 2 dcl 10-6 set ref 1172* 1406* 1449* 1497 1499* info 11 based structure level 2 packed packed unaligned dcl 4-3 initial 11 based pointer level 2 packed packed unaligned dcl 5-3 ref 365 614 614 1019 1911 instruction based structure level 1 dcl 237 int_entry constant fixed bin(15,0) initial dcl 9-1 ref 1794 k 000141 automatic fixed bin(17,0) dcl 74 set ref 434* 451* 466 495 524 633* 634 635 636 638 647* 647* 1278* 1280* 1283 1294 1295* 1299 1355* 1356 1356 1479* 1482 1491 1728* 1729* 1803* 1804* 1805 2185* 2187* 2201* label_constant constant fixed bin(15,0) initial dcl 9-1 ref 1794 label_node constant bit(9) initial dcl 7-5 ref 298 314 last_macro 000167 automatic bit(1) dcl 78 set ref 286* 1239* 1855* 2068 lda constant fixed bin(15,0) initial dcl 180 ref 1023 1231 ldfl1 constant fixed bin(15,0) initial dcl 180 ref 718 left_shift 000056 constant fixed bin(15,0) initial array dcl 180 ref 2097 length 17 based fixed bin(8,0) level 3 in structure "machine_state" dcl 10-6 in procedure "assign_op" set ref 1026* 1259 1259 1283 1286* 1296* 1491* 1510* length 6 based pointer level 2 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" ref 356 392 448 469 514 731 732 743 745 757 769 802 815 847 847 936 1059 1178 1186 1189 1210 1425 1516 1908 1931 1973 2133 length1 000144 automatic fixed bin(17,0) dcl 75 set ref 726* 728 731 732 778 856 859* 869 869 869 869 872* 1228 1228 1461* 2217 length2 000145 automatic fixed bin(17,0) dcl 75 set ref 339* 340 368 369 369 370 731 732 778 807 869 869 869 869 874* 1228 1228 1442* 1443 1512* 1518 1523 1523 1911 1911 2217 level 45 based fixed bin(17,0) level 2 dcl 6-5 ref 1798 1812 lls constant fixed bin(15,0) initial dcl 180 ref 1508 load 000144 constant entry external dcl 143 ref 394 818 869 877 965 997 1235 1342 1455 1465 1474 1619 1781 1856 load$for_store 000146 constant entry external dcl 144 ref 284 629 load$long_string 000150 constant entry external dcl 145 ref 1319 load$short_string 000152 constant entry external dcl 146 ref 827 936 1215 load_it 000173 automatic bit(1) dcl 79 set ref 1431* 1453 1711* load_prog 000220 automatic entry variable dcl 147 set ref 284* 394* 573 677 714 818* 822 973 981 1003 1014 1030 load_size 000154 constant entry external dcl 148 ref 854 1120 1143 1941 load_size$xr_or_aq 000156 constant entry external dcl 149 ref 1136 loaded 000166 automatic bit(1) dcl 78 set ref 286* 719* 1371* 1465 1474 local_label_variable constant fixed bin(15,0) initial dcl 9-1 ref 1539 long_op$extend_stack 000162 constant entry external dcl 151 ref 415 423 long_op$one_eis 000160 constant entry external dcl 150 ref 1921 1935 long_ref 12(08) based bit(1) level 3 packed packed unaligned dcl 4-3 set ref 325* 404 736 771 781 821 826 834 936 1073 1178 1178 1190 1197 1205 1314 1431 1516 longbs_to_fx2 constant fixed bin(15,0) initial dcl 180 ref 1321 lrl constant fixed bin(15,0) initial dcl 180 ref 642 lrs constant fixed bin(15,0) initial dcl 180 ref 644 m1 000212 automatic fixed bin(15,0) dcl 88 set ref 488* 493 547* 1329* 1378 1378* 1502 1502* 1721 1721* 1920* 1921* 1925* 1926* 1934* 1935* 1949* 1950* m2 000213 automatic fixed bin(15,0) dcl 88 set ref 492* 496 508 508 508 534 548* 696* 701* 1232* 1236* 1240* 1330* 1382 1382* 1504 1504* 1621* m_a 000166 constant entry external dcl 153 ref 1097 1782 1801 1815 2054 2062 m_s_p 000226 automatic pointer initial dcl 10-3 set ref 631 631 633 636 636 639 639 651 1024 1025 1026 1172 1245 1249 1257 1257 1259 1259 1259 1269 1274 1275 1278 1283 1286 1296 1299 1299 1307 1307 1307 1307 1347 1348 1349 1406 1449 1491 1497 1499 1510 1512 1514 10-3* mac 000336 automatic fixed bin(15,0) dcl 2178 set ref 2181* 2201* machine_state based structure level 1 dcl 10-6 macro parameter fixed bin(15,0) dcl 2043 in procedure "expmac_length_of_varying" set ref 2040 2072* macro 000214 automatic fixed bin(15,0) dcl 88 in procedure "assign_op" set ref 642* 644* 647* 888* 890* 894* 946* 948* 952* 1125* 1127* 1129* 1131* 1139* 1145* 1147* 1150* 1155* 1170* 1484* 1486* 1489 1663* 1678* 1691* 1872* 1891* 1955* 1957* 1960 2181 2183 macro_1 0(12) based bit(12) level 2 packed packed unaligned dcl 173 ref 547 1329 macro_2 0(24) based bit(12) level 2 packed packed unaligned dcl 173 ref 548 1330 make_both_addressable 000170 constant entry external dcl 154 ref 1826 make_lv constant fixed bin(15,0) initial dcl 180 ref 1813 make_n_addressable 000164 constant entry external dcl 152 ref 911 1116 max builtin function dcl 170 ref 1470 1665 1728 max_dec_scale constant fixed bin(8,0) initial dcl 1-5 ref 1665 1669 1672 1694 min builtin function dcl 170 ref 869 869 869 869 1227 1227 1228 1228 1415 1665 min_dec_scale 011756 constant fixed bin(8,0) initial dcl 1-5 ref 1665 1669 1670 1694 min_fx1 constant fixed bin(15,0) initial dcl 180 ref 890 1127 misc_attributes 31(19) based structure level 3 packed packed unaligned dcl 5-3 mod builtin function dcl 170 ref 781 784 944 992 1012 1294 1641 1918 1933 more_bits 13 based structure level 2 packed packed unaligned dcl 4-3 move_chars constant fixed bin(15,0) initial dcl 180 ref 426 move_data$move_block 000174 constant entry external dcl 156 ref 789 1656 move_decimal constant fixed bin(15,0) initial dcl 180 ref 1663 multiply_decimal constant fixed bin(15,0) initial dcl 180 ref 1678 1691 1872 1891 2183 need_temp 000172 constant entry external dcl 155 ref 885 1103 1942 ninst 000337 automatic fixed bin(15,0) dcl 2178 set ref 2190* 2195 2200 no_address 10(27) based bit(1) level 3 packed packed unaligned dcl 4-3 set ref 2054 no_store 000176 automatic bit(1) dcl 79 set ref 286* 405* 762 940 963 1250 node based structure level 1 dcl 7-27 null builtin function dcl 170 ref 354 356 392 448 469 514 558 558 565 565 609 731 732 743 745 757 769 802 815 856 856 867 867 874 899 909 909 936 1059 1112 1112 1178 1186 1189 1210 1425 1440 1516 1825 1825 1908 1931 1975 2003 2026 2156 2218 2218 number 15 based fixed bin(17,0) level 3 in structure "machine_state" dcl 10-6 in procedure "assign_op" ref 1348 number 0(21) based fixed bin(14,0) level 2 in structure "operator" packed packed unaligned dcl 3-6 in procedure "assign_op" ref 2153 offset 20 based fixed bin(8,0) level 3 in structure "machine_state" dcl 10-6 in procedure "assign_op" set ref 631 636* 636 639 639* 1024* 1257 1259 1269 1274* 1278 1299 1307 1307 1347 1514* offset 10(03) based bit(15) level 3 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" set ref 1785* 1785 1835* 1835 1837* 1837 2054 2056* 2076* offset 5 based pointer level 2 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" ref 354 609 899 2114 2114 one_bs constant fixed bin(15,0) initial dcl 180 ref 1925 one_cs constant fixed bin(15,0) initial dcl 180 ref 1920 op_code 0(09) based bit(9) level 2 in structure "operator" packed packed unaligned dcl 3-6 in procedure "assign_op" ref 290 461 1053 op_code 000204 automatic bit(9) dcl 83 in procedure "assign_op" set ref 290* 291 292 342 1435 1435 operand 1 based pointer array level 2 packed packed unaligned dcl 3-6 set ref 294 297 463 484 485 522 1056 1072 1073 1076 1083 1427* 1552* 1559 1569* 1707* 1977 1978* 1980 2152 2156 2156 operator based structure level 1 dcl 3-6 operator_node constant bit(9) initial dcl 7-5 ref 298 459 485 586 709 1037 1976 2151 oraq constant fixed bin(15,0) initial dcl 180 ref 1292 orig_count 000157 automatic fixed bin(17,0) dcl 76 set ref 295* 1415 1428* 1532* 1708* p 000326 automatic pointer dcl 2130 in procedure "adjust_suff_temp" set ref 2132* 2133 2135* p 000266 automatic pointer dcl 2020 in procedure "get_suffix_length" set ref 2022* 2024* 2027 2027 2027 p 000100 automatic pointer dcl 2146 in procedure "adjust_suff_op" set ref 2149* 2151 2152 2153 2156 2156 2160 2163 p 000100 automatic pointer dcl 70 in procedure "assign_op" set ref 289* 290 294 297 962 1427 1431 1435* 1569 1599* 1707 1711 p 000256 automatic pointer dcl 1999 in procedure "get_length_in_storage" set ref 2001* 2003 2003 2003* 2003* 2007 p 000300 automatic pointer dcl 2046 in procedure "expmac_length_of_varying" set ref 2050* 2052 2052 2054 2054 2054* 2056 2059 2060 2061 2061 2062* 2063 2063 2066 2068 2068 2068 2072* 2074 2076 2076 2076 2079 2080 p1 000102 automatic pointer dcl 70 in procedure "assign_op" set ref 294* 295 303 315 323 324 325 325 328 382 385 387 392 396 397 397* 399 399 404 414 414 415* 416* 423* 424* 426* 446 448 475 496 558 571 600 622 652 675 726 731 732 734 743 754 757 759 781 784 789* 796 808 808 809* 810 810 811* 815 826 834 837 840 847 847* 849* 896* 914* 916* 921 921* 940* 940* 944 950 950 950 952* 955 959 959* 963 963 965* 972 977 990* 992 992 998* 1002 1012 1012 1042 1062* 1092* 1097* 1099 1100 1100 1100 1102* 1103 1103* 1113 1115 1117 1120* 1121* 1163* 1167 1168 1170* 1178 1178 1178 1185 1186 1197 1221 1224 1224 1224 1227* 1230 1240* 1301* 1304* 1334 1334 1336* 1338* 1410* 1412 1415 1415 1415 1418 1418 1425 1425 1425 1427* 1427* 1431 1431 1438* 1454 1454 1455* 1461 1516 1516 1516 1532 1539 1552 1575 1579 1583* 1590 1597 1600 1600 1600* 1604 1604 1604 1612 1612 1612* 1614* 1633 1636 1656* 1705 1705 1707* 1707* 1711 1715* 1751* 1754 1754 1754 1759 1766* 1773 1773 1773 1776 1777* 1782* 1783 1785 1785 1786* 1787 1788 1801* 1802 1803 1805* 1815* 1816 1817* 1821 1821 1821 1826* 1829 1832* 1835 1835 1841 1870* 1871 1876 1888* 1889 1895 1895 1905 1905 1908 1910* 1918 1921* 1926* 1931 1931 1933 1935* 1940 1941* 1942 1942* 1945* 1950* 1960* 2192 2196* p1 parameter pointer dcl 2108 in procedure "compare_refs" ref 2105 2110 2112 2114 2116 p2 000104 automatic pointer dcl 70 in procedure "assign_op" set ref 297* 298 298 298 298* 298* 305 312 324 339 354 356 358 360 420* 426* 467 469 475 496 517 522* 525* 525* 528* 528* 573* 590 606 609 611 614* 622 629* 656 659 667 671 675 677* 679 687* 696* 708* 714* 718* 735 736 736 745 765 767 769 771 789* 802 804 821 822* 827* 847 852 854* 865* 885 885* 896* 899 910 916* 919 919* 930 936 936 936* 973* 981* 996* 997* 1003* 1014* 1021* 1023* 1030* 1178 1178* 1189 1190 1205 1210 1213 1215* 1228* 1231* 1235* 1314 1314 1319* 1342* 1438* 1440 1442 1465* 1474 1474* 1481 1517* 1518 1519 1520 1521 1522 1523* 1549 1559* 1569* 1570 1575 1578 1579 1579* 1590 1590* 1607 1607 1607* 1610* 1619* 1633 1636 1641 1641 1644 1649 1653 1656* 1715* 1740* 1760 1766* 1771* 1779* 1780 1781* 1804* 1810 1823 1823 1823 1826* 1830 1831* 1833* 1836 1837 1837 1842 1868* 1869 1887* 1890 1960* 2193 2197* p2 parameter pointer dcl 2108 in procedure "compare_refs" ref 2105 2110 2112 2114 2116 pack constant bit(9) initial dcl 11-8 ref 342 1435 pack_char_pic 000177 automatic bit(1) dcl 80 set ref 286* 342* 444 550 packed 33 based bit(1) level 4 packed packed unaligned dcl 5-3 ref 606 packed_digits_per_word constant fixed bin(8,0) initial dcl 1-5 ref 1640 packed_ptr constant fixed bin(15,0) initial dcl 9-1 ref 1568 1570 1597 pad 000224 automatic bit(1) level 2 packed packed unaligned dcl 246 set ref 1679* 1692* 1873* 1892* padded_for_store_ref 13(01) based bit(1) level 3 packed packed unaligned dcl 4-3 ref 784 1933 1940 perm_address 12(18) based bit(1) level 3 packed packed unaligned dcl 4-3 set ref 1115* 1117* 1168* 1169* 1783* 1787* 1802* 1816* 1829* 1830* 1841* 1842* 2066* 2074* picture_op 000176 constant entry external dcl 157 ref 1435 prec1 000151 automatic fixed bin(17,0) dcl 76 set ref 308* 593 622 prec2 000152 automatic fixed bin(17,0) dcl 76 set ref 320* 593 622 1470* 1470 1482 1508 1508 1512 prefix 12(12) based bit(12) level 2 packed packed unaligned dcl 2-9 ref 342 prepare_operand 000200 constant entry external dcl 158 ref 294 298 490 525 528 1070 1072 pt parameter pointer dcl 2145 in procedure "adjust_suff_op" ref 2142 2149 pt parameter pointer dcl 2129 in procedure "adjust_suff_temp" ref 2126 2132 pt parameter pointer dcl 1998 in procedure "get_length_in_storage" ref 1995 2001 pt parameter pointer dcl 2019 in procedure "get_suffix_length" ref 2016 2022 pt parameter pointer dcl 67 in procedure "assign_op" set ref 63 289 1850 1857* 1864 1868 1876* 1883 1888 pt parameter pointer dcl 1970 in procedure "get_length" ref 1967 1973 pt parameter pointer dcl 2044 in procedure "expmac_length_of_varying" ref 2040 2050 ptr_convert 000050 constant fixed bin(15,0) initial array dcl 232 ref 1621 q 000244 automatic pointer dcl 1971 in procedure "get_length" set ref 1973* 1975 1976 1977 1978 1980* 1980 1983 1983 1983 1987 q 000102 automatic pointer dcl 2146 in procedure "adjust_suff_op" set ref 2152* 2153 2153 2160* 2163 2163 2163* q 000270 automatic pointer dcl 2020 in procedure "get_suffix_length" set ref 2024* 2026 2027* 2030 2030* 2030* 2033 q 000114 automatic pointer dcl 70 in procedure "assign_op" set ref 365* 369 369 370 377 378 544* 545 546 547 548 1056* 1057 1059 1062* 1070* 1070* 1136* 1143* 1158 1158* 1328* 1329 1330 1331 1349* 1350 1350 q 11(10) based bit(1) level 4 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" ref 659 671 q1 000246 automatic pointer dcl 1971 in procedure "get_length" set ref 1977* 1978 1978* q1 000116 automatic pointer dcl 70 in procedure "assign_op" set ref 1072* 1073 1076* 1090 1090* 1114 1119 1129 1129* 1169 1170* q2 000120 automatic pointer dcl 70 set ref 484* 485 485* 485 488 490* 490* 492 493 512 514 517 1090* 1092* 1131* 1150* qualifier 4 based pointer level 2 packed packed unaligned dcl 4-3 ref 2116 2116 real_fix_bin_1 constant fixed bin(15,0) initial dcl 9-1 ref 593 602 1334 1388 1390 1478 1498 1758 real_fix_bin_2 constant fixed bin(15,0) initial dcl 9-1 ref 892 1325 1464 1474 2030 real_fix_dec constant fixed bin(15,0) initial dcl 9-1 ref 508 real_flt_bin_1 constant fixed bin(15,0) initial dcl 9-1 ref 674 677 real_flt_bin_2 constant fixed bin(15,0) initial dcl 9-1 ref 434 674 ref_count 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 4-3 set ref 295 399 399* 414* 414 463 590 880* 880 885 950* 950 963* 963 1100* 1100 1103 1224* 1224 1350 1415* 1415 1454* 1454 1521* 1532 1754* 1754 1773* 1773 1821* 1821 1823* 1823 1942 1983* 1983 2068* 2068 2153 reference based structure level 1 dcl 4-3 reference_node constant bit(9) initial dcl 7-5 ref 2163 refs_are_same 000201 automatic bit(1) dcl 80 set ref 896* 899 916 reloc_hold 000303 automatic bit(12) dcl 2048 set ref 2060* 2080 relocation 12(24) based bit(12) level 2 packed packed unaligned dcl 4-3 set ref 2060 2080* rflb1_to_cflb1 000062 constant fixed bin(15,0) initial dcl 180 set ref 1741* right_constant 000174 automatic bit(1) dcl 79 set ref 310* 363* 1001 s1 000106 automatic pointer dcl 70 set ref 303* 307 308 322 622 1386 1394 1396 1431 1626 1636 1660 1674 1681 1687 1711 1711 1871* 1889* 1893 2181 2190 2203 s2 000110 automatic pointer dcl 70 set ref 305* 314 319 320 348 350 352 365 604 606 614 614 622 642 856 856 1019 1484 1495 1563 1604 1626 1636 1638 1638 1641 1660 1675 1682 1688 1792 1869* 1870 1870 1874 1890* 1911 sbfx1 constant fixed bin(15,0) initial dcl 180 ref 1121 scale 2(28) based fixed bin(7,0) level 2 packed packed unaligned dcl 5-3 set ref 307 319 1674* 1675* 1681* 1682* 1687* 1688* 1874 1893 scale1 000147 automatic fixed bin(17,0) dcl 75 set ref 307* 662 720 1360 1631 1665 1665 1669 1670 1674 1680 1687 1694 1694 1694 1725 1747 scale2 000150 automatic fixed bin(17,0) dcl 75 set ref 319* 662 1464 1468 1470 1631 1665 1665 1669 1670 1674 1680 1688 1696 1725 1736 set_label_const 000060 constant fixed bin(15,0) initial array dcl 180 ref 1805 shared 0(11) based bit(1) level 2 packed packed unaligned dcl 4-3 ref 880 919 921 950 1100 1158 1224 1418 1425 1579 1590 1607 1705 1773 1821 1823 1895 1978 1983 2068 2163 signal_stringsize constant fixed bin(15,0) initial dcl 180 ref 2220 size 16 based fixed bin(8,0) level 3 dcl 10-6 set ref 631 633 651* 1025* 1245 1249 1257 1275 1299* 1307 1307* 1512* size1 000142 automatic fixed bin(17,0) dcl 74 set ref 600* 614 614 614 614 614* 633 651 728* 729 736 774 781 784 789 789 944 946 977 993 995 1013 1019 1020 1227 1227 1245 1249 1250* 1259 1269 1278 1278 1301 1461* 1918 1921 1921 1933 1935 1935 size2 000143 automatic fixed bin(17,0) dcl 74 set ref 340* 377 378 679* 1019 1025 1210 1216* 1227 1227 1301 1354 1355 1443* 1512* size_check_fx1 constant fixed bin(15,0) initial dcl 180 ref 1398 size_check_uns_fx1 constant fixed bin(15,0) initial dcl 180 ref 1396 size_ck_decimal constant fixed bin(15,0) initial dcl 180 ref 2203 size_ck_macro 000216 automatic fixed bin(15,0) dcl 88 set ref 1396* 1398* 1401* size_ck_suffix constant fixed bin(15,0) initial dcl 180 ref 1125 size_ck_suffix_1 constant fixed bin(15,0) initial dcl 180 ref 1145 size_ck_varying constant fixed bin(15,0) initial dcl 180 ref 888 source parameter pointer dcl 1853 set ref 1850 1856* 1883 1887 sta constant fixed bin(15,0) initial dcl 180 ref 1227 1232 1523 stack_temp$assign_temp 000202 constant entry external dcl 159 ref 397 state_man$erase_reg 000204 constant entry external dcl 160 ref 1111 1350 1360 state_man$flush_ref 000206 constant entry external dcl 161 ref 811 990 1336 1833 state_man$flush_sym 000210 constant entry external dcl 162 ref 840 955 statement based structure level 1 dcl 2-9 stfx1 constant fixed bin(15,0) initial dcl 180 set ref 914* 1236 1857 storage 11(23) based bit(1) level 4 packed packed unaligned dcl 4-3 set ref 1213* 1522* 1905* storage_block 31(12) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 322 storage_class 32(09) based structure level 3 packed packed unaligned dcl 5-3 store 000212 constant entry external dcl 163 ref 1304 1410 store$all_ones 000214 constant entry external dcl 164 ref 1301 store$force 000216 constant entry external dcl 165 ref 1786 store$save_string_temp 000220 constant entry external dcl 166 ref 416 424 store_lv constant fixed bin(15,0) initial dcl 180 ref 1817 string builtin function dcl 170 set ref 2052 2059 2076 2079* substr builtin function dcl 170 set ref 342 369 370 614 614 993* 1019* 1836* 1911 suppress_warnings 13(08) based bit(1) level 3 packed packed unaligned dcl 2-9 ref 2218 symbol 3 based pointer level 2 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" ref 303 305 558 840 955 1869 1871 1889 1890 2110 2110 symbol based structure level 1 dcl 5-3 in procedure "assign_op" tag 000203 automatic bit(4) dcl 82 in procedure "assign_op" set ref 1136* 1152* 1167 tag 10(30) based bit(6) level 3 in structure "reference" packed packed unaligned dcl 4-3 in procedure "assign_op" set ref 1099 1167* 1230 1836* temp_ref 12(11) based bit(1) level 3 packed packed unaligned dcl 4-3 set ref 298 360 382 959 972 1334 1350 1415 1425 1431 1519* 1575 1575 1597 1600 1604 1607 1612 1705 1711 1754 1905 2052 2076 top 000132 automatic pointer dcl 73 set ref 2133* 2134* 2163 truncate 000054 constant fixed bin(15,0) initial array dcl 180 ref 2095 type based bit(9) level 2 in structure "node" packed packed unaligned dcl 7-27 in procedure "assign_op" ref 298 298 314 459 485 586 709 1037 1976 2151 2163 type parameter fixed bin(17,0) dcl 2091 in procedure "scaler" ref 2088 2095 2097 type1 000137 automatic fixed bin(17,0) dcl 74 set ref 315* 323* 325 325 328* 333 413 437 544 583 593 602 674 674 675* 713 728 1259 1289 1328 1334 1388 1449 1455 1455 1539 1539* 1549 1568 1597 1621 1629 1668 1728 1741 1758 1765 1788 type2 000140 automatic fixed bin(17,0) dcl 74 set ref 312* 323 325 335 335 340 342 367 413 434 437 439 441 496 508 534 540 544 583 677 1325* 1328 1390 1444* 1464 1468* 1474 1478 1498 1534 1542 1570* 1597 1597 1604 1621 1629 1668 1728 1770 1770 1794 1794 1808 unaligned 31(22) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 1636 1636 1638 units 0(14) based fixed bin(3,0) level 2 packed packed unaligned dcl 4-3 ref 736 992 1012 units_per_wrd 000160 automatic fixed bin(17,0) dcl 76 set ref 1640* 1648* 1652* 1656 1656 1656 1656 unpack constant bit(9) initial dcl 11-8 ref 1435 unpacked_ptr constant fixed bin(15,0) initial dcl 9-1 ref 1534 1539 1542 1549 1604 1765 1776 1780 uns_fx1_to_bs constant fixed bin(15,0) initial dcl 180 ref 1484 unsigned 31(24) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 622 622 642 1396 1484 1495 value 0(01) 000224 automatic fixed bin(7,0) level 2 packed packed unaligned dcl 246 set ref 1680* 1694* 1696* 1874* 1893* value_in 11(09) based structure level 3 packed packed unaligned dcl 4-3 variable 3 based pointer array level 3 packed packed unaligned dcl 10-6 ref 1349 varying 31(26) based bit(1) level 4 packed packed unaligned dcl 5-3 ref 350 varying_ref 0(10) based bit(1) level 2 packed packed unaligned dcl 4-3 ref 446 467 512 754 767 796 804 837 852 930 1042 1129 1178 1185 1221 1314 1516 2027 verify builtin function dcl 170 ref 369 which_base 000017 constant fixed bin(17,0) initial array dcl 8-14 ref 1611 word based bit(36) dcl 86 ref 614 614 word_ constant fixed bin(3,0) initial dcl 12-5 ref 736 xr_man$load_const 000222 constant entry external dcl 167 ref 1394 2094 zero_bs constant fixed bin(15,0) initial dcl 180 ref 1949 zero_cs constant fixed bin(15,0) initial dcl 180 ref 1934 zero_cs_q constant fixed bin(15,0) initial dcl 180 ref 1945 zero_mac constant fixed bin(15,0) initial dcl 180 ref 809 946 1338 zero_mac_p_1 constant fixed bin(15,0) initial dcl 180 ref 948 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_format internal static bit(9) initial dcl 11-8 ab defined bit(3) dcl 8-9 abs_fun internal static bit(9) initial dcl 11-8 acos_fun internal static bit(9) initial dcl 11-8 acosd_fun internal static bit(9) initial dcl 11-8 add internal static bit(9) initial dcl 11-8 addbitno_fun internal static bit(9) initial dcl 11-8 addcharno_fun internal static bit(9) initial dcl 11-8 addr_fun internal static bit(9) initial dcl 11-8 addr_fun_bits internal static bit(9) initial dcl 11-8 addrel_fun internal static bit(9) initial dcl 11-8 allocation_fun internal static bit(9) initial dcl 11-8 allot_auto internal static bit(9) initial dcl 11-8 allot_based internal static bit(9) initial dcl 11-8 allot_ctl internal static bit(9) initial dcl 11-8 allot_var internal static bit(9) initial dcl 11-8 and_bits internal static bit(9) initial dcl 11-8 ap defined bit(3) dcl 8-4 array_node internal static bit(9) initial dcl 7-5 asin_fun internal static bit(9) initial dcl 11-8 asind_fun internal static bit(9) initial dcl 11-8 assign_by_name internal static bit(9) initial dcl 11-8 assign_zero internal static bit(9) initial dcl 11-8 atan_fun internal static bit(9) initial dcl 11-8 atand_fun internal static bit(9) initial dcl 11-8 b_format internal static bit(9) initial dcl 11-8 baseno_fun internal static bit(9) initial dcl 11-8 baseptr_fun internal static bit(9) initial dcl 11-8 bb defined bit(3) dcl 8-9 bit_ internal static fixed bin(3,0) initial dcl 12-5 bit_pointer internal static bit(9) initial dcl 11-8 bit_to_char internal static bit(9) initial dcl 11-8 bit_to_word internal static bit(9) initial dcl 11-8 bitno_fun internal static bit(9) initial dcl 11-8 bits_per_four_words internal static fixed bin(8,0) initial dcl 1-5 bits_per_half 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 7-5 bn_format internal static bit(9) initial dcl 11-8 bool_fun internal static bit(9) initial dcl 11-8 bound_ck internal static bit(9) initial dcl 11-8 bound_node internal static bit(9) initial dcl 7-5 break_even_words internal static fixed bin(8,0) initial dcl 1-5 by_name_agg_node internal static bit(9) initial dcl 7-5 byte_fun internal static bit(9) initial dcl 11-8 c_format internal static bit(9) initial dcl 11-8 ceil_fun internal static bit(9) initial dcl 11-8 char_to_word internal static bit(9) initial dcl 11-8 character_ internal static fixed bin(3,0) initial dcl 12-5 charno_fun internal static bit(9) initial dcl 11-8 clock_fun internal static bit(9) initial dcl 11-8 close_file internal static bit(9) initial dcl 11-8 codeptr_fun internal static bit(9) initial dcl 11-8 column_format internal static bit(9) initial dcl 11-8 complex_fix_bin_1 internal static fixed bin(15,0) initial dcl 9-1 complex_fix_bin_2 internal static fixed bin(15,0) initial dcl 9-1 complex_fix_dec internal static fixed bin(15,0) initial dcl 9-1 complex_flt_bin_2 internal static fixed bin(15,0) initial dcl 9-1 complex_fun internal static bit(9) initial dcl 11-8 conjg_fun internal static bit(9) initial dcl 11-8 context_node internal static bit(9) initial dcl 7-5 copy_string internal static bit(9) initial dcl 11-8 copy_words internal static bit(9) initial dcl 11-8 cos_fun internal static bit(9) initial dcl 11-8 cosd_fun internal static bit(9) initial dcl 11-8 cross_reference_node internal static bit(9) initial dcl 7-5 default_fix_bin_p internal static fixed bin(8,0) initial dcl 1-5 default_node internal static bit(9) initial dcl 7-5 delete_file internal static bit(9) initial dcl 11-8 desc_size internal static bit(9) initial dcl 11-8 digit_ internal static fixed bin(3,0) initial dcl 12-5 digit_to_bit internal static bit(9) initial dcl 11-8 div internal static bit(9) initial dcl 11-8 do_fun internal static bit(9) initial dcl 11-8 do_spec internal static bit(9) initial dcl 11-8 e_format internal static bit(9) initial dcl 11-8 empty_area internal static bit(9) initial dcl 11-8 enable_on internal static bit(9) initial dcl 11-8 environmentptr_fun internal static bit(9) initial dcl 11-8 equal internal static bit(9) initial dcl 11-8 ex_prologue internal static bit(9) initial dcl 11-8 exp internal static bit(9) initial dcl 11-8 exp_fun internal static bit(9) initial dcl 11-8 f_format internal static bit(9) initial dcl 11-8 floor_fun internal static bit(9) initial dcl 11-8 format_value_node internal static bit(9) initial dcl 7-5 fortran_read internal static bit(9) initial dcl 11-8 fortran_write internal static bit(9) initial dcl 11-8 free_based internal static bit(9) initial dcl 11-8 free_ctl internal static bit(9) initial dcl 11-8 free_var internal static bit(9) initial dcl 11-8 ftn_file_manip internal static bit(9) initial dcl 11-8 ftn_trans_loop internal static bit(9) initial dcl 11-8 get_data_trans internal static bit(9) initial dcl 11-8 get_edit_trans internal static bit(9) initial dcl 11-8 get_file internal static bit(9) initial dcl 11-8 get_list_trans internal static bit(9) initial dcl 11-8 get_string internal static bit(9) initial dcl 11-8 greater_or_equal internal static bit(9) initial dcl 11-8 greater_than internal static bit(9) initial dcl 11-8 half_ internal static fixed bin(3,0) initial dcl 12-5 half_to_word internal static bit(9) initial dcl 11-8 imag_fun internal static bit(9) initial dcl 11-8 ind_decimal_reg internal static fixed bin(17,0) initial dcl 10-68 ind_known_refs internal static fixed bin(17,0) initial dcl 10-68 ind_logical internal static fixed bin(17,0) initial dcl 10-68 ind_string_aq internal static fixed bin(17,0) initial dcl 10-68 ind_x internal static fixed bin(17,0) initial array dcl 10-68 index_after_fun internal static bit(9) initial dcl 11-8 index_before_fun internal static bit(9) initial dcl 11-8 index_fun internal static bit(9) initial dcl 11-8 index_rev_fun internal static bit(9) initial dcl 11-8 int_entry_other internal static fixed bin(15,0) initial dcl 9-1 join internal static bit(9) initial dcl 11-8 jump internal static bit(9) initial dcl 11-8 jump_false internal static bit(9) initial dcl 11-8 jump_if_eq internal static bit(9) initial dcl 11-8 jump_if_ge internal static bit(9) initial dcl 11-8 jump_if_gt internal static bit(9) initial dcl 11-8 jump_if_le internal static bit(9) initial dcl 11-8 jump_if_lt internal static bit(9) initial dcl 11-8 jump_if_ne internal static bit(9) initial dcl 11-8 jump_true internal static bit(9) initial dcl 11-8 l_parn internal static bit(9) initial dcl 11-8 label_array_element_node internal static bit(9) initial dcl 7-5 label_size internal static fixed bin(8,0) initial dcl 1-5 label_variable internal static fixed bin(15,0) initial dcl 9-1 lb defined bit(3) dcl 8-9 length_fun internal static bit(9) initial dcl 11-8 less_or_equal internal static bit(9) initial dcl 11-8 less_than internal static bit(9) initial dcl 11-8 line_format internal static bit(9) initial dcl 11-8 list_node internal static bit(9) initial dcl 7-5 locate_file internal static bit(9) initial dcl 11-8 lock_file internal static bit(9) initial dcl 11-8 lock_fun internal static bit(9) initial dcl 11-8 log10_fun internal static bit(9) initial dcl 11-8 log2_fun internal static bit(9) initial dcl 11-8 log_fun internal static bit(9) initial dcl 11-8 loop internal static bit(9) initial dcl 11-8 lp defined bit(3) dcl 8-4 machine_state_node internal static bit(9) initial dcl 7-5 make_desc internal static bit(9) initial dcl 11-8 max_block_number internal static fixed bin(17,0) initial dcl 6-74 max_fun internal static bit(9) initial dcl 11-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 3-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 max_short_size internal static fixed bin(8,0) initial array dcl 1-5 min_fun internal static bit(9) initial dcl 11-8 mod2_ internal static fixed bin(3,0) initial dcl 12-5 mod4_ internal static fixed bin(3,0) initial dcl 12-5 mod_bit internal static bit(9) initial dcl 11-8 mod_byte internal static bit(9) initial dcl 11-8 mod_fun internal static bit(9) initial dcl 11-8 mod_half internal static bit(9) initial dcl 11-8 mod_word internal static bit(9) initial dcl 11-8 mult internal static bit(9) initial dcl 11-8 negate internal static bit(9) initial dcl 11-8 nop internal static bit(9) initial dcl 11-8 not_bits internal static bit(9) initial dcl 11-8 not_equal internal static bit(9) initial dcl 11-8 off_fun internal static bit(9) initial dcl 11-8 open_file internal static bit(9) initial dcl 11-8 or_bits internal static bit(9) initial dcl 11-8 packed_digits_per_char internal static fixed bin(8,0) initial dcl 1-5 page_format internal static bit(9) initial dcl 11-8 param_desc_ptr internal static bit(9) initial dcl 11-8 param_ptr internal static bit(9) initial dcl 11-8 picture_format internal static bit(9) initial dcl 11-8 pl1_mod_fun internal static bit(9) initial dcl 11-8 prefix_plus internal static bit(9) initial dcl 11-8 ptr_fun internal static bit(9) initial dcl 11-8 put_control internal static bit(9) initial dcl 11-8 put_data_trans internal static bit(9) initial dcl 11-8 put_edit_trans internal static bit(9) initial dcl 11-8 put_field internal static bit(9) initial dcl 11-8 put_field_chk internal static bit(9) initial dcl 11-8 put_file internal static bit(9) initial dcl 11-8 put_list_trans internal static bit(9) initial dcl 11-8 put_string internal static bit(9) initial dcl 11-8 r_format internal static bit(9) initial dcl 11-8 r_parn internal static bit(9) initial dcl 11-8 range_ck internal static bit(9) initial dcl 11-8 rank_fun internal static bit(9) initial dcl 11-8 read_file internal static bit(9) initial dcl 11-8 real_flt_dec internal static fixed bin(15,0) initial dcl 9-1 real_fun internal static bit(9) initial dcl 11-8 record_io internal static bit(9) initial dcl 11-8 refer internal static bit(9) initial dcl 11-8 rel_fun internal static bit(9) initial dcl 11-8 repeat_fun internal static bit(9) initial dcl 11-8 return_bits internal static bit(9) initial dcl 11-8 return_string internal static bit(9) initial dcl 11-8 return_value internal static bit(9) initial dcl 11-8 return_words internal static bit(9) initial dcl 11-8 reverse_fun internal static bit(9) initial dcl 11-8 revert_on internal static bit(9) initial dcl 11-8 rewrite_file internal static bit(9) initial dcl 11-8 round_fun internal static bit(9) initial dcl 11-8 sb defined bit(3) dcl 8-9 search_fun internal static bit(9) initial dcl 11-8 search_rev_fun internal static bit(9) initial dcl 11-8 segno_fun internal static bit(9) initial dcl 11-8 setbitno_fun internal static bit(9) initial dcl 11-8 setcharno_fun internal static bit(9) initial dcl 11-8 sf_par_node internal static bit(9) initial dcl 7-5 sign_fun internal static bit(9) initial dcl 11-8 signal_on internal static bit(9) initial dcl 11-8 sin_fun internal static bit(9) initial dcl 11-8 sind_fun internal static bit(9) initial dcl 11-8 skip_format internal static bit(9) initial dcl 11-8 source_node internal static bit(9) initial dcl 7-5 sp defined bit(3) dcl 8-4 sqrt_fun internal static bit(9) initial dcl 11-8 stack_ptr internal static bit(9) initial dcl 11-8 stackbaseptr_fun internal static bit(9) initial dcl 11-8 stackframeptr_fun internal static bit(9) initial dcl 11-8 stacq_fun internal static bit(9) initial dcl 11-8 statement_node internal static bit(9) initial dcl 7-5 std_arg_list internal static bit(9) initial dcl 11-8 std_call internal static bit(9) initial dcl 11-8 std_entry internal static bit(9) initial dcl 11-8 std_return internal static bit(9) initial dcl 11-8 stop internal static bit(9) initial dcl 11-8 stream_prep internal static bit(9) initial dcl 11-8 sub internal static bit(9) initial dcl 11-8 symbol_node internal static bit(9) initial dcl 7-5 tan_fun internal static bit(9) initial dcl 11-8 tand_fun internal static bit(9) initial dcl 11-8 temporary_node internal static bit(9) initial dcl 7-5 terminate_trans internal static bit(9) initial dcl 11-8 token_node internal static bit(9) initial dcl 7-5 translate_fun internal static bit(9) initial dcl 11-8 trunc_fun internal static bit(9) initial dcl 11-8 units_per_word internal static fixed bin(8,0) initial array dcl 1-5 unlock_file internal static bit(9) initial dcl 11-8 vclock_fun internal static bit(9) initial dcl 11-8 verify_fun internal static bit(9) initial dcl 11-8 verify_ltrim_fun internal static bit(9) initial dcl 11-8 verify_rev_fun internal static bit(9) initial dcl 11-8 verify_rtrim_fun internal static bit(9) initial dcl 11-8 word_to_mod2 internal static bit(9) initial dcl 11-8 word_to_mod4 internal static bit(9) initial dcl 11-8 word_to_mod8 internal static bit(9) initial dcl 11-8 wordno_fun internal static bit(9) initial dcl 11-8 write_file internal static bit(9) initial dcl 11-8 x_format internal static bit(9) initial dcl 11-8 xor_bits internal static bit(9) initial dcl 11-8 NAMES DECLARED BY EXPLICIT CONTEXT. A 000000 constant label array(0:7) dcl 565 ref 561 1445 A1a 001233 constant label dcl 573 ref 583 586 590 593 656 659 662 671 683 A1b 001551 constant label dcl 656 ref 609 611 A5a 002042 constant label dcl 754 ref 741 743 745 A5c 002161 constant label dcl 793 ref 754 757 759 762 765 767 769 771 774 778 781 A5ca 002164 constant label dcl 796 ref 1037 B 000010 constant label array(7) dcl 1378 ref 578 690 702 709 722 1331 1374 1736 1747 B2b 005375 constant label dcl 1449 ref 1717 B3a 005726 constant label dcl 1512 ref 1492 B3b 005601 constant label dcl 1495 ref 1471 B4a 006603 constant label dcl 1660 ref 1629 1631 1633 B4b 006752 constant label dcl 1705 ref 1626 CONVERT_UNPACKED_PTR_TO_SOMETHING 006244 constant label dcl 1597 ref 1560 LABEL_ENTRY_OR_PTR 006027 constant label dcl 1532 ref 540 adjust_suff_op 011241 constant entry internal dcl 2142 ref 2134 2156 adjust_suff_temp 011207 constant entry internal dcl 2126 ref 1083 assign_decimal 011352 constant entry internal dcl 2175 ref 1665 1685 1699 1875 1894 assign_op 000114 constant entry external dcl 63 assign_op$fix_dec_scaled 010034 constant entry external dcl 1864 assign_op$length_of_varying 007774 constant entry external dcl 1850 assign_op$to_dec_scaled 010122 constant entry external dcl 1883 check_stringsize 011536 constant entry internal dcl 2214 ref 748 1527 chk 002274 constant label dcl 834 ref 796 chk_temp 000476 constant label dcl 382 ref 335 348 350 352 354 356 358 360 compare_refs 011104 constant entry internal dcl 2105 ref 896 1062 done 005216 constant label dcl 1412 ref 428 567 790 812 842 925 968 999 1174 1242 1310 1339 1457 1554 1593 1602 1616 1657 1702 1762 1767 1789 1806 1845 eis_move 010167 constant entry internal dcl 1902 ref 841 957 elim 001053 constant label dcl 522 ref 475 499 534 expmac_length_of_varying 010657 constant entry internal dcl 2040 ref 914 1121 1129 1163 1240 1857 fake_bit 001373 constant label dcl 619 ref 606 668 get_info 000667 constant label dcl 430 ref 382 385 387 401 406 417 get_length 010471 constant entry internal dcl 1967 ref 849 865 2001 get_length_in_storage 010547 constant entry internal dcl 1995 ref 847 2024 get_suffix_length 010602 constant entry internal dcl 2016 ref 1090 1092 gi 001125 constant label dcl 540 ref 430 437 439 441 444 446 448 459 461 463 467 469 529 gt 000245 constant label dcl 303 ref 526 l0 005104 constant label dcl 1382 ref 1622 l1 005115 constant label dcl 1386 ref 653 697 715 1732 1743 1752 l10 002512 constant label dcl 885 ref 862 l11 002571 constant label dcl 896 ref 856 870 882 l4 004133 constant label dcl 1178 ref 1042 1053 1057 1059 1062 l9 002300 constant label dcl 837 ref 802 804 815 832 lab_or_ent 007134 constant label dcl 1754 ref 316 1534 le_1 007470 constant label dcl 1808 ref 1794 le_2 007472 constant label dcl 1810 ref 1798 lg 002300 constant label dcl 837 ref 1186 1189 1197 1524 now_fx2 004654 constant label dcl 1325 ref 1363 pad 004467 constant label dcl 1284 ref 1262 repair 001124 constant label dcl 537 ref 496 508 512 514 517 scaler 011013 constant entry internal dcl 2088 ref 1468 1729 short_eis 002747 constant label dcl 940 ref 626 930 933 1202 1207 1210 st 004556 constant label dcl 1301 ref 1245 1252 1259 1289 string_store_check 004377 constant label dcl 1245 ref 680 string_store_work 004254 constant label dcl 1221 ref 823 828 974 982 1004 1015 1027 1031 1034 1190 1529 zm 004714 constant label dcl 1336 ref 977 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 13026 13256 11762 13036 Length 14160 11762 230 666 1043 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME assign_op 402 external procedure is an external procedure. eis_move internal procedure shares stack frame of external procedure assign_op. get_length internal procedure shares stack frame of external procedure assign_op. get_length_in_storage internal procedure shares stack frame of external procedure assign_op. get_suffix_length internal procedure shares stack frame of external procedure assign_op. expmac_length_of_varying internal procedure shares stack frame of external procedure assign_op. scaler internal procedure shares stack frame of external procedure assign_op. compare_refs internal procedure shares stack frame of external procedure assign_op. adjust_suff_temp internal procedure shares stack frame of external procedure assign_op. adjust_suff_op 93 internal procedure calls itself recursively. assign_decimal internal procedure shares stack frame of external procedure assign_op. check_stringsize internal procedure shares stack frame of external procedure assign_op. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME adjust_suff_op 000100 p adjust_suff_op 000102 q adjust_suff_op 000104 i adjust_suff_op assign_op 000100 p assign_op 000102 p1 assign_op 000104 p2 assign_op 000106 s1 assign_op 000110 s2 assign_op 000112 b2 assign_op 000114 q assign_op 000116 q1 assign_op 000120 q2 assign_op 000122 exp_pt assign_op 000124 arg assign_op 000132 top assign_op 000134 a assign_op 000135 b assign_op 000136 i assign_op 000137 type1 assign_op 000140 type2 assign_op 000141 k assign_op 000142 size1 assign_op 000143 size2 assign_op 000144 length1 assign_op 000145 length2 assign_op 000146 aq_used assign_op 000147 scale1 assign_op 000150 scale2 assign_op 000151 prec1 assign_op 000152 prec2 assign_op 000153 ds assign_op 000154 d assign_op 000155 dt assign_op 000156 cfo assign_op 000157 orig_count assign_op 000160 units_per_wrd assign_op 000161 atomic assign_op 000162 all_blanks assign_op 000163 all_ones assign_op 000164 all_zeros assign_op 000165 all_same assign_op 000166 loaded assign_op 000167 last_macro assign_op 000170 hard1 assign_op 000171 hard2 assign_op 000172 here_before assign_op 000173 load_it assign_op 000174 right_constant assign_op 000175 check_size assign_op 000176 no_store assign_op 000177 pack_char_pic assign_op 000200 always_round assign_op 000201 refs_are_same assign_op 000202 base assign_op 000203 tag assign_op 000204 op_code assign_op 000205 full_word assign_op 000206 c_length assign_op 000210 double_string assign_op 000212 m1 assign_op 000213 m2 assign_op 000214 macro assign_op 000215 bump_mac assign_op 000216 size_ck_macro assign_op 000220 load_prog assign_op 000224 exponent assign_op 000226 m_s_p assign_op 000244 q get_length 000246 q1 get_length 000256 p get_length_in_storage 000266 p get_suffix_length 000270 q get_suffix_length 000300 p expmac_length_of_varying 000302 addr_hold expmac_length_of_varying 000303 reloc_hold expmac_length_of_varying 000326 p adjust_suff_temp 000336 mac assign_decimal 000337 ninst assign_decimal 000340 arg assign_decimal THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as r_ne_as r_ge_a alloc_bit_temp call_ent_var call_ext_out_desc call_ext_out call_int_this call_int_other return_mac mdfx1 shorten_stack ext_entry int_entry trunc_fx1 verify_eis scaled_mod_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. adjust_ref_count aq_man$check_strings aq_man$left_shift aq_man$lock aq_man$right_shift aq_man$trim_aq base_man$load_any_var base_man$load_packed base_man$load_var base_man$store_ptr_to base_man$update_base base_to_core c_a compare_expression compile_exp compile_exp$save compile_exp$save_exp convert_arithmetic convert_chars copy_temp decimal_op$get_float_temp error expmac expmac$many expmac$many_eis expmac$one expmac$one_eis expmac$two_eis expmac$zero fixed_to_float float_to_fixed generate_constant generate_constant$bit_string generate_constant$char_string generate_constant$real_fix_bin_1 get_imaginary get_single_ref load load$for_store load$long_string load$short_string load_size load_size$xr_or_aq long_op$extend_stack long_op$one_eis m_a make_both_addressable make_n_addressable move_data$move_block need_temp picture_op prepare_operand stack_temp$assign_temp state_man$erase_reg state_man$flush_ref state_man$flush_sym store store$all_ones store$force store$save_string_temp xr_man$load_const THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. assign_info$assign_info cg_stat$cur_level cg_stat$cur_statement cg_stat$cur_tree cg_stat$null_value cg_stat$packed_null_value cg_stat$save_exp_called cg_stat$temp_ref cg_stat$text_base cg_stat$text_pos cg_static_$m_s_p LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 3 000103 63 000111 284 000122 286 000127 289 000142 290 000146 291 000152 292 000155 294 000161 295 000201 297 000205 298 000211 300 000243 303 000245 305 000250 307 000253 308 000257 310 000261 312 000262 314 000266 315 000272 316 000276 319 000277 320 000303 322 000305 323 000312 324 000317 325 000321 327 000340 328 000341 331 000345 333 000347 335 000352 339 000357 340 000361 342 000364 347 000402 348 000405 350 000411 352 000414 354 000417 356 000422 358 000425 360 000427 363 000432 365 000434 367 000436 368 000441 369 000443 370 000451 372 000457 373 000460 375 000462 377 000463 378 000471 382 000476 385 000502 387 000505 392 000510 394 000513 396 000520 397 000523 399 000534 401 000544 404 000545 405 000550 406 000552 413 000553 414 000556 415 000563 416 000577 417 000606 420 000607 423 000623 424 000637 426 000650 428 000666 430 000667 434 000672 437 000700 439 000702 441 000704 444 000706 446 000710 448 000713 451 000717 459 000720 461 000724 463 000731 466 000740 467 000742 469 000745 475 000751 484 000755 485 000760 488 000766 490 000772 492 001010 493 001014 495 001017 496 001021 499 001031 508 001032 512 001042 514 001045 517 001050 522 001053 524 001057 525 001061 526 001100 528 001101 529 001120 534 001121 537 001124 540 001125 544 001130 545 001137 546 001142 547 001146 548 001152 550 001155 551 001157 552 001161 558 001162 561 001205 565 001207 567 001226 571 001227 573 001233 576 001250 578 001257 583 001261 586 001264 590 001273 593 001300 600 001311 602 001313 604 001316 606 001322 609 001331 611 001335 614 001337 619 001373 622 001375 625 001423 626 001425 629 001426 631 001440 633 001444 634 001447 635 001450 636 001461 637 001464 638 001465 639 001466 642 001503 644 001512 647 001514 651 001542 652 001545 653 001550 656 001551 659 001555 662 001560 667 001563 668 001565 671 001566 674 001572 675 001576 677 001606 679 001621 680 001624 683 001625 687 001626 690 001642 694 001644 696 001647 697 001660 700 001661 701 001670 702 001671 706 001673 708 001676 709 001707 713 001713 714 001716 715 001727 718 001730 719 001743 720 001745 722 001751 726 001753 728 001756 729 001761 731 001765 732 002000 734 002002 735 002006 736 002013 741 002030 743 002033 745 002036 748 002041 754 002042 757 002047 759 002053 762 002056 765 002060 767 002064 769 002067 771 002072 774 002075 778 002106 781 002111 784 002122 786 002127 789 002141 790 002160 793 002161 796 002164 802 002167 804 002173 807 002176 808 002200 809 002203 810 002216 811 002220 812 002227 815 002230 818 002234 820 002241 821 002243 822 002246 823 002256 826 002257 827 002262 828 002272 832 002273 834 002274 837 002300 840 002303 841 002315 842 002316 847 002317 849 002327 852 002331 854 002334 856 002343 859 002356 862 002367 865 002370 867 002372 869 002402 870 002432 872 002433 874 002445 877 002462 879 002474 880 002500 882 002511 885 002512 888 002532 890 002540 892 002542 894 002560 896 002571 899 002573 909 002602 910 002617 911 002621 914 002636 916 002640 919 002662 921 002700 925 002716 930 002717 933 002722 936 002726 940 002747 944 002761 946 002771 948 002777 950 003001 952 003011 955 003022 957 003034 959 003035 962 003057 963 003063 965 003072 968 003102 969 003103 970 003104 972 003106 973 003111 974 003121 977 003122 981 003130 982 003140 990 003141 991 003150 992 003152 993 003170 995 003174 996 003201 997 003224 998 003235 999 003252 1001 003253 1002 003255 1003 003260 1004 003270 1012 003271 1013 003306 1014 003312 1015 003322 1018 003323 1019 003325 1020 003335 1021 003342 1023 003365 1024 003402 1025 003405 1026 003407 1027 003413 1030 003414 1031 003424 1034 003425 1037 003426 1042 003432 1053 003434 1056 003441 1057 003444 1059 003446 1062 003451 1070 003456 1072 003475 1073 003517 1076 003541 1083 003555 1090 003562 1092 003571 1097 003573 1099 003606 1100 003612 1102 003622 1103 003637 1111 003657 1112 003670 1113 003705 1114 003707 1115 003711 1116 003713 1117 003730 1119 003733 1120 003737 1121 003746 1125 003752 1127 003760 1129 003762 1131 003770 1136 004001 1138 004012 1139 004014 1140 004017 1143 004020 1145 004027 1147 004035 1150 004037 1152 004050 1154 004052 1155 004054 1158 004057 1163 004075 1167 004077 1168 004105 1169 004107 1170 004112 1172 004125 1174 004132 1178 004133 1182 004165 1185 004174 1186 004177 1189 004203 1190 004207 1197 004212 1202 004216 1205 004220 1207 004224 1210 004227 1213 004235 1215 004237 1216 004250 1221 004254 1224 004257 1227 004270 1228 004315 1230 004333 1231 004340 1232 004353 1233 004355 1235 004356 1236 004370 1239 004372 1240 004374 1242 004376 1245 004377 1249 004403 1250 004404 1252 004415 1257 004416 1259 004421 1262 004432 1269 004433 1274 004437 1275 004452 1278 004455 1280 004463 1283 004465 1284 004467 1286 004476 1289 004501 1292 004504 1294 004534 1295 004540 1296 004547 1299 004552 1301 004556 1304 004573 1307 004602 1310 004612 1314 004613 1317 004622 1319 004634 1321 004643 1325 004654 1328 004656 1329 004665 1330 004671 1331 004674 1334 004700 1336 004714 1338 004723 1339 004736 1342 004737 1344 004756 1347 004765 1348 004770 1349 004772 1350 004774 1354 005014 1355 005017 1356 005022 1360 005041 1363 005054 1367 005055 1369 005060 1371 005067 1374 005071 1378 005073 1382 005104 1386 005115 1388 005124 1390 005132 1392 005140 1394 005141 1396 005162 1398 005172 1401 005175 1406 005204 1410 005207 1412 005216 1415 005221 1418 005233 1421 005240 1425 005241 1427 005253 1428 005270 1431 005272 1435 005327 1438 005343 1440 005357 1441 005363 1442 005365 1443 005370 1444 005372 1445 005374 1449 005375 1453 005403 1454 005405 1455 005413 1457 005431 1461 005432 1464 005436 1465 005443 1468 005457 1470 005463 1471 005471 1474 005472 1478 005516 1479 005520 1481 005523 1482 005524 1484 005543 1486 005552 1489 005554 1491 005575 1492 005600 1495 005601 1497 005605 1498 005611 1499 005643 1502 005646 1504 005657 1508 005670 1510 005723 1512 005726 1514 005732 1516 005733 1517 005745 1518 005764 1519 005767 1520 005771 1521 005773 1522 005775 1523 005777 1524 006021 1527 006022 1529 006026 1532 006027 1534 006033 1539 006036 1542 006046 1548 006051 1549 006054 1552 006063 1553 006066 1554 006075 1558 006076 1559 006105 1560 006110 1563 006111 1568 006115 1569 006120 1570 006135 1575 006142 1578 006157 1579 006164 1583 006206 1590 006217 1593 006241 1595 006242 1597 006244 1599 006261 1600 006272 1602 006315 1604 006316 1607 006335 1610 006357 1611 006374 1612 006400 1614 006424 1616 006440 1619 006441 1621 006453 1622 006460 1626 006461 1629 006474 1631 006477 1633 006502 1636 006507 1638 006526 1640 006533 1641 006535 1644 006547 1646 006551 1648 006552 1649 006554 1650 006556 1652 006557 1653 006561 1656 006563 1657 006602 1660 006603 1663 006611 1665 006613 1668 006631 1669 006634 1670 006646 1672 006654 1674 006656 1675 006662 1676 006666 1678 006667 1679 006671 1680 006673 1681 006701 1682 006705 1685 006711 1687 006712 1688 006717 1689 006724 1691 006725 1692 006727 1694 006731 1696 006743 1699 006750 1702 006751 1705 006752 1707 006761 1708 006776 1711 007000 1715 007034 1717 007050 1721 007051 1725 007062 1727 007065 1728 007066 1729 007073 1732 007075 1736 007076 1740 007100 1741 007107 1743 007121 1747 007122 1751 007124 1752 007133 1754 007134 1758 007150 1759 007153 1760 007154 1761 007156 1762 007177 1765 007200 1766 007202 1767 007213 1770 007214 1771 007221 1773 007240 1776 007251 1777 007254 1779 007267 1780 007312 1781 007315 1782 007327 1783 007342 1785 007345 1786 007361 1787 007370 1788 007373 1789 007376 1792 007377 1794 007402 1798 007406 1801 007412 1802 007424 1803 007427 1804 007436 1805 007453 1806 007467 1808 007470 1810 007472 1812 007474 1813 007514 1815 007535 1816 007550 1817 007553 1818 007566 1821 007567 1823 007577 1825 007610 1826 007630 1828 007645 1829 007653 1830 007656 1831 007661 1832 007677 1833 007712 1834 007721 1835 007724 1836 007741 1837 007744 1839 007760 1841 007762 1842 007765 1845 007767 1850 007770 1855 010002 1856 010003 1857 010016 1858 010031 1864 010032 1867 010042 1868 010045 1869 010051 1870 010053 1871 010072 1872 010075 1873 010077 1874 010101 1875 010113 1876 010114 1877 010117 1883 010120 1886 010130 1887 010133 1888 010137 1889 010142 1890 010144 1891 010146 1892 010150 1893 010152 1894 010157 1895 010160 1897 010166 1902 010167 1905 010170 1908 010176 1909 010204 1910 010206 1911 010221 1914 010235 1917 010236 1918 010240 1920 010247 1921 010251 1922 010271 1925 010272 1926 010274 1927 010305 1930 010306 1931 010310 1933 010316 1934 010325 1935 010327 1937 010346 1939 010347 1940 010350 1941 010353 1942 010362 1944 010402 1945 010413 1946 010426 1949 010427 1950 010431 1951 010442 1955 010443 1957 010451 1960 010453 1961 010470 1967 010471 1973 010473 1975 010477 1976 010503 1977 010507 1978 010511 1980 010530 1983 010532 1987 010543 1995 010547 2001 010551 2003 010556 2007 010576 2016 010602 2022 010604 2024 010607 2026 010611 2027 010615 2029 010635 2030 010636 2033 010653 2040 010657 2050 010661 2052 010664 2054 010672 2056 010713 2057 010716 2059 010717 2060 010721 2061 010724 2062 010726 2063 010741 2066 010743 2068 010745 2072 010757 2074 010771 2076 010774 2079 011005 2080 011007 2083 011012 2088 011013 2093 011015 2094 011017 2095 011036 2096 011051 2097 011052 2100 011103 2105 011104 2110 011106 2112 011117 2114 011124 2116 011151 2118 011203 2126 011207 2132 011211 2133 011214 2134 011216 2135 011224 2137 011237 2142 011240 2149 011246 2151 011252 2152 011256 2153 011260 2156 011301 2158 011316 2159 011320 2160 011321 2163 011322 2168 011351 2175 011352 2181 011353 2183 011366 2184 011371 2185 011423 2186 011425 2187 011426 2190 011430 2192 011436 2193 011440 2195 011442 2196 011444 2197 011455 2200 011466 2201 011475 2203 011513 2206 011533 2208 011535 2214 011536 2217 011537 2218 011542 2220 011566 2223 011577 ----------------------------------------------------------- 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