COMPILATION LISTING OF SEGMENT make_both_addressable Compiled by: Multics PL/I Compiler, Release 28d, of September 14, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/03/83 1649.8 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* Procedure to make two or three references addressable at the same time 12* 13* Initial Version: 19 December 1971 by BLW 14* Modified: 2 October 1972 by BLW 15* Modified: 19 February 1973 by RAB 16* Rewritten: 20 May 1973 by RAB for EIS 17* Modified: 19 July 1974 by RAB to recognize that parameters 18* are no longer referenced through lp 19* Modified: 25 December 1976 by RAB to fix 1566 */ 20 21 make_both_addressable: proc(pt1,pt2,pno_ind); 22 23 dcl pt1 ptr, /* points at first ref to be made addressable */ 24 pt2 ptr, /* points at second ref to be made addressable */ 25 pno_ind bit(1) aligned; /* "1"b indicates no indirection allowed */ 26 27 dcl (p(3),s(3),q2) ptr; 28 29 dcl (i,j,lbase,lx,n) fixed bin; 30 31 dcl (eis,lock_base,lock_index,no_ind,no_tag) bit(1) aligned; 32 33 dcl bit3 bit(3) aligned; 34 35 dcl (m_a, need_temp) entry(ptr,bit(2) aligned), 36 (base_man$lock,base_man$unlock,xr_man$super_lock,xr_man$super_unlock) entry(fixed bin), 37 aq_man$lock entry(ptr,fixed bin), 38 base_man$load_any_var entry(fixed bin,ptr,bit(3) aligned); 39 40 dcl (abs,fixed,null,string,substr) builtin; 41 42 dcl cg_stat$cur_block ptr ext static; 43 1 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 1 2 1 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 1 4 1 5 dcl ( block_node initial("000000001"b), 1 6 statement_node initial("000000010"b), 1 7 operator_node initial("000000011"b), 1 8 reference_node initial("000000100"b), 1 9 token_node initial("000000101"b), 1 10 symbol_node initial("000000110"b), 1 11 context_node initial("000000111"b), 1 12 array_node initial("000001000"b), 1 13 bound_node initial("000001001"b), 1 14 format_value_node initial("000001010"b), 1 15 list_node initial("000001011"b), 1 16 default_node initial("000001100"b), 1 17 machine_state_node initial("000001101"b), 1 18 source_node initial("000001110"b), 1 19 label_node initial("000001111"b), 1 20 cross_reference_node initial("000010000"b), 1 21 sf_par_node initial("000010001"b), 1 22 temporary_node initial("000010010"b), 1 23 label_array_element_node initial("000010011"b), 1 24 by_name_agg_node initial("000010100"b)) 1 25 bit(9) internal static aligned options(constant); 1 26 1 27 dcl 1 node based aligned, 1 28 2 type unal bit(9), 1 29 2 source_id unal structure, 1 30 3 file_number bit(8), 1 31 3 line_number bit(14), 1 32 3 statement_number bit(5); 1 33 1 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 44 2 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 2 2 2 3 dcl 1 reference based aligned, 2 4 2 node_type bit(9) unaligned, 2 5 2 array_ref bit(1) unaligned, 2 6 2 varying_ref bit(1) unaligned, 2 7 2 shared bit(1) unaligned, 2 8 2 put_data_sw bit(1) unaligned, 2 9 2 processed bit(1) unaligned, 2 10 2 units fixed(3) unaligned, 2 11 2 ref_count fixed(17) unaligned, 2 12 2 c_offset fixed(24), 2 13 2 c_length fixed(24), 2 14 2 symbol ptr unaligned, 2 15 2 qualifier ptr unaligned, 2 16 2 offset ptr unaligned, 2 17 2 length ptr unaligned, 2 18 2 subscript_list ptr unaligned, 2 19 /* these fields are used by the 645 code generator */ 2 20 2 address structure unaligned, 2 21 3 base bit(3), 2 22 3 offset bit(15), 2 23 3 op bit(9), 2 24 3 no_address bit(1), 2 25 3 inhibit bit(1), 2 26 3 ext_base bit(1), 2 27 3 tag bit(6), 2 28 2 info structure unaligned, 2 29 3 address_in structure, 2 30 4 b dimension(0:7) bit(1), 2 31 4 storage bit(1), 2 32 3 value_in structure, 2 33 4 a bit(1), 2 34 4 q bit(1), 2 35 4 aq bit(1), 2 36 4 string_aq bit(1), 2 37 4 complex_aq bit(1), 2 38 4 decimal_aq bit(1), 2 39 4 b dimension(0:7) bit(1), 2 40 4 storage bit(1), 2 41 4 indicators bit(1), 2 42 4 x dimension(0:7) bit(1), 2 43 3 other structure, 2 44 4 big_offset bit(1), 2 45 4 big_length bit(1), 2 46 4 modword_in_offset bit(1), 2 47 2 data_type fixed(5) unaligned, 2 48 2 bits structure unaligned, 2 49 3 padded_ref bit(1), 2 50 3 aligned_ref bit(1), 2 51 3 long_ref bit(1), 2 52 3 forward_ref bit(1), 2 53 3 ic_ref bit(1), 2 54 3 temp_ref bit(1), 2 55 3 defined_ref bit(1), 2 56 3 evaluated bit(1), 2 57 3 allocate bit(1), 2 58 3 allocated bit(1), 2 59 3 aliasable bit(1), 2 60 3 even bit(1), 2 61 3 perm_address bit(1), 2 62 3 aggregate bit(1), 2 63 3 hit_zero bit(1), 2 64 3 dont_save bit(1), 2 65 3 fo_in_qual bit(1), 2 66 3 hard_to_load bit(1), 2 67 2 relocation bit(12) unaligned, 2 68 2 more_bits structure unaligned, 2 69 3 substr bit(1), 2 70 3 padded_for_store_ref bit(1), 2 71 3 aligned_for_store_ref bit(1), 2 72 3 mbz bit(15), 2 73 2 store_ins bit(18) unaligned; 2 74 2 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 45 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 */ 46 4 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) 4 2 options(constant); 4 3 4 4 dcl ( ap defined(bases(0)), 4 5 bp defined(bases(1)), 4 6 lp defined(bases(2)), 4 7 sp defined(bases(7))) bit(3) aligned; 4 8 4 9 dcl ( ab defined(bases(3)), 4 10 bb defined(bases(4)), 4 11 lb defined(bases(5)), 4 12 sb defined(bases(6))) bit(3) aligned; 4 13 4 14 dcl which_base(0:7) fixed bin int static init(0,3,1,4,2,5,7,6) options(constant); 47 48 49 no_tag, eis = "0"b; 50 no_ind = pno_ind; 51 n = 2; 52 p(1) = pt1; 53 p(2) = pt2; 54 55 common: lock_base, lock_index = "0"b; 56 57 if p(1) -> reference.perm_address 58 then j = 2; 59 else j = 1; 60 61 do i = j + 1 to n; 62 if string(p(i) -> reference.address_in.b) then go to flip; 63 64 q2 = p(i) -> reference.qualifier; 65 if q2 ^= null 66 then if q2 -> node.type ^= temporary_node 67 then do; 68 if q2 -> node.type = operator_node then q2 = q2 -> operand(1); 69 70 if string(q2 -> reference.value_in.b) 71 then do; 72 flip: q2 = p(j); 73 p(j) = p(i); 74 p(i) = q2; 75 j = i; 76 end; 77 end; 78 end; 79 80 do i = 1 to n; 81 s(i) = p(i) -> reference.symbol; 82 end; 83 84 do i = 1 to n; 85 86 if ^ p(i) -> reference.perm_address 87 then call m_a(p(i),no_ind || eis); 88 89 if ^ eis 90 then if i ^= 1 91 then go to step; 92 93 if no_tag 94 then if p(i) -> address.tag 95 then do; 96 call get_base; 97 go to base_lock; 98 end; 99 100 if p(i) -> reference.ext_base 101 then if p(i) -> address.base ^= sp 102 then do; 103 if ^ eis 104 then do; 105 if s(1) = null then go to check_index; 106 if s(1) -> node.type ^= symbol_node then go to check_index; 107 if s(2) = null then go to check_index; 108 if s(2) -> node.type ^= symbol_node then go to check_index; 109 end; 110 111 if p(i) -> address.base ^= lp 112 then do; 113 base_lock: 114 lock_base = "1"b; 115 lbase = which_base(fixed(p(i) -> address.base,3)); 116 call base_man$lock(lbase); 117 end; 118 else; /* lp is only used to address linkage (static) section */ 119 end; 120 121 check_index: 122 if substr(p(i) -> address.tag,3,1) 123 then do; 124 lock_index = "1"b; 125 lx = fixed(substr(p(i) -> address.tag,4,3),3); 126 call xr_man$super_lock(lx); 127 end; 128 else if eis 129 then if substr(p(i) -> address.tag,4,1) 130 then do; 131 lx = fixed(substr(p(i) -> address.tag,5,2),2); 132 if lx > 0 133 then if lx <= 2 134 then call aq_man$lock(p(i),lx); 135 end; 136 137 step: if p(i) -> reference.ref_count = 1 then call need_temp(p(i),"10"b); 138 end; 139 140 if eis then return; 141 142 if lock_index 143 then call xr_man$super_unlock(lx); 144 145 if lock_base 146 then call base_man$unlock(lbase); 147 148 p(1) -> reference.perm_address = "1"b; 149 p(2) -> reference.perm_address = "1"b; 150 return; 151 152 153 make_n_addressable: entry(pt,pn); 154 155 dcl pt ptr, 156 pn fixed bin; 157 158 dcl ptarray(3) ptr aligned based(pt); 159 160 no_ind, eis = "1"b; 161 no_tag = pn < 0; 162 n = abs(pn); 163 do i = 1 to n; 164 p(i) = ptarray(i); 165 end; 166 go to common; 167 168 169 170 get_base: proc; 171 172 p(i) -> reference.perm_address = "1"b; 173 174 if ^ p(i) -> reference.shared 175 then p(i) -> reference.ref_count = p(i) -> reference.ref_count + 1; 176 177 call base_man$load_any_var(2,p(i),bit3); 178 179 end; 180 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/03/83 1008.9 make_both_addressable.pl1 >spec>on>pl128d>make_both_addressable.pl1 44 1 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.incl.pl1 45 2 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 46 3 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 47 4 05/03/76 1320.8 bases.incl.pl1 >ldd>include>bases.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. abs builtin function dcl 40 ref 162 address 10 based structure level 2 packed unaligned dcl 2-3 address_in 11 based structure level 3 packed unaligned dcl 2-3 aq_man$lock 000024 constant entry external dcl 35 ref 132 b 11(15) based bit(1) array level 4 in structure "reference" packed unaligned dcl 2-3 in procedure "make_both_addressable" ref 70 b 11 based bit(1) array level 4 in structure "reference" packed unaligned dcl 2-3 in procedure "make_both_addressable" ref 62 base 10 based bit(3) level 3 packed unaligned dcl 2-3 ref 100 111 115 base_man$load_any_var 000026 constant entry external dcl 35 ref 177 base_man$lock 000014 constant entry external dcl 35 ref 116 base_man$unlock 000016 constant entry external dcl 35 ref 145 bases 000010 constant bit(3) initial array dcl 4-1 ref 100 100 111 111 bit3 000130 automatic bit(3) dcl 33 set ref 177* bits 12(06) based structure level 2 packed unaligned dcl 2-3 eis 000123 automatic bit(1) dcl 31 set ref 49* 86 89 103 128 140 160* ext_base 10(29) based bit(1) level 3 packed unaligned dcl 2-3 ref 100 fixed builtin function dcl 40 ref 115 125 131 i 000116 automatic fixed bin(17,0) dcl 29 set ref 61* 62 64 73 74 75* 80* 81 81* 84* 86 86 89 93 100 100 111 115 121 125 128 131 132 137 137* 163* 164 164* 172 174 174 174 177 info 11 based structure level 2 packed unaligned dcl 2-3 j 000117 automatic fixed bin(17,0) dcl 29 set ref 57* 59* 61 72 73 75* lbase 000120 automatic fixed bin(17,0) dcl 29 set ref 115* 116* 145* lock_base 000124 automatic bit(1) dcl 31 set ref 55* 113* 145 lock_index 000125 automatic bit(1) dcl 31 set ref 55* 124* 142 lp defined bit(3) dcl 4-4 ref 111 lx 000121 automatic fixed bin(17,0) dcl 29 set ref 125* 126* 131* 132 132 132* 142* m_a 000010 constant entry external dcl 35 ref 86 n 000122 automatic fixed bin(17,0) dcl 29 set ref 51* 61 80 84 162* 163 need_temp 000012 constant entry external dcl 35 ref 137 no_ind 000126 automatic bit(1) dcl 31 set ref 50* 86 160* no_tag 000127 automatic bit(1) dcl 31 set ref 49* 93 161* node based structure level 1 dcl 1-27 null builtin function dcl 40 ref 65 105 107 operand 1 based pointer array level 2 packed unaligned dcl 3-6 ref 68 operator based structure level 1 dcl 3-6 operator_node constant bit(9) initial dcl 1-5 ref 68 p 000100 automatic pointer array dcl 27 set ref 52* 53* 57 62 64 72 73* 73 74* 81 86 86* 93 100 100 111 115 121 125 128 131 132* 137 137* 148 149 164* 172 174 174 174 177* perm_address 12(18) based bit(1) level 3 packed unaligned dcl 2-3 set ref 57 86 148* 149* 172* pn parameter fixed bin(17,0) dcl 155 ref 153 161 162 pno_ind parameter bit(1) dcl 23 ref 21 50 pt parameter pointer dcl 155 ref 153 164 pt1 parameter pointer dcl 23 ref 21 52 pt2 parameter pointer dcl 23 ref 21 53 ptarray based pointer array dcl 158 ref 164 q2 000114 automatic pointer dcl 27 set ref 64* 65 65 68 68* 68 70 72* 74 qualifier 4 based pointer level 2 packed unaligned dcl 2-3 ref 64 ref_count 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 2-3 set ref 137 174* 174 reference based structure level 1 dcl 2-3 s 000106 automatic pointer array dcl 27 set ref 81* 105 106 107 108 shared 0(11) based bit(1) level 2 packed unaligned dcl 2-3 ref 174 sp defined bit(3) dcl 4-4 ref 100 string builtin function dcl 40 ref 62 70 substr builtin function dcl 40 ref 121 125 128 131 symbol 3 based pointer level 2 packed unaligned dcl 2-3 ref 81 symbol_node constant bit(9) initial dcl 1-5 ref 106 108 tag 10(30) based bit(6) level 3 packed unaligned dcl 2-3 ref 93 121 125 128 131 temporary_node constant bit(9) initial dcl 1-5 ref 65 type based bit(9) level 2 packed unaligned dcl 1-27 ref 65 68 106 108 value_in 11(09) based structure level 3 packed unaligned dcl 2-3 which_base 000000 constant fixed bin(17,0) initial array dcl 4-14 ref 115 xr_man$super_lock 000020 constant entry external dcl 35 ref 126 xr_man$super_unlock 000022 constant entry external dcl 35 ref 142 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ab defined bit(3) dcl 4-9 ap defined bit(3) dcl 4-4 array_node internal static bit(9) initial dcl 1-5 bb defined bit(3) dcl 4-9 block_node internal static bit(9) initial dcl 1-5 bound_node internal static bit(9) initial dcl 1-5 bp defined bit(3) dcl 4-4 by_name_agg_node internal static bit(9) initial dcl 1-5 cg_stat$cur_block external static pointer dcl 42 context_node internal static bit(9) initial dcl 1-5 cross_reference_node internal static bit(9) initial dcl 1-5 default_node internal static bit(9) initial dcl 1-5 format_value_node internal static bit(9) initial dcl 1-5 label_array_element_node internal static bit(9) initial dcl 1-5 label_node internal static bit(9) initial dcl 1-5 lb defined bit(3) dcl 4-9 list_node internal static bit(9) initial dcl 1-5 machine_state_node internal static bit(9) initial dcl 1-5 max_number_of_operands internal static fixed bin(15,0) initial dcl 3-15 reference_node internal static bit(9) initial dcl 1-5 sb defined bit(3) dcl 4-9 sf_par_node internal static bit(9) initial dcl 1-5 source_node internal static bit(9) initial dcl 1-5 statement_node internal static bit(9) initial dcl 1-5 token_node internal static bit(9) initial dcl 1-5 NAMES DECLARED BY EXPLICIT CONTEXT. base_lock 000273 constant label dcl 113 ref 97 check_index 000313 constant label dcl 121 ref 105 106 107 108 common 000055 constant label dcl 55 ref 166 flip 000131 constant label dcl 72 ref 62 get_base 000512 constant entry internal dcl 170 ref 96 make_both_addressable 000032 constant entry external dcl 21 make_n_addressable 000452 constant entry external dcl 153 step 000365 constant label dcl 137 ref 89 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 672 722 551 702 Length 1166 551 30 230 121 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME make_both_addressable 118 external procedure is an external procedure. get_base internal procedure shares stack frame of external procedure make_both_addressable. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME make_both_addressable 000100 p make_both_addressable 000106 s make_both_addressable 000114 q2 make_both_addressable 000116 i make_both_addressable 000117 j make_both_addressable 000120 lbase make_both_addressable 000121 lx make_both_addressable 000122 n make_both_addressable 000123 eis make_both_addressable 000124 lock_base make_both_addressable 000125 lock_index make_both_addressable 000126 no_ind make_both_addressable 000127 no_tag make_both_addressable 000130 bit3 make_both_addressable THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. aq_man$lock base_man$load_any_var base_man$lock base_man$unlock m_a need_temp xr_man$super_lock xr_man$super_unlock NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 21 000026 49 000037 50 000041 51 000045 52 000047 53 000052 55 000055 57 000057 59 000066 61 000070 62 000101 64 000107 65 000111 68 000121 70 000125 72 000131 73 000135 74 000136 75 000140 78 000142 80 000144 81 000153 82 000157 84 000161 86 000171 89 000214 93 000223 96 000232 97 000233 100 000234 103 000245 105 000250 106 000254 107 000260 108 000264 111 000270 113 000273 115 000275 116 000304 121 000313 124 000322 125 000324 126 000327 127 000336 128 000337 131 000344 132 000347 137 000365 138 000411 140 000413 142 000415 145 000426 148 000437 149 000442 150 000445 153 000446 160 000457 161 000462 162 000466 163 000473 164 000501 165 000507 166 000511 170 000512 172 000513 174 000520 177 000531 179 000547 ----------------------------------------------------------- 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