COMPILATION LISTING OF SEGMENT copy_acl Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 09/12/84 1451.6 mst Wed Options: optimize map 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1983 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 6* * * 7* ************************************************************** */ 8 9 10 11 12 /* format: style2,idind30,indcomtxt */ 13 14 copy_acl: 15 procedure options (variable); 16 17 /* COPY_ACL, COPY_IACL_SEG, COPY_IACL_DIR */ 18 /* initial coding 8/76 THVV */ 19 /* Added -working_dir or -wd in place of pathnames 07/25/80 S. Herbst */ 20 /* cleaned and neatened BIM and J. Pattin, 83-(8 9) */ 21 /* Modified 11/01/83 by C. Spitzer. fix arg processing bug, allow equal 22* convention in place of missing last argument */ 23 24 dcl arg char (al) based (ap); 25 dcl (dn1, dn2) char (168); 26 dcl (en1, en2) char (32); 27 dcl error_sw bit (1); 28 dcl (ap, areap) ptr; 29 dcl (eptr, nptr) ptr init (null); 30 dcl whoami char (13); 31 dcl (i, ecount) fixed bin; 32 dcl al fixed bin (21); 33 dcl an fixed bin init (1); 34 dcl (starsw, areasw) bit (1) init ("0"b); 35 36 dcl system_area area ((1024)) based (areap); 37 38 dcl 1 entries (100) based (eptr) aligned, 39 2 type bit (2) unaligned, 40 2 nnames bit (16) unaligned, 41 2 nindex bit (18) unaligned; 42 43 dcl names (100) char (32) based (nptr); 44 45 dcl arg_count fixed bin; 46 dcl code fixed bin (35); 47 dcl error_table_$badopt fixed bin (35) ext; 48 dcl error_table_$noarg fixed bin (35) ext; 49 dcl error_table_$odd_no_of_args fixed bin (35) ext; 50 dcl error_table_$badequal fixed bin (35) ext; 51 52 dcl check_star_name_$entry entry (char (*), fixed bin (35)); 53 dcl com_err_ entry options (variable); 54 dcl com_err_$suppress_name entry options (variable); 55 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 56 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 57 dcl get_equal_name_ entry (char (*), char (*), char (*), fixed bin (35)); 58 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 59 dcl hcs_$star_ entry (char (*), char (*), fixed bin, ptr, fixed bin, ptr, ptr, 60 fixed bin (35)); 61 dcl get_system_free_area_ entry () returns (ptr); 62 dcl get_wdir_ entry returns (char (168)); 63 dcl copy_acl_ entry (char (*), char (*), char (*), char (*), bit (1), fixed bin (35)); 64 dcl copy_iacl_$dir entry (char (*), char (*), char (*), char (*), bit (1), fixed bin (35)); 65 dcl copy_iacl_$seg entry (char (*), char (*), char (*), char (*), bit (1), fixed bin (35)); 66 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 67 68 dcl (addr, addrel, bin, null) builtin; 69 dcl cleanup condition; 70 71 72 73 whoami = "copy_acl"; 74 go to start; 75 76 copy_iacl_seg: 77 entry; 78 whoami = "copy_iacl_seg"; 79 go to start; 80 81 copy_iacl_dir: 82 entry; 83 whoami = "copy_iacl_dir"; 84 85 start: 86 call cu_$arg_count (arg_count, code); 87 if code ^= 0 88 then do; 89 call com_err_ (code, whoami); 90 return; 91 end; 92 if arg_count = 0 93 then do; 94 call com_err_$suppress_name (0, whoami, "Usage: ^a path11 {path21 ... pathN1 {pathN2}}", whoami); 95 return; 96 end; 97 98 do an = 1 to arg_count by 2; 99 call cu_$arg_ptr (an, ap, al, (0)); 100 101 if index (arg, "-") = 1 102 then if arg = "-working_dir" | arg = "-wd" 103 then call expand_pathname_ (get_wdir_ (), dn1, en1, code); 104 else do; 105 BADOPT: 106 call com_err_ (error_table_$badopt, whoami, "^a", arg); 107 return; 108 end; 109 else call expand_pathname_ (arg, dn1, en1, code); 110 111 if code ^= 0 112 then do; 113 call com_err_ (code, whoami, "^a", arg); 114 return; 115 end; 116 117 call check_star_name_$entry (en1, code); 118 if code = 0 119 then starsw = "0"b; /* No stars */ 120 else if code <= 2 121 then do; /* Name1 has stars */ 122 if ^areasw 123 then do; 124 areasw = "1"b; 125 areap = get_system_free_area_ (); 126 on condition (cleanup) call cleanup_handler; 127 end; 128 call hcs_$star_ (dn1, en1, 3, areap, ecount, eptr, nptr, code); 129 if code ^= 0 130 then do; 131 call com_err_ (code, whoami, "Could not star list ^a.", pathname_ (dn1, en1)); 132 return; 133 end; 134 starsw = "1"b; 135 end; 136 else 137 PATHNAME_ERROR: 138 do; 139 call com_err_ (code, whoami, "^a.", pathname_ (dn1, en1)); 140 return; 141 end; 142 143 if an = arg_count 144 then do; /* last argument missing */ 145 dn2 = get_wdir_ (); 146 en2 = "==="; /* same name in current [wd] */ 147 end; 148 else do; 149 call cu_$arg_ptr (an+1, ap, al, (0)); /* Get Name2 */ 150 151 if index (arg, "-") = 1 152 then if arg = "-working_dir" | arg = "-wd" 153 then call expand_pathname_ (get_wdir_ (), dn2, en2, code); 154 else go to BADOPT; 155 else call expand_pathname_ (arg, dn2, en2, code); 156 157 if code ^= 0 158 then go to PATHNAME_ERROR; 159 end; 160 161 if ^starsw 162 then call PERFORM_COPY (en1); 163 else do i = 1 to ecount; 164 call PERFORM_COPY (names (bin (entries (i).nindex, 18))); 165 end; 166 again: 167 if starsw 168 then call cleanup_handler; 169 end; 170 171 PERFORM_COPY: 172 proc (oldent); 173 174 dcl oldent char (32); 175 dcl newent char (32); 176 177 call get_equal_name_ (oldent, en2, newent, code); 178 if code ^= 0 179 then if code = error_table_$badequal 180 then go to PATHNAME_ERROR; /* skip this pair of arguments */ 181 else do; /* must be longeql */ 182 call com_err_ (code, whoami, arg); /* print arg name in error message */ 183 return; 184 end; 185 186 if whoami = "copy_acl" 187 then call copy_acl_ (dn1, oldent, dn2, newent, error_sw, code); 188 else if whoami = "copy_iacl_seg" 189 then call copy_iacl_$seg (dn1, oldent, dn2, newent, error_sw, code); 190 else if whoami = "copy_iacl_dir" 191 then call copy_iacl_$dir (dn1, oldent, dn2, newent, error_sw, code); 192 193 if code ^= 0 194 then do; 195 if error_sw 196 then call com_err_ (code, whoami, "^a", pathname_ (dn2, newent)); 197 else call com_err_ (code, whoami, "^a", pathname_ (dn1, oldent)); 198 end; 199 200 end PERFORM_COPY; 201 202 cleanup_handler: 203 proc; 204 if eptr ^= null 205 then free entries in (system_area); 206 if nptr ^= null 207 then free names in (system_area); 208 end cleanup_handler; 209 210 end copy_acl; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/12/84 1451.6 copy_acl.pl1 >spec>on>6801>copy_acl.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. al 000264 automatic fixed bin(21,0) dcl 32 set ref 99* 101 101 101 105 105 109 109 113 113 149* 151 151 151 155 155 182 182 an 000265 automatic fixed bin(17,0) initial dcl 33 set ref 33* 98* 99* 143 149* ap 000246 automatic pointer dcl 28 set ref 99* 101 101 101 105 109 113 149* 151 151 151 155 182 areap 000250 automatic pointer dcl 28 set ref 125* 128* 204 206 areasw 000267 automatic bit(1) initial unaligned dcl 34 set ref 34* 122 124* arg based char unaligned dcl 24 set ref 101 101 101 105* 109* 113* 151 151 151 155* 182* arg_count 000270 automatic fixed bin(17,0) dcl 45 set ref 85* 92 98 143 bin builtin function dcl 68 ref 164 check_star_name_$entry 000014 constant entry external dcl 52 ref 117 cleanup 000272 stack reference condition dcl 69 ref 126 code 000271 automatic fixed bin(35,0) dcl 46 set ref 85* 87 89* 101* 109* 111 113* 117* 118 120 128* 129 131* 139* 151* 155* 157 177* 178 178 182* 186* 188* 190* 193 195* 197* com_err_ 000016 constant entry external dcl 53 ref 89 105 113 131 139 182 195 197 com_err_$suppress_name 000020 constant entry external dcl 54 ref 94 copy_acl_ 000040 constant entry external dcl 63 ref 186 copy_iacl_$dir 000042 constant entry external dcl 64 ref 190 copy_iacl_$seg 000044 constant entry external dcl 65 ref 188 cu_$arg_count 000022 constant entry external dcl 55 ref 85 cu_$arg_ptr 000024 constant entry external dcl 56 ref 99 149 dn1 000100 automatic char(168) unaligned dcl 25 set ref 101* 109* 128* 131* 131* 139* 139* 186* 188* 190* 197* 197* dn2 000152 automatic char(168) unaligned dcl 25 set ref 145* 151* 155* 186* 188* 190* 195* 195* ecount 000263 automatic fixed bin(17,0) dcl 31 set ref 128* 163 en1 000224 automatic char(32) unaligned dcl 26 set ref 101* 109* 117* 128* 131* 131* 139* 139* 161* en2 000234 automatic char(32) unaligned dcl 26 set ref 146* 151* 155* 177* entries based structure array level 1 dcl 38 ref 204 eptr 000252 automatic pointer initial dcl 29 set ref 29* 128* 164 204 204 error_sw 000244 automatic bit(1) unaligned dcl 27 set ref 186* 188* 190* 195 error_table_$badequal 000012 external static fixed bin(35,0) dcl 50 ref 178 error_table_$badopt 000010 external static fixed bin(35,0) dcl 47 set ref 105* expand_pathname_ 000030 constant entry external dcl 58 ref 101 109 151 155 get_equal_name_ 000026 constant entry external dcl 57 ref 177 get_system_free_area_ 000034 constant entry external dcl 61 ref 125 get_wdir_ 000036 constant entry external dcl 62 ref 101 101 145 151 151 hcs_$star_ 000032 constant entry external dcl 59 ref 128 i 000262 automatic fixed bin(17,0) dcl 31 set ref 163* 164* names based char(32) array unaligned dcl 43 set ref 164* 206 newent 000310 automatic char(32) unaligned dcl 175 set ref 177* 186* 188* 190* 195* 195* nindex 0(18) based bit(18) array level 2 packed unaligned dcl 38 ref 164 nptr 000254 automatic pointer initial dcl 29 set ref 29* 128* 164 206 206 null builtin function dcl 68 ref 29 29 204 206 oldent parameter char(32) unaligned dcl 174 set ref 171 177* 186* 188* 190* 197* 197* pathname_ 000046 constant entry external dcl 66 ref 131 131 139 139 195 195 197 197 starsw 000266 automatic bit(1) initial unaligned dcl 34 set ref 34* 118* 134* 161 166 system_area based area(1024) dcl 36 ref 204 206 whoami 000256 automatic char(13) unaligned dcl 30 set ref 73* 78* 83* 89* 94* 94* 105* 113* 131* 139* 182* 186 188 190 195* 197* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addr builtin function dcl 68 addrel builtin function dcl 68 error_table_$noarg external static fixed bin(35,0) dcl 48 error_table_$odd_no_of_args external static fixed bin(35,0) dcl 49 NAMES DECLARED BY EXPLICIT CONTEXT. BADOPT 000330 constant label dcl 105 ref 151 PATHNAME_ERROR 000653 constant label dcl 136 ref 157 178 PERFORM_COPY 001140 constant entry internal dcl 171 ref 161 164 again 001126 constant label dcl 166 cleanup_handler 001507 constant entry internal dcl 202 ref 126 166 copy_acl 000100 constant entry external dcl 14 copy_iacl_dir 000126 constant entry external dcl 81 copy_iacl_seg 000113 constant entry external dcl 76 start 000137 constant label dcl 85 ref 74 79 NAME DECLARED BY CONTEXT OR IMPLICATION. index builtin function ref 101 151 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1776 2046 1540 2006 Length 2252 1540 50 167 235 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME copy_acl 386 external procedure is an external procedure. on unit on line 126 64 on unit PERFORM_COPY internal procedure shares stack frame of external procedure copy_acl. cleanup_handler 64 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME copy_acl 000100 dn1 copy_acl 000152 dn2 copy_acl 000224 en1 copy_acl 000234 en2 copy_acl 000244 error_sw copy_acl 000246 ap copy_acl 000250 areap copy_acl 000252 eptr copy_acl 000254 nptr copy_acl 000256 whoami copy_acl 000262 i copy_acl 000263 ecount copy_acl 000264 al copy_acl 000265 an copy_acl 000266 starsw copy_acl 000267 areasw copy_acl 000270 arg_count copy_acl 000271 code copy_acl 000310 newent PERFORM_COPY THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return enable ext_entry int_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_star_name_$entry com_err_ com_err_$suppress_name copy_acl_ copy_iacl_$dir copy_iacl_$seg cu_$arg_count cu_$arg_ptr expand_pathname_ get_equal_name_ get_system_free_area_ get_wdir_ hcs_$star_ pathname_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badequal error_table_$badopt LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000066 33 000071 34 000073 14 000077 73 000106 74 000111 76 000112 78 000121 79 000124 81 000125 83 000134 85 000137 87 000150 89 000152 90 000167 92 000170 94 000172 95 000222 98 000223 99 000231 101 000247 105 000330 107 000362 108 000363 109 000364 111 000414 113 000416 114 000450 117 000451 118 000466 120 000472 122 000474 124 000476 125 000500 126 000507 128 000531 129 000575 131 000577 132 000647 134 000650 135 000652 139 000653 140 000722 143 000723 145 000726 146 000735 147 000740 149 000741 151 000761 155 001042 157 001072 161 001074 163 001101 164 001111 165 001124 166 001126 169 001134 210 001137 171 001140 177 001142 178 001165 182 001172 183 001215 186 001216 188 001257 190 001320 193 001360 195 001362 197 001435 200 001505 202 001506 204 001514 206 001523 208 001532 ----------------------------------------------------------- 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