COMPILATION LISTING OF SEGMENT mlsys_hash_ Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 06/30/86 1402.5 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 4* * * 5* *********************************************************** */ 6 7 /* format: off */ 8 9 /* Hash table management for the Multics Mail System */ 10 11 /* Created: July 1983 by G. Palter */ 12 13 /* format: on,style4,delnl,insnl,ifthenstmt,ifthen */ 14 15 16 mlsys_hash_: 17 procedure (); 18 19 return; /* not an entrypoint */ 20 21 22 /* Parameters */ 23 24 dcl P_string character (*) parameter; /* hash: the string to be hashed */ 25 dcl P_hash_table_size fixed binary parameter; /* hash: # of slots in the hash table */ 26 27 28 /* Remaining declarations */ 29 30 dcl hash_value fixed binary (71); 31 dcl 1 hash_value_words aligned based (addr (hash_value)), 32 2 upper fixed binary (35), 33 2 lower fixed binary (35); 34 35 dcl 1 local_ai aligned like area_info; 36 dcl code fixed binary (35); 37 dcl old_validation_level fixed binary (3); 38 39 dcl hash_result fixed binary (35); 40 dcl n_words fixed binary (18); 41 dcl idx fixed binary; 42 43 dcl MAIL_SYSTEM_ character (32) static options (constant) initial ("mail_system_"); 44 45 dcl BLANKS_AS_CHARACTERS character (4) aligned static options (constant) initial (" "); 46 dcl BLANKS fixed binary (35) based (addr (BLANKS_AS_CHARACTERS)); 47 48 dcl sys_info$max_seg_size fixed binary (19) external; 49 50 dcl cu_$level_get entry (fixed binary (3)); 51 dcl cu_$level_set entry (fixed binary (3)); 52 dcl define_area_ entry (pointer, fixed binary (35)); 53 dcl get_ring_ entry () returns (fixed binary (3)); 54 dcl mlsys_storage_mgr_$get_temp_segment entry (pointer, fixed binary (35)); 55 dcl sub_err_ entry () options (variable); 56 57 dcl cleanup condition; 58 59 dcl (abs, addr, divide, length, null, string, wordno) builtin; 60 61 /* Initialize the hash tables used by the mail system */ 62 63 initialize: 64 entry (); 65 66 call cu_$level_get (old_validation_level); 67 68 on condition (cleanup) 69 begin; 70 call cu_$level_set (old_validation_level); 71 end; 72 73 call cu_$level_set (get_ring_ ()); 74 75 call mlsys_storage_mgr_$get_temp_segment (mlsys_data_$hash_tables_segment_ptr, code); 76 if code ^= 0 then do; 77 RESIGNAL_INITIALIZATION_FAILURE: 78 call sub_err_ (code, MAIL_SYSTEM_, ACTION_CANT_RESTART, null (), (0), 79 "Unable to initialize the mail system hash tables.^/Contact your system programming staff."); 80 go to RESIGNAL_INITIALIZATION_FAILURE; 81 end; 82 83 local_ai.version = area_info_version_1; 84 string (local_ai.control) = ""b; 85 local_ai.extend = "1"b; /* an extensible area not that it should matter ... */ 86 local_ai.system = "1"b; /* ... which is extended with proper ring bracket copying */ 87 local_ai.owner = MAIL_SYSTEM_; 88 local_ai.size = sys_info$max_seg_size - wordno (addr (hash_tables_segment.hash_area)); 89 local_ai.areap = addr (hash_tables_segment.hash_area); 90 91 call define_area_ (addr (local_ai), code); 92 if code ^= 0 then go to RESIGNAL_INITIALIZATION_FAILURE; 93 94 hash_tables_segment.field_name_hash_table.buckets (*) = null (); 95 96 hash_tables_segment.message_id_hash_table.buckets (*) = null (); 97 98 call cu_$level_set (old_validation_level); 99 100 return; 101 102 /* Compute the index in a hash table of the specified string: patterned after the hash_index_ ALM subroutine but designed 103* to work on strings longer than 32 characters */ 104 105 hash: 106 entry (P_string, P_hash_table_size) returns (fixed binary); 107 108 n_words = divide ((length (P_string) + 3), 4, 18, 0); 109 110 begin; 111 112 dcl the_string character (4 * n_words) aligned; /* needed to get the last word filled with blanks */ 113 dcl words (n_words) fixed binary (35) based (addr (the_string)); 114 115 the_string = P_string; 116 117 hash_value = 0; /* no bias */ 118 119 do idx = 1 to n_words; 120 if words (idx) ^= BLANKS then /* add all non-blank words together */ 121 hash_value = hash_value + words (idx); 122 end; 123 124 hash_result = /* really mod (hash_value_words.lower, P_hash_table_size) */ 125 hash_value_words.lower 126 - P_hash_table_size * divide (hash_value_words.lower, P_hash_table_size, 35, 0); 127 128 return (abs (hash_result)); /* always want a positive result ... */ 129 130 end; 131 1 1 /* BEGIN INCLUDE FILE ... mlsys_hash_tables_seg.incl.pl1 */ 1 2 /* Created: August 1983 by G. Palter */ 1 3 1 4 /* Definition of the hash tables used by the mail system */ 1 5 1 6 dcl 1 hash_tables_segment aligned based (mlsys_data_$hash_tables_segment_ptr), 1 7 2 field_name_hash_table, /* hash table for user-defined fields */ 1 8 3 buckets (0:511) pointer, 1 9 2 message_id_hash_table, /* hash table for non-local Message-IDs */ 1 10 3 buckets (0:511) pointer, 1 11 2 hash_area area; /* area where actual slots are allocated */ 1 12 1 13 /* END INCLUDE FILE ... mlsys_hash_tables_seg.incl.pl1 */ 132 133 2 1 /* BEGIN INCLUDE FILE ... mlsys_internal_data.incl.pl1 */ 2 2 2 3 2 4 /****^ HISTORY COMMENTS: 2 5* 1) change(86-06-11,Mills), approve(86-06-11,MCR7419), 2 6* audit(86-06-17,Margolin), install(86-06-30,MR12.0-1080): 2 7* Added mlsys_data_$domains_available. 2 8* END HISTORY COMMENTS */ 2 9 2 10 2 11 /* Created: May 1981 by G. Palter */ 2 12 /* Modified: July 1983 by G. Palter to merge with mlsys_data_ */ 2 13 2 14 /* Constants used internally by the Multics mail system */ 2 15 2 16 dcl mlsys_data_$max_opening_retries fixed binary external; /* maximum number of times to reopen a mailbox if it gets 2 17* damaged and salvaged while open */ 2 18 2 19 dcl mlsys_data_$max_lock_wait_retries fixed binary external; 2 20 /* maximum number of times to try to send a message while the 2 21* mailbox is locked (being salvaged?) */ 2 22 2 23 2 24 /* Allocation overhead factors: When allocating those structures with refer extents, insure that the variable portion of 2 25* the structure contains a multiple of the appropriate constant number of slots. These extra slots will be used for 2 26* later additions to the structure; when a new element must be added to a full structure, add this many new slots (rather 2 27* than a single new slot) 2 28* 2 29* The following expression should be used to determine the initial allocation: 2 30* 2 31* n_slots_to_allocate = n_slots_needed + CONSTANT - mod (n_slots_needed, CONSTANT); */ 2 32 2 33 dcl (mlsys_data_$mailbox_allocation, /* mailbox.messages */ 2 34 mlsys_data_$message_body_sections_allocation, /* message.body_sections */ 2 35 mlsys_data_$message_redistributions_list_allocation, /* message_redistributions_list.redistributions */ 2 36 mlsys_data_$message_user_fields_allocation, /* message_user_fields_list.user_fields */ 2 37 mlsys_data_$message_references_list_allocation, /* message_references_list.references */ 2 38 mlsys_data_$address_list_allocation) /* address_list.addresses */ 2 39 fixed binary external; 2 40 2 41 2 42 /* Static data user by the Multics mail system */ 2 43 2 44 dcl (mlsys_data_$forum_not_available, /* 1 => forum isn't available on the system or in this ring */ 2 45 mlsys_data_$ism_not_available, /* 1 => no inter-system mailer on this system */ 2 46 mlsys_data_$domains_available) /* 1 => domain name system software on this sytem */ 2 47 fixed binary (1) external; 2 48 2 49 dcl (mlsys_data_$subsystem_ring, /* ring in which the mail system is secured */ 2 50 mlsys_data_$highest_usable_ring, /* highest ring of execution which may use the mail system */ 2 51 mlsys_data_$lowest_forum_ring) /* lowest ring of execution with access to forum */ 2 52 fixed binary (3) external; 2 53 2 54 dcl mlsys_data_$temp_segment_list_ptr pointer external; /* -> list of all mail system temporary segments */ 2 55 2 56 dcl mlsys_data_$valid_segments (0:4095) bit (1) unaligned external; 2 57 /* indicates which segments have been used by the mail system 2 58* for the allocation of user-visible data in order to 2 59* validate that pointers passed from the user-ring are OK */ 2 60 2 61 dcl mlsys_area area based (mlsys_data_$subsystem_area_ptr);/* area used for all user-visible allocations ... */ 2 62 dcl mlsys_data_$subsystem_area_ptr pointer external; /* ... and the pointer on which it is based */ 2 63 2 64 dcl mlsys_data_$hash_tables_segment_ptr pointer external; /* -> hash tables used by the mail system */ 2 65 2 66 dcl mlsys_data_$transmit_cache_ptr pointer external; /* -> cache of recently used mailboxes for mlsys_transmit_ */ 2 67 2 68 dcl mlsys_data_$user_is_anonymous bit (1) aligned external;/* ON => the user is an anonymous user */ 2 69 2 70 dcl mlsys_data_$person_id character (24) varying external; /* the user's Person_id */ 2 71 dcl mlsys_data_$project_id character (12) varying external;/* the user's Project_id */ 2 72 dcl mlsys_data_$user_id character (32) varying external; /* the user's User_id (Person_id.Project_id) */ 2 73 2 74 /* END INCLUDE FILE ... mlsys_internal_data.incl.pl1 */ 134 135 3 1 /* BEGIN INCLUDE FILE area_info.incl.pl1 12/75 */ 3 2 3 3 dcl area_info_version_1 fixed bin static init (1) options (constant); 3 4 3 5 dcl area_infop ptr; 3 6 3 7 dcl 1 area_info aligned based (area_infop), 3 8 2 version fixed bin, /* version number for this structure is 1 */ 3 9 2 control aligned like area_control, /* control bits for the area */ 3 10 2 owner char (32) unal, /* creator of the area */ 3 11 2 n_components fixed bin, /* number of components in the area (returned only) */ 3 12 2 size fixed bin (18), /* size of the area in words */ 3 13 2 version_of_area fixed bin, /* version of area (returned only) */ 3 14 2 areap ptr, /* pointer to the area (first component on multisegment area) */ 3 15 2 allocated_blocks fixed bin, /* number of blocks allocated */ 3 16 2 free_blocks fixed bin, /* number of free blocks not in virgin */ 3 17 2 allocated_words fixed bin (30), /* number of words allocated in the area */ 3 18 2 free_words fixed bin (30); /* number of words free in area not in virgin */ 3 19 3 20 dcl 1 area_control aligned based, 3 21 2 extend bit (1) unal, /* says area is extensible */ 3 22 2 zero_on_alloc bit (1) unal, /* says block gets zerod at allocation time */ 3 23 2 zero_on_free bit (1) unal, /* says block gets zerod at free time */ 3 24 2 dont_free bit (1) unal, /* debugging aid, turns off free requests */ 3 25 2 no_freeing bit (1) unal, /* for allocation method without freeing */ 3 26 2 system bit (1) unal, /* says area is managed by system */ 3 27 2 pad bit (30) unal; 3 28 3 29 /* END INCLUDE FILE area_info.incl.pl1 */ 136 137 4 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 4 2 /* format: style3 */ 4 3 4 4 /* These constants are to be used for the flags argument of sub_err_ */ 4 5 /* They are just "string (condition_info_header.action_flags)" */ 4 6 4 7 declare ( 4 8 ACTION_CAN_RESTART init (""b), 4 9 ACTION_CANT_RESTART init ("1"b), 4 10 ACTION_DEFAULT_RESTART 4 11 init ("01"b), 4 12 ACTION_QUIET_RESTART 4 13 init ("001"b), 4 14 ACTION_SUPPORT_SIGNAL 4 15 init ("0001"b) 4 16 ) bit (36) aligned internal static options (constant); 4 17 4 18 /* End include file */ 138 139 140 end mlsys_hash_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/30/86 1343.9 mlsys_hash_.pl1 >spec>install>1080>mlsys_hash_.pl1 132 1 10/27/83 2104.2 mlsys_hash_tables_seg.incl.pl1 >ldd>include>mlsys_hash_tables_seg.incl.pl1 134 2 06/30/86 1338.7 mlsys_internal_data.incl.pl1 >spec>install>1080>mlsys_internal_data.incl.pl1 136 3 06/11/76 1043.4 area_info.incl.pl1 >ldd>include>area_info.incl.pl1 138 4 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.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. ACTION_CANT_RESTART 000011 constant bit(36) initial dcl 4-7 set ref 77* BLANKS based fixed bin(35,0) dcl 46 ref 120 BLANKS_AS_CHARACTERS 000000 constant char(4) initial dcl 45 set ref 120 MAIL_SYSTEM_ 000001 constant char(32) initial unaligned dcl 43 set ref 77* 87 P_hash_table_size parameter fixed bin(17,0) dcl 25 ref 105 124 124 P_string parameter char unaligned dcl 24 ref 105 108 115 abs builtin function dcl 59 ref 128 addr builtin function dcl 59 ref 88 89 91 91 120 120 120 124 124 area_control based structure level 1 dcl 3-20 area_info based structure level 1 dcl 3-7 area_info_version_1 constant fixed bin(17,0) initial dcl 3-3 ref 83 areap 16 000102 automatic pointer level 2 dcl 35 set ref 89* buckets based pointer array level 3 in structure "hash_tables_segment" dcl 1-6 in procedure "mlsys_hash_" set ref 94* buckets 2000 based pointer array level 3 in structure "hash_tables_segment" dcl 1-6 in procedure "mlsys_hash_" set ref 96* cleanup 000134 stack reference condition dcl 57 ref 68 code 000126 automatic fixed bin(35,0) dcl 36 set ref 75* 76 77* 91* 92 control 1 000102 automatic structure level 2 dcl 35 set ref 84* cu_$level_get 000012 constant entry external dcl 50 ref 66 cu_$level_set 000014 constant entry external dcl 51 ref 70 73 98 define_area_ 000016 constant entry external dcl 52 ref 91 divide builtin function dcl 59 ref 108 124 extend 1 000102 automatic bit(1) level 3 packed unaligned dcl 35 set ref 85* field_name_hash_table based structure level 2 dcl 1-6 get_ring_ 000020 constant entry external dcl 53 ref 73 73 hash_area 4000 based area(1024) level 2 dcl 1-6 set ref 88 89 hash_result 000130 automatic fixed bin(35,0) dcl 39 set ref 124* 128 hash_tables_segment based structure level 1 dcl 1-6 hash_value 000100 automatic fixed bin(71,0) dcl 30 set ref 117* 120* 120 124 124 hash_value_words based structure level 1 dcl 31 idx 000132 automatic fixed bin(17,0) dcl 41 set ref 119* 120 120* length builtin function dcl 59 ref 108 local_ai 000102 automatic structure level 1 dcl 35 set ref 91 91 lower 1 based fixed bin(35,0) level 2 dcl 31 ref 124 124 message_id_hash_table 2000 based structure level 2 dcl 1-6 mlsys_data_$hash_tables_segment_ptr 000026 external static pointer dcl 2-64 set ref 75* 88 89 94 96 mlsys_storage_mgr_$get_temp_segment 000022 constant entry external dcl 54 ref 75 n_words 000131 automatic fixed bin(18,0) dcl 40 set ref 108* 112 119 null builtin function dcl 59 ref 77 77 94 96 old_validation_level 000127 automatic fixed bin(3,0) dcl 37 set ref 66* 70* 98* owner 2 000102 automatic char(32) level 2 packed unaligned dcl 35 set ref 87* size 13 000102 automatic fixed bin(18,0) level 2 dcl 35 set ref 88* string builtin function dcl 59 set ref 84* sub_err_ 000024 constant entry external dcl 55 ref 77 sys_info$max_seg_size 000010 external static fixed bin(19,0) dcl 48 ref 88 system 1(05) 000102 automatic bit(1) level 3 packed unaligned dcl 35 set ref 86* the_string 000100 automatic char dcl 112 set ref 115* 120 120 version 000102 automatic fixed bin(17,0) level 2 dcl 35 set ref 83* wordno builtin function dcl 59 ref 88 words based fixed bin(35,0) array dcl 113 ref 120 120 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CAN_RESTART internal static bit(36) initial dcl 4-7 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 4-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 4-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 4-7 area_infop automatic pointer dcl 3-5 mlsys_area based area(1024) dcl 2-61 mlsys_data_$address_list_allocation external static fixed bin(17,0) dcl 2-33 mlsys_data_$domains_available external static fixed bin(1,0) dcl 2-44 mlsys_data_$forum_not_available external static fixed bin(1,0) dcl 2-44 mlsys_data_$highest_usable_ring external static fixed bin(3,0) dcl 2-49 mlsys_data_$ism_not_available external static fixed bin(1,0) dcl 2-44 mlsys_data_$lowest_forum_ring external static fixed bin(3,0) dcl 2-49 mlsys_data_$mailbox_allocation external static fixed bin(17,0) dcl 2-33 mlsys_data_$max_lock_wait_retries external static fixed bin(17,0) dcl 2-19 mlsys_data_$max_opening_retries external static fixed bin(17,0) dcl 2-16 mlsys_data_$message_body_sections_allocation external static fixed bin(17,0) dcl 2-33 mlsys_data_$message_redistributions_list_allocation external static fixed bin(17,0) dcl 2-33 mlsys_data_$message_references_list_allocation external static fixed bin(17,0) dcl 2-33 mlsys_data_$message_user_fields_allocation external static fixed bin(17,0) dcl 2-33 mlsys_data_$person_id external static varying char(24) dcl 2-70 mlsys_data_$project_id external static varying char(12) dcl 2-71 mlsys_data_$subsystem_area_ptr external static pointer dcl 2-62 mlsys_data_$subsystem_ring external static fixed bin(3,0) dcl 2-49 mlsys_data_$temp_segment_list_ptr external static pointer dcl 2-54 mlsys_data_$transmit_cache_ptr external static pointer dcl 2-66 mlsys_data_$user_id external static varying char(32) dcl 2-72 mlsys_data_$user_is_anonymous external static bit(1) dcl 2-68 mlsys_data_$valid_segments external static bit(1) array unaligned dcl 2-56 NAMES DECLARED BY EXPLICIT CONTEXT. RESIGNAL_INITIALIZATION_FAILURE 000201 constant label dcl 77 ref 80 92 hash 000367 constant entry external dcl 105 initialize 000106 constant entry external dcl 63 mlsys_hash_ 000070 constant entry external dcl 16 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 664 714 513 674 Length 1170 513 30 240 150 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mlsys_hash_ 167 external procedure is an external procedure. on unit on line 68 68 on unit begin block on line 110 70 begin block uses auto adjustable storage. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 110 000100 the_string begin block on line 110 mlsys_hash_ 000100 hash_value mlsys_hash_ 000102 local_ai mlsys_hash_ 000126 code mlsys_hash_ 000127 old_validation_level mlsys_hash_ 000130 hash_result mlsys_hash_ 000131 n_words mlsys_hash_ 000132 idx mlsys_hash_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. enter_begin call_ext_out_desc call_ext_out begin_return return alloc_auto_adj signal enable ext_entry ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$level_get cu_$level_set define_area_ get_ring_ mlsys_storage_mgr_$get_temp_segment sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. mlsys_data_$hash_tables_segment_ptr sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 16 000067 19 000077 63 000105 66 000115 68 000124 70 000140 71 000147 73 000150 75 000166 76 000177 77 000201 80 000244 83 000245 84 000247 85 000250 86 000252 87 000254 88 000257 89 000271 91 000275 92 000310 94 000312 96 000330 98 000346 100 000354 105 000363 108 000403 110 000407 112 000412 115 000423 117 000432 119 000434 120 000444 122 000454 124 000456 128 000465 140 000504 ----------------------------------------------------------- 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