COMPILATION LISTING OF SEGMENT set_lock_ Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 1009.6 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 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 /* format: off */ 13 14 /* set_lock_ -- This procedure allows a user to guarantee that two processes 15* will not simultaneously execute the same critical section of code. A user 16* provided lock word can be set to the lock identifier of only one process at 17* a time thereby guaranteeing, assuming the proper conventions are followed, 18* that only this process can be currently executing in the critical section of 19* code. 20* 21* Originally coded by R. J. Feiertag on November 5, 1971 22* Modified on April 6, 1972 by R. J. Feiertag to work in all rings. 23* Fixed by THVV 10/75 to work even if alrm is masked 24* Modified by M. Pierret 03/80 , adding no_write_permission condition 25* handler, stacq and clock builtins, and avoiding clock on waittime=0 26* and on 04/24/80 not_in_write_bracket condition. */ 27 28 /****^ HISTORY COMMENTS: 29* 1) change(71-11-05,Feiertag), approve(), audit(), install(): 30* Written by R. J. Feiertag. 31* 2) change(72-04-06,Feiertag), approve(), audit(), install(): 32* Modified by R. J. Feiertag to work in all rings. 33* 3) change(75-10-01,VanVleck), approve(), audit(), install(): 34* Modified by THVV 10/75 to work even if alrm is masked 35* 4) change(80-04-24,Pierret), approve(), audit(), install(): 36* Modified by M. Pierret 03/80, adding no_write_permission condition 37* handler, stacq and clock builtins, and avoiding clock on waittime=0 38* and on 04/24/80, not_in_write_bracket condition handler 39* 5) change(85-01-09,Lippard), approve(85-01-30,MCR7159), 40* audit(85-11-07,Spitzer), install(86-02-21,MR12.0-1024): 41* Modified by Jim Lippard to add no_write_permission condition handler 42* to set_lock_$unlock. 43* 6) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 44* audit(86-10-20,Fawcett), install(86-11-03,MR12.0-1206): 45* Changed to support control point management. These changes were actually 46* done in April 1985 by G. Palter. The main change was to always use 47* timer_manager_$sleep as that entrypoint was updated in 1979 to work in 48* any ring regardless of the state of the alrm IPS signal. This change had 49* to be made as the old code herein did not work with multiple control 50* points. 51* END HISTORY COMMENTS */ 52 53 /* format: style3,linecom */ 54 55 set_lock_: 56 procedure (); 57 58 return; /* not an entrypoint */ 59 60 61 /* Parameters */ 62 63 dcl lock bit (36) aligned parameter; /* lock word */ 64 65 dcl wait_time fixed binary parameter; /* time in seconds to wait for lock to be unlocked */ 66 67 dcl status fixed binary (35) parameter; 68 69 70 /* Static data -- Initialized once per ring */ 71 72 dcl first_invocation bit (1) aligned static initial ("1"b); 73 74 dcl lock_id bit (36) aligned static; /* our process lock ID */ 75 76 77 /* Remaining declarations */ 78 79 dcl failure_time fixed binary (71); 80 dcl sleep_time fixed binary (71); 81 dcl ttul_code fixed binary; 82 83 dcl ( 84 error_table_$invalid_lock_reset, 85 error_table_$lock_not_locked, 86 error_table_$lock_wait_time_exceeded, 87 error_table_$locked_by_other_process, 88 error_table_$locked_by_this_process, 89 error_table_$no_w_permission 90 ) fixed binary (35) external; 91 92 dcl get_lock_id_ entry (bit (36) aligned); 93 dcl hcs_$try_to_unlock_lock 94 entry (pointer, fixed binary); 95 dcl timer_manager_$sleep 96 entry (fixed binary (71), bit (2)); 97 98 dcl (addr, clock, min, stacq) 99 builtin; 100 101 dcl (no_write_permission, not_in_write_bracket) 102 condition; 103 104 dcl AVERY_LONG_TIME fixed bin (71) /* (2**52) microseconds) */ 105 init (10000000000000000000000000000000000000000000000000000b) static options (constant); 106 107 dcl ONE_SEC_MICRO fixed bin (35) init (1000000) static options (constant); 108 109 dcl IN_MICRO bit (2) init ("10"b) static options (constant); 110 111 /* format: off */ 112 113 /* set_lock_$lock -- This entry attempts to set the lock word to the lock 114* identifier of the calling process. If the lock is already set by some other 115* existing process then it waits for some given period of time for the lock to 116* be unlocked. If the lock is not unlocked in the given time then set_lock_ 117* gives up and returns. 118* 119* dcl set_lock_$lock entry (bit(36) aligned, fixed binary, fixed binary (35)); 120* call set_lock_$lock (lock, wait_time, status); 121* 122* where: 123* 124* lock (Input/Output) 125* is the lock word. 126* 127* wait_time (Input) 128* is the number of seconds to wait for the lock to be unlocked. 129* If wait_time is zero, set_lock_$lock will never wait if the 130* lock is already locked. If wait_time is negative, 131* set_lock_$lock will wait forever for the lock to be unlocked. 132* 133* status (Output) 134* is a standard system status code. It may take on one of the 135* following values: 136* 137* 0 the lock was successfully locked and was not previously 138* locked. 139* error_table_$lock_wait_time_exceeded 140* the lock was validly locked, we waited the requested 141* period but the lock was not unlocked. 142* error_table_$locked_by_this_process 143* the lock was already locked by this process. 144* error_table_$invalid_lock_reset 145* the lock was successfully locked but was previously locked 146* with an invalid lock ID. (E.g., a dead process) 147* error_table_$no_w_permission 148* the caller does not have the necessary access (write) to 149* lock the supplied lock. 150* */ 151 /* format: on */ 152 153 set_lock_$lock: 154 entry (lock, wait_time, status); 155 156 if first_invocation /* first time in this ring */ 157 then call initialize_set_lock (); 158 159 on no_write_permission, not_in_write_bracket 160 begin; 161 status = error_table_$no_w_permission; 162 go to RETURN_FROM_SET_LOCK; 163 end; 164 165 failure_time = 0; 166 167 do while ("1"b); /* forever */ 168 169 if stacq (lock, lock_id, "0"b) /* try the lock */ 170 then call return_from_set_lock (0); /* ... got it */ 171 172 call hcs_$try_to_unlock_lock (addr (lock), ttul_code); 173 if ttul_code = 3 /* ring 0 reset an invalid lock and relocked it for us */ 174 then call return_from_set_lock (error_table_$invalid_lock_reset); 175 176 if ttul_code ^= 2 177 then do; /* it's locked by a live process */ 178 179 if lock = lock_id /* already locked by this process */ 180 then call return_from_set_lock (error_table_$locked_by_this_process); 181 182 if wait_time = 0 183 then sleep_time = 0; /* caller does not want to wait */ 184 185 else do; /* either wait forever or for the requested time */ 186 if failure_time = 0 /* ... determine when to give up */ 187 then if wait_time < 0 188 then failure_time = AVERY_LONG_TIME; 189 /* ... wait forever (2**52 microseconds) */ 190 else failure_time = clock () + wait_time * ONE_SEC_MICRO; 191 /* ... wait the specified number of seconds */ 192 sleep_time = failure_time - clock (); 193 end; /* ... compute how long to sleep */ 194 195 if sleep_time <= 0 /* we've waited long enough */ 196 then call return_from_set_lock (error_table_$lock_wait_time_exceeded); 197 198 /*** We need to sleep before trying the lock again -- 199* As of 1979, timer_manager_$sleep will work in any 200* ring and will also work when the alrm IPS signal 201* is masked. */ 202 203 call timer_manager_$sleep (min (sleep_time, ONE_SEC_MICRO), IN_MICRO); 204 end; 205 end; 206 207 /* set_lock_$unlock -- This entry unlocks a lock word that is set to the 208* calling process's lock identifier. 209* 210* dcl set_lock_$unlock entry (bit(36) aligned, fixed binary (35)); 211* call set_lock_$unlock (lock, status); 212* 213* where: 214* 215* lock (Input/Output) 216* is the lock word. 217* 218* status (Output) 219* is a standard system status code. 220* */ 221 222 set_lock_$unlock: 223 entry (lock, status); 224 225 if first_invocation /* first time in this ring */ 226 then call initialize_set_lock (); 227 228 if stacq (lock, "0"b, lock_id) 229 then call return_from_set_lock (0); /* we unlocked it */ 230 231 else if lock = ""b /* it wasn't locked */ 232 then call return_from_set_lock (error_table_$lock_not_locked); 233 234 else call return_from_set_lock (error_table_$locked_by_other_process); 235 236 /* Set the status code and return to our caller */ 237 238 return_from_set_lock: 239 procedure (p_status); 240 241 dcl p_status fixed binary (35) parameter; 242 243 status = p_status; 244 go to RETURN_FROM_SET_LOCK; 245 246 end return_from_set_lock; 247 248 249 RETURN_FROM_SET_LOCK: 250 return; 251 252 253 254 /* Initialize the set_lock_ mechanism in this this ring */ 255 256 initialize_set_lock: 257 procedure (); 258 259 call get_lock_id_ (lock_id); 260 261 first_invocation = "0"b; 262 263 return; 264 265 end initialize_set_lock; 266 267 end set_lock_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0803.3 set_lock_.pl1 >spec>install>1110>set_lock_.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. AVERY_LONG_TIME 000002 constant fixed bin(71,0) initial dcl 104 ref 186 IN_MICRO 000004 constant bit(2) initial packed unaligned dcl 109 set ref 203* ONE_SEC_MICRO 000000 constant fixed bin(35,0) initial dcl 107 ref 190 203 203 addr builtin function dcl 98 ref 172 172 clock builtin function dcl 98 ref 190 192 error_table_$invalid_lock_reset 000012 external static fixed bin(35,0) dcl 83 set ref 173* error_table_$lock_not_locked 000014 external static fixed bin(35,0) dcl 83 set ref 231* error_table_$lock_wait_time_exceeded 000016 external static fixed bin(35,0) dcl 83 set ref 195* error_table_$locked_by_other_process 000020 external static fixed bin(35,0) dcl 83 set ref 234* error_table_$locked_by_this_process 000022 external static fixed bin(35,0) dcl 83 set ref 179* error_table_$no_w_permission 000024 external static fixed bin(35,0) dcl 83 ref 161 failure_time 000100 automatic fixed bin(71,0) dcl 79 set ref 165* 186 186* 190* 192 first_invocation 000010 internal static bit(1) initial dcl 72 set ref 156 225 261* get_lock_id_ 000026 constant entry external dcl 92 ref 259 hcs_$try_to_unlock_lock 000030 constant entry external dcl 93 ref 172 lock parameter bit(36) dcl 63 set ref 153 169 172 172 179 222 228 231 lock_id 000011 internal static bit(36) dcl 74 set ref 169 179 228 259* min builtin function dcl 98 ref 203 203 no_write_permission 000106 stack reference condition dcl 101 ref 159 not_in_write_bracket 000114 stack reference condition dcl 101 ref 159 p_status parameter fixed bin(35,0) dcl 241 ref 238 243 sleep_time 000102 automatic fixed bin(71,0) dcl 80 set ref 182* 192* 195 203 203 stacq builtin function dcl 98 ref 169 228 status parameter fixed bin(35,0) dcl 67 set ref 153 161* 222 243* timer_manager_$sleep 000032 constant entry external dcl 95 ref 203 ttul_code 000104 automatic fixed bin(17,0) dcl 81 set ref 172* 173 176 wait_time parameter fixed bin(17,0) dcl 65 ref 153 182 186 190 NAMES DECLARED BY EXPLICIT CONTEXT. RETURN_FROM_SET_LOCK 000313 constant label dcl 249 ref 162 244 initialize_set_lock 000321 constant entry internal dcl 256 ref 156 225 return_from_set_lock 000314 constant entry internal dcl 238 ref 169 173 179 195 228 231 234 set_lock_ 000025 constant entry external dcl 55 set_lock_$lock 000037 constant entry external dcl 153 set_lock_$unlock 000245 constant entry external dcl 222 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 552 606 344 562 Length 776 344 34 153 205 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME set_lock_ 110 external procedure is an external procedure. on unit on line 159 64 on unit return_from_set_lock internal procedure shares stack frame of external procedure set_lock_. initialize_set_lock internal procedure shares stack frame of external procedure set_lock_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 first_invocation set_lock_ 000011 lock_id set_lock_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME set_lock_ 000100 failure_time set_lock_ 000102 sleep_time set_lock_ 000104 ttul_code set_lock_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac tra_ext_1 enable_op ext_entry int_entry stacq_mac clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. get_lock_id_ hcs_$try_to_unlock_lock timer_manager_$sleep THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$invalid_lock_reset error_table_$lock_not_locked error_table_$lock_wait_time_exceeded error_table_$locked_by_other_process error_table_$locked_by_this_process error_table_$no_w_permission LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 55 000024 58 000032 153 000033 156 000047 159 000053 161 000067 162 000072 159 000075 165 000102 169 000104 172 000116 173 000132 176 000144 179 000147 182 000162 186 000170 190 000177 192 000204 195 000210 203 000220 205 000237 222 000240 225 000255 228 000261 231 000274 234 000305 249 000313 238 000314 243 000316 244 000320 256 000321 259 000322 261 000331 263 000333 ----------------------------------------------------------- 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