COMPILATION LISTING OF SEGMENT lister_hash_fid_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/05/84 1154.4 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 /* format: style3 */ 19 lister_hash_fid_: 20 procedure (bv_in_file_ptr, field_id, return_field_index) options (packed_decimal); 21 22 /* Modified 791221 by PG to use rank builtin */ 23 24 /* parameters */ 25 26 dcl ( 27 bv_in_file_ptr ptr, 28 field_id char (*), 29 return_field_index fixed bin, 30 return_field_ptr ptr 31 ) parameter; 32 33 /* automatic */ 34 35 dcl main_entry bit (1) aligned; 36 dcl (i, j, k) fixed bin; 37 dcl mod_2_sum bit (36) aligned; 38 dcl hash_index fixed bin; 39 dcl (p, old_fidp) ptr; 40 41 /* builtins */ 42 43 dcl (addr, binary, bool, dim, divide, length, mod, null, offset, pointer, rank, substr) 44 builtin; 45 46 /* based */ 47 48 dcl string_bit_array dim (0:65536) bit (36) unal based (p); 49 50 /* internal static */ 51 52 dcl mask dim (3) bit (36) aligned int static init ((9)"1"b, (18)"1"b, (27)"1"b); 53 54 /* include files */ 55 1 1 /* ====== BEGIN INCLUDE FILE lister_structures.incl.pl1 ================================ */ 1 2 1 3 /* 1 4* Modified 800813 by PB to add PUT_UID to listform declarations. 1 5* Modified 800825 by PB for version 2 lister file. 1 6* Modified 840523 by PB to add SELECT_BEG and SELECT_END. 1 7**/ 1 8 /* MASTER DECLARATIONS */ 1 9 1 10 /* format: style3 */ 1 11 dcl lister_file_version_2 1 12 fixed bin initial (2) internal static options (constant); 1 13 1 14 dcl 1 input_file based (in_file_ptr) aligned, 1 15 2 ( 1 16 field_table_offset, 1 17 record_head, 1 18 record_tail, 1 19 unused (2) 1 20 ) offset (input_file.area), 1 21 2 next_uid fixed bin (24) unsigned, 1 22 2 version fixed bin, 1 23 2 n_records fixed bin (17), 1 24 2 area area (261112); 1 25 1 26 dcl 1 update_file based (up_file_ptr) aligned, 1 27 2 ( 1 28 field_table_offset, 1 29 record_head, 1 30 record_tail, 1 31 unused (2) 1 32 ) offset (update_file.area), 1 33 2 next_uid fixed bin (24) unsigned, 1 34 2 version fixed bin, 1 35 2 n_records fixed bin (17), 1 36 2 area area (261112); 1 37 1 38 dcl 1 output_file based (out_file_ptr) aligned, 1 39 2 ( 1 40 field_table_offset, 1 41 record_head, 1 42 record_tail, 1 43 unused (2) 1 44 ) offset (output_file.area), 1 45 2 next_uid fixed bin (24) unsigned, 1 46 2 version fixed bin, 1 47 2 n_records fixed bin (17), 1 48 2 area area (261112); 1 49 1 50 dcl 1 input_record based (recordp) aligned, 1 51 2 next offset (input_file.area), 1 52 2 uid fixed bin (24) unsigned unaligned, 1 53 2 max_field_index fixed bin (12) unsigned unaligned, 1 54 2 field dim (0:field_table.max_field_index refer (input_record.max_field_index)) 1 55 offset (input_file.area); 1 56 1 57 dcl 1 update_record based aligned, 1 58 2 next offset (update_file.area), 1 59 2 uid fixed bin (24) unsigned unaligned, 1 60 2 max_field_index fixed bin (12) unsigned unaligned, 1 61 2 field dim (0:field_table.max_field_index refer (update_record.max_field_index)) 1 62 offset (update_file.area); 1 63 1 64 dcl 1 output_record based aligned, 1 65 2 next offset (output_file.area), 1 66 2 uid fixed bin (24) unsigned unaligned, 1 67 2 max_field_index fixed bin (12) unsigned unaligned, 1 68 2 field dim (0:field_table.max_field_index refer (output_record.max_field_index)) 1 69 offset (output_file.area); 1 70 1 71 dcl atom char (atom_length) based (atomp) varying aligned, 1 72 atom_length fixed bin initial (0), /* for table option */ 1 73 atomp ptr; 1 74 1 75 dcl (fidp, field_table_ptr, format_table_ptr, in_file_ptr, ltp, recordp, select_ptr, out_file_ptr, up_file_ptr) 1 76 ptr, 1 77 n fixed bin; 1 78 1 79 dcl 1 field_table based (field_table_ptr) aligned, 1 80 2 record_delimiter 1 81 unal char (1), 1 82 2 field_delimiter unal char (1), 1 83 2 max_field_index unal fixed bin (17), 1 84 2 hash_field_id_to_index 1 85 dimension (0:18) offset, 1 86 2 index_to_field_id 1 87 dimension (0:n refer (field_table.max_field_index)) offset; 1 88 1 89 dcl 1 field_identifier based (fidp) aligned, 1 90 2 next offset, 1 91 2 field_index unal fixed bin (17), 1 92 2 size unal fixed bin (17), 1 93 2 string unal char (n refer (field_identifier.size)); 1 94 1 95 dcl system_area area (261120) based (area_ptr); 1 96 dcl area_ptr ptr; 1 97 1 98 /* LISTFORM DECLARATIONS */ 1 99 1 100 declare ( 1 101 PUT_LITERAL initial (-1), 1 102 PUT_SPACES initial (-2), 1 103 PUT_END initial (-3), 1 104 PUT_DATE initial (-4), 1 105 PUT_TIME initial (-5), 1 106 PUT_RECORD_COUNT initial (-6), 1 107 PUT_ARGUMENT initial (-7), 1 108 PUT_UID initial (-8) 1 109 ) fixed bin internal static; 1 110 1 111 dcl 1 format_table aligned based (format_table_ptr), 1 112 2 size fixed bin (17) unal, 1 113 2 before fixed bin (17) unal, 1 114 2 after fixed bin (17) unal, 1 115 2 record fixed bin (17) unal, 1 116 2 literal_table ptr, 1 117 2 item dim (n refer (format_table.size)), 1 118 3 action fixed bin (17) unal, 1 119 3 justification bit (2) unal, 1 120 3 argument_number 1 121 fixed bin (15) unal, 1 122 3 width fixed bin (21); 1 123 1 124 dcl 1 literal_table aligned based (ltp), 1 125 2 size fixed bin, /* number of slots allocated */ 1 126 2 n_literals fixed bin, /* number of slots in use */ 1 127 2 literal dim (n refer (literal_table.size)) ptr unal; 1 128 1 129 dcl ( 1 130 flush_left initial ("00"b), 1 131 center initial ("01"b), 1 132 flush_right initial ("10"b) 1 133 ) bit (2) aligned internal static options (constant); 1 134 1 135 dcl MIN_FIELD_INDEX fixed bin initial (0) internal static options (constant); 1 136 1 137 dcl 1 list_node aligned based, 1 138 2 size fixed bin, 1 139 2 list dimension (n refer (list_node.size)) ptr; 1 140 1 141 /* SELECT DECLARATIONS */ 1 142 1 143 dcl 1 select_expression based (select_ptr) aligned, 1 144 2 literal_table_ptr 1 145 ptr, 1 146 2 size fixed bin, 1 147 2 last_element fixed bin, 1 148 2 element dim (n refer (select_expression.size)), 1 149 3 opcode unal bit (9), 1 150 3 not unal bit (1), 1 151 3 top unal bit (1), 1 152 3 unused unal bit (7), 1 153 3 field_index unal fixed bin (8), 1 154 3 literal_index unal fixed bin (8), 1 155 1 element aligned, 1 156 2 opcode fixed bin, 1 157 2 not bit (1) aligned, 1 158 2 top bit (1) aligned, 1 159 2 field_index fixed bin, 1 160 2 literal_index fixed bin, 1 161 operand1 fixed bin defined (element.field_index), 1 162 operand2 fixed bin defined (element.literal_index); 1 163 1 164 dcl ( 1 165 SELECT_AND init ("000000001"b), 1 166 SELECT_OR init ("000000010"b), 1 167 SELECT_NOT init ("000000011"b), 1 168 SELECT_FIND init ("000000100"b), 1 169 SELECT_EQ init ("000000101"b), 1 170 SELECT_LT init ("000000110"b), 1 171 SELECT_GT init ("000000111"b), 1 172 SELECT_LE init ("000001000"b), 1 173 SELECT_GE init ("000001001"b), 1 174 SELECT_NEQ init ("000001010"b), 1 175 SELECT_NLT init ("000001011"b), 1 176 SELECT_NGT init ("000001100"b), 1 177 SELECT_NLE init ("000001101"b), 1 178 SELECT_NGE init ("000001110"b), 1 179 SELECT_BEG init ("000001111"b), 1 180 SELECT_END init ("000010000"b) 1 181 ) bit (9) aligned internal static; 1 182 1 183 dcl ( 1 184 ANY_FIELD init (-1), 1 185 NULL_FIELD init (-2), 1 186 NUMERIC_FIELD init (-3), 1 187 UID init (-4) 1 188 ) aligned fixed bin (8) static; 1 189 1 190 dcl 1 numeric_atom aligned based (atomp), 1 191 2 flag fixed bin (35), /* must be -1 */ 1 192 2 value float dec (29) unal; 1 193 1 194 dcl numeric_flag fixed bin (35) internal static initial (-1) options (constant); 1 195 1 196 /* SORT DECLARATIONS */ 1 197 1 198 declare n_items_to_sort fixed bin, 1 199 sort_list_ptr ptr; 1 200 1 201 declare 1 sort_list aligned based (sort_list_ptr), 1 202 2 n_keys fixed bin, 1 203 2 key (n_items_to_sort refer (sort_list.n_keys)), 1 204 3 field_index fixed bin, 1 205 3 ascending bit (1) aligned, 1 206 3 numeric bit (1) aligned; 1 207 1 208 /* MERGE DECLARATIONS */ 1 209 1 210 dcl ( 1 211 MERGE_ADD init (0), 1 212 MERGE_AND init (1), 1 213 MERGE_OR init (2), 1 214 MERGE_SUBTRACT init (3) 1 215 ) fixed bin internal static options (constant); 1 216 1 217 /* ------ END INCLUDE FILE lister_structures.incl.pl1 -------------------------------- */ 56 57 58 /* program */ 59 60 main_entry = "1"b; 61 go to begin; 62 63 lister_hash_fid_$enter: 64 entry (bv_in_file_ptr, field_id, return_field_ptr); 65 66 main_entry = "0"b; 67 begin: 68 in_file_ptr = bv_in_file_ptr; 69 n = length (field_id); 70 if n = 1 71 then hash_index = mod (rank (substr (field_id, 1, 1)), dim (hash_field_id_to_index, 1)); 72 else do; 73 p = addr (field_id); 74 mod_2_sum = "0"b; 75 j = divide (n - 1, 4, 17, 0); 76 k = n - 4 * j; 77 if k ^= 4 78 then string_bit_array (j) = string_bit_array (j) & mask (k); 79 do i = 0 to j; 80 mod_2_sum = bool (mod_2_sum, string_bit_array (i), "0110"b); 81 end; 82 hash_index = mod (binary (mod_2_sum, 35), dim (hash_field_id_to_index, 1)); 83 end; 84 85 old_fidp = null; 86 field_table_ptr = input_file.field_table_offset; 87 do fidp = pointer (field_table.hash_field_id_to_index (hash_index), input_file.area) 88 repeat pointer (fidp -> field_identifier.next, input_file.area) while (fidp ^= null); 89 90 if n < fidp -> field_identifier.size 91 then go to not_found; 92 if n = fidp -> field_identifier.size 93 then if field_id = fidp -> field_identifier.string 94 then do; 95 if main_entry 96 then return_field_index = fidp -> field_identifier.field_index; 97 else return_field_ptr = null; /* it already exists */ 98 return; 99 end; 100 old_fidp = fidp; 101 end; 102 103 not_found: 104 if main_entry 105 then do; 106 return_field_index = -1; /* not found */ 107 return; 108 end; 109 110 p = fidp; 111 allocate field_identifier in (input_file.area) set (fidp); 112 fidp -> field_identifier.next = offset (p, input_file.area); 113 fidp -> field_identifier.field_index = -1; 114 fidp -> field_identifier.string = field_id; 115 116 if old_fidp = null 117 then field_table.hash_field_id_to_index (hash_index) = offset (fidp, input_file.area); 118 else old_fidp -> field_identifier.next = offset (fidp, input_file.area); 119 120 return_field_ptr = fidp; 121 return; 122 123 end /* lister_hash_fid_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/05/84 1151.5 lister_hash_fid_.pl1 >special_ldd>online>6883-11/02/84>lister_hash_fid_.pl1 56 1 11/02/84 1208.5 lister_structures.incl.pl1 >special_ldd>online>6883-11/02/84>lister_structures.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. addr builtin function dcl 43 ref 73 area 10 based area(261112) level 2 dcl 1-14 ref 86 87 101 111 112 116 118 atom_length 000112 automatic fixed bin(17,0) initial dcl 1-71 set ref 1-71* binary builtin function dcl 43 ref 82 bool builtin function dcl 43 ref 80 bv_in_file_ptr parameter pointer dcl 26 ref 19 63 67 dim builtin function dcl 43 ref 70 82 divide builtin function dcl 43 ref 75 fidp 000114 automatic pointer dcl 1-75 set ref 87* 87* 90 92 92 95 100* 101 110 111* 112 113 114 116 118 120 field_id parameter char unaligned dcl 26 set ref 19 63 69 70 73 92 114 field_identifier based structure level 1 dcl 1-89 set ref 111 field_index 1 based fixed bin(17,0) level 2 packed unaligned dcl 1-89 set ref 95 113* field_table based structure level 1 dcl 1-79 field_table_offset based offset level 2 dcl 1-14 ref 86 field_table_ptr 000116 automatic pointer dcl 1-75 set ref 70 82 86* 87 116 hash_field_id_to_index 1 based offset array level 2 dcl 1-79 set ref 70 82 87 116* hash_index 000105 automatic fixed bin(17,0) dcl 38 set ref 70* 82* 87 116 i 000101 automatic fixed bin(17,0) dcl 36 set ref 79* 80* in_file_ptr 000120 automatic pointer dcl 1-75 set ref 67* 86 86 87 101 111 112 116 118 input_file based structure level 1 dcl 1-14 j 000102 automatic fixed bin(17,0) dcl 36 set ref 75* 76 77 77 79 k 000103 automatic fixed bin(17,0) dcl 36 set ref 76* 77 77 length builtin function dcl 43 ref 69 main_entry 000100 automatic bit(1) dcl 35 set ref 60* 66* 95 103 mask 000000 constant bit(36) initial array dcl 52 ref 77 mod builtin function dcl 43 ref 70 82 mod_2_sum 000104 automatic bit(36) dcl 37 set ref 74* 80* 80 82 n 000122 automatic fixed bin(17,0) dcl 1-75 set ref 69* 70 75 76 90 92 111 111 next based offset level 2 dcl 1-89 set ref 101 112* 118* null builtin function dcl 43 ref 85 87 97 116 offset builtin function dcl 43 ref 112 116 118 old_fidp 000110 automatic pointer dcl 39 set ref 85* 100* 116 118 p 000106 automatic pointer dcl 39 set ref 73* 77 77 80 110* 112 pointer builtin function dcl 43 ref 87 101 rank builtin function dcl 43 ref 70 return_field_index parameter fixed bin(17,0) dcl 26 set ref 19 95* 106* return_field_ptr parameter pointer dcl 26 set ref 63 97* 120* size 1(18) based fixed bin(17,0) level 2 packed unaligned dcl 1-89 set ref 90 92 92 111* 114 string 2 based char level 2 packed unaligned dcl 1-89 set ref 92 114* string_bit_array based bit(36) array unaligned dcl 48 set ref 77* 77 80 substr builtin function dcl 43 ref 70 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ANY_FIELD internal static fixed bin(8,0) initial dcl 1-183 MERGE_ADD internal static fixed bin(17,0) initial dcl 1-210 MERGE_AND internal static fixed bin(17,0) initial dcl 1-210 MERGE_OR internal static fixed bin(17,0) initial dcl 1-210 MERGE_SUBTRACT internal static fixed bin(17,0) initial dcl 1-210 MIN_FIELD_INDEX internal static fixed bin(17,0) initial dcl 1-135 NULL_FIELD internal static fixed bin(8,0) initial dcl 1-183 NUMERIC_FIELD internal static fixed bin(8,0) initial dcl 1-183 PUT_ARGUMENT internal static fixed bin(17,0) initial dcl 1-100 PUT_DATE internal static fixed bin(17,0) initial dcl 1-100 PUT_END internal static fixed bin(17,0) initial dcl 1-100 PUT_LITERAL internal static fixed bin(17,0) initial dcl 1-100 PUT_RECORD_COUNT internal static fixed bin(17,0) initial dcl 1-100 PUT_SPACES internal static fixed bin(17,0) initial dcl 1-100 PUT_TIME internal static fixed bin(17,0) initial dcl 1-100 PUT_UID internal static fixed bin(17,0) initial dcl 1-100 SELECT_AND internal static bit(9) initial dcl 1-164 SELECT_BEG internal static bit(9) initial dcl 1-164 SELECT_END internal static bit(9) initial dcl 1-164 SELECT_EQ internal static bit(9) initial dcl 1-164 SELECT_FIND internal static bit(9) initial dcl 1-164 SELECT_GE internal static bit(9) initial dcl 1-164 SELECT_GT internal static bit(9) initial dcl 1-164 SELECT_LE internal static bit(9) initial dcl 1-164 SELECT_LT internal static bit(9) initial dcl 1-164 SELECT_NEQ internal static bit(9) initial dcl 1-164 SELECT_NGE internal static bit(9) initial dcl 1-164 SELECT_NGT internal static bit(9) initial dcl 1-164 SELECT_NLE internal static bit(9) initial dcl 1-164 SELECT_NLT internal static bit(9) initial dcl 1-164 SELECT_NOT internal static bit(9) initial dcl 1-164 SELECT_OR internal static bit(9) initial dcl 1-164 UID internal static fixed bin(8,0) initial dcl 1-183 area_ptr automatic pointer dcl 1-96 atom based varying char dcl 1-71 atomp automatic pointer dcl 1-71 center internal static bit(2) initial dcl 1-129 element automatic structure level 1 dcl 1-143 flush_left internal static bit(2) initial dcl 1-129 flush_right internal static bit(2) initial dcl 1-129 format_table based structure level 1 dcl 1-111 format_table_ptr automatic pointer dcl 1-75 input_record based structure level 1 dcl 1-50 list_node based structure level 1 dcl 1-137 lister_file_version_2 internal static fixed bin(17,0) initial dcl 1-11 literal_table based structure level 1 dcl 1-124 ltp automatic pointer dcl 1-75 n_items_to_sort automatic fixed bin(17,0) dcl 1-198 numeric_atom based structure level 1 dcl 1-190 numeric_flag internal static fixed bin(35,0) initial dcl 1-194 operand1 defined fixed bin(17,0) dcl 1-143 operand2 defined fixed bin(17,0) dcl 1-143 out_file_ptr automatic pointer dcl 1-75 output_file based structure level 1 dcl 1-38 output_record based structure level 1 dcl 1-64 recordp automatic pointer dcl 1-75 select_expression based structure level 1 dcl 1-143 select_ptr automatic pointer dcl 1-75 sort_list based structure level 1 dcl 1-201 sort_list_ptr automatic pointer dcl 1-198 system_area based area(261120) dcl 1-95 up_file_ptr automatic pointer dcl 1-75 update_file based structure level 1 dcl 1-26 update_record based structure level 1 dcl 1-57 NAMES DECLARED BY EXPLICIT CONTEXT. begin 000060 constant label dcl 67 ref 61 lister_hash_fid_ 000020 constant entry external dcl 19 lister_hash_fid_$enter 000043 constant entry external dcl 63 not_found 000236 constant label dcl 103 ref 90 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 364 374 320 374 Length 570 320 10 160 44 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lister_hash_fid_ 87 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lister_hash_fid_ 000100 main_entry lister_hash_fid_ 000101 i lister_hash_fid_ 000102 j lister_hash_fid_ 000103 k lister_hash_fid_ 000104 mod_2_sum lister_hash_fid_ 000105 hash_index lister_hash_fid_ 000106 p lister_hash_fid_ 000110 old_fidp lister_hash_fid_ 000112 atom_length lister_hash_fid_ 000114 fidp lister_hash_fid_ 000116 field_table_ptr lister_hash_fid_ 000120 in_file_ptr lister_hash_fid_ 000122 n lister_hash_fid_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return mod_fx1 ext_entry_desc pointer_hard offset_hard alloc_based NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1 71 000011 19 000014 60 000034 61 000036 63 000037 66 000057 67 000060 69 000064 70 000066 73 000101 74 000103 75 000104 76 000107 77 000114 79 000132 80 000141 81 000147 82 000151 85 000156 86 000160 87 000165 90 000176 92 000204 95 000216 97 000224 98 000226 100 000227 101 000230 103 000236 106 000240 107 000243 110 000244 111 000246 112 000261 113 000266 114 000271 116 000300 118 000312 120 000315 121 000316 ----------------------------------------------------------- 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