COMPILATION LISTING OF SEGMENT delete_old_pdds Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 03/20/87 1346.7 mst Fri 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 12 /****^ HISTORY COMMENTS: 13* 1) change(87-01-02,TLNguyen), approve(87-01-02,MCR7594), 14* audit(87-01-08,Blair), install(87-03-20,MR12.1-1007): 15* Fixed bug which occurs when delete_old_pdds creates two temporary segments 16* but it does not release them when it finishes. 17* END HISTORY COMMENTS */ 18 19 20 /* format: style2,indcomtxt,idind25 */ 21 22 delete_old_pdds: 23 procedure options (variable); 24 25 /* DPDD cleans out old copies of process_dir_dir */ 26 /* Made more robust by C. Hornig, December 1980 */ 27 /* Made useable from non-Initializer processes, M.Pierret July 1981 */ 28 /* Made to delete old >sl1's too by C. Hornig, March 1982 */ 29 /* 84-01-16 BIM. Explicit salvage to shut up the online salvager. 30* soos privilege. */ 31 32 dcl code fixed bin (35); 33 dcl a_time fixed bin (71); 34 dcl saved_quota uns fixed bin (18); 35 dcl areap ptr; 36 dcl (ap, ap1) pointer; 37 dcl (al, al1) fixed bin; 38 dcl arg char (al) based (ap); 39 dcl arg1 char (al1) based (ap1); 40 dcl (argno, nargs) fixed bin; 41 dcl (first_count, last_count) 42 fixed bin; 43 dcl soos_priv_code fixed bin (35); /* zero implies turn it off */ 44 dcl tsps (2) pointer; 45 46 47 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 48 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 49 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 50 dcl get_system_free_area_ entry () returns (ptr); 51 dcl get_privileges_ entry () returns (bit (36) aligned); 52 dcl get_temp_segments_ entry (character (*), (*) pointer, fixed binary (35)); 53 dcl release_temp_segments_ entry (character (*), (*) pointer, fixed binary (35)); 54 dcl hphcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, 55 fixed bin (35)); 56 dcl system_privilege_$soos_priv_on 57 entry (fixed bin (35)); 58 dcl system_privilege_$soos_priv_off 59 entry (fixed bin (35)); 60 dcl system_privilege_$check_mode_reset 61 entry (char (*), char (*), fixed bin (35)); 62 dcl hphcs_$delentry_file entry (char (*), char (*), fixed bin (35)); 63 dcl hphcs_$quota_read entry (char (*), uns fixed bin (18), fixed bin (71), bit (36), fixed bin, 64 fixed bin (1), fixed bin, fixed bin (35)); 65 dcl hphcs_$quota_set entry (char (*), uns fixed bin (18), fixed bin (35)); 66 dcl hphcs_$salv_directory entry (ptr, char (*) var, ptr, fixed bin, fixed bin (35)); 67 68 dcl com_err_ entry options (variable); 69 70 dcl ( 71 error_table_$nomatch, 72 error_table_$bad_conversion, 73 error_table_$noarg, 74 error_table_$badopt, 75 error_table_$inconsistent 76 ) fixed bin (35) ext; 77 78 dcl whoami char (32) internal static options (constant) init ("delete_old_pdds"); 79 80 dcl (cleanup, seg_fault_error) 81 condition; 82 83 dcl (length, null, reverse, substr, sum, verify) 84 builtin; 85 86 87 88 tsps = null (); 89 soos_priv_code = -1; 90 on cleanup call clean_up (); 91 92 if (get_privileges_ () & SOOS_PRIVILEGE) = ""b 93 then do; 94 call system_privilege_$soos_priv_on (soos_priv_code); 95 if soos_priv_code ^= 0 96 then call com_err_ (soos_priv_code, whoami, "Warning: could not enable SOOS privilege."); 97 end; 98 99 first_count, last_count = -1; /* default initial values */ 100 101 call cu_$arg_count (nargs, code); 102 if code ^= 0 103 then do; 104 call com_err_ (code, whoami, "Usage: delete_old_pdds {-exclude_first Ndirs -exclude_last Ndirs}"); 105 return; 106 end; 107 108 do argno = 1 to nargs; 109 call cu_$arg_ptr (argno, ap, al, code); 110 if /* case */ arg = "-exclude_first" 111 then do; 112 if first_count >= 0 113 then do; 114 ONLY_ONCE: 115 call com_err_ (error_table_$inconsistent, whoami, 116 "The ^a control argument may only be specified once.", arg); 117 return; 118 end; 119 120 if argno = nargs 121 then do; 122 NEED_NUMBER: 123 call com_err_ (error_table_$noarg, whoami, 124 "The ^a control argument must be followed by a number.", arg); 125 return; 126 end; 127 128 argno = argno + 1; 129 call cu_$arg_ptr (argno, ap1, al1, code); 130 first_count = cv_dec_check_ (arg1, code); 131 if code ^= 0 | first_count < 0 132 then do; /* negative numbers not allowed, either */ 133 NEED_GOOD_NUMBER: 134 call com_err_ (error_table_$bad_conversion, whoami, 135 "The ^a control argument must be followed by a non-negative number, not ""^a"".", 136 arg, arg1); 137 return; 138 end; 139 140 end; /* of processing for -first */ 141 142 else if arg = "-exclude_last" 143 then do; 144 if last_count >= 0 145 then goto ONLY_ONCE; 146 if argno = nargs 147 then goto NEED_NUMBER; 148 149 argno = argno + 1; 150 call cu_$arg_ptr (argno, ap1, al1, code); 151 last_count = cv_dec_check_ (arg1, code); 152 if code ^= 0 | last_count < 0 153 then goto NEED_GOOD_NUMBER; 154 end; 155 156 else do; 157 call com_err_ (error_table_$badopt, whoami, "^a", arg); 158 return; 159 end; 160 end; /* of argument processing */ 161 162 if first_count < 0 163 then first_count = 0; /* apply defaults */ 164 if last_count < 0 165 then last_count = 0; 166 167 areap = get_system_free_area_ (); 168 169 saved_quota = 0; /* set up for recovery */ 170 call hphcs_$quota_read (">", saved_quota, (0), ("0"b), (0), (0), (0), code); 171 if code ^= 0 172 then do; 173 call com_err_ (code, whoami, "getting root quota"); 174 return; 175 end; 176 177 a_time = clock (); 178 call get_temp_segments_ (whoami, tsps, (0)); 179 SA.temp1_ptr = tsps (1); 180 SA.temp2_ptr = tsps (2); 181 SA.salv_time = substr (unspec (a_time), 21, 36); 182 SA.options = "0"b; 183 SA.options.delete_connection_failure = "1"b; 184 SA.options.force_rebuild = "1"b; 185 SA.options.check_vtoce = "1"b; 186 SA.branch_ptr = null (); 187 SA.current_length = 0; 188 SA.master_dir_uid = ""b; 189 190 191 call do_it ("pdd"); 192 call do_it ("sl1"); 193 194 if saved_quota > 0 195 then call hphcs_$quota_set (">", saved_quota, code); 196 197 call clean_up (); 198 199 200 clean_up: 201 procedure (); 202 203 if soos_priv_code = 0 204 then do; 205 call system_privilege_$soos_priv_off (code); 206 if code = 0 then soos_priv_code = -1; 207 if code ^= 0 208 then call com_err_ (code, whoami, "Failed to reset soos priv."); 209 end; 210 if tsps (1) ^= null () 211 then call release_temp_segments_ (whoami, tsps, (0)); 212 return; 213 214 end clean_up; 215 216 do_it: 217 procedure (Dir); 218 219 dcl Dir char (*) parameter; 220 221 dcl i fixed bin; 222 dcl ename char (32); 223 224 star_entry_ptr, star_names_ptr = null (); 225 call hphcs_$star_ (">", rtrim (Dir) || ".!??????????????", star_ALL_ENTRIES, areap, star_entry_count, 226 star_entry_ptr, star_names_ptr, code); 227 if code ^= 0 228 then do; 229 if code ^= error_table_$nomatch 230 then call com_err_ (code, whoami, "listing root"); 231 return; 232 end; 233 234 do i = first_count + 1 to star_entry_count - last_count; 235 /* delete only those not excluded */ 236 ename = star_names (star_entries (i).nindex); 237 call deldir (">", ename, code); 238 if code ^= 0 239 then call com_err_ (code, whoami, "Unable to delete >^a", ename); 240 end; 241 242 done_it: 243 if star_names_ptr ^= null () 244 then free star_names; 245 if star_entry_ptr ^= null () 246 then free star_entries; 247 return; 248 1 1 /* BEGIN INCLUDE FILE . . . star_structures.incl.pl1 */ 1 2 1 3 /* This include file contains structures for the hcs_$star_, 1 4* hcs_$star_list_ and hcs_$star_dir_list_ entry points. 1 5* 1 6* Written 23 October 1978 by Monte Davidoff. 1 7* Modified January 1979 by Michael R. Jordan to use unsigned and different pointers for different structures. 1 8* Modified June 1981 by C. Hornig to count link pathnames more efficiently. 1 9**/ 1 10 1 11 /* automatic */ 1 12 1 13 declare star_branch_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching branch count */ 1 14 declare star_entry_count fixed binary; /* hcs_$star_: number of matching entries */ 1 15 declare star_entry_ptr pointer; /* hcs_$star_: pointer to array of entry information */ 1 16 declare star_list_branch_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to array of info */ 1 17 declare star_link_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching link count */ 1 18 declare star_linkx fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: index into star_links */ 1 19 declare star_names_ptr pointer; /* hcs_$star_: pointer to array of entry names */ 1 20 declare star_list_names_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to entry names */ 1 21 declare star_select_sw fixed binary (3); /* hcs_$star_list_, hcs_$star_dir_list_: what info to return */ 1 22 1 23 /* based */ 1 24 1 25 /* hcs_$star_ entry structure */ 1 26 1 27 declare 1 star_entries (star_entry_count) aligned based (star_entry_ptr), 1 28 2 type fixed binary (2) unsigned unaligned, 1 29 /* storage system type */ 1 30 2 nnames fixed binary (16) unsigned unaligned, 1 31 /* number of names of entry that match star_name */ 1 32 2 nindex fixed binary (18) unsigned unaligned; 1 33 /* index of first name in star_names */ 1 34 1 35 /* hcs_$star_ name structure */ 1 36 1 37 declare star_names (sum (star_entries (*).nnames)) char (32) based (star_names_ptr); 1 38 1 39 /* hcs_$star_list_ branch structure */ 1 40 1 41 declare 1 star_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 1 42 2 type fixed binary (2) unsigned unaligned, 1 43 /* storage system type */ 1 44 2 nnames fixed binary (16) unsigned unaligned, 1 45 /* number of names of entry that match star_name */ 1 46 2 nindex fixed binary (18) unsigned unaligned, 1 47 /* index of first name in star_list_names */ 1 48 2 dtcm bit (36) unaligned, /* date-time contents of branch were last modified */ 1 49 2 dtu bit (36) unaligned, /* date-time branch was last used */ 1 50 2 mode bit (5) unaligned, /* user's access mode to the branch */ 1 51 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 1 52 2 master_dir bit (1) unaligned, /* is branch a master directory */ 1 53 2 pad bit (7) unaligned, 1 54 2 records fixed binary (18) unsigned unaligned; 1 55 /* records used by branch */ 1 56 1 57 /* hcs_$star_dir_list_ branch structure */ 1 58 1 59 declare 1 star_dir_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 1 60 2 type fixed binary (2) unsigned unaligned, 1 61 /* storage system type */ 1 62 2 nnames fixed binary (16) unsigned unaligned, 1 63 /* number of names of entry that match star_name */ 1 64 2 nindex fixed binary (18) unsigned unaligned, 1 65 /* index of first name in star_list_names */ 1 66 2 dtem bit (36) unaligned, /* date-time directory entry of branch was last modified */ 1 67 2 pad bit (36) unaligned, 1 68 2 mode bit (5) unaligned, /* user's access mode to the branch */ 1 69 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 1 70 2 master_dir bit (1) unaligned, /* is branch a master directory */ 1 71 2 bit_count fixed binary (24) unaligned; 1 72 /* bit count of the branch */ 1 73 1 74 /* hcs_$star_list_ and hcs_$star_dir_list_ link structure */ 1 75 1 76 declare 1 star_links (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 1 77 2 type fixed binary (2) unsigned unaligned, 1 78 /* storage system type */ 1 79 2 nnames fixed binary (16) unsigned unaligned, 1 80 /* number of names of entry that match star_name */ 1 81 2 nindex fixed binary (18) unsigned unaligned, 1 82 /* index of first name in star_list_names */ 1 83 2 dtem bit (36) unaligned, /* date-time link was last modified */ 1 84 2 dtd bit (36) unaligned, /* date-time the link was last dumped */ 1 85 2 pathname_len fixed binary (18) unsigned unaligned, 1 86 /* length of the pathname of the link */ 1 87 2 pathname_index fixed binary (18) unsigned unaligned; 1 88 /* index of start of pathname in star_list_names */ 1 89 1 90 /* hcs_$star_list_ and hcs_$star_dir_list_ name array */ 1 91 1 92 declare star_list_names char (32) based (star_list_names_ptr) 1 93 dimension (star_links (star_branch_count + star_link_count).nindex 1 94 + star_links (star_branch_count + star_link_count).nnames 1 95 + divide (star_links (star_branch_count + star_link_count).pathname_len + 31, 32, 17, 0) 1 96 * binary ( 1 97 (star_links (star_branch_count + star_link_count).type = star_LINK) 1 98 & (star_select_sw >= star_LINKS_ONLY_WITH_LINK_PATHS), 1)); 1 99 1 100 /* hcs_$star_list_ and hcs_$star_dir_list_ link pathname */ 1 101 1 102 declare star_link_pathname char (star_links (star_linkx).pathname_len) 1 103 based (addr (star_list_names (star_links (star_linkx).pathname_index))); 1 104 1 105 /* internal static */ 1 106 1 107 /* star_select_sw values */ 1 108 1 109 declare star_LINKS_ONLY fixed binary (2) internal static options (constant) initial (1); 1 110 declare star_BRANCHES_ONLY fixed binary (2) internal static options (constant) initial (2); 1 111 declare star_ALL_ENTRIES fixed binary (2) internal static options (constant) initial (3); 1 112 declare star_LINKS_ONLY_WITH_LINK_PATHS 1 113 fixed binary (3) internal static options (constant) initial (5); 1 114 declare star_ALL_ENTRIES_WITH_LINK_PATHS 1 115 fixed binary (3) internal static options (constant) initial (7); 1 116 1 117 /* storage system types */ 1 118 1 119 declare star_LINK fixed binary (2) unsigned internal static options (constant) initial (0); 1 120 declare star_SEGMENT fixed binary (2) unsigned internal static options (constant) initial (1); 1 121 declare star_DIRECTORY fixed binary (2) unsigned internal static options (constant) initial (2); 1 122 1 123 /* END INCLUDE FILE . . . star_structures.incl.pl1 */ 249 250 end do_it; 251 252 253 254 deldir: 255 procedure (a_dn, a_en, code); 256 257 dcl (a_dn, a_en) char (*) parameter; 258 dcl code fixed bin (35) parameter; 259 260 dcl dn char (168); 261 dcl en char (32); 262 dcl dnen char (168); 263 dcl ename char (32); 264 dcl j fixed bin; 265 266 dn = a_dn; 267 en = a_en; 268 if dn = ">" 269 then dnen = ">" || en; 270 else dnen = rtrim (dn) || ">" || en; 271 272 SA.pathname = dnen; 273 call hphcs_$salv_directory (addr (SA), "", null (), (0), code); 274 if code ^= 0 275 then do; 276 call com_err_ (code, whoami, "Unable to salvage ^a. Will attempt to delete it.", SA.pathname); 277 go to DELETE_TOP; /* skip starnaming */ 278 end; 279 280 on seg_fault_error goto connection_failure; 281 282 call system_privilege_$check_mode_reset (dn, en, code); 283 star_entry_ptr, star_names_ptr = null (); 284 call hphcs_$star_ (dnen, "**", star_ALL_ENTRIES, areap, star_entry_count, star_entry_ptr, star_names_ptr, code); 285 if code ^= error_table_$nomatch 286 then do; 287 if code ^= 0 288 then call com_err_ (code, whoami, "^a", dnen); 289 else do j = 1 to star_entry_count; 290 ename = star_names (star_entries (j).nindex); 291 if /* case */ star_entries (j).type = star_SEGMENT 292 then do; 293 call system_privilege_$check_mode_reset (dnen, ename, code); 294 call hphcs_$delentry_file (dnen, ename, code); 295 end; 296 else if star_entries (j).type = star_DIRECTORY 297 then do; 298 call system_privilege_$check_mode_reset (dnen, ename, code); 299 call deldir (dnen, ename, code); 300 end; 301 else do; /* link */ 302 call hphcs_$delentry_file (dnen, ename, code); 303 end; 304 if code ^= 0 305 then call com_err_ (code, whoami, "^a>^a", dnen, ename); 306 end; 307 308 if star_names_ptr ^= null () 309 then free star_names; 310 if star_entry_ptr ^= null () 311 then free star_entries; 312 end; 313 314 connection_failure: 315 DELETE_TOP: 316 call hphcs_$quota_set (dnen, 1, code); 317 call hphcs_$delentry_file (dn, en, code); 318 return; 2 1 /* BEGIN INCLUDE FILE . . . star_structures.incl.pl1 */ 2 2 2 3 /* This include file contains structures for the hcs_$star_, 2 4* hcs_$star_list_ and hcs_$star_dir_list_ entry points. 2 5* 2 6* Written 23 October 1978 by Monte Davidoff. 2 7* Modified January 1979 by Michael R. Jordan to use unsigned and different pointers for different structures. 2 8* Modified June 1981 by C. Hornig to count link pathnames more efficiently. 2 9**/ 2 10 2 11 /* automatic */ 2 12 2 13 declare star_branch_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching branch count */ 2 14 declare star_entry_count fixed binary; /* hcs_$star_: number of matching entries */ 2 15 declare star_entry_ptr pointer; /* hcs_$star_: pointer to array of entry information */ 2 16 declare star_list_branch_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to array of info */ 2 17 declare star_link_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching link count */ 2 18 declare star_linkx fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: index into star_links */ 2 19 declare star_names_ptr pointer; /* hcs_$star_: pointer to array of entry names */ 2 20 declare star_list_names_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to entry names */ 2 21 declare star_select_sw fixed binary (3); /* hcs_$star_list_, hcs_$star_dir_list_: what info to return */ 2 22 2 23 /* based */ 2 24 2 25 /* hcs_$star_ entry structure */ 2 26 2 27 declare 1 star_entries (star_entry_count) aligned based (star_entry_ptr), 2 28 2 type fixed binary (2) unsigned unaligned, 2 29 /* storage system type */ 2 30 2 nnames fixed binary (16) unsigned unaligned, 2 31 /* number of names of entry that match star_name */ 2 32 2 nindex fixed binary (18) unsigned unaligned; 2 33 /* index of first name in star_names */ 2 34 2 35 /* hcs_$star_ name structure */ 2 36 2 37 declare star_names (sum (star_entries (*).nnames)) char (32) based (star_names_ptr); 2 38 2 39 /* hcs_$star_list_ branch structure */ 2 40 2 41 declare 1 star_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 2 42 2 type fixed binary (2) unsigned unaligned, 2 43 /* storage system type */ 2 44 2 nnames fixed binary (16) unsigned unaligned, 2 45 /* number of names of entry that match star_name */ 2 46 2 nindex fixed binary (18) unsigned unaligned, 2 47 /* index of first name in star_list_names */ 2 48 2 dtcm bit (36) unaligned, /* date-time contents of branch were last modified */ 2 49 2 dtu bit (36) unaligned, /* date-time branch was last used */ 2 50 2 mode bit (5) unaligned, /* user's access mode to the branch */ 2 51 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 2 52 2 master_dir bit (1) unaligned, /* is branch a master directory */ 2 53 2 pad bit (7) unaligned, 2 54 2 records fixed binary (18) unsigned unaligned; 2 55 /* records used by branch */ 2 56 2 57 /* hcs_$star_dir_list_ branch structure */ 2 58 2 59 declare 1 star_dir_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 2 60 2 type fixed binary (2) unsigned unaligned, 2 61 /* storage system type */ 2 62 2 nnames fixed binary (16) unsigned unaligned, 2 63 /* number of names of entry that match star_name */ 2 64 2 nindex fixed binary (18) unsigned unaligned, 2 65 /* index of first name in star_list_names */ 2 66 2 dtem bit (36) unaligned, /* date-time directory entry of branch was last modified */ 2 67 2 pad bit (36) unaligned, 2 68 2 mode bit (5) unaligned, /* user's access mode to the branch */ 2 69 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 2 70 2 master_dir bit (1) unaligned, /* is branch a master directory */ 2 71 2 bit_count fixed binary (24) unaligned; 2 72 /* bit count of the branch */ 2 73 2 74 /* hcs_$star_list_ and hcs_$star_dir_list_ link structure */ 2 75 2 76 declare 1 star_links (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 2 77 2 type fixed binary (2) unsigned unaligned, 2 78 /* storage system type */ 2 79 2 nnames fixed binary (16) unsigned unaligned, 2 80 /* number of names of entry that match star_name */ 2 81 2 nindex fixed binary (18) unsigned unaligned, 2 82 /* index of first name in star_list_names */ 2 83 2 dtem bit (36) unaligned, /* date-time link was last modified */ 2 84 2 dtd bit (36) unaligned, /* date-time the link was last dumped */ 2 85 2 pathname_len fixed binary (18) unsigned unaligned, 2 86 /* length of the pathname of the link */ 2 87 2 pathname_index fixed binary (18) unsigned unaligned; 2 88 /* index of start of pathname in star_list_names */ 2 89 2 90 /* hcs_$star_list_ and hcs_$star_dir_list_ name array */ 2 91 2 92 declare star_list_names char (32) based (star_list_names_ptr) 2 93 dimension (star_links (star_branch_count + star_link_count).nindex 2 94 + star_links (star_branch_count + star_link_count).nnames 2 95 + divide (star_links (star_branch_count + star_link_count).pathname_len + 31, 32, 17, 0) 2 96 * binary ( 2 97 (star_links (star_branch_count + star_link_count).type = star_LINK) 2 98 & (star_select_sw >= star_LINKS_ONLY_WITH_LINK_PATHS), 1)); 2 99 2 100 /* hcs_$star_list_ and hcs_$star_dir_list_ link pathname */ 2 101 2 102 declare star_link_pathname char (star_links (star_linkx).pathname_len) 2 103 based (addr (star_list_names (star_links (star_linkx).pathname_index))); 2 104 2 105 /* internal static */ 2 106 2 107 /* star_select_sw values */ 2 108 2 109 declare star_LINKS_ONLY fixed binary (2) internal static options (constant) initial (1); 2 110 declare star_BRANCHES_ONLY fixed binary (2) internal static options (constant) initial (2); 2 111 declare star_ALL_ENTRIES fixed binary (2) internal static options (constant) initial (3); 2 112 declare star_LINKS_ONLY_WITH_LINK_PATHS 2 113 fixed binary (3) internal static options (constant) initial (5); 2 114 declare star_ALL_ENTRIES_WITH_LINK_PATHS 2 115 fixed binary (3) internal static options (constant) initial (7); 2 116 2 117 /* storage system types */ 2 118 2 119 declare star_LINK fixed binary (2) unsigned internal static options (constant) initial (0); 2 120 declare star_SEGMENT fixed binary (2) unsigned internal static options (constant) initial (1); 2 121 declare star_DIRECTORY fixed binary (2) unsigned internal static options (constant) initial (2); 2 122 2 123 /* END INCLUDE FILE . . . star_structures.incl.pl1 */ 319 320 end deldir; 321 322 3 1 /* Begin include file aim_privileges.incl.pl1 BIM 831206 */ 3 2 /* format: style3 */ 3 3 3 4 declare aim_privileges_ptr pointer; 3 5 declare 1 aim_privileges unaligned based (aim_privileges_ptr), 3 6 ( 2 ipc, /** interprocess communication privilege */ 3 7 2 dir, /** directory privilege */ 3 8 2 seg, /** segment privilege */ 3 9 2 soos, /** security out-of-service privilege */ 3 10 2 ring1, /** ring 1 access privilege */ 3 11 2 rcp, /** RCP resource access privilege */ 3 12 2 comm /** communications cross-AIM privilege */ 3 13 ) bit (1), 3 14 2 pad bit (29); 3 15 3 16 declare ( 3 17 IPC_PRIVILEGE init ("1"b), 3 18 DIR_PRIVILEGE init ("01"b), 3 19 SEG_PRIVILEGE init ("001"b), 3 20 SOOS_PRIVILEGE init ("0001"b), 3 21 RING1_PRIVILEGE init ("00001"b), 3 22 RCP_PRIVILEGE init ("000001"b), 3 23 COMM_PRIVILEGE init ("0000001"b), 3 24 ALL_PRIVILEGES init ("1111111"b) 3 25 ) bit (36) int static aligned options (constant); 3 26 3 27 3 28 /* End include file aim_privileges.incl.pl1 */ 323 4 1 /* BEGIN INCLUDE FILE . . . salv_args */ 4 2 /* Keith Loepere made pathname unal November 1984. */ 4 3 4 4 dcl 1 salv_args aligned based, 4 5 2 temp1_ptr ptr, /* ptr to temp segment */ 4 6 2 temp2_ptr ptr, /* ptr to temp segment */ 4 7 2 salv_time bit (36) aligned, /* Highest valid date/time */ 4 8 2 options aligned, 4 9 3 force_rebuild bit (1) unal, /* ON, if should rebuild directory */ 4 10 3 print_trace bit (1) unal, /* ON, if debugging trace information should be printed. */ 4 11 3 correct_oosw bit (1) unal, /* ON, if directory's out-of-service switch should be reset */ 4 12 3 check_vtoce bit (1) unal, /* ON, if VTOC entries of all branches should be checked. */ 4 13 3 dump bit (1) unal, /* ON, if should dump directory on error condition */ 4 14 3 compact bit (1) unal, /* ON, to force rebuild if one pages can be recovered. */ 4 15 3 delete_connection_failure bit (1) unal, /* ON, to delete branches that have no VTOC entries */ 4 16 3 pad bit (29), 4 17 2 branch_ptr ptr, /* ptr to branch for directory */ 4 18 2 current_length fixed bin, /* number of pages in directory */ 4 19 2 pathname char (168) unal, /* pathname of directory being salvaged */ 4 20 2 master_dir_uid bit (36) aligned, /* master UID for this directory */ 4 21 2 tree_depth fixed bin; /* number of levels from root for this directory */ 4 22 4 23 /* END INCLUDE FILE . . . salv_args */ 324 325 declare 1 SA aligned like salv_args; 326 end delete_old_pdds; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/20/87 1346.7 delete_old_pdds.pl1 >spec>install>1007>delete_old_pdds.pl1 249 1 06/10/82 1045.5 star_structures.incl.pl1 >ldd>include>star_structures.incl.pl1 319 2 06/10/82 1045.5 star_structures.incl.pl1 >ldd>include>star_structures.incl.pl1 323 3 08/19/84 1445.6 aim_privileges.incl.pl1 >ldd>include>aim_privileges.incl.pl1 324 4 01/30/85 1523.9 salv_args.incl.pl1 >ldd>include>salv_args.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. Dir parameter char unaligned dcl 219 ref 216 225 SA 000136 automatic structure level 1 dcl 325 set ref 273 273 SOOS_PRIVILEGE constant bit(36) initial dcl 3-16 ref 92 a_dn parameter char unaligned dcl 257 ref 254 266 a_en parameter char unaligned dcl 257 ref 254 267 a_time 000102 automatic fixed bin(71,0) dcl 33 set ref 177* 181 al 000114 automatic fixed bin(17,0) dcl 37 set ref 109* 110 114 114 122 122 133 133 142 157 157 al1 000115 automatic fixed bin(17,0) dcl 37 set ref 129* 130 130 133 133 150* 151 151 ap 000110 automatic pointer dcl 36 set ref 109* 110 114 122 133 142 157 ap1 000112 automatic pointer dcl 36 set ref 129* 130 133 150* 151 areap 000106 automatic pointer dcl 35 set ref 167* 225* 284* arg based char unaligned dcl 38 set ref 110 114* 122* 133* 142 157* arg1 based char unaligned dcl 39 set ref 130* 133* 151* argno 000116 automatic fixed bin(17,0) dcl 40 set ref 108* 109* 120 128* 128 129* 146 149* 149 150* cleanup 000130 stack reference condition dcl 80 ref 90 code parameter fixed bin(35,0) dcl 258 in procedure "deldir" set ref 254 273* 274 276* 282* 284* 285 287 287* 293* 294* 298* 299* 302* 304 304* 314* 317* code 000100 automatic fixed bin(35,0) dcl 32 in procedure "delete_old_pdds" set ref 101* 102 104* 109* 129* 130* 131 150* 151* 152 170* 171 173* 194* 205* 206 207 207* 225* 227 229 229* 237* 238 238* com_err_ 000046 constant entry external dcl 68 ref 95 104 114 122 133 157 173 207 229 238 276 287 304 cu_$arg_count 000010 constant entry external dcl 47 ref 101 cu_$arg_ptr 000012 constant entry external dcl 48 ref 109 129 150 cv_dec_check_ 000014 constant entry external dcl 49 ref 130 151 dn 000100 automatic char(168) unaligned dcl 260 set ref 266* 268 270 282* 317* dnen 000162 automatic char(168) unaligned dcl 262 set ref 268* 270* 272 284* 287* 293* 294* 298* 299* 302* 304* 314* en 000152 automatic char(32) unaligned dcl 261 set ref 267* 268 270 282* 317* ename 000234 automatic char(32) unaligned dcl 263 in procedure "deldir" set ref 290* 293* 294* 298* 299* 302* 304* ename 000237 automatic char(32) unaligned dcl 222 in procedure "do_it" set ref 236* 237* 238* error_table_$bad_conversion 000052 external static fixed bin(35,0) dcl 70 set ref 133* error_table_$badopt 000056 external static fixed bin(35,0) dcl 70 set ref 157* error_table_$inconsistent 000060 external static fixed bin(35,0) dcl 70 set ref 114* error_table_$noarg 000054 external static fixed bin(35,0) dcl 70 set ref 122* error_table_$nomatch 000050 external static fixed bin(35,0) dcl 70 ref 229 285 first_count 000120 automatic fixed bin(17,0) dcl 41 set ref 99* 112 130* 131 162 162* 234 get_privileges_ 000020 constant entry external dcl 51 ref 92 get_system_free_area_ 000016 constant entry external dcl 50 ref 167 get_temp_segments_ 000022 constant entry external dcl 52 ref 178 hphcs_$delentry_file 000036 constant entry external dcl 62 ref 294 302 317 hphcs_$quota_read 000040 constant entry external dcl 63 ref 170 hphcs_$quota_set 000042 constant entry external dcl 65 ref 194 314 hphcs_$salv_directory 000044 constant entry external dcl 66 ref 273 hphcs_$star_ 000026 constant entry external dcl 54 ref 225 284 i 000236 automatic fixed bin(17,0) dcl 221 set ref 234* 236* j 000244 automatic fixed bin(17,0) dcl 264 set ref 289* 290 291 296* last_count 000121 automatic fixed bin(17,0) dcl 41 set ref 99* 144 151* 152 164 164* 234 nargs 000117 automatic fixed bin(17,0) dcl 40 set ref 101* 108 120 146 nindex 0(18) based fixed bin(18,0) array level 2 in structure "star_entries" packed unsigned unaligned dcl 2-27 in procedure "deldir" ref 290 nindex 0(18) based fixed bin(18,0) array level 2 in structure "star_entries" packed unsigned unaligned dcl 1-27 in procedure "do_it" ref 236 nnames 0(02) based fixed bin(16,0) array level 2 in structure "star_entries" packed unsigned unaligned dcl 2-27 in procedure "deldir" ref 308 nnames 0(02) based fixed bin(16,0) array level 2 in structure "star_entries" packed unsigned unaligned dcl 1-27 in procedure "do_it" ref 242 null builtin function dcl 83 ref 88 186 210 224 242 245 273 273 283 308 310 release_temp_segments_ 000024 constant entry external dcl 53 ref 210 salv_args based structure level 1 dcl 4-4 saved_quota 000104 automatic fixed bin(18,0) unsigned dcl 34 set ref 169* 170* 194 194* seg_fault_error 000000 stack reference condition dcl 80 ref 280 soos_priv_code 000122 automatic fixed bin(35,0) dcl 43 set ref 89* 94* 95 95* 203 206* star_ALL_ENTRIES 000014 constant fixed bin(2,0) initial dcl 2-111 in procedure "deldir" set ref 284* star_ALL_ENTRIES 000014 constant fixed bin(2,0) initial dcl 1-111 in procedure "do_it" set ref 225* star_DIRECTORY constant fixed bin(2,0) initial unsigned dcl 2-121 ref 296 star_SEGMENT constant fixed bin(2,0) initial unsigned dcl 2-120 ref 291 star_entries based structure array level 1 dcl 1-27 in procedure "do_it" ref 245 star_entries based structure array level 1 dcl 2-27 in procedure "deldir" ref 310 star_entry_count 000245 automatic fixed bin(17,0) dcl 2-14 in procedure "deldir" set ref 284* 289 308 310 star_entry_count 000247 automatic fixed bin(17,0) dcl 1-14 in procedure "do_it" set ref 225* 234 242 245 star_entry_ptr 000246 automatic pointer dcl 2-15 in procedure "deldir" set ref 283* 284* 290 291 296 308 310 310 star_entry_ptr 000250 automatic pointer dcl 1-15 in procedure "do_it" set ref 224* 225* 236 242 245 245 star_names based char(32) array unaligned dcl 2-37 in procedure "deldir" ref 290 308 star_names based char(32) array unaligned dcl 1-37 in procedure "do_it" ref 236 242 star_names_ptr 000250 automatic pointer dcl 2-19 in procedure "deldir" set ref 283* 284* 290 308 308 star_names_ptr 000252 automatic pointer dcl 1-19 in procedure "do_it" set ref 224* 225* 236 242 242 substr builtin function dcl 83 ref 181 sum builtin function dcl 83 ref 242 308 system_privilege_$check_mode_reset 000034 constant entry external dcl 60 ref 282 293 298 system_privilege_$soos_priv_off 000032 constant entry external dcl 58 ref 205 system_privilege_$soos_priv_on 000030 constant entry external dcl 56 ref 94 tsps 000124 automatic pointer array dcl 44 set ref 88* 178* 179 180 210 210* type based fixed bin(2,0) array level 2 packed unsigned unaligned dcl 2-27 ref 291 296 whoami 000000 constant char(32) initial unaligned dcl 78 set ref 95* 104* 114* 122* 133* 157* 173* 178* 207* 210* 229* 238* 276* 287* 304* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ALL_PRIVILEGES internal static bit(36) initial dcl 3-16 COMM_PRIVILEGE internal static bit(36) initial dcl 3-16 DIR_PRIVILEGE internal static bit(36) initial dcl 3-16 IPC_PRIVILEGE internal static bit(36) initial dcl 3-16 RCP_PRIVILEGE internal static bit(36) initial dcl 3-16 RING1_PRIVILEGE internal static bit(36) initial dcl 3-16 SEG_PRIVILEGE internal static bit(36) initial dcl 3-16 aim_privileges based structure level 1 packed unaligned dcl 3-5 aim_privileges_ptr automatic pointer dcl 3-4 length builtin function dcl 83 reverse builtin function dcl 83 star_ALL_ENTRIES_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 1-114 in procedure "do_it" star_ALL_ENTRIES_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 2-114 in procedure "deldir" star_BRANCHES_ONLY internal static fixed bin(2,0) initial dcl 2-110 in procedure "deldir" star_BRANCHES_ONLY internal static fixed bin(2,0) initial dcl 1-110 in procedure "do_it" star_DIRECTORY internal static fixed bin(2,0) initial unsigned dcl 1-121 star_LINK internal static fixed bin(2,0) initial unsigned dcl 2-119 in procedure "deldir" star_LINK internal static fixed bin(2,0) initial unsigned dcl 1-119 in procedure "do_it" star_LINKS_ONLY internal static fixed bin(2,0) initial dcl 2-109 in procedure "deldir" star_LINKS_ONLY internal static fixed bin(2,0) initial dcl 1-109 in procedure "do_it" star_LINKS_ONLY_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 2-112 in procedure "deldir" star_LINKS_ONLY_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 1-112 in procedure "do_it" star_SEGMENT internal static fixed bin(2,0) initial unsigned dcl 1-120 star_branch_count automatic fixed bin(17,0) dcl 2-13 in procedure "deldir" star_branch_count automatic fixed bin(17,0) dcl 1-13 in procedure "do_it" star_dir_list_branch based structure array level 1 dcl 2-59 in procedure "deldir" star_dir_list_branch based structure array level 1 dcl 1-59 in procedure "do_it" star_link_count automatic fixed bin(17,0) dcl 1-17 in procedure "do_it" star_link_count automatic fixed bin(17,0) dcl 2-17 in procedure "deldir" star_link_pathname based char unaligned dcl 1-102 in procedure "do_it" star_link_pathname based char unaligned dcl 2-102 in procedure "deldir" star_links based structure array level 1 dcl 1-76 in procedure "do_it" star_links based structure array level 1 dcl 2-76 in procedure "deldir" star_linkx automatic fixed bin(17,0) dcl 1-18 in procedure "do_it" star_linkx automatic fixed bin(17,0) dcl 2-18 in procedure "deldir" star_list_branch based structure array level 1 dcl 2-41 in procedure "deldir" star_list_branch based structure array level 1 dcl 1-41 in procedure "do_it" star_list_branch_ptr automatic pointer dcl 1-16 in procedure "do_it" star_list_branch_ptr automatic pointer dcl 2-16 in procedure "deldir" star_list_names based char(32) array unaligned dcl 2-92 in procedure "deldir" star_list_names based char(32) array unaligned dcl 1-92 in procedure "do_it" star_list_names_ptr automatic pointer dcl 1-20 in procedure "do_it" star_list_names_ptr automatic pointer dcl 2-20 in procedure "deldir" star_select_sw automatic fixed bin(3,0) dcl 2-21 in procedure "deldir" star_select_sw automatic fixed bin(3,0) dcl 1-21 in procedure "do_it" verify builtin function dcl 83 NAMES DECLARED BY EXPLICIT CONTEXT. DELETE_TOP 002552 constant label dcl 314 ref 277 NEED_GOOD_NUMBER 000634 constant label dcl 133 ref 152 NEED_NUMBER 000531 constant label dcl 122 ref 146 ONLY_ONCE 000472 constant label dcl 114 ref 144 clean_up 001274 constant entry internal dcl 200 ref 90 197 connection_failure 002552 constant label dcl 314 set ref 280 deldir 001704 constant entry internal dcl 254 ref 237 299 delete_old_pdds 000257 constant entry external dcl 22 do_it 001375 constant entry internal dcl 216 ref 191 192 done_it 001641 constant label dcl 242 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 273 273 clock builtin function ref 177 rtrim builtin function ref 225 270 unspec builtin function ref 181 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3146 3230 2640 3156 Length 3542 2640 62 276 305 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME delete_old_pdds 378 external procedure is an external procedure. on unit on line 90 64 on unit clean_up 90 internal procedure is called by several nonquick procedures. do_it internal procedure shares stack frame of external procedure delete_old_pdds. deldir 262 internal procedure enables or reverts conditions. on unit on line 280 64 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME deldir 000100 dn deldir 000152 en deldir 000162 dnen deldir 000234 ename deldir 000244 j deldir 000245 star_entry_count deldir 000246 star_entry_ptr deldir 000250 star_names_ptr deldir delete_old_pdds 000100 code delete_old_pdds 000102 a_time delete_old_pdds 000104 saved_quota delete_old_pdds 000106 areap delete_old_pdds 000110 ap delete_old_pdds 000112 ap1 delete_old_pdds 000114 al delete_old_pdds 000115 al1 delete_old_pdds 000116 argno delete_old_pdds 000117 nargs delete_old_pdds 000120 first_count delete_old_pdds 000121 last_count delete_old_pdds 000122 soos_priv_code delete_old_pdds 000124 tsps delete_old_pdds 000136 SA delete_old_pdds 000236 i do_it 000237 ename do_it 000247 star_entry_count do_it 000250 star_entry_ptr do_it 000252 star_names_ptr do_it THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 mpfx2 enable_op shorten_stack ext_entry int_entry int_entry_desc op_freen_ clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr cv_dec_check_ get_privileges_ get_system_free_area_ get_temp_segments_ hphcs_$delentry_file hphcs_$quota_read hphcs_$quota_set hphcs_$salv_directory hphcs_$star_ release_temp_segments_ system_privilege_$check_mode_reset system_privilege_$soos_priv_off system_privilege_$soos_priv_on THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$badopt error_table_$inconsistent error_table_$noarg error_table_$nomatch LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 22 000256 88 000264 89 000277 90 000301 92 000323 94 000335 95 000344 99 000372 101 000375 102 000406 104 000410 105 000434 108 000435 109 000445 110 000462 112 000470 114 000472 117 000525 120 000526 122 000531 125 000564 128 000565 129 000566 130 000603 131 000630 133 000634 137 000676 140 000677 142 000700 144 000704 146 000706 149 000711 150 000712 151 000727 152 000754 154 000760 157 000761 158 001013 160 001014 162 001016 164 001021 167 001024 169 001033 170 001034 171 001111 173 001113 174 001142 177 001143 178 001145 179 001167 180 001171 181 001173 182 001176 183 001215 184 001217 185 001221 186 001223 187 001225 188 001226 191 001227 192 001234 194 001241 197 001266 326 001272 200 001273 203 001301 205 001304 206 001312 207 001317 210 001345 212 001374 216 001375 224 001406 225 001411 227 001506 229 001511 231 001540 234 001541 236 001553 237 001564 238 001606 240 001637 242 001641 245 001674 247 001702 254 001703 266 001724 267 001732 268 001736 270 001756 272 002016 273 002023 274 002060 276 002063 277 002114 280 002115 282 002134 283 002156 284 002161 285 002230 287 002235 289 002266 290 002275 291 002306 293 002314 294 002336 295 002360 296 002361 298 002363 299 002405 300 002427 302 002430 304 002452 306 002507 308 002511 310 002544 314 002552 317 002576 318 002620 ----------------------------------------------------------- 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