COMPILATION LISTING OF SEGMENT copy Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/24/89 0851.0 mst Tue Options: optimize map 1 /****^ ************************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1989 * 4* * * 5* * Copyright, (C) Massachusetts Institute of Technology, 1983 * 6* * * 7* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 8* * * 9* ************************************************************** */ 10 11 12 13 14 15 16 /****^ HISTORY COMMENTS: 17* 1) change(87-02-13,TLNguyen), approve(87-02-13,MCR7619), 18* audit(87-03-20,Gilcrease), install(87-03-24,MR12.1-1011): 19* - Change "copy" to always display a correct error message when copying 20* a specified extended entry types into unsuffixed targets. 21* - Change "move" to always display a correct error message when moving 22* a specified MSF that has unsufficient ACL requirements in order to move. 23* - Change "copy" to always display a correct error message when copying 24* a specified segment or star convention is applied and unsufficient 25* ACL requirements for directory containing a specified segment. 26* 2) change(88-10-03,Flegel), approve(89-01-09,MCR8020), audit(89-01-16,Lee), 27* install(89-01-24,MR12.3-1012): 28* Change sub_err_handler display of an error so that the causing pathname is 29* properly displayed with the error according to the 30* copy_error_info.target_err_switch value. This sort of backs out phx20384 31* as the solution addressed the wrong source its problem. 32* END HISTORY COMMENTS */ 33 34 35 /* format: style2,idind30,indcomtxt */ 36 copy: 37 cp: 38 procedure () options (variable); 39 40 41 /**** 42* This is the standard service system command to copy a segment or 43* multi-segment file. This procedure also includes the move command, which 44* consists of a copy (with names and ACLs) followed by a delete. 45* Both commands take multiple arguments and the star convention. 46* Under control of optional arguments it will also copy extra names 47* and/or the ACL of the segment. 48**/ 49 50 /* Coded 3 Aug 1969 David Clark */ 51 /* Revised 25 Sept 1969 0935 DDC */ 52 /* Modified by M Weaver 11 April 1970 */ 53 /* Broken into four routines by John Strayhorn. July 1, 1970 */ 54 /* Check for same directory, when copying names, added by T.Casey, Jan 1973 */ 55 /* Modified June 4 1974 by Steve Herbst */ 56 57 /* Rewritten: June 1979 by G. Palter, adding -chase in the process */ 58 /* Bugs fixed, check for "copy foo" added 07/14/81 S. Herbst */ 59 /* Changed move to move switches, max length, and ring brackets 11/17/82 S. Herbst */ 60 /* Fixed to move MSF ring brackets correctly 12/15/82 S. Herbst */ 61 /* Modified: 6/2/83 Jay Pattin moved it all to copy_ */ 62 /* 831001 BIM infintessimally cleaned up for installation */ 63 /* 841102 C Spitzer. fixed bug in sub_error_handler, getting null pointer fault if info_ptr not set */ 64 /* 850206 MSharpe. changed -force_no_type to -inase/-inaee; modified to advise 65* user that no non-dirs matched the starname */ 66 67 dcl argument character (argument_lth) based (argument_ptr); 68 dcl argument_lth fixed binary (21); 69 dcl argument_ptr pointer; 70 71 dcl system_area area based (system_area_ptr); 72 73 dcl system_area_ptr pointer; 74 75 dcl (argument_count, arg_idx) fixed binary; 76 dcl arg_list_ptr pointer; 77 78 dcl NAME character (32); 79 /* who I am */ 80 81 dcl code fixed binary (35); 82 83 dcl chase_sw bit (2) aligned; 84 /* either default or one of two given values */ 85 dcl (brief, copy_command_sw, entry_only_sw, have_paths) 86 bit (1) aligned; 87 dcl (successful_copy, 88 inhibit_nomatch_error) bit (1) aligned; 89 90 dcl (source_dir, target_dir) character (168); 91 dcl (source_ename, target_eqname, ename) 92 character (32); 93 dcl source_stars fixed binary (35); 94 dcl source_type fixed binary (2); 95 96 dcl select_sw fixed binary (2); 97 dcl idx fixed binary; 98 99 dcl DEFAULT_2ND_NAME character (2) static options (constant) initial ("=="); 100 101 dcl ( 102 error_table_$argerr, 103 error_table_$badopt, 104 error_table_$badstar, 105 error_table_$dirseg, 106 error_table_$incorrect_access, 107 error_table_$moderr, 108 error_table_$namedup, 109 error_table_$noarg, 110 error_table_$noentry, 111 error_table_$no_info, 112 error_table_$not_seg_type, 113 error_table_$sameseg, 114 error_table_$inconsistent, 115 error_table_$root, 116 error_table_$unsupported_operation 117 ) fixed binary (35) external; 118 119 dcl (cleanup, sub_error_) condition; 120 121 dcl ( 122 com_err_, 123 com_err_$suppress_name 124 ) entry () options (variable); 125 dcl check_star_name_$entry entry (character (*), fixed binary (35)); 126 dcl continue_to_signal_ entry (fixed bin (35)); 127 dcl copy_ entry (ptr); 128 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 129 dcl cu_$arg_list_ptr entry () returns (pointer); 130 dcl cu_$arg_ptr entry (fixed binary, pointer, fixed binary (21), fixed binary (35)); 131 dcl cu_$arg_ptr_rel entry (fixed binary, pointer, fixed binary (21), fixed binary (35), 132 pointer); 133 dcl expand_pathname_ entry (character (*), character (*), character (*), fixed binary (35)); 134 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); 135 dcl get_equal_name_ entry (character (*), character (*), character (*), fixed binary (35)); 136 dcl get_system_free_area_ entry () returns (pointer); 137 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, 138 fixed bin (35)); 139 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), 140 fixed bin (35)); 141 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 142 143 dcl (addr, length, index, null, rtrim, search, string, substr, sum) 144 builtin; 145 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 */ 146 147 2 1 /* BEGIN INCLUDE FILE: copy_options.incl.pl1 */ 2 2 2 3 /* This structure declares the input structure used by the copy_ subroutine. 2 4* 2 5* NOTE: This include file depends on declarations in the include file 2 6* copy_flags.incl.pl1. 2 7* 2 8* Jay Pattin 6/1/83 */ 2 9 2 10 declare copy_options_ptr ptr; 2 11 2 12 declare 1 copy_options aligned based (copy_options_ptr), 2 13 2 version char (8), /* currently COPY_OPTIONS_VERSION_1 */ 2 14 2 caller_name char (32) unal, /* Used in nd_handler_ call */ 2 15 2 source_dir char (168) unal, 2 16 2 source_name char (32) unal, 2 17 2 target_dir char (168) unal, 2 18 2 target_name char (32) unal, 2 19 2 flags, 2 20 3 no_name_dup bit (1) unaligned, /* ON = don't call nd_handler_ */ 2 21 3 raw bit (1) unaligned, /* ON = don't call object_type_, use hcs_ */ 2 22 3 force bit (1) unaligned, /* ON = delete or force access to target */ 2 23 3 delete bit (1) unaligned, /* ON = delete original after copy (for move) */ 2 24 3 target_err_switch bit (1) unaligned, 2 25 3 mbz bit (31) unaligned, 2 26 2 copy_items like copy_flags; /* see copy_flags.incl.pl1 */ 2 27 2 28 declare COPY_OPTIONS_VERSION_1 char (8) static options (constant) init ("CPOPT001"); 2 29 2 30 /* END INCLUDE FILE: copy_options.incl.pl1 */ 148 149 3 1 /* BEGIN INCLUDE FILE: copy_flags.incl.pl1 */ 3 2 3 3 /* Flags for attributes that should/may be copied by the copy_ subroutine. This include file is 3 4* required by suffix_info.incl.pl1 and copy_options.incl.pl1 3 5* 3 6* Jay Pattin 6/23/83 */ 3 7 3 8 declare 1 copy_flags aligned based, /* ON means that this attribute may be copied by copy_ */ 3 9 2 names bit (1) unaligned, 3 10 2 acl bit (1) unaligned, 3 11 2 ring_brackets bit (1) unaligned, 3 12 2 max_length bit (1) unaligned, 3 13 2 copy_switch bit (1) unaligned, 3 14 2 safety_switch bit (1) unaligned, 3 15 2 dumper_switches bit (1) unaligned, 3 16 2 entry_bound bit (1) unaligned, /* only for vanilla object segments */ 3 17 2 extend bit (1) unaligned, /* copy_ may append to end of existing object */ 3 18 2 update bit (1) unaligned, /* copy_ may replace contents of existing object */ 3 19 2 mbz bit (26) unaligned; 3 20 3 21 /* END INCLUDE FILE: copy_flags.incl.pl1 */ 150 151 152 dcl 1 cpo aligned like copy_options; 153 dcl 1 explicit aligned like copy_flags; 154 4 1 /* BEGIN INCLUDE FILE sub_error_info.incl.pl1 */ 4 2 /* format: style2 */ 4 3 4 4 /* The include file condition_info_header must be used with this file */ 4 5 4 6 declare sub_error_info_ptr pointer; 4 7 declare 1 sub_error_info aligned based (sub_error_info_ptr), 4 8 2 header aligned like condition_info_header, 4 9 2 retval fixed bin (35), /* return value */ 4 10 2 name char (32), /* module name */ 4 11 2 info_ptr ptr; 4 12 4 13 declare sub_error_info_version_1 4 14 internal static options (constant) fixed bin init (1); 4 15 4 16 /* END INCLUDE FILE sub_error_info.incl.pl1 */ 155 156 5 1 /* BEGIN INCLUDE FILE condition_info_header.incl.pl1 BIM 1981 */ 5 2 /* format: style2 */ 5 3 5 4 declare condition_info_header_ptr 5 5 pointer; 5 6 declare 1 condition_info_header 5 7 aligned based (condition_info_header_ptr), 5 8 2 length fixed bin, /* length in words of this structure */ 5 9 2 version fixed bin, /* version number of this structure */ 5 10 2 action_flags aligned, /* tell handler how to proceed */ 5 11 3 cant_restart bit (1) unaligned, /* caller doesn't ever want to be returned to */ 5 12 3 default_restart bit (1) unaligned, /* caller can be returned to with no further action */ 5 13 3 quiet_restart bit (1) unaligned, /* return, and print no message */ 5 14 3 support_signal bit (1) unaligned, /* treat this signal as if the signalling procedure had the support bit set */ 5 15 /* if the signalling procedure had the support bit set, do the same for its caller */ 5 16 3 pad bit (32) unaligned, 5 17 2 info_string char (256) varying, /* may contain printable message */ 5 18 2 status_code fixed bin (35); /* if^=0, code interpretable by com_err_ */ 5 19 5 20 /* END INCLUDE FILE condition_info_header.incl.pl1 */ 157 158 6 1 /* BEGIN INCLUDE FILE ... condition_info.incl.pl1 */ 6 2 6 3 /* Structure for find_condition_info_. 6 4* 6 5* Written 1-Mar-79 by M. N. Davidoff. 6 6**/ 6 7 6 8 /* automatic */ 6 9 6 10 declare condition_info_ptr pointer; 6 11 6 12 /* based */ 6 13 6 14 declare 1 condition_info aligned based (condition_info_ptr), 6 15 2 mc_ptr pointer, /* pointer to machine conditions at fault time */ 6 16 2 version fixed binary, /* Must be 1 */ 6 17 2 condition_name char (32) varying, /* name of condition */ 6 18 2 info_ptr pointer, /* pointer to the condition data structure */ 6 19 2 wc_ptr pointer, /* pointer to wall crossing machine conditions */ 6 20 2 loc_ptr pointer, /* pointer to location where condition occured */ 6 21 2 flags unaligned, 6 22 3 crawlout bit (1), /* on if condition occured in lower ring */ 6 23 3 pad1 bit (35), 6 24 2 pad2 bit (36), 6 25 2 user_loc_ptr pointer, /* ptr to most recent nonsupport loc before condition occurred */ 6 26 2 pad3 (4) bit (36); 6 27 6 28 /* internal static */ 6 29 6 30 declare condition_info_version_1 6 31 fixed binary internal static options (constant) initial (1); 6 32 6 33 /* END INCLUDE FILE ... condition_info.incl.pl1 */ 159 160 7 1 /* BEGIN INCLUDE FILE: copy_error_info.incl.pl1 7 2* 7 3* This is the structure pointed to by sub_error_info.info_ptr when copy_ 7 4* signals the sub_err_ condition. 7 5* 7 6* Jay Pattin 6/13/83 */ 7 7 7 8 declare 1 copy_error_info aligned based (sub_error_info.info_ptr), 7 9 2 copy_options_ptr ptr, /* Pointer to input argument of copy_ */ 7 10 2 operation char (32), /* Name of operation that failed. */ 7 11 2 target_err_switch bit (1) aligned; /* ON = error was on the target */ 7 12 7 13 /* END INCLUDE FILE: copy_error_info.incl.pl1 */ 161 162 163 /* copy: cp: entry () options (variable); */ 164 165 NAME = "copy"; 166 167 copy_command_sw = "1"b; 168 string (cpo.copy_items) = ""b; /* default options */ 169 170 go to COMMON; 171 172 173 174 /* This is the move command */ 175 176 move: 177 mv: 178 entry () options (variable); 179 180 NAME = "move"; 181 182 copy_command_sw = "0"b; 183 184 string (cpo.copy_items) = ""b; 185 cpo.copy_items.acl, cpo.copy_items.names, cpo.copy_items.ring_brackets, cpo.copy_items.max_length, 186 cpo.copy_items.copy_switch, cpo.copy_items.safety_switch, cpo.copy_items.dumper_switches = "1"b; 187 188 189 190 /* Actual work starts here */ 191 192 COMMON: 193 chase_sw = "00"b; /* none supplied */ 194 cpo.version = COPY_OPTIONS_VERSION_1; 195 cpo.caller_name = NAME; 196 197 cpo.copy_items.entry_bound = "1"b; /* always copy */ 198 string (cpo.flags) = ""b; 199 cpo.flags.delete = ^copy_command_sw; 200 201 string (explicit) = ""b; 202 203 call cu_$arg_count (argument_count, code); 204 if code ^= 0 205 then do; 206 call com_err_ (code, NAME); 207 return; 208 end; 209 210 if argument_count = 0 211 then do; 212 USAGE: 213 call com_err_ (error_table_$noarg, NAME, "^/^6xUsage: ^a path1 {equal_name1 ...} {-control_args}", 214 NAME); 215 return; 216 end; 217 218 219 /* Scan for control arguments */ 220 221 have_paths = "0"b; /* haven't found any yet */ 222 223 do arg_idx = 1 to argument_count; 224 225 call cu_$arg_ptr (arg_idx, argument_ptr, argument_lth, code); 226 if code ^= 0 227 then do; 228 call com_err_ (code, NAME, "Fetching argument #^d.", arg_idx); 229 return; 230 end; 231 232 if substr (argument, 1, 1) ^= "-" 233 then have_paths = "1"b; /* found some pathnames */ 234 235 else if (argument = "-brief") | (argument = "-bf") 236 then brief = "1"b; 237 238 else if (argument = "-long") | (argument = "-lg") 239 then brief = "0"b; 240 241 else if (argument = "-all") | (argument = "-a") 242 then cpo.copy_items.acl, cpo.copy_items.names, cpo.copy_items.ring_brackets, cpo.copy_items.max_length, 243 cpo.copy_items.copy_switch, cpo.copy_items.safety_switch, cpo.copy_items.dumper_switches = "1"b; 244 245 else if (argument = "-acl") 246 then cpo.copy_items.acl, explicit.acl = "1"b; 247 248 else if (argument = "-no_acl") 249 then cpo.copy_items.acl, explicit.acl = "0"b; 250 251 else if (argument = "-name") | (argument = "-nm") 252 then cpo.copy_items.names, explicit.names = "1"b; 253 254 else if (argument = "-no_name") | (argument = "-nnm") 255 then cpo.copy_items.names, explicit.names = "0"b; 256 257 else if (argument = "-chase") 258 then chase_sw = "11"b; /* explicit request to do chasing */ 259 260 else if (argument = "-no_chase") 261 then chase_sw = "10"b; 262 263 else if argument = "-force" | argument = "-fc" 264 then cpo.flags.force = "1"b; 265 266 else if argument = "-no_force" | argument = "-nfc" 267 then cpo.flags.force = "0"b; 268 269 else if argument = "-max_length" | argument = "-ml" 270 then cpo.copy_items.max_length, explicit.max_length = "1"b; 271 272 else if argument = "-no_max_length" | argument = "-nml" 273 then cpo.copy_items.max_length, explicit.max_length = "0"b; 274 275 else if argument = "-ring_brackets" | argument = "-rb" 276 then cpo.copy_items.ring_brackets, explicit.ring_brackets = "1"b; 277 278 else if argument = "-no_ring_brackets" | argument = "-nrb" 279 then cpo.copy_items.ring_brackets, explicit.ring_brackets = "0"b; 280 281 else if argument = "-copy_switch" | argument = "-csw" 282 then cpo.copy_items.copy_switch, explicit.copy_switch = "1"b; 283 284 else if argument = "-no_copy_switch" | argument = "-ncsw" 285 then cpo.copy_items.copy_switch, explicit.copy_switch = "0"b; 286 287 else if argument = "-safety_switch" | argument = "-ssw" 288 then cpo.copy_items.safety_switch, explicit.safety_switch = "1"b; 289 290 else if argument = "-no_safety_switch" | argument = "-nssw" 291 then cpo.copy_items.safety_switch, explicit.safety_switch = "0"b; 292 293 else if argument = "-volume_dumper_switches" | argument = "-vdsw" 294 then cpo.copy_items.dumper_switches, explicit.dumper_switches = "1"b; 295 296 else if argument = "-no_volume_dumper_switches" | argument = "-nvdsw" 297 then cpo.copy_items.dumper_switches, explicit.dumper_switches = "0"b; 298 299 else if argument = "-entry_bound" | argument = "-eb" 300 then cpo.copy_items.entry_bound, explicit.entry_bound = "1"b; 301 302 else if argument = "-no_entry_bound" | argument = "-neb" 303 then cpo.copy_items.entry_bound, explicit.entry_bound = "0"b; 304 305 else if argument = "-extend" 306 then do; 307 cpo.copy_items.extend = "1"b; 308 cpo.copy_items.update = "0"b; 309 end; 310 311 else if ^copy_command_sw 312 then goto BADOPT; 313 314 else if argument = "-replace" | argument = "-rp" 315 then cpo.copy_items.extend, cpo.copy_items.update = "0"b; 316 317 else if argument = "-update" | argument = "-ud" 318 then do; 319 cpo.copy_items.update = "1"b; 320 cpo.copy_items.extend = "0"b; 321 end; 322 323 else if argument = "-interpret_as_standard_entry" | argument = "-inase" 324 then cpo.flags.raw = "1"b; 325 326 else if argument = "-interpret_as_extended_entry" | argument = "-inaee" 327 then cpo.flags.raw = "0"b; 328 329 else do; 330 BADOPT: 331 call com_err_ (error_table_$badopt, NAME, """^a""", argument); 332 return; 333 end; 334 end; 335 336 if ^have_paths 337 then /* nothing to work on */ 338 go to USAGE; 339 340 if (cpo.copy_items.extend | cpo.copy_items.update) 341 & (cpo.copy_items.acl | cpo.copy_items.names | cpo.copy_items.ring_brackets | cpo.copy_items.max_length 342 | cpo.copy_items.copy_switch | cpo.copy_items.safety_switch | cpo.copy_items.dumper_switches) 343 then do; 344 call com_err_ (error_table_$inconsistent, NAME, 345 "Attributes may not be copied when -^[extend^;update^] is used.", cpo.copy_items.extend); 346 return; 347 end; /* */ 348 349 system_area_ptr = get_system_free_area_ (); 350 351 star_entry_ptr, /* so cleanup will work */ 352 star_names_ptr = null (); 353 354 on condition (cleanup) call clean_up (); 355 356 357 /* Process the pairs of pathnames supplied */ 358 359 arg_list_ptr = cu_$arg_list_ptr (); 360 361 do arg_idx = 1 to argument_count; 362 363 call cu_$arg_ptr (arg_idx, argument_ptr, argument_lth, (0)); 364 /* known to work from above */ 365 366 if substr (argument, 1, 1) ^= "-" 367 then do; /* ignore control args */ 368 369 entry_only_sw = (search (argument, "<>") = 0); 370 371 call expand_pathname_ (argument, source_dir, source_ename, code); 372 if code ^= 0 373 then do; 374 call com_err_ (code, NAME, "^a", argument); 375 call find_second_arg (); 376 go to NEXT_PAIR; 377 end; 378 379 call check_star_name_$entry (source_ename, source_stars); 380 if (source_stars ^= 0) & (source_stars ^= 1) & (source_stars ^= 2) 381 then do; 382 call com_err_ (source_stars, NAME, "^a", pathname_ (source_dir, source_ename)); 383 call find_second_arg (); 384 go to NEXT_PAIR; 385 end; 386 387 call find_second_arg (); /* move on to second pair (if any) */ 388 389 if arg_idx > argument_count 390 then do; /* none, use === */ 391 if entry_only_sw 392 then do; 393 call com_err_ (0, NAME, "No target pathname specified."); 394 return; 395 end; 396 argument_ptr = addr (DEFAULT_2ND_NAME); 397 argument_lth = length (DEFAULT_2ND_NAME); 398 end; 399 400 call expand_pathname_ (argument, target_dir, target_eqname, code); 401 if code ^= 0 402 then do; 403 call com_err_ (code, NAME, "^a", argument); 404 go to NEXT_PAIR; 405 end; 406 407 call check_star_name_$entry (target_eqname, code); 408 if code ^= 0 409 then do; 410 if code > 2 then /* code = error_table_$badstar */ 411 /* fix an incorrect error message, for example ! copy foo > */ 412 if argument = ">" then do; 413 call com_err_ (error_table_$root, NAME, 414 "^a. Your request has been aborted.", argument); 415 go to NEXT_PAIR; 416 end; 417 /* end of bug fix */ 418 else call com_err_ (code, NAME, "^a", pathname_ (target_dir, target_eqname)); 419 else call com_err_ (0, NAME, "Star convention not allowed in second argument. ^a", 420 pathname_ (target_dir, target_eqname)); 421 go to NEXT_PAIR; 422 end; 423 424 425 /* Preliminary checks OK for this pair; now do the work */ 426 427 if source_stars = 0 428 then do; /* source name is a single entry */ 429 if chase_sw = "10"b 430 then do; /* user doesn't want links chased */ 431 call hcs_$status_minf (source_dir, source_ename, 0b, source_type, (0), code); 432 if code ^= 0 433 then do; 434 call com_err_ (code, NAME, "^a", 435 pathname_ (source_dir, source_ename)); 436 go to NEXT_PAIR; 437 end; 438 if source_type = star_LINK 439 then do; 440 call com_err_ (0, NAME, 441 "^a is a link and ""-no_chase"" was specified.", 442 pathname_ (source_dir, source_ename)); 443 go to NEXT_PAIR; 444 end; 445 end; 446 447 call process_entry (source_ename, "1"b, ("0"b)); 448 /* ignore the successful_copy bit */ 449 end; /* do the work */ 450 451 452 else do; /* source name is a star name */ 453 if chase_sw = "11"b 454 then select_sw = star_ALL_ENTRIES; 455 /* request -chase */ 456 else select_sw = star_BRANCHES_ONLY; 457 458 call hcs_$star_ (source_dir, source_ename, select_sw, system_area_ptr, 459 star_entry_count, star_entry_ptr, star_names_ptr, code); 460 if code ^= 0 then 461 /* fix bug for TR number 19526 */ 462 if code = error_table_$moderr then do; 463 call com_err_ (error_table_$incorrect_access, NAME, "^a", 464 pathname_ (source_dir, source_ename)); 465 go to NEXT_PAIR; 466 end; 467 /* end of bug fix */ 468 else do; 469 call com_err_ (code, NAME, "^a", pathname_ (source_dir, source_ename)); 470 go to NEXT_PAIR; 471 end; 472 473 inhibit_nomatch_error, 474 successful_copy = "0"b; /* If still OFF after the loop, there were no 475* non-dirs that matched the starname */ 476 do idx = 1 to star_entry_count; 477 478 ename = star_names (star_entries (idx).nindex); 479 call process_entry (ename, "0"b, successful_copy); 480 end; /* ignore directories */ 481 if ^successful_copy 482 & ^inhibit_nomatch_error 483 then call com_err_ (0, NAME, 484 "No entries of appropriate type matched the starname ^a", 485 pathname_ (source_dir, source_ename)); 486 end; 487 488 NEXT_PAIR: 489 call clean_up (); /* free up anything still around */ 490 end; /* of non-control argument */ 491 end; 492 493 /* */ 494 495 /* This internal procedure cleans up after an argument pair */ 496 497 clean_up: 498 procedure (); 499 500 501 if star_names_ptr ^= null () 502 then do; 503 free star_names in (system_area); 504 star_names_ptr = null (); 505 end; 506 507 if star_entry_ptr ^= null () 508 then do; 509 free star_entries in (system_area); 510 star_entry_ptr = null (); 511 end; 512 513 return; 514 515 end clean_up; /* */ 516 find_second_arg: 517 procedure (); 518 519 /* This internal procedure scans the argument list looking for the second pathname 520* of the current pair (if any) */ 521 522 do arg_idx = (arg_idx + 1) to argument_count; 523 524 call cu_$arg_ptr_rel (arg_idx, argument_ptr, argument_lth, (0), arg_list_ptr); 525 526 if substr (argument, 1, 1) ^= "-" 527 then /* found it */ 528 return; 529 end; 530 531 arg_idx = argument_count + 1; /* none found */ 532 533 return; 534 535 end find_second_arg; 536 537 process_entry: /* copy one segment */ 538 procedure (P_ename, P_report_dirseg, P_successful_copy); 539 540 dcl P_ename character (32) parameter; 541 /* source entry name */ 542 dcl P_report_dirseg bit (1) aligned parameter; 543 /* ON => e_t_$dirseg on source */ 544 545 dcl P_successful_copy bit (1) aligned parameter; 546 /* OUTPUT: ON => entry successfully copied */ 547 548 dcl bit_count fixed binary (24); /* bit count returned by hcs_$status_minf. */ 549 dcl (source_ename, target_ename) character (32); 550 dcl code fixed binary (35); 551 dcl target_type fixed binary (2); /* type of a target entryname returned by hcs_$status_minf. */ 552 553 source_ename = P_ename; 554 bit_count = -0; /* initialized */ 555 target_type = -0; /* initialized */ 556 557 call get_equal_name_ (source_ename, target_eqname, target_ename, code); 558 if code ^= 0 559 then do; 560 call com_err_ (code, NAME, "^a for ^a", pathname_ (target_dir, target_eqname), source_ename); 561 return; 562 end; 563 564 cpo.source_dir = source_dir; 565 cpo.source_name = source_ename; 566 cpo.target_dir = target_dir; 567 cpo.target_name = target_ename; 568 569 on sub_error_ call sub_err_handler (); /* copy_ reports erors with sub_err_ */ 570 571 call copy_ (addr (cpo)); /* go to it */ 572 P_successful_copy = "1"b; 573 574 COPY_LOST: 575 return; 576 577 sub_err_handler: 578 proc (); 579 580 declare 1 ci aligned like condition_info; 581 declare reverse builtin; 582 declare suffix_name char (8) varying init (""); 583 declare temp_source_ename char (32) varying init (""); 584 585 ci.version = condition_info_version_1; 586 call find_condition_info_ (null (), addr (ci), (0)); 587 sub_error_info_ptr = ci.info_ptr; 588 589 if sub_error_info.name ^= "copy_" 590 then do; 591 CONTINUE_TO_SIGNAL: 592 call continue_to_signal_ ((0)); 593 goto END_HANDLER; 594 end; 595 else if sub_error_info.info_ptr = null 596 then goto CONTINUE_TO_SIGNAL; 597 else if copy_error_info.copy_options_ptr ^= addr (cpo) 598 then goto CONTINUE_TO_SIGNAL; 599 600 code = sub_error_info.status_code; 601 602 if sub_error_info.cant_restart 603 then do; /* copy failed */ 604 if ^copy_error_info.target_err_switch 605 then if code = error_table_$dirseg 606 then /* source is a directory */ 607 if ^P_report_dirseg 608 then /* but that's OK for starnames */ 609 goto COPY_LOST; 610 611 inhibit_nomatch_error = "1"b; /* found an appropriate entry that matched the starname, 612* but still didn't get it copied -- 613* Don't report a nomatch for this starname */ 614 615 if code ^= error_table_$namedup then /* already reported */ 616 /* fix bug for TR number phx20617 */ 617 if (code = error_table_$badstar) | (code = error_table_$argerr) then do; 618 temp_source_ename = reverse (rtrim (source_ename)); 619 620 suffix_name = substr (temp_source_ename, 1, (index (temp_source_ename, ".") - 1)); 621 suffix_name = reverse (suffix_name); 622 call com_err_ (error_table_$not_seg_type, NAME, "The .^a suffix was missing from ^a", 623 suffix_name, pathname_ (target_dir, target_ename)); 624 end; 625 /* fix bug for TR number phx19526 */ 626 else if code = error_table_$no_info then 627 call com_err_ (error_table_$incorrect_access, NAME, sub_error_info.info_string); 628 /* end of bug fixes */ 629 else call com_err_ (code, NAME, sub_error_info.info_string); 630 else; 631 if ^copy_command_sw 632 then if (code ^= error_table_$noentry) & (code ^= error_table_$dirseg) 633 & (code ^= error_table_$moderr) & (code ^= error_table_$sameseg) 634 & (code ^= error_table_$namedup) 635 then call com_err_$suppress_name (0, NAME, "Segment ^a not deleted.", 636 pathname_ (source_dir, source_ename)); 637 goto COPY_LOST; 638 end; /* fatal error */ 639 640 else if sub_error_info.default_restart 641 then if ^brief 642 then call com_err_ (code, NAME, sub_error_info.info_string); 643 else ; 644 645 else do; 646 if code = error_table_$unsupported_operation 647 then if badop () 648 then call com_err_ (0, NAME, sub_error_info.info_string); 649 else ; 650 /* fix an incorrect error message for TR number phx20384, this is backed out 651* * with phx20481 as the original repair was incorrect */ 652 else do; 653 call com_err_ (code, NAME, sub_error_info.info_string); 654 goto COPY_LOST; 655 end; 656 /* end of fixing */ 657 end; 658 END_HANDLER: 659 return; 660 661 end sub_err_handler; 662 663 badop: /* returns true iff operation specifically requested */ 664 proc returns (bit (1) aligned); 665 666 declare op char (32); 667 668 op = copy_error_info.operation; 669 if op = "names" 670 then return (explicit.names | ^copy_command_sw); 671 if op = "ACL" 672 then return (explicit.acl | ^copy_command_sw); 673 if op = "ring brackets" 674 then return (explicit.ring_brackets); 675 if op = "max length" 676 then return (explicit.max_length); 677 if op = "copy switch" 678 then return (explicit.copy_switch); 679 if op = "safety switch" 680 then return (explicit.safety_switch); 681 if op = "dumper switches" 682 then return (explicit.dumper_switches); 683 if op = "entry bound" 684 then return (explicit.entry_bound); 685 686 return ("1"b); /* if we don't recognize it, print it. */ 687 end badop; 688 end process_entry; 689 690 end copy; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/24/89 0847.4 copy.pl1 >spec>install>MR12.3-1012>copy.pl1 146 1 06/10/82 1045.5 star_structures.incl.pl1 >ldd>include>star_structures.incl.pl1 148 2 10/14/83 1606.7 copy_options.incl.pl1 >ldd>include>copy_options.incl.pl1 150 3 10/14/83 1606.7 copy_flags.incl.pl1 >ldd>include>copy_flags.incl.pl1 155 4 07/18/81 1100.0 sub_error_info.incl.pl1 >ldd>include>sub_error_info.incl.pl1 157 5 03/24/82 1347.2 condition_info_header.incl.pl1 >ldd>include>condition_info_header.incl.pl1 159 6 06/28/79 1204.8 condition_info.incl.pl1 >ldd>include>condition_info.incl.pl1 161 7 10/14/83 1606.7 copy_error_info.incl.pl1 >ldd>include>copy_error_info.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. COPY_OPTIONS_VERSION_1 000000 constant char(8) initial packed unaligned dcl 2-28 ref 194 DEFAULT_2ND_NAME 000002 constant char(2) initial packed unaligned dcl 99 set ref 396 397 NAME 000112 automatic char(32) packed unaligned dcl 78 set ref 165* 180* 195 206* 212* 212* 228* 330* 344* 374* 382* 393* 403* 413* 418* 419* 434* 440* 463* 469* 481* 560* 622* 626* 629* 631* 640* 646* 653* P_ename parameter char(32) packed unaligned dcl 540 ref 537 553 P_report_dirseg parameter bit(1) dcl 542 ref 537 604 P_successful_copy parameter bit(1) dcl 545 set ref 537 572* acl 0(01) 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 245* 248* 671 acl 157(01) 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 185* 241* 245* 248* 340 action_flags 2 based structure level 3 dcl 4-7 addr builtin function dcl 143 ref 396 571 571 586 586 597 arg_idx 000107 automatic fixed bin(17,0) dcl 75 set ref 223* 225* 228* 361* 363* 389* 522* 522* 524* 531* arg_list_ptr 000110 automatic pointer dcl 76 set ref 359* 524* argument based char packed unaligned dcl 67 set ref 232 235 235 238 238 241 241 245 248 251 251 254 254 257 260 263 263 266 266 269 269 272 272 275 275 278 278 281 281 284 284 287 287 290 290 293 293 296 296 299 299 302 302 305 314 314 317 317 323 323 326 326 330* 366 369 371* 374* 400* 403* 410 413* 526 argument_count 000106 automatic fixed bin(17,0) dcl 75 set ref 203* 210 223 361 389 522 531 argument_lth 000100 automatic fixed bin(21,0) dcl 68 set ref 225* 232 235 235 238 238 241 241 245 248 251 251 254 254 257 260 263 263 266 266 269 269 272 272 275 275 278 278 281 281 284 284 287 287 290 290 293 293 296 296 299 299 302 302 305 314 314 317 317 323 323 326 326 330 330 363* 366 369 371 371 374 374 397* 400 400 403 403 410 413 413 524* 526 argument_ptr 000102 automatic pointer dcl 69 set ref 225* 232 235 235 238 238 241 241 245 248 251 251 254 254 257 260 263 263 266 266 269 269 272 272 275 275 278 278 281 281 284 284 287 287 290 290 293 293 296 296 299 299 302 302 305 314 314 317 317 323 323 326 326 330 363* 366 369 371 374 396* 400 403 410 413 524* 526 bit_count 000100 automatic fixed bin(24,0) dcl 548 set ref 554* brief 000124 automatic bit(1) dcl 85 set ref 235* 238* 640 caller_name 2 000326 automatic char(32) level 2 packed packed unaligned dcl 152 set ref 195* cant_restart 2 based bit(1) level 4 packed packed unaligned dcl 4-7 ref 602 chase_sw 000123 automatic bit(2) dcl 83 set ref 192* 257* 260* 429 453 check_star_name_$entry 000052 constant entry external dcl 125 ref 379 407 ci 000106 automatic structure level 1 dcl 580 set ref 586 586 cleanup 000312 stack reference condition dcl 119 ref 354 code 000122 automatic fixed bin(35,0) dcl 81 in procedure "cp" set ref 203* 204 206* 225* 226 228* 371* 372 374* 400* 401 403* 407* 408 410 418* 431* 432 434* 458* 460 460 469* code 000121 automatic fixed bin(35,0) dcl 550 in procedure "process_entry" set ref 557* 558 560* 600* 604 615 615 615 626 629* 631 631 631 631 631 640* 646 653* com_err_ 000046 constant entry external dcl 121 ref 206 212 228 330 344 374 382 393 403 413 418 419 434 440 463 469 481 560 622 626 629 640 646 653 com_err_$suppress_name 000050 constant entry external dcl 121 ref 631 condition_info based structure level 1 dcl 6-14 condition_info_header based structure level 1 dcl 5-6 condition_info_version_1 constant fixed bin(17,0) initial dcl 6-30 ref 585 continue_to_signal_ 000054 constant entry external dcl 126 ref 591 copy_ 000056 constant entry external dcl 127 ref 571 copy_command_sw 000125 automatic bit(1) dcl 85 set ref 167* 182* 199 311 631 669 671 copy_error_info based structure level 1 dcl 7-8 copy_flags based structure level 1 dcl 3-8 copy_items 157 000326 automatic structure level 2 dcl 152 set ref 168* 184* copy_options based structure level 1 dcl 2-12 copy_options_ptr based pointer level 2 dcl 7-8 ref 597 copy_switch 0(04) 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 281* 284* 677 copy_switch 157(04) 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 185* 241* 281* 284* 340 cpo 000326 automatic structure level 1 dcl 152 set ref 571 571 597 cu_$arg_count 000060 constant entry external dcl 128 ref 203 cu_$arg_list_ptr 000062 constant entry external dcl 129 ref 359 cu_$arg_ptr 000064 constant entry external dcl 130 ref 225 363 cu_$arg_ptr_rel 000066 constant entry external dcl 131 ref 524 default_restart 2(01) based bit(1) level 4 packed packed unaligned dcl 4-7 ref 640 delete 156(03) 000326 automatic bit(1) level 3 packed packed unaligned dcl 152 set ref 199* dumper_switches 0(06) 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 293* 296* 681 dumper_switches 157(06) 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 185* 241* 293* 296* 340 ename 000276 automatic char(32) packed unaligned dcl 91 set ref 478* 479* entry_bound 157(07) 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 197* 299* 302* entry_bound 0(07) 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 299* 302* 683 entry_only_sw 000126 automatic bit(1) dcl 85 set ref 369* 391 error_table_$argerr 000010 external static fixed bin(35,0) dcl 101 ref 615 error_table_$badopt 000012 external static fixed bin(35,0) dcl 101 set ref 330* error_table_$badstar 000014 external static fixed bin(35,0) dcl 101 ref 615 error_table_$dirseg 000016 external static fixed bin(35,0) dcl 101 ref 604 631 error_table_$inconsistent 000040 external static fixed bin(35,0) dcl 101 set ref 344* error_table_$incorrect_access 000020 external static fixed bin(35,0) dcl 101 set ref 463* 626* error_table_$moderr 000022 external static fixed bin(35,0) dcl 101 ref 460 631 error_table_$namedup 000024 external static fixed bin(35,0) dcl 101 ref 615 631 error_table_$no_info 000032 external static fixed bin(35,0) dcl 101 ref 626 error_table_$noarg 000026 external static fixed bin(35,0) dcl 101 set ref 212* error_table_$noentry 000030 external static fixed bin(35,0) dcl 101 ref 631 error_table_$not_seg_type 000034 external static fixed bin(35,0) dcl 101 set ref 622* error_table_$root 000042 external static fixed bin(35,0) dcl 101 set ref 413* error_table_$sameseg 000036 external static fixed bin(35,0) dcl 101 ref 631 error_table_$unsupported_operation 000044 external static fixed bin(35,0) dcl 101 ref 646 expand_pathname_ 000070 constant entry external dcl 133 ref 371 400 explicit 000506 automatic structure level 1 dcl 153 set ref 201* extend 157(08) 000326 automatic bit(1) level 3 packed packed unaligned dcl 152 set ref 307* 314* 320* 340 344* find_condition_info_ 000072 constant entry external dcl 134 ref 586 flags 156 000326 automatic structure level 2 dcl 152 set ref 198* force 156(02) 000326 automatic bit(1) level 3 packed packed unaligned dcl 152 set ref 263* 266* get_equal_name_ 000074 constant entry external dcl 135 ref 557 get_system_free_area_ 000076 constant entry external dcl 136 ref 349 have_paths 000127 automatic bit(1) dcl 85 set ref 221* 232* 336 hcs_$star_ 000100 constant entry external dcl 137 ref 458 hcs_$status_minf 000102 constant entry external dcl 139 ref 431 header based structure level 2 dcl 4-7 idx 000311 automatic fixed bin(17,0) dcl 97 set ref 476* 478* index builtin function dcl 143 ref 620 info_ptr 116 based pointer level 2 in structure "sub_error_info" dcl 4-7 in procedure "cp" ref 595 597 604 668 info_ptr 14 000106 automatic pointer level 2 in structure "ci" dcl 580 in procedure "sub_err_handler" set ref 587 info_string 3 based varying char(256) level 3 dcl 4-7 set ref 626* 629* 640* 646* 653* inhibit_nomatch_error 000131 automatic bit(1) dcl 87 set ref 473* 481 611* length builtin function dcl 143 ref 397 max_length 0(03) 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 269* 272* 675 max_length 157(03) 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 185* 241* 269* 272* 340 name 106 based char(32) level 2 dcl 4-7 ref 589 names 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 251* 254* 669 names 157 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 185* 241* 251* 254* 340 nindex 0(18) based fixed bin(18,0) array level 2 packed packed unsigned unaligned dcl 1-27 ref 478 nnames 0(02) based fixed bin(16,0) array level 2 packed packed unsigned unaligned dcl 1-27 ref 503 null builtin function dcl 143 ref 351 501 504 507 510 586 586 595 op 000162 automatic char(32) packed unaligned dcl 666 set ref 668* 669 671 673 675 677 679 681 683 operation 2 based char(32) level 2 dcl 7-8 ref 668 pathname_ 000104 constant entry external dcl 141 ref 382 382 418 418 419 419 434 434 440 440 463 463 469 469 481 481 560 560 622 622 631 631 raw 156(01) 000326 automatic bit(1) level 3 packed packed unaligned dcl 152 set ref 323* 326* reverse builtin function dcl 581 ref 618 621 ring_brackets 0(02) 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 275* 278* 673 ring_brackets 157(02) 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 185* 241* 275* 278* 340 rtrim builtin function dcl 143 ref 618 safety_switch 0(05) 000506 automatic bit(1) level 2 in structure "explicit" packed packed unaligned dcl 153 in procedure "cp" set ref 287* 290* 679 safety_switch 157(05) 000326 automatic bit(1) level 3 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 185* 241* 287* 290* 340 search builtin function dcl 143 ref 369 select_sw 000310 automatic fixed bin(2,0) dcl 96 set ref 453* 456* 458* source_dir 12 000326 automatic char(168) level 2 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 564* source_dir 000132 automatic char(168) packed unaligned dcl 90 in procedure "cp" set ref 371* 382* 382* 431* 434* 434* 440* 440* 458* 463* 463* 469* 469* 481* 481* 564 631* 631* source_ename 000256 automatic char(32) packed unaligned dcl 91 in procedure "cp" set ref 371* 379* 382* 382* 431* 434* 434* 440* 440* 447* 458* 463* 463* 469* 469* 481* 481* source_ename 000101 automatic char(32) packed unaligned dcl 549 in procedure "process_entry" set ref 553* 557* 560* 565 618 631* 631* source_name 64 000326 automatic char(32) level 2 packed packed unaligned dcl 152 set ref 565* source_stars 000306 automatic fixed bin(35,0) dcl 93 set ref 379* 380 380 380 382* 427 source_type 000307 automatic fixed bin(2,0) dcl 94 set ref 431* 438 star_ALL_ENTRIES constant fixed bin(2,0) initial dcl 1-111 ref 453 star_BRANCHES_ONLY constant fixed bin(2,0) initial dcl 1-110 ref 456 star_LINK constant fixed bin(2,0) initial unsigned dcl 1-119 ref 438 star_entries based structure array level 1 dcl 1-27 ref 509 star_entry_count 000320 automatic fixed bin(17,0) dcl 1-14 set ref 458* 476 503 509 star_entry_ptr 000322 automatic pointer dcl 1-15 set ref 351* 458* 478 503 507 509 510* star_names based char(32) array packed unaligned dcl 1-37 ref 478 503 star_names_ptr 000324 automatic pointer dcl 1-19 set ref 351* 458* 478 501 503 504* status_code 104 based fixed bin(35,0) level 3 dcl 4-7 ref 600 string builtin function dcl 143 set ref 168* 184* 198* 201* sub_error_ 000000 stack reference condition dcl 119 ref 569 sub_error_info based structure level 1 dcl 4-7 sub_error_info_ptr 000510 automatic pointer dcl 4-6 set ref 587* 589 595 597 600 602 604 626 629 640 640 646 653 668 substr builtin function dcl 143 ref 232 366 526 620 successful_copy 000130 automatic bit(1) dcl 87 set ref 473* 479* 481 suffix_name 000140 automatic varying char(8) initial dcl 582 set ref 582* 620* 621* 621 622* sum builtin function dcl 143 ref 503 system_area based area(1024) dcl 71 ref 503 509 system_area_ptr 000104 automatic pointer dcl 73 set ref 349* 458* 503 509 target_dir 000204 automatic char(168) packed unaligned dcl 90 in procedure "cp" set ref 400* 418* 418* 419* 419* 560* 560* 566 622* 622* target_dir 74 000326 automatic char(168) level 2 in structure "cpo" packed packed unaligned dcl 152 in procedure "cp" set ref 566* target_ename 000111 automatic char(32) packed unaligned dcl 549 set ref 557* 567 622* 622* target_eqname 000266 automatic char(32) packed unaligned dcl 91 set ref 400* 407* 418* 418* 419* 419* 557* 560* 560* target_err_switch 12 based bit(1) level 2 dcl 7-8 ref 604 target_name 146 000326 automatic char(32) level 2 packed packed unaligned dcl 152 set ref 567* target_type 000122 automatic fixed bin(2,0) dcl 551 set ref 555* temp_source_ename 000143 automatic varying char(32) initial dcl 583 set ref 583* 618* 620 620 update 157(09) 000326 automatic bit(1) level 3 packed packed unaligned dcl 152 set ref 308* 314* 319* 340 version 2 000106 automatic fixed bin(17,0) level 2 in structure "ci" dcl 580 in procedure "sub_err_handler" set ref 585* version 000326 automatic char(8) level 2 in structure "cpo" dcl 152 in procedure "cp" set ref 194* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. condition_info_header_ptr automatic pointer dcl 5-4 condition_info_ptr automatic pointer dcl 6-10 copy_options_ptr automatic pointer dcl 2-10 star_ALL_ENTRIES_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 1-114 star_DIRECTORY internal static fixed bin(2,0) initial unsigned dcl 1-121 star_LINKS_ONLY internal static fixed bin(2,0) initial dcl 1-109 star_LINKS_ONLY_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 1-112 star_SEGMENT internal static fixed bin(2,0) initial unsigned dcl 1-120 star_branch_count automatic fixed bin(17,0) dcl 1-13 star_dir_list_branch based structure array level 1 dcl 1-59 star_link_count automatic fixed bin(17,0) dcl 1-17 star_link_pathname based char packed unaligned dcl 1-102 star_links based structure array level 1 dcl 1-76 star_linkx automatic fixed bin(17,0) dcl 1-18 star_list_branch based structure array level 1 dcl 1-41 star_list_branch_ptr automatic pointer dcl 1-16 star_list_names based char(32) array packed unaligned dcl 1-92 star_list_names_ptr automatic pointer dcl 1-20 star_select_sw automatic fixed bin(3,0) dcl 1-21 sub_error_info_version_1 internal static fixed bin(17,0) initial dcl 4-13 NAMES DECLARED BY EXPLICIT CONTEXT. BADOPT 001451 constant label dcl 330 ref 311 COMMON 000537 constant label dcl 192 ref 170 CONTINUE_TO_SIGNAL 003506 constant label dcl 591 ref 595 597 COPY_LOST 003447 constant label dcl 574 ref 604 637 654 END_HANDLER 004207 constant label dcl 658 ref 593 NEXT_PAIR 003124 constant label dcl 488 ref 376 384 404 415 421 436 443 465 470 USAGE 000612 constant label dcl 212 ref 336 badop 004210 constant entry internal dcl 663 ref 646 clean_up 003134 constant entry internal dcl 497 ref 354 488 copy 000463 constant entry external dcl 36 cp 000454 constant entry external dcl 36 find_second_arg 003212 constant entry internal dcl 516 ref 375 383 387 move 000507 constant entry external dcl 176 mv 000500 constant entry external dcl 176 process_entry 003256 constant entry internal dcl 537 ref 447 479 sub_err_handler 003450 constant entry internal dcl 577 ref 569 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5172 5300 4565 5202 Length 5710 4565 106 374 405 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cp 470 external procedure is an external procedure. on unit on line 354 64 on unit clean_up 64 internal procedure is called by several nonquick procedures. find_second_arg internal procedure shares stack frame of external procedure cp. process_entry 188 internal procedure enables or reverts conditions. on unit on line 569 225 on unit sub_err_handler internal procedure shares stack frame of on unit on line 569. badop internal procedure shares stack frame of on unit on line 569. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cp 000100 argument_lth cp 000102 argument_ptr cp 000104 system_area_ptr cp 000106 argument_count cp 000107 arg_idx cp 000110 arg_list_ptr cp 000112 NAME cp 000122 code cp 000123 chase_sw cp 000124 brief cp 000125 copy_command_sw cp 000126 entry_only_sw cp 000127 have_paths cp 000130 successful_copy cp 000131 inhibit_nomatch_error cp 000132 source_dir cp 000204 target_dir cp 000256 source_ename cp 000266 target_eqname cp 000276 ename cp 000306 source_stars cp 000307 source_type cp 000310 select_sw cp 000311 idx cp 000320 star_entry_count cp 000322 star_entry_ptr cp 000324 star_names_ptr cp 000326 cpo cp 000506 explicit cp 000510 sub_error_info_ptr cp on unit on line 569 000106 ci sub_err_handler 000140 suffix_name sub_err_handler 000143 temp_source_ename sub_err_handler 000162 op badop process_entry 000100 bit_count process_entry 000101 source_ename process_entry 000111 target_ename process_entry 000121 code process_entry 000122 target_type process_entry THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out_desc call_ext_out call_int_this call_int_other return_mac tra_ext_1 mpfx2 enable_op shorten_stack ext_entry int_entry reverse_cs set_chars_eis op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_star_name_$entry com_err_ com_err_$suppress_name continue_to_signal_ copy_ cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr cu_$arg_ptr_rel expand_pathname_ find_condition_info_ get_equal_name_ get_system_free_area_ hcs_$star_ hcs_$status_minf pathname_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$argerr error_table_$badopt error_table_$badstar error_table_$dirseg error_table_$inconsistent error_table_$incorrect_access error_table_$moderr error_table_$namedup error_table_$no_info error_table_$noarg error_table_$noentry error_table_$not_seg_type error_table_$root error_table_$sameseg error_table_$unsupported_operation LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 36 000453 165 000470 167 000473 168 000475 170 000476 176 000477 180 000514 182 000517 184 000520 185 000521 192 000537 194 000540 195 000542 197 000545 198 000547 199 000550 201 000556 203 000557 204 000570 206 000572 207 000607 210 000610 212 000612 215 000641 221 000642 223 000643 225 000651 226 000666 228 000670 229 000723 232 000724 235 000734 238 000750 241 000762 245 001011 248 001022 251 001032 254 001047 257 001063 260 001072 263 001101 266 001114 269 001127 272 001144 275 001160 278 001175 281 001211 284 001226 287 001242 290 001257 293 001273 296 001310 299 001324 302 001341 305 001355 307 001361 308 001363 309 001365 311 001366 314 001370 317 001406 319 001416 320 001420 321 001422 323 001423 326 001436 330 001451 332 001503 334 001504 336 001506 340 001510 344 001516 346 001550 349 001551 351 001560 354 001563 359 001605 361 001614 363 001623 366 001641 369 001646 371 001662 372 001712 374 001714 375 001746 376 001747 379 001750 380 001765 382 001773 383 002042 384 002043 387 002044 389 002045 391 002050 393 002052 394 002077 396 002100 397 002102 400 002104 401 002134 403 002136 404 002170 407 002171 408 002206 410 002210 413 002220 415 002253 418 002254 419 002324 421 002375 427 002376 429 002400 431 002403 432 002442 434 002444 436 002513 438 002514 440 002516 443 002567 447 002570 449 002606 453 002607 456 002615 458 002617 460 002662 463 002667 465 002735 469 002736 470 003004 473 003005 476 003007 478 003017 479 003030 480 003044 481 003046 488 003124 491 003130 690 003132 497 003133 501 003141 503 003146 504 003175 507 003200 509 003204 510 003206 513 003211 516 003212 522 003213 524 003221 526 003241 529 003247 531 003251 533 003254 537 003255 553 003263 554 003270 555 003271 557 003272 558 003315 560 003317 561 003376 564 003377 565 003403 566 003406 567 003411 569 003414 571 003432 572 003444 574 003447 577 003450 582 003451 583 003452 585 003453 586 003455 587 003475 589 003501 591 003506 593 003516 595 003517 597 003523 600 003531 602 003534 604 003537 611 003554 615 003560 618 003571 620 003616 621 003636 622 003652 624 003730 626 003731 629 003755 631 003776 637 004074 640 004077 643 004125 646 004126 649 004163 653 004164 654 004204 658 004207 663 004210 668 004212 669 004221 671 004235 673 004252 675 004263 677 004274 679 004305 681 004316 683 004327 686 004340 ----------------------------------------------------------- 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