COMPILATION LISTING OF SEGMENT upd_log_task_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1724.1 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 upd_log_task_: procedure; 12 13 14 dcl /* automatic variables */ 15 Ldir fixed bin, /* length of the non-blank part of dir. */ 16 Llog_name fixed bin, /* length of the non-blank part of log_name. */ 17 Plock ptr, /* ptr to the lock segment. */ 18 Stype fixed bin(2), /* type of found installation log; 1 = segment, */ 19 /* 2 = directory, 3 = MSF. */ 20 bitc fixed bin(24), 21 bitct fixed bin(24), /* bit count */ 22 code fixed bin(35), /* a status code. */ 23 dir char(168) aligned, /* directory part of log_name (absolute) path */ 24 dummy_code fixed bin(35), /* dummy code value */ 25 e fixed bin, /* entry variable */ 26 entry char(32) aligned, /* entry part of log_name (absolute) path */ 27 lock_seg char(32) aligned, /* entry part of properly-suffixed lock seg path. */ 28 log_file char(32) aligned, /* entry part of found log file's path. */ 29 log_name char(168), /* relative or absolute path of installation log */ 30 mode fixed bin(5), /* installer's access mode to found log. */ 31 p ptr, 32 path char(168) aligned, /* absolute path name of found installation log. */ 33 status_code bit(72) aligned, /* an IO system status code. */ 34 time fixed bin; /* time (in sec) we will wait for lock to unlock */ 35 36 dcl /* based variables */ 37 1 lock based (Plock), /* structure of the lock segment. */ 38 2 word bit(36) aligned, /* the lock word. */ 39 2 process_group_id char(32) aligned, /* installer who has locked the lock. */ 40 2 program char(65) aligned, /* the program he is running which did the locking*/ 41 1 status based (addr (status_code)), 42 /* overlay for the IO status code. */ 43 2 code fixed bin(35); /* for file_; this is a regular status code. */ 44 45 dcl 1 acl aligned, /* acl structure */ 46 2 userid char (32), /* user id */ 47 2 mode bit(36), /* access mode */ 48 2 pad bit(36) init ("0"b), /* padding */ 49 2 code fixed bin (35); /* error code */ 50 51 dcl 1 diracl aligned, /* directory acl structure */ 52 2 userid char (32), /* user */ 53 2 dir_mode bit (36), /* bits 1-3 are "sma" */ 54 2 code fixed bin (35); /* error code */ 55 56 dcl /* entries and builtin functions */ 57 addr builtin, 58 expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin(35)), 59 get_group_id_ entry returns (char(32) aligned), 60 get_group_id_$tag_star entry returns (char(32) aligned), 61 hcs_$add_acl_entries entry (char(*) aligned, char(*) aligned, ptr, fixed bin, fixed bin(35)), 62 hcs_$add_dir_acl_entries entry (char(*) aligned, char(*) aligned, ptr, fixed bin, fixed bin(35)), 63 hcs_$initiate_count entry ( char(*) aligned, char(*) aligned, char(*) aligned, 64 fixed bin(24), fixed bin(2), ptr, fixed bin(35) ), 65 hcs_$make_seg entry (char(*) aligned, char(*) aligned, char(*) aligned, fixed bin(5), 66 ptr, fixed bin(35)), 67 hcs_$terminate_noname entry (ptr, fixed bin(35)), 68 index builtin, 69 ios_$attach entry (char(*) aligned, char(*) aligned, char(*) aligned, char(*) aligned, 70 bit(72) aligned), 71 ios_$detach entry (char(*) aligned, char(*) aligned, char(*) aligned, bit(72) aligned), 72 mod builtin, 73 null builtin, 74 set_lock_$lock entry (bit(36) aligned, fixed bin, fixed bin(35)), 75 set_lock_$unlock entry (bit(36) aligned, fixed bin(35)), 76 substr builtin, 77 suffixed_name_$find entry (char(*) aligned, char(*) aligned, char(*) aligned, char(32) aligned, 78 fixed bin(2), fixed bin(5), fixed bin(35)), 79 suffixed_name_$new_suffix entry (char(*) aligned, char(*) aligned, char(*) aligned, char(32) aligned, 80 fixed bin(35)), 81 upd_print_err_ entry options (variable); 82 83 dcl /* static variables */ 84 directory fixed bin(2) int static init (2), 85 error_table_$dirseg fixed bin(35) ext static, 86 error_table_$file_is_full fixed bin(35) ext static, 87 error_table_$incorrect_access fixed bin(35) ext static, 88 error_table_$invalid_lock_reset 89 fixed bin(35) ext static, 90 error_table_$locked_by_this_process 91 fixed bin(35) ext static, 92 error_table_$lock_wait_time_exceeded 93 fixed bin(35) ext static, 94 error_table_$moderr fixed bin(35) ext static, 95 error_table_$namedup fixed bin(35) ext static, 96 error_table_$noentry fixed bin(35) ext static, 97 error_table_$segknown fixed bin(35) ext static, 98 msf fixed bin(2) int static init (3), 99 proc char (32) aligned int static init ("upd_log_task_"); 100 101 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 102 103 104 lock: entry (log_name, code); 105 106 e = 1; 107 go to COMMON; 108 109 unlock: entry ( log_name, code); 110 111 e = 2; 112 113 COMMON: 114 Llog_name = mod (index (log_name, " ")+168, 169); /* get length of non-blank part of log name path. */ 115 call expand_path_ (addr (log_name), Llog_name, addr (dir), addr (entry), code); 116 if code ^= 0 then /* split the path into directory and entry parts. */ 117 return; 118 if index ( entry, ".log") ^= 0 then 119 call suffixed_name_$new_suffix (entry, "log", "lock", lock_seg, code); 120 else 121 call suffixed_name_$new_suffix (entry, "info", "lock", lock_seg, code); 122 if code ^= 0 then /* get name of lock segment assoc. with log. */ 123 return; 124 go to start(e); 125 126 start(1): 127 acl.userid = get_group_id_$tag_star(); /* find out who the installer is. */ 128 acl.mode = "101"b; /* set his "mode" to "rw". */ 129 acl.code = 0; /* zap error code. */ 130 call hcs_$make_seg (dir, lock_seg, "", 01010b, Plock, code); 131 if code ^= 0 then do; /* try to create the lock segment. */ 132 if code = error_table_$namedup | code = error_table_$segknown | code = error_table_$moderr then do; 133 call hcs_$add_acl_entries (dir, lock_seg, addr(acl), 1, code); 134 if code ^= 0 then /* if it already exists, make sure the installer */ 135 return; /* has "rw" access to it. */ 136 end; 137 else /* treat any other errors as such. */ 138 return; 139 end; 140 else /* if we had to create the lock segment, then */ 141 /* warn the installer. */ 142 call upd_print_err_ (0, 0, "Warning", "", (proc), "", "^2xCreating ^a>^a .", dir, lock_seg); 143 144 time = 60; /* lock the lock segment. Wait 60 sec for it to */ 145 lock_it: call set_lock_$lock (lock.word, time, code); /* be unlocked, if its already locked. */ 146 if code ^= 0 then do; 147 if code = error_table_$invalid_lock_reset then do; 148 call upd_print_err_ ( code, 0, "Warning", "", (proc), "", 149 "^/^a ^R^a>^a^B ^/^a", "Installation lock segment", 150 dir, lock_seg, "The lock has been re-locked by this process."); 151 code = 0; /* someone had it locked when his process or system failed */ 152 end; 153 else 154 if code = error_table_$locked_by_this_process then 155 code = 0; /* I was the guy that previously locked it. */ 156 else 157 if code = error_table_$lock_wait_time_exceeded then do; 158 if time = 60 then do; /* if its already locked, tell user. */ 159 call upd_print_err_ (code, 0, "Warning", "", (proc), "", 160 "^/^a ^R^a>^a^B ^/^a ^a (^a).^/^a ^a.", "Installation lock segment", 161 dir, lock_seg, "has been locked for 1 minute by", lock.process_group_id, 162 lock.program, (proc), "will continue waiting on this lock for 20 minutes"); 163 time = 1200; /* this time, wait for 20 minutes on the lock. */ 164 go to lock_it; 165 end; 166 else /* if lock isn't unlocked after 21 minutes, then */ 167 return; /* quit. */ 168 end; 169 end; 170 lock.process_group_id = get_group_id_(); /* it's locked. */ 171 lock.program = proc; /* let other processes know who's in control. */ 172 173 if index ( entry, ".log") ^= 0 then 174 call suffixed_name_$find (dir, entry, "log", log_file, Stype, mode, code); 175 else 176 call suffixed_name_$find (dir, entry, "info", log_file, Stype, mode, code); 177 /* find the installation log. */ 178 Ldir = mod (index (dir, " ")+168, 169); /* get length of non-blank part of directory. */ 179 path = substr (dir, 1, Ldir) || ">" || log_file; /* concatenate directory and log entry name. */ 180 if (code = 0 | code = error_table_$incorrect_access) then do; 181 /* log exists. */ 182 if Stype = directory then do; /* make sure it's not a directory. */ 183 code = error_table_$dirseg; 184 go to un_lock; 185 end; 186 else if Stype = msf then do; /* if log is an MSF, then make sure installer is */ 187 /* on the ACL of the MSF directory. */ 188 if index ( log_file, ".info") ^= 0 then do; /* unless it's an info file */ 189 code = error_table_$file_is_full; /* then we don't allow further expansion */ 190 go to un_lock; 191 end; 192 diracl.userid = get_group_id_$tag_star();/* who is the installer */ 193 diracl.dir_mode = "111"b; /* set acl to "sma" */ 194 diracl.code = 0; /* zap error code */ 195 call hcs_$add_dir_acl_entries (path, "", addr(diracl), 1, code); 196 if code ^= 0 then 197 go to un_lock; 198 end; 199 /* and if it's a segment, */ 200 else if mode ^= 101b then do; /* make sure installer has access to the log. */ 201 call hcs_$add_acl_entries (dir, log_file, addr(acl), 1, code); 202 if code ^= 0 then 203 go to un_lock; 204 end; 205 end; 206 else 207 if code = error_table_$noentry then do; /* if there's no entry, then warn the installer */ 208 call upd_print_err_ (0, 0, "Warning", "", (proc), "", "^2xCreating ^a>^a .", dir, log_file); 209 call hcs_$make_seg (dir, log_file, "", 01010b, p, code); 210 if code ^= 0 then 211 goto un_lock; 212 end; 213 else /* the only other error is incorrect_access. */ 214 go to un_lock; /* entlong cannot happen since we already made */ 215 /* the lock_seg name. Tell user. */ 216 217 return; 218 219 220 start(2): 221 call hcs_$initiate_count ( dir, lock_seg, "", bitc, 0, Plock, code); 222 if Plock = null then 223 return; /* something's wrong. */ 224 code = 0; /* clear "segknown code */ 225 226 un_lock: call set_lock_$unlock (lock.word, dummy_code); /* unlock the lock segment. */ 227 if dummy_code ^= 0 then 228 call upd_print_err_ (dummy_code, 0, "Warning", "", (proc), "^/While unlocking ^R^a>^a^B .", 229 dir, lock_seg); 230 call hcs_$terminate_noname (Plock, dummy_code); /* clean up completely. */ 231 return; /* That's All, Folks! */ 232 233 end upd_log_task_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1514.3 upd_log_task_.pl1 >dumps>old>recomp>upd_log_task_.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. Ldir 000100 automatic fixed bin(17,0) dcl 14 set ref 178* 179 Llog_name 000101 automatic fixed bin(17,0) dcl 14 set ref 113* 115* Plock 000102 automatic pointer dcl 14 set ref 130* 145 159 159 170 171 220* 222 226 230* Stype 000104 automatic fixed bin(2,0) dcl 14 set ref 173* 175* 182 186 acl 000271 automatic structure level 1 dcl 45 set ref 133 133 201 201 addr builtin function dcl 56 ref 115 115 115 115 115 115 133 133 195 195 201 201 bitc 000105 automatic fixed bin(24,0) dcl 14 set ref 220* code parameter fixed bin(35,0) dcl 14 in procedure "upd_log_task_" set ref 104 109 115* 116 118* 120* 122 130* 131 132 132 132 133* 134 145* 146 147 148* 151* 153 153* 156 159* 173* 175* 180 180 183* 189* 195* 196 201* 202 206 209* 210 220* 224* code 11 000304 automatic fixed bin(35,0) level 2 in structure "diracl" dcl 51 in procedure "upd_log_task_" set ref 194* code 12 000271 automatic fixed bin(35,0) level 2 in structure "acl" dcl 45 in procedure "upd_log_task_" set ref 129* dir 000106 automatic char(168) dcl 14 set ref 115 115 130* 133* 140* 148* 159* 173* 175* 178 179 201* 208* 209* 220* 227* dir_mode 10 000304 automatic bit(36) level 2 dcl 51 set ref 193* diracl 000304 automatic structure level 1 dcl 51 set ref 195 195 directory constant fixed bin(2,0) initial dcl 83 ref 182 dummy_code 000160 automatic fixed bin(35,0) dcl 14 set ref 226* 227 227* 230* e 000161 automatic fixed bin(17,0) dcl 14 set ref 106* 111* 124 entry 000162 automatic char(32) dcl 14 set ref 115 115 118 118* 120* 173 173* 175* error_table_$dirseg 000042 external static fixed bin(35,0) dcl 83 ref 183 error_table_$file_is_full 000044 external static fixed bin(35,0) dcl 83 ref 189 error_table_$incorrect_access 000046 external static fixed bin(35,0) dcl 83 ref 180 error_table_$invalid_lock_reset 000050 external static fixed bin(35,0) dcl 83 ref 147 error_table_$lock_wait_time_exceeded 000054 external static fixed bin(35,0) dcl 83 ref 156 error_table_$locked_by_this_process 000052 external static fixed bin(35,0) dcl 83 ref 153 error_table_$moderr 000056 external static fixed bin(35,0) dcl 83 ref 132 error_table_$namedup 000060 external static fixed bin(35,0) dcl 83 ref 132 error_table_$noentry 000062 external static fixed bin(35,0) dcl 83 ref 206 error_table_$segknown 000064 external static fixed bin(35,0) dcl 83 ref 132 expand_path_ 000010 constant entry external dcl 56 ref 115 get_group_id_ 000012 constant entry external dcl 56 ref 170 get_group_id_$tag_star 000014 constant entry external dcl 56 ref 126 192 hcs_$add_acl_entries 000016 constant entry external dcl 56 ref 133 201 hcs_$add_dir_acl_entries 000020 constant entry external dcl 56 ref 195 hcs_$initiate_count 000022 constant entry external dcl 56 ref 220 hcs_$make_seg 000024 constant entry external dcl 56 ref 130 209 hcs_$terminate_noname 000026 constant entry external dcl 56 ref 230 index builtin function dcl 56 ref 113 118 173 178 188 lock based structure level 1 unaligned dcl 36 lock_seg 000172 automatic char(32) dcl 14 set ref 118* 120* 130* 133* 140* 148* 159* 220* 227* log_file 000202 automatic char(32) dcl 14 set ref 173* 175* 179 188 201* 208* 209* log_name parameter char(168) unaligned dcl 14 set ref 104 109 113 115 115 mod builtin function dcl 56 ref 113 178 mode 10 000271 automatic bit(36) level 2 in structure "acl" dcl 45 in procedure "upd_log_task_" set ref 128* mode 000212 automatic fixed bin(5,0) dcl 14 in procedure "upd_log_task_" set ref 173* 175* 200 msf constant fixed bin(2,0) initial dcl 83 ref 186 null builtin function dcl 56 ref 222 p 000214 automatic pointer dcl 14 set ref 209* pad 11 000271 automatic bit(36) initial level 2 dcl 45 set ref 45* path 000216 automatic char(168) dcl 14 set ref 179* 195* proc 000002 constant char(32) initial dcl 83 ref 140 148 159 159 171 208 227 process_group_id 1 based char(32) level 2 dcl 36 set ref 159* 170* program 11 based char(65) level 2 dcl 36 set ref 159* 171* set_lock_$lock 000030 constant entry external dcl 56 ref 145 set_lock_$unlock 000032 constant entry external dcl 56 ref 226 substr builtin function dcl 56 ref 179 suffixed_name_$find 000034 constant entry external dcl 56 ref 173 175 suffixed_name_$new_suffix 000036 constant entry external dcl 56 ref 118 120 time 000270 automatic fixed bin(17,0) dcl 14 set ref 144* 145* 158 163* upd_print_err_ 000040 constant entry external dcl 56 ref 140 148 159 208 227 userid 000271 automatic char(32) level 2 in structure "acl" dcl 45 in procedure "upd_log_task_" set ref 126* userid 000304 automatic char(32) level 2 in structure "diracl" dcl 51 in procedure "upd_log_task_" set ref 192* word based bit(36) level 2 dcl 36 set ref 145* 226* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. bitct automatic fixed bin(24,0) dcl 14 ios_$attach 000000 constant entry external dcl 56 ios_$detach 000000 constant entry external dcl 56 status based structure level 1 unaligned dcl 36 status_code automatic bit(72) dcl 14 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 000221 constant label dcl 113 ref 107 lock 000176 constant entry external dcl 104 lock_it 000602 constant label dcl 145 ref 164 start 000000 constant label array(2) dcl 126 ref 124 un_lock 001630 constant label dcl 226 set ref 184 190 196 202 206 210 unlock 000211 constant entry external dcl 109 upd_log_task_ 000163 constant entry external dcl 11 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2234 2322 1734 2244 Length 2540 1734 66 201 277 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME upd_log_task_ 438 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME upd_log_task_ 000100 Ldir upd_log_task_ 000101 Llog_name upd_log_task_ 000102 Plock upd_log_task_ 000104 Stype upd_log_task_ 000105 bitc upd_log_task_ 000106 dir upd_log_task_ 000160 dummy_code upd_log_task_ 000161 e upd_log_task_ 000162 entry upd_log_task_ 000172 lock_seg upd_log_task_ 000202 log_file upd_log_task_ 000212 mode upd_log_task_ 000214 p upd_log_task_ 000216 path upd_log_task_ 000270 time upd_log_task_ 000271 acl upd_log_task_ 000304 diracl upd_log_task_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return mod_fx1 shorten_stack ext_entry set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. expand_path_ get_group_id_ get_group_id_$tag_star hcs_$add_acl_entries hcs_$add_dir_acl_entries hcs_$initiate_count hcs_$make_seg hcs_$terminate_noname set_lock_$lock set_lock_$unlock suffixed_name_$find suffixed_name_$new_suffix upd_print_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$dirseg error_table_$file_is_full error_table_$incorrect_access error_table_$invalid_lock_reset error_table_$lock_wait_time_exceeded error_table_$locked_by_this_process error_table_$moderr error_table_$namedup error_table_$noentry error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 45 000157 11 000162 104 000171 106 000204 107 000206 109 000207 111 000217 113 000221 115 000236 116 000263 118 000266 120 000332 122 000365 124 000370 126 000372 128 000401 129 000403 130 000404 131 000444 132 000447 133 000456 134 000512 136 000515 137 000516 139 000517 140 000520 144 000600 145 000602 146 000616 147 000621 148 000624 151 000724 152 000726 153 000727 156 000733 158 000735 159 000740 163 001062 164 001064 166 001065 170 001066 171 001076 173 001102 175 001155 178 001220 179 001233 180 001260 182 001267 183 001272 184 001275 186 001276 188 001300 189 001307 190 001312 192 001313 193 001322 194 001324 195 001325 196 001363 198 001366 200 001367 201 001372 202 001427 205 001432 206 001433 208 001435 209 001514 210 001554 217 001557 220 001560 222 001622 224 001626 226 001630 227 001641 230 001720 231 001731 ----------------------------------------------------------- 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