COMPILATION LISTING OF SEGMENT sweep_disk_dec_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1644.2 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 sweep_disk_dec_: proc (path, counter); 12 13 /* SWEEP_DISK_ - driver for statistics programs. 14* 15* This program is called with a pathname, the root node of a tree 16* to sweep, and a function, which will be called for each directory entry. 17* The program recursively walks down the directory tree and 18* calls the user function for each entry found. 19* 20* This version of the program will try to give itself access if it doesn't have it 21* 22* THVV 23* 24* Modified January 14, 1978 by Peter C. Krupp to be used with hunt_dec. 25* Modified March 16, 1977 by S. Webber to remove long entry, and to chase links that go to dirs (via chase_links entry). 26* Modified on 9 September 1976 by R. G. Bratt to not terminate and to use (get release)_temp_segments_. 27* Modified on 5 June 1975 by J. C. Whitmore to attempt to set system privileges. 28* 29* */ 30 31 dcl path char (168), /* path name to sweep */ 32 counter entry (char (168), char (32), fixed bin, 33 char (32), ptr, ptr); 34 35 dcl dummy_dir char (168), 36 dummy_ename char (32); 37 38 dcl areap ptr, /* ptr to area segment. */ 39 two_ptr (2) ptr init (null,null), 40 myname char (15) init ("sweep_disk_dec_") static options (constant), 41 n_ids fixed bin init (0), /* number of dir UIDs we've processed */ 42 ec fixed bin (35); /* err code */ 43 44 dcl ids (1) bit (36) aligned based (two_ptr (2)); 45 46 dcl chase_links_sw bit (1) aligned init ("0"b); /* Indicates if links to dirs are to be chased */ 47 dcl priv_off bit (1); /* flag to tell that system privileges are off */ 48 dcl priv_set fixed bin (35); /* this will be zero if we set system privileges */ 49 50 dcl sys_info$max_seg_size fixed bin (35) ext; 51 52 dcl 1 acla (1) aligned, 53 2 userid char (32), 54 2 modes bit (36), 55 2 erc fixed bin (35); 56 57 dcl 1 delacla (1) aligned, 58 2 userid char (32), 59 2 erc fixed bin (35); 60 61 62 dcl com_err_ entry options (variable), 63 get_group_id_ entry () returns (char (32) aligned), 64 expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), 65 area_ entry (fixed bin (35), ptr); 66 67 dcl system_privilege_$dir_priv_on entry (fixed bin (35)); 68 dcl system_privilege_$dir_priv_off entry (fixed bin (35)); 69 dcl hcs_$add_dir_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 70 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 71 dcl hcs_$get_link_target entry (char (*), char (*), char (*), char (*), fixed bin (35)); 72 dcl hcs_$delete_dir_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 73 dcl hcs_$star_list_ entry (char (*), char (*), fixed bin (3), 74 ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35)), 75 get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)), 76 release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 77 78 dcl (cleanup, linkage_error) condition; 79 dcl (addr, null, index, fixed) builtin; 80 81 /* - - - - */ 82 83 84 start: 85 call get_temp_segments_ (myname, two_ptr, ec); 86 areap = two_ptr (1); 87 call area_ (sys_info$max_seg_size, areap); 88 acla (1).userid = get_group_id_ (); 89 delacla (1).userid = acla (1).userid; 90 acla (1).modes = "111"b; 91 92 priv_off = "1"b; /* assume that we don't have dir privilege */ 93 priv_set = 1; /* and that we did not set dir priv */ 94 95 on cleanup call clean_up; /* so we can undo what we did */ 96 97 /* Now we will try to set dir privilege so we can look at each dir in the system. */ 98 99 on linkage_error go to revert_handler; /* in case of no access to system_privilege_ */ 100 call system_privilege_$dir_priv_on (priv_set); /* try to set it */ 101 priv_off = "0"b; /* privileges are on now for sure */ 102 revert_handler: 103 revert linkage_error; /* it was only to catch system_privilege_ error */ 104 105 if priv_off then do; /* see if we now have the dir priv */ 106 107 call com_err_ (0, myname, "Unable to set directory privilege. Access to storage system may not be complete."); 108 priv_set = 1; /* just to be safe */ 109 end; 110 call expand_pathname_ (path, dummy_dir, dummy_ename, ec); /* Just check for syntax error */ 111 if ec ^= 0 then do; 112 call com_err_ (ec, myname, "^a", path); 113 call clean_up; 114 return; 115 end; 116 call process (path, 0); /* Looks innocent ... */ 117 call clean_up; 118 119 return; /* Done. */ 120 121 122 /* - - - - - - - - - - - - - - */ 123 124 process: proc (apth, lvl); 125 126 /* internal doit procedure */ 127 128 dcl apth char (168), /* path of tree to process */ 129 lvl fixed bin; /* recursion level */ 130 131 dcl npth char (168), /* new path for recursion */ 132 dstar char (2) init ("**") internal static options (constant), /* for star, gets all. */ 133 ddn char (168), /* ... for expand */ 134 een char (32), /* ... */ 135 c32 char (32), 136 new_dirname char (168), 137 new_ename char (32), 138 ifail fixed bin (35), 139 (eptr, nptr) ptr init (null), /* for star and status */ 140 ecc fixed bin (35), 141 (t, bcount, lc, ii, nix, i) fixed bin; /* indices */ 142 143 dcl names (100) char (32) aligned based (nptr); /* Structure returned by star_ */ 144 145 dcl 1 branches (100) aligned based (eptr), /* ... */ 146 2 type bit (2) unaligned, /* 10b is directory */ 147 2 nnam bit (16) unaligned, /* number of names this seg */ 148 2 nindex bit (18) unaligned, /* index in names structure */ 149 2 padx bit (108) unaligned; 150 151 dcl 1 entry aligned, 152 2 type bit (2) unaligned, 153 2 nnam fixed bin (15) unaligned, 154 2 nindex fixed bin (17) unaligned, 155 2 padx bit (288) aligned, 156 2 uid bit (36) aligned; 157 158 on cleanup begin; 159 if eptr ^= null then free eptr -> branches; 160 if nptr ^= null then free nptr -> names; 161 if ifail = 0 then call hcs_$delete_dir_acl_entries (ddn, een, addr (delacla), 1, ecc); 162 end; 163 164 call expand_pathname_ (apth, ddn, een, ecc); /* needn't check ecc, cause we made path */ 165 /* except for first time which is checked */ 166 167 /* Now get UID of the dir and place on stack */ 168 169 call hcs_$status_long (ddn, een, 0, addr (entry), null, ecc); 170 n_ids = n_ids + 1; 171 ids (n_ids) = entry.uid; 172 call hcs_$add_dir_acl_entries (ddn, een, addr (acla), 1, ifail); 173 call hcs_$star_list_ (apth, dstar, 111b, areap, bcount, lc, eptr, nptr, ecc); 174 if ecc = 0 then do; 175 do ii = 1 to bcount + lc; /* Now do all branches, look for sub-dirs. */ 176 nix = fixed (eptr -> branches (ii).nindex); 177 c32 = nptr -> names (nix); 178 call counter (ddn, een, lvl, c32, addr (eptr -> branches (ii)), nptr); 179 if eptr -> branches (ii).type = "10"b then do; 180 if apth = ">" 181 then npth = ">" || c32; 182 else npth = rtrim (apth) || ">" || c32; 183 call process (npth, lvl+1); /* recursion here */ 184 end; 185 186 /* Now check to see if we have a link to a directory */ 187 188 else if eptr -> branches (ii).type = "00"b & chase_links_sw then do; 189 call hcs_$get_link_target (apth, c32, new_dirname, new_ename, ecc); 190 if ecc = 0 then do; 191 call hcs_$status_long (new_dirname, new_ename, 0, addr (entry), null, ecc); 192 if ecc = 0 then do; 193 if entry.type = "10"b then do; 194 do i = 1 to n_ids; 195 if ids (i) = entry.uid then goto already_done; 196 end; 197 n_ids = n_ids + 1; 198 ids (n_ids) = entry.uid; 199 call process (rtrim (new_dirname) || ">" || new_ename, lvl+1); 200 end; 201 end; 202 end; 203 already_done: 204 end; 205 end; 206 free eptr -> branches; /* Clean up area. */ 207 free nptr -> names; /* ... */ 208 end; 209 if ifail = 0 then call hcs_$delete_dir_acl_entries (ddn, een, addr (delacla), 1, ecc); 210 end process; /* Whew. */ 211 212 /* CHASE_LINK: Entry to chase links to directories */ 213 214 chase_links: entry (path, counter); 215 216 chase_links_sw = "1"b; 217 goto start; 218 219 220 221 clean_up: proc; 222 if priv_set = 0 then call system_privilege_$dir_priv_off (priv_set); 223 call release_temp_segments_ (myname, two_ptr, ec); 224 return; 225 end clean_up; 226 227 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1506.4 sweep_disk_dec_.pl1 >dumps>old>recomp>sweep_disk_dec_.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. acla 000175 automatic structure array level 1 dcl 52 set ref 172 172 addr builtin function dcl 79 ref 161 161 169 169 172 172 178 178 191 191 209 209 apth parameter char(168) unaligned dcl 128 set ref 124 164* 173* 180 182 189* area_ 000020 constant entry external dcl 62 ref 87 areap 000162 automatic pointer dcl 38 set ref 86* 87* 173* bcount 000335 automatic fixed bin(17,0) dcl 131 set ref 173* 175 branches based structure array level 1 dcl 145 set ref 159 178 178 206 c32 000234 automatic char(32) unaligned dcl 131 set ref 177* 178* 180 182 189* chase_links_sw 000172 automatic bit(1) initial dcl 46 set ref 46* 188 216* cleanup 000220 stack reference condition dcl 78 ref 95 158 com_err_ 000012 constant entry external dcl 62 ref 107 112 counter parameter entry variable dcl 31 ref 11 178 214 ddn 000152 automatic char(168) unaligned dcl 131 set ref 161* 164* 169* 172* 178* 209* delacla 000207 automatic structure array level 1 dcl 57 set ref 161 161 209 209 dstar 000000 constant char(2) initial unaligned dcl 131 set ref 173* dummy_dir 000100 automatic char(168) unaligned dcl 35 set ref 110* dummy_ename 000152 automatic char(32) unaligned dcl 35 set ref 110* ec 000171 automatic fixed bin(35,0) dcl 38 set ref 84* 110* 111 112* 223* ecc 000334 automatic fixed bin(35,0) dcl 131 set ref 161* 164* 169* 173* 174 189* 190 191* 192 209* een 000224 automatic char(32) unaligned dcl 131 set ref 161* 164* 169* 172* 178* 209* entry 000342 automatic structure level 1 dcl 151 set ref 169 169 191 191 eptr 000330 automatic pointer initial dcl 131 set ref 131* 159 159 173* 176 178 178 179 188 206 expand_pathname_ 000016 constant entry external dcl 62 ref 110 164 fixed builtin function dcl 79 ref 176 get_group_id_ 000014 constant entry external dcl 62 ref 88 get_temp_segments_ 000040 constant entry external dcl 73 ref 84 hcs_$add_dir_acl_entries 000026 constant entry external dcl 69 ref 172 hcs_$delete_dir_acl_entries 000034 constant entry external dcl 72 ref 161 209 hcs_$get_link_target 000032 constant entry external dcl 71 ref 189 hcs_$star_list_ 000036 constant entry external dcl 73 ref 173 hcs_$status_long 000030 constant entry external dcl 70 ref 169 191 i 000341 automatic fixed bin(17,0) dcl 131 set ref 194* 195* ids based bit(36) array dcl 44 set ref 171* 195 198* ifail 000326 automatic fixed bin(35,0) dcl 131 set ref 161 172* 209 ii 000337 automatic fixed bin(17,0) dcl 131 set ref 175* 176 178 178 179 188* lc 000336 automatic fixed bin(17,0) dcl 131 set ref 173* 175 linkage_error 000226 stack reference condition dcl 78 ref 99 102 lvl parameter fixed bin(17,0) dcl 128 set ref 124 178* 183 199 modes 10 000175 automatic bit(36) array level 2 dcl 52 set ref 90* myname 000001 constant char(15) initial unaligned dcl 38 set ref 84* 107* 112* 223* n_ids 000170 automatic fixed bin(17,0) initial dcl 38 set ref 38* 170* 170 171 194 197* 197 198 names based char(32) array dcl 143 ref 160 177 207 new_dirname 000244 automatic char(168) unaligned dcl 131 set ref 189* 191* 199 new_ename 000316 automatic char(32) unaligned dcl 131 set ref 189* 191* 199 nindex 0(18) based bit(18) array level 2 packed unaligned dcl 145 set ref 176 nix 000340 automatic fixed bin(17,0) dcl 131 set ref 176* 177 npth 000100 automatic char(168) unaligned dcl 131 set ref 180* 182* 183* nptr 000332 automatic pointer initial dcl 131 set ref 131* 160 160 173* 177 178* 207 null builtin function dcl 79 ref 38 38 131 131 159 160 169 169 191 191 path parameter char(168) unaligned dcl 31 set ref 11 110* 112* 116* 214 priv_off 000173 automatic bit(1) unaligned dcl 47 set ref 92* 101* 105 priv_set 000174 automatic fixed bin(35,0) dcl 48 set ref 93* 100* 108* 222 222* release_temp_segments_ 000042 constant entry external dcl 73 ref 223 sys_info$max_seg_size 000010 external static fixed bin(35,0) dcl 50 set ref 87* system_privilege_$dir_priv_off 000024 constant entry external dcl 68 ref 222 system_privilege_$dir_priv_on 000022 constant entry external dcl 67 ref 100 two_ptr 000164 automatic pointer initial array dcl 38 set ref 38* 38* 84* 86 171 195 198 223* type based bit(2) array level 2 in structure "branches" packed unaligned dcl 145 in procedure "process" set ref 179 188 type 000342 automatic bit(2) level 2 in structure "entry" packed unaligned dcl 151 in procedure "process" set ref 193 uid 11 000342 automatic bit(36) level 2 dcl 151 set ref 171 195 198 userid 000207 automatic char(32) array level 2 in structure "delacla" dcl 57 in procedure "sweep_disk_dec_" set ref 89* userid 000175 automatic char(32) array level 2 in structure "acla" dcl 52 in procedure "sweep_disk_dec_" set ref 88* 89 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. index builtin function dcl 79 t automatic fixed bin(17,0) dcl 131 NAMES DECLARED BY EXPLICIT CONTEXT. already_done 001322 constant label dcl 203 ref 195 chase_links 000404 constant entry external dcl 214 clean_up 001372 constant entry internal dcl 221 ref 95 113 117 process 000416 constant entry internal dcl 124 ref 116 183 199 revert_handler 000245 constant label dcl 102 ref 99 start 000120 constant label dcl 84 ref 217 sweep_disk_dec_ 000112 constant entry external dcl 11 NAME DECLARED BY CONTEXT OR IMPLICATION. rtrim builtin function ref 182 199 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1702 1746 1434 1712 Length 2152 1434 44 167 246 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME sweep_disk_dec_ 194 external procedure is an external procedure. on unit on line 95 64 on unit on unit on line 99 64 on unit process 376 internal procedure enables or reverts conditions. on unit on line 158 90 on unit clean_up 82 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME process 000100 npth process 000152 ddn process 000224 een process 000234 c32 process 000244 new_dirname process 000316 new_ename process 000326 ifail process 000330 eptr process 000332 nptr process 000334 ecc process 000335 bcount process 000336 lc process 000337 ii process 000340 nix process 000341 i process 000342 entry process sweep_disk_dec_ 000100 dummy_dir sweep_disk_dec_ 000152 dummy_ename sweep_disk_dec_ 000162 areap sweep_disk_dec_ 000164 two_ptr sweep_disk_dec_ 000170 n_ids sweep_disk_dec_ 000171 ec sweep_disk_dec_ 000172 chase_links_sw sweep_disk_dec_ 000173 priv_off sweep_disk_dec_ 000174 priv_set sweep_disk_dec_ 000175 acla sweep_disk_dec_ 000207 delacla sweep_disk_dec_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_var call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext enable shorten_stack ext_entry int_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. area_ com_err_ expand_pathname_ get_group_id_ get_temp_segments_ hcs_$add_dir_acl_entries hcs_$delete_dir_acl_entries hcs_$get_link_target hcs_$star_list_ hcs_$status_long release_temp_segments_ system_privilege_$dir_priv_off system_privilege_$dir_priv_on THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 38 000065 46 000103 11 000106 84 000120 86 000141 87 000143 88 000154 89 000163 90 000166 92 000170 93 000172 95 000174 99 000216 100 000235 101 000244 102 000245 105 000246 107 000250 108 000275 110 000277 111 000324 112 000326 113 000356 114 000362 116 000363 117 000375 119 000401 214 000402 216 000412 217 000414 124 000415 131 000423 158 000426 159 000442 160 000451 161 000460 162 000521 164 000522 169 000547 170 000610 171 000612 172 000616 173 000653 174 000725 175 000727 176 000737 177 000746 178 000754 179 001001 180 001012 182 001034 183 001074 184 001111 188 001112 189 001117 190 001147 191 001151 192 001212 193 001214 194 001220 195 001230 196 001235 197 001237 198 001241 199 001245 200 001321 205 001322 206 001324 207 001326 209 001330 210 001370 221 001371 222 001377 223 001410 224 001432 ----------------------------------------------------------- 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