COMPILATION LISTING OF SEGMENT sweep_disk_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/12/82 1307.4 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 sweep_disk_: 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 on 9 September 1976 by R. G. Bratt to not terminate and to use (get release)_temp_segments_. 25* Modified on 5 June 1975 by J. C. Whitmore to attempt to set system privileges. 26* sweep_disk_$dir_list entry point added to call hcs_$star_dir_list_ 05/29/79 S. Herbst 27* 28* */ 29 30 dcl path char (168) aligned, /* path name to sweep */ 31 counter entry (char (168) aligned, char (32) aligned, fixed bin, 32 char (32) aligned, ptr, ptr); 33 34 dcl areap ptr, /* ptr to area segment. */ 35 one_ptr (1) ptr init (null), 36 myname char (11) init ("sweep_disk_") static options (constant), 37 ec fixed bin (35); /* err code */ 38 39 dcl bfsw bit (1) int static init ("1"b); /* default will suppress non fatal errors */ 40 dcl dir_list_sw bit (1); /* ON: sweep_disk_$dir_list */ 41 dcl priv_set bit (1); /* flag to tell that system privileges are off */ 42 dcl priv fixed bin (35); /* this will be zero if we set system privileges */ 43 44 dcl sys_info$max_seg_size fixed bin (35) ext; 45 46 dcl 1 acla (1) aligned, 47 2 userid char (32), 48 2 modes bit (36), 49 2 erc fixed bin (35); 50 51 dcl 1 delacla (1) aligned, 52 2 userid char (32), 53 2 erc fixed bin (35); 54 55 56 dcl com_err_ entry options (variable), 57 get_group_id_ entry () returns (char (32) aligned), 58 expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)), 59 area_ entry (fixed bin (35), ptr); 60 61 dcl error_table_$ai_restricted fixed bin (35) ext; 62 63 dcl system_privilege_$dir_priv_on entry (fixed bin (35)); 64 dcl system_privilege_$dir_priv_off entry (fixed bin (35)); 65 dcl hcs_$add_dir_acl_entries entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin (35)); 66 dcl hcs_$delete_dir_acl_entries entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin (35)); 67 dcl (hcs_$star_list_, hcs_$star_dir_list_) entry 68 (char (*) aligned, char (*) aligned, fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35)); 69 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 70 dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 71 72 dcl (cleanup, linkage_error) condition; 73 dcl (addr, fixed, index, null, substr) builtin; 74 75 /* - - - - */ 76 77 78 dir_list_sw = "0"b; /* sweep_disk_ entry */ 79 go to COMMON; 80 81 dir_list: entry (path, counter); 82 83 dir_list_sw = "1"b; 84 85 COMMON: call get_temp_segments_ (myname, one_ptr, ec); 86 areap = one_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_set = "0"b; 93 priv = 1; 94 95 on cleanup call clean_up; /* so we can undo what we did */ 96 97 call process (path, 0, dir_list_sw); /* start recursion */ 98 call clean_up; 99 100 return; /* Done. */ 101 102 103 /* - - - - - - - - - - - - - - */ 104 105 process: proc (apth, lvl, asw); 106 107 /* internal doit procedure */ 108 109 dcl apth char (168) aligned, /* path of tree to process */ 110 lvl fixed bin, /* recursion level */ 111 asw bit (1); /* ON: star_dir_list_; OFF: star_list_ */ 112 113 dcl npth char (168) aligned, /* new path for recursion */ 114 dstar char (32) aligned init ("**") internal static, /* for star, gets all. */ 115 ddn char (168) aligned, /* ... for expand */ 116 een char (32) aligned, /* ... */ 117 c32 char (32) aligned, 118 error_table_$nomatch fixed bin ext, 119 ifail fixed bin (35), 120 (eptr, nptr) ptr init (null), /* for star */ 121 ecc fixed bin (35), 122 (t, bcount, lc, ii, nix) fixed bin; /* indices */ 123 124 dcl names (100) char (32) aligned based (nptr); /* Structure returned by star_ */ 125 126 dcl 1 branches (100) aligned based (eptr), /* ... */ 127 2 type bit (2) unaligned, /* 10b is directory */ 128 2 nnam bit (16) unaligned, /* number of names this seg */ 129 2 nindex bit (18) unaligned, /* index in names structure */ 130 2 padx bit (108) unaligned; 131 132 on cleanup begin; 133 if eptr ^= null then free eptr -> branches; 134 if nptr ^= null then free nptr -> names; 135 if ifail = 0 then call hcs_$delete_dir_acl_entries (ddn, een, addr (delacla), 1, ecc); 136 end; 137 138 t = index (apth, " ") - 1; 139 call expand_path_ (addr (apth), t, addr (ddn), addr (een), ecc); 140 if ecc ^= 0 then do; 141 call com_err_ (ecc, myname, apth); 142 return; 143 end; 144 RETRY: call hcs_$add_dir_acl_entries (ddn, een, addr (acla), 1, ifail); 145 if ifail ^= 0 then 146 if ifail = error_table_$ai_restricted & ^priv_set then do; 147 148 on linkage_error go to REVERT_HANDLER; 149 150 call system_privilege_$dir_priv_on (priv); 151 priv_set = "1"b; 152 REVERT_HANDLER: 153 revert linkage_error; 154 if ^priv_set then do; /* linkage_error */ 155 if ^bfsw then call com_err_ (0, myname, 156 "Unable to set directory privilege. 157 Cannot reference AIM-restricted directory."); 158 priv = 1; 159 end; 160 161 priv_set = "1"b; /* try only once to set priv */ 162 go to RETRY; 163 end; 164 if asw then call hcs_$star_dir_list_ (apth, dstar, 111b, areap, bcount, lc, eptr, nptr, ecc); 165 else call hcs_$star_list_ (apth, dstar, 111b, areap, bcount, lc, eptr, nptr, ecc); 166 if ecc = error_table_$nomatch then go to pexit; /* Get all names. If none, go. */ 167 if ecc ^= 0 then do; /* If any other error from star, name it. */ 168 if ^bfsw then call com_err_ (ecc, myname, "Error listing contents of ^a", apth); 169 go to pexit; 170 end; 171 inloop: do ii = 1 to bcount + lc; /* Now do all branches, look for sub-dirs. */ 172 nix = fixed (eptr -> branches (ii).nindex); 173 c32 = nptr -> names (nix); 174 call counter (ddn, een, lvl, c32, addr (eptr -> branches (ii)), nptr); 175 if eptr -> branches (ii).type = "10"b then do; 176 if t > 1 then /* Fabricate path name. */ 177 npth = substr (apth, 1, t) || ">" || c32; 178 else do; /* The root is special. */ 179 npth = ">" || c32; 180 if npth = ">process_dir_dir" then go to nopdir; 181 if npth = ">pdd" then go to nopdir; 182 if npth = ">PDD" then go to nopdir; 183 end; 184 call process (npth, lvl+1, asw); /* recursion here */ 185 nopdir: end; 186 end inloop; 187 free eptr -> branches; /* Clean up area. */ 188 free nptr -> names; /* ... */ 189 pexit: if ifail = 0 then call hcs_$delete_dir_acl_entries (ddn, een, addr (delacla), 1, ecc); 190 end process; /* Whew. */ 191 192 193 loud: entry; /* entry to print more error messages */ 194 bfsw = "0"b; 195 return; 196 197 clean_up: proc; 198 if priv = 0 then call system_privilege_$dir_priv_off (priv); 199 if one_ptr (1) ^= null () then call release_temp_segments_ (myname, one_ptr, ec); 200 return; 201 end clean_up; 202 203 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/12/82 1045.6 sweep_disk_.pl1 >spec>on>11/12/82>sweep_disk_.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 000110 automatic structure array level 1 dcl 46 set ref 144 144 addr builtin function dcl 73 ref 135 135 139 139 139 139 139 139 144 144 174 174 189 189 apth parameter char(168) dcl 109 set ref 105 138 139 139 141* 164* 165* 168* 176 area_ 000032 constant entry external dcl 56 ref 87 areap 000100 automatic pointer dcl 34 set ref 86* 87* 164* 165* asw parameter bit(1) unaligned dcl 109 set ref 105 164 184* bcount 000254 automatic fixed bin(17,0) dcl 113 set ref 164* 165* 171 bfsw 000010 internal static bit(1) initial unaligned dcl 39 set ref 155 168 194* branches based structure array level 1 dcl 126 set ref 133 174 174 187 c32 000234 automatic char(32) dcl 113 set ref 173* 174* 176 179 cleanup 000134 stack reference condition dcl 72 ref 95 132 com_err_ 000024 constant entry external dcl 56 ref 141 155 168 counter parameter entry variable dcl 30 ref 11 81 174 ddn 000152 automatic char(168) dcl 113 set ref 135* 139 139 144* 174* 189* delacla 000122 automatic structure array level 1 dcl 51 set ref 135 135 189 189 dir_list_sw 000105 automatic bit(1) unaligned dcl 40 set ref 78* 83* 97* dstar 000011 internal static char(32) initial dcl 113 set ref 164* 165* ec 000104 automatic fixed bin(35,0) dcl 34 set ref 85* 199* ecc 000252 automatic fixed bin(35,0) dcl 113 set ref 135* 139* 140 141* 164* 165* 166 167 168* 189* een 000224 automatic char(32) dcl 113 set ref 135* 139 139 144* 174* 189* eptr 000246 automatic pointer initial dcl 113 set ref 113* 133 133 164* 165* 172 174 174 175 187 error_table_$ai_restricted 000034 external static fixed bin(35,0) dcl 61 ref 145 error_table_$nomatch 000056 external static fixed bin(17,0) dcl 113 ref 166 expand_path_ 000030 constant entry external dcl 56 ref 139 fixed builtin function dcl 73 ref 172 get_group_id_ 000026 constant entry external dcl 56 ref 88 get_temp_segments_ 000052 constant entry external dcl 69 ref 85 hcs_$add_dir_acl_entries 000042 constant entry external dcl 65 ref 144 hcs_$delete_dir_acl_entries 000044 constant entry external dcl 66 ref 135 189 hcs_$star_dir_list_ 000050 constant entry external dcl 67 ref 164 hcs_$star_list_ 000046 constant entry external dcl 67 ref 165 ifail 000244 automatic fixed bin(35,0) dcl 113 set ref 135 144* 145 145 189 ii 000256 automatic fixed bin(17,0) dcl 113 set ref 171* 172 174 174 175* index builtin function dcl 73 ref 138 lc 000255 automatic fixed bin(17,0) dcl 113 set ref 164* 165* 171 linkage_error 000000 stack reference condition dcl 72 ref 148 152 lvl parameter fixed bin(17,0) dcl 109 set ref 105 174* 184 modes 10 000110 automatic bit(36) array level 2 dcl 46 set ref 90* myname 000000 constant char(11) initial unaligned dcl 34 set ref 85* 141* 155* 168* 199* names based char(32) array dcl 124 ref 134 173 188 nindex 0(18) based bit(18) array level 2 packed unaligned dcl 126 set ref 172 nix 000257 automatic fixed bin(17,0) dcl 113 set ref 172* 173 npth 000100 automatic char(168) dcl 113 set ref 176* 179* 180 181 182 184* nptr 000250 automatic pointer initial dcl 113 set ref 113* 134 134 164* 165* 173 174* 188 null builtin function dcl 73 ref 34 113 113 133 134 199 one_ptr 000102 automatic pointer initial array dcl 34 set ref 34* 85* 86 199 199* path parameter char(168) dcl 30 set ref 11 81 97* priv 000107 automatic fixed bin(35,0) dcl 42 set ref 93* 150* 158* 198 198* priv_set 000106 automatic bit(1) unaligned dcl 41 set ref 92* 145 151* 154 161* release_temp_segments_ 000054 constant entry external dcl 70 ref 199 substr builtin function dcl 73 ref 176 sys_info$max_seg_size 000022 external static fixed bin(35,0) dcl 44 set ref 87* system_privilege_$dir_priv_off 000040 constant entry external dcl 64 ref 198 system_privilege_$dir_priv_on 000036 constant entry external dcl 63 ref 150 t 000253 automatic fixed bin(17,0) dcl 113 set ref 138* 139* 176 176 type based bit(2) array level 2 packed unaligned dcl 126 set ref 175 userid 000110 automatic char(32) array level 2 in structure "acla" dcl 46 in procedure "sweep_disk_" set ref 88* 89 userid 000122 automatic char(32) array level 2 in structure "delacla" dcl 51 in procedure "sweep_disk_" set ref 89* NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 000135 constant label dcl 85 set ref 79 RETRY 000456 constant label dcl 144 ref 162 REVERT_HANDLER 000556 constant label dcl 152 ref 148 clean_up 001245 constant entry internal dcl 197 ref 95 98 dir_list 000125 constant entry external dcl 81 inloop 001011 constant label dcl 171 loud 000254 constant entry external dcl 193 nopdir 001175 constant label dcl 185 ref 180 181 182 pexit 001203 constant label dcl 189 ref 166 169 process 000266 constant entry internal dcl 105 ref 97 184 sweep_disk_ 000113 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 1576 1656 1313 1606 Length 2064 1313 60 171 263 12 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME sweep_disk_ 116 external procedure is an external procedure. on unit on line 95 64 on unit process 283 internal procedure enables or reverts conditions. on unit on line 132 90 on unit on unit on line 148 64 on unit clean_up 82 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 bfsw sweep_disk_ 000011 dstar process STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME process 000100 npth process 000152 ddn process 000224 een process 000234 c32 process 000244 ifail process 000246 eptr process 000250 nptr process 000252 ecc process 000253 t process 000254 bcount process 000255 lc process 000256 ii process 000257 nix process sweep_disk_ 000100 areap sweep_disk_ 000102 one_ptr sweep_disk_ 000104 ec sweep_disk_ 000105 dir_list_sw sweep_disk_ 000106 priv_set sweep_disk_ 000107 priv sweep_disk_ 000110 acla sweep_disk_ 000122 delacla sweep_disk_ 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_path_ get_group_id_ get_temp_segments_ hcs_$add_dir_acl_entries hcs_$delete_dir_acl_entries hcs_$star_dir_list_ hcs_$star_list_ release_temp_segments_ system_privilege_$dir_priv_off system_privilege_$dir_priv_on THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$ai_restricted error_table_$nomatch sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 34 000076 11 000107 78 000121 79 000122 81 000123 83 000133 85 000135 86 000156 87 000160 88 000171 89 000200 90 000203 92 000205 93 000206 95 000210 97 000232 98 000246 100 000252 193 000253 194 000262 195 000264 105 000265 113 000273 132 000276 133 000312 134 000321 135 000330 136 000371 138 000372 139 000404 140 000431 141 000433 142 000455 144 000456 145 000514 148 000524 150 000543 151 000553 152 000556 154 000557 155 000562 158 000611 161 000614 162 000616 164 000617 165 000677 166 000750 167 000754 168 000756 169 001010 171 001011 172 001021 173 001030 174 001036 175 001063 176 001072 178 001125 179 001126 180 001141 181 001146 182 001152 184 001156 186 001175 187 001177 188 001201 189 001203 190 001243 197 001244 198 001252 199 001263 200 001311 ----------------------------------------------------------- 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