COMPILATION LISTING OF SEGMENT archive Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/12/88 1245.7 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 /****^ HISTORY COMMENTS: 14* 1) change(87-10-15,TLNguyen), approve(87-10-15,MCR7774), 15* audit(87-12-16,GWMay), install(88-01-12,MR12.2-1012): 16* - The archive replace operation will display an appropriate error message 17* for invalid components specified in the command line. 18* 19* - Replace the expand_pathname_ with the expand_pathname_$add_suffix to 20* always append the "archive" suffix to an archive segment if an user 21* does not supply the "archive" suffix. 22* 2) change(87-10-15,TLNguyen), approve(87-10-15,MCR7776), 23* audit(87-12-16,GWMay), install(88-01-12,MR12.2-1012): 24* - Make the archive xd operation produce correct error message when it 25* extracts a single existing archive component into a nonexistent 26* directory and delete this component in the archive if it extracts 27* successfully. 28* 29* - Error also raised when more than one existing components to be 30* extracted and place one of extracted components into a nonexistent 31* directory (e.g. ac xd archive_seg >nonexistent_dir>seg_a seg_b). 32* Currently, it deletes the component in the archive when it found 33* the directory where the extracted component to be placed 34* does not exist. This error found while testing the archive. 35* 3) change(87-10-15,TLNguyen), approve(87-10-15,MCR7780), 36* audit(87-12-16,GWMay), install(88-01-12,MR12.2-1012): 37* - Make the archive append operation to avoid an out_of_bound fault. 38* This error raised when an user sets the max length of the original 39* archive less than its default max length and attempts to run the 40* archive append operation. 41* 42* - So do the archive delete, replace, and update operations. 43* These errors found while testing the archive. 44* END HISTORY COMMENTS */ 45 46 47 48 archive: ac: proc; 49 50 /* archive command : operates as described in the MPM 51* 52* coded 8/1/69 J.W. Gintell 53* conv to pl1 2/1/70 54**/ 55 56 57 /* the following names have been shortened: 58* 59* gbct global_bit_count 60* wdct word_count 61* rcmp replace_component 62* ccmp copy_component 63* amsw arc_mod_sw 64* hbgn header_begin 65* hend header_end 66* bcnt bit_count 67* optr orig_ptr 68* cptr copy_ptr 69* tptr tempptr 70**/ 71 /* last modified on 12-4-73 by Kobziar not to check for append mode */ 72 /* changed to use external flag archive_data_$active 08/29/79 S. Herbst */ 73 /* Error messages fixed for "ac cud" 09/24/79 S. Herbst */ 74 /* A few bugs fixed 04/09/80 S. Herbst */ 75 /* Improve error messages 01/12/81 S. Herbst */ 76 /* Added "xd" key to extract and delete archive component 07/01/82 S. Herbst */ 77 /* Changed archive move to restore original on rqo 07/02/82 S. Herbst */ 78 /* Fixed to truncate after it shortens the archive 10/29/82 S. Herbst */ 79 /* Changed some error messages to give full component pathname 11/24/82 S. Herbst */ 80 /* Changed to prefix "appended to" and "updated in" msgs with command name 1st time only 11/21/83 S. Herbst */ 81 /* Changed update to print message if no components matched segs or none updated 12/12/83 S. Herbst */ 82 /* Fixed bug: overflow of global array if deleting many components and no comp args specified 12/12/83 S. Herbst */ 83 /* Fixed to ignore error_table_$no_s_permission from hcs_$status_long 04/18/85 Steve Herbst */ 84 /* Fixed to report error_table_$entlong with .archive appended 04/18/85 Steve Herbst */ 85 86 87 dcl moi char (8) aligned init ("archive"); 88 89 90 dcl archive_data_$active bit (1) aligned external; /* ON if archive or archive_table af is active */ 91 92 dcl (archive_data_$ident, 93 archive_data_$fence) ext char (8) aligned; 94 95 dcl error_table_$incorrect_access external fixed bin (35); 96 dcl error_table_$namedup external fixed bin (35); 97 dcl error_table_$no_append external fixed bin (35); 98 dcl error_table_$no_s_permission external fixed bin (35); 99 dcl error_table_$noentry external fixed bin (35); 100 dcl error_table_$moderr external fixed bin (35); 101 dcl error_table_$rqover external fixed bin (35); 102 dcl error_table_$segknown external fixed bin (35); 103 104 dcl archive_key_$last_index external fixed bin (17); 105 106 declare 1 archive_key_$begin_table (100 /* archive_key_$last_index */) aligned ext, 107 2 key char (4), /* key to be matched */ 108 2 bits unaligned, /* required for Version II */ 109 3 action bit (2), /* = 0 table 110* = 1 replace 111* = 2 extract 112* = 3 delete */ 113 3 update bit (1), /* = 1 if update feature */ 114 3 append bit (1), /* = 1 if append feature */ 115 3 copy bit (1), /* = 1 if copy feature */ 116 3 delete bit (1), /* = 1 if should delete */ 117 3 force bit (1), /* = 1 for delete force */ 118 3 long bit (1), /* = 1 for long output */ 119 3 zero_arg_ok bit (1), /* = 1 if OK to have zero arguments */ 120 3 star_ok bit (1), /* = 1 if star convention may be used */ 121 3 empty_ok bit (1), /* = 1 if OK to start with an empty archive */ 122 3 no_orig_ok bit (1), /* = 1 if OK to not find original */ 123 3 brief_bit bit (1); /* Suppress header printing in "t" keys */ 124 125 declare 1 key_template aligned based (keyp), 126 2 key char (4), /* key to be matched */ 127 2 bits unaligned, /* required for Version II */ 128 3 action bit (2), /* = 0 table 129* = 1 replace 130* = 2 extract 131* = 3 delete */ 132 3 update bit (1), /* = 1 if update feature */ 133 3 append bit (1), /* = 1 if append feature */ 134 3 copy bit (1), /* = 1 if copy feature */ 135 3 delete bit (1), /* = 1 if should delete */ 136 3 force bit (1), /* = 1 for delete force */ 137 3 long bit (1), /* = 1 for long output */ 138 3 zero_arg_ok bit (1), /* = 1 if OK to have zero arguments */ 139 3 star_ok bit (1), /* = 1 if star convention may be used */ 140 3 empty_ok bit (1), /* = 1 if OK to start with an empty archive */ 141 3 no_orig_ok bit (1), /* = 1 if OK to not find original */ 142 3 brief_bit bit (1); /* Suppress header printing in "t" keys */ 143 144 dcl key_index fixed bin (17), /* hold index to table of keys here */ 145 keyp ptr; /* Pointer to current entry in key list */ 146 147 dcl (mcode, code, savecode, max_length) fixed bin (35); 148 dcl (i, j, k) fixed bin (17); 149 dcl wdct fixed bin (19); 150 dcl lastarg fixed bin (17); 151 dcl curlen fixed bin (17); 152 dcl bcnt fixed bin (24), 153 gbct fixed bin (24) initial (0); 154 dcl noroomsw bit (1) initial ("1"b); /* set to ""b when message printed */ 155 dcl header_printed bit (1) initial (""b); /* set to "1"b when table header printed */ 156 dcl first_line_sw bit (1) init ("1"b); /* to prefix "appended to" and "updated in" msgs */ 157 /* with "archive:" first time only */ 158 159 /* one record may be enough to hold component names. If not, we open a seg */ 160 161 dcl stack_space (1024) fixed bin (35) init ((1024) 0); 162 163 dcl (sp, new_sp) pointer aligned; 164 dcl (dcount, lcount) fixed bin (17) aligned; 165 166 dcl (NONGLOBAL_ELEMENT_SIZE init (53), GLOBAL_ELEMENT_SIZE init (10)) 167 fixed bin int static options (constant); 168 169 dcl 1 nonglobal (2500) aligned based (sp), 170 2 component_name char (32) aligned, /* if this structure changes, change NONGLOBAL_ELEMENT_SIZE */ 171 2 component_path char (168) aligned, 172 2 component_code fixed bin (35) aligned, 173 2 flags fixed bin (3) aligned, 174 2 ngtype bit (2) unaligned; 175 176 dcl 1 global (2500) aligned based (sp), 177 2 gcomponent_name char (32) aligned, /* if this structure changes, change GLOBAL_ELEMENT_SIZE */ 178 2 gflags fixed bin (3) aligned, 179 2 gtype bit (2) unaligned; 180 181 /* flags = 0: not found in archive 182* 1: action completed 183* 2: not found in archive or filesys 184* 3: found in archive but not in filesys 185* 4: appended to archive 186* 5: found in archive during append request 187* 6: archive overflow during processing 188* 7: no message, but no delete either */ 189 190 dcl (dn, initpath, archive_dir, new_archive_dir) char (168) aligned, 191 time char (16) aligned, 192 timenow char (16) aligned, /* store current time here */ 193 patharg char (pathlen) based (pathptr), 194 pathlen fixed bin (17), 195 pathptr ptr, 196 keyb char (key_l) based (key_p), 197 key_l fixed bin (17), 198 key_p ptr; 199 dcl arglist_ptr ptr; 200 201 dcl archive_name char (32) aligned initial (""), 202 temp_name char (32) aligned static init ("archive_temp_.archive"), 203 act_com char (8) aligned, /* update, replace, or append */ 204 key char (4) aligned; 205 206 dcl buffer char (150) varying; 207 dcl (optr, cptr, p1_orig) ptr init (null); 208 dcl tptr ptr static init (null); 209 dcl (p1, p2) ptr init (null); 210 211 dcl iflag fixed bin (3); /* temporary copy */ 212 213 dcl amsw fixed bin (17) init (0); /* = 1 if a modified copy is to replace the archive */ 214 215 dcl cleanup_temp bit (1) internal static init (""b); /* =1 if must truncate temp */ 216 217 declare 1 aux_wstructure aligned, /* structure for archive_aux_ */ 218 2 mustfree bit (1) init (""b), /* set to "1"b by archive_aux_$listwdir */ 219 2 ecount fixed bin, /* # of entries in dir */ 220 2 my_wdir char (168), /* Needed for link chasing in $inwdir call */ 221 2 eptr ptr init (null), /* for archive_aux_ */ 222 2 nptr ptr init (null); /* " */ 223 224 dcl auxw_ptr ptr; 225 226 dcl 1 query_info aligned, /* structure for command query */ 227 2 version fixed bin init (1), 228 2 yes_or_no_sw bit (1) unal init ("1"b), /* require yes or no answer */ 229 2 supress_name_sw bit (1) unal init ("0"b), /* print name with question */ 230 2 extra bit (34) unal, 231 2 status_code fixed bin (35), /* set to code of prompting question */ 232 2 query_code fixed bin (35); 233 234 dcl 1 seg_acl aligned, /* structure for adding one acl */ 235 2 userid char (32), 236 2 access bit (36), 237 2 ex_access bit (36), 238 2 status fixed bin (35); 239 240 dcl 1 delete_acl aligned, /* structure for deleting one acl */ 241 2 userid char (32), 242 2 status fixed bin (35); 243 244 dcl mustreprotect bit (1) init (""b); /* set to true if archive is protected */ 245 dcl entry_type bit (2); /* set to entry_type of entry */ 246 dcl typef fixed bin (2); 247 dcl stars_found bit (1) init (""b); /* set to "1" on star_entry */ 248 dcl found_something_sw bit (1) init (""b); /* for update: ON when matching seg found in dir */ 249 dcl updated_something_sw bit (1) init (""b); /* for update: ON when a component is actually replaced */ 250 251 dcl 1 mask based aligned, 252 2 keep bit (36 - maskl) unaligned, 253 2 kill bit (maskl) unaligned; 254 dcl maskl fixed bin; 255 dcl array (wdct) fixed bin (35) based, 256 fix17 fixed bin (35), 257 fix35 fixed bin (35) based, 258 259 1 stat, /* structure for status_ call */ 260 2 type bit (2) unaligned, 261 2 pad bit (34) unaligned, 262 2 dtm bit (36), 263 2 pad1 (5) bit (36), 264 2 len, 265 3 cur bit (12) unaligned, 266 3 bitcnt bit (24) unaligned, 267 2 pad2 (2) bit (36), 268 269 dtm bit (36) aligned, 270 271 (copy, delete, force, long) bit (1) init (""b), 272 update bit (1) init (""b), /* = "1"b if update feature requested */ 273 append bit (1) init (""b), /* = "1"b if append feature requested */ 274 dlast fixed bin (17) init (0), 275 last fixed bin (17) init (0), 276 dontcopy fixed bin (17) init (0), 277 278 char8 picture "zzzzzzz9", 279 char32 char (32) aligned; 280 281 dcl (header_length init (25), /* # of words in header */ 282 header_length_bits init (900)) fixed bin static; /* .. bits */ 283 284 dcl 1 archive based (p1) aligned, 285 2 hbgn char (8), 286 2 pad1 char (4), 287 2 name char (32), 288 2 timeup char (16), 289 2 mode char (4), 290 2 time char (16), 291 2 pad char (4), 292 2 bcnt char (8), 293 2 hend char (8), 294 2 begin fixed bin; 295 296 dcl 1 modeb aligned based (addr (mode)), 297 2 pad bit (32) unaligned, 298 2 r bit (1) unaligned, 299 2 e bit (1) unaligned, 300 2 w bit (1) unaligned, 301 2 obsolete bit (1) unaligned, 302 mode fixed bin (5); 303 dcl amode fixed bin (5); /* keep mode of archive segment here */ 304 305 dcl 1 contents_overlay aligned based, 306 2 offset_space (offset_words) fixed bin, 307 2 contents (new_words - offset_words) fixed bin; 308 309 dcl orig_bc fixed bin (24); 310 dcl (new_words, offset_words, orig_words) fixed bin (21); 311 312 dcl iox_$error_output ptr external; 313 314 dcl check_star_name_$entry entry (char (*)aligned, fixed bin (35)), 315 clock_ returns (fixed bin (71)), 316 cu_$arg_ptr entry (fixed bin (17), ptr, fixed bin (17), fixed bin (35)), 317 cu_$arg_list_ptr returns (ptr), 318 cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr), 319 cu_$arg_count returns (fixed bin (17)), 320 expand_pathname_$add_suffix entry (char (*), char (*), char (*) aligned, char (*) aligned, fixed bin (35)), 321 expand_pathname_ entry (char (*), char (*) aligned, char (*) aligned, fixed bin (35)), 322 get_group_id_ entry returns (char (32) aligned), 323 get_group_id_$tag_star entry returns (char (32) aligned), 324 get_pdir_ returns (char (168) aligned), 325 get_wdir_ returns (char (168) aligned), 326 327 (com_err_, command_query_, ioa_, ioa_$ioa_switch) entry options (variable), 328 329 fs_util_$get_max_length entry (char (*) aligned, char (*) aligned, fixed bin (35), fixed bin (35)), 330 hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin, ptr, fixed bin (35)), 331 hcs_$terminate_noname entry (ptr, fixed bin (35)), 332 hcs_$terminate_seg entry (ptr, fixed bin (1), fixed bin (35)), 333 hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5), ptr, fixed bin (35)), 334 hcs_$set_bc entry (char (*) aligned, char (*) aligned, fixed bin (24), fixed bin (35)), 335 hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)), 336 hcs_$add_acl_entries entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin (35)), 337 hcs_$delete_acl_entries entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin (35)), 338 hcs_$chname_seg entry (ptr, char (*) aligned, char (*) aligned, fixed bin (35)), 339 hcs_$truncate_seg entry (ptr, fixed bin (21), fixed bin (35)), 340 hcs_$star_list_ entry (char (*)aligned, char (*), fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35)), 341 hcs_$status_long entry (char (*) aligned, char (*) aligned, fixed bin, ptr, ptr, fixed bin (35)), 342 hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (2), fixed bin, fixed bin (35)), 343 hcs_$fs_get_mode entry (ptr, fixed bin (5), fixed bin (35)), 344 hcs_$delentry_file entry (char (*) aligned, char (*) aligned, fixed bin (35)), 345 hcs_$delentry_seg entry (ptr, fixed bin (35)), 346 initiate_file_ entry (char (*) aligned, char (*) aligned, bit (*), pointer, fixed bin (24), fixed bin (35)), 347 pathname_ entry (char (*) aligned, char (*) aligned) returns (char (168)), 348 term_ entry (char (*) aligned, char (*) aligned, fixed bin (35)), 349 350 dl_handler_ entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)), 351 dl_handler_$noquestion entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)), 352 nd_handler_ entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)), 353 354 archive_util_$first_element entry (ptr, fixed bin (35)), 355 archive_util_$next_element entry (ptr, fixed bin (35)), 356 archive_aux_$listwdir entry (ptr, fixed bin (35)), 357 archive_aux_$inwdir entry (ptr, char (32) aligned, bit (36) aligned, bit (2)) returns (bit (1)), 358 archive_aux_$free entry (ptr), 359 archive_aux_$active entry (bit (1) aligned), 360 archive_star_ entry (char (*) aligned, char (*) aligned, char (*) aligned, ptr, fixed bin), 361 362 convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)), 363 date_time_$fstime entry (fixed bin (35), char (*) aligned), 364 date_time_ entry (fixed bin (71), char (*) aligned), 365 cv_dec_ entry (char (*) aligned) returns (fixed bin (24)); 366 367 dcl (addr, addrel, bin, bit, divide, fixed, max, null, ptr, rel, size, substr) builtin; 368 369 dcl (cleanup, record_quota_overflow) condition; 370 371 dcl action fixed bin (2); 372 373 /* This block of code gets the arguments and initializes various data items. */ 374 375 376 if archive_data_$active then call archive_aux_$active (archive_data_$active); 377 /* query about recursive use */ 378 if archive_data_$active then return; /* active reset if wish to proceed */ 379 380 lastarg = cu_$arg_count (); 381 382 arglist_ptr = cu_$arg_list_ptr (); /* save argument list pointer */ 383 go to SKIPENTRY; 384 385 /* This entry point is called by archive_star_ to implement star convention */ 386 387 star_entry: entry (dummy_key, dummy_name, dummy_arglist_ptr, dummy_lastarg); 388 389 dcl dummy_arglist_ptr ptr; 390 dcl dummy_lastarg fixed bin; 391 dcl (dummy_key, dummy_name) char (*); 392 393 arglist_ptr = dummy_arglist_ptr; 394 lastarg = dummy_lastarg; 395 stars_found = "1"b; /* mark that through this entry */ 396 397 SKIPENTRY: 398 399 sp = addr (stack_space); 400 auxw_ptr = addr (aux_wstructure); 401 call cu_$arg_ptr (1, key_p, key_l, code); /* get key */ 402 if code ^= 0 then go to NARG; 403 if key_l <= 4 then key = keyb; 404 else do; 405 KEYERR: call com_err_ ((0), moi, "Unrecognized key - ^a", keyb); 406 goto RETURN; 407 end; 408 do key_index = archive_key_$last_index to 1 by -1 while (key ^= archive_key_$begin_table (key_index).key);end; 409 if key_index = 0 then go to KEYERR; /* couldn't find key */ 410 411 keyp = addr (archive_key_$begin_table (key_index)); 412 413 copy = key_template.copy; 414 update = key_template.update; 415 append = key_template.append; 416 delete = key_template.delete; 417 force = key_template.force; 418 long = key_template.long; 419 header_printed = key_template.brief_bit; /* That wasn't hard at all! */ 420 421 action = bin (key_template.action, 17); 422 423 if action = 1 /* If some form of replacement */ 424 then if update 425 then act_com = "update "; 426 else if append 427 then act_com = "append "; 428 else act_com = "replace "; 429 430 call cu_$arg_ptr (2, pathptr, pathlen, code); /* archive name */ 431 if code ^= 0 then do; 432 NARG: if append | delete then call com_err_ (0, moi, "Usage: ^a key archive_path component_names", moi); 433 else call com_err_ (0, moi, "Usage: ^a key archive_path {component_names}", moi); 434 goto RETURN; 435 end; 436 437 call expand_pathname_$add_suffix (patharg, "archive", archive_dir, archive_name, code); 438 if code ^= 0 then do; 439 call com_err_ (code, moi, patharg); 440 goto RETURN; 441 end; 442 443 call check_star_name_$entry (archive_name, code); 444 if code ^= 0 then do; 445 if code = 1 | code = 2 then 446 if ^key_template.star_ok then 447 call com_err_ ((0), moi, "Star convention cannot be used with this key. ^a", key); 448 449 else call archive_star_ (archive_dir, archive_name, key, arglist_ptr, lastarg); 450 451 else call com_err_ (code, moi, "^a", pathname_ (archive_dir, archive_name)); 452 453 go to RETURN; 454 end; 455 456 my_wdir = get_wdir_ (); 457 on condition (cleanup) call clean_up; 458 459 call initiate_file_ (archive_dir, archive_name, R_ACCESS, p1, orig_bc, code); 460 p1_orig = p1; /* save pointer to archive */ 461 if p1 ^= null then do; 462 call hcs_$fs_get_mode (p1, amode, code); 463 if code = 0 then if ^addr (amode) -> modeb.r then code = error_table_$moderr; 464 if code ^= 0 then do; /* print message and return */ 465 ERROR_RETURN: 466 call com_err_ (code, moi, "^a", pathname_ (archive_dir, archive_name)); 467 goto RETURN; 468 end; 469 470 call fs_util_$get_max_length (archive_dir, archive_name, max_length, code); 471 if code ^= 0 then go to ERROR_RETURN; 472 473 call archive_util_$first_element (p1, savecode); 474 if savecode = 2 then do; 475 FERROR: call com_err_ (0, moi, "Format error in ^a", pathname_ (archive_dir, archive_name)); 476 if p2 ^= null then if copy then call hcs_$delentry_seg (p2, code); 477 go to COMRETN; 478 end; 479 end; 480 481 if ^key_template.no_orig_ok then if p1 = null then do; 482 NOARCHIVE: call com_err_ (code, moi, "^a", pathname_ (archive_dir, archive_name)); 483 goto COMRETN; 484 end; 485 486 if ^key_template.empty_ok then if savecode = 1 then do; 487 call com_err_ (0, moi, "^a is empty.", pathname_ (archive_dir, archive_name)); 488 go to COMRETN; /* cleanup and return */ 489 end; 490 491 if copy then do; /* special checking for copy */ 492 if p1 = null then do; 493 call com_err_ (0, moi, "Attempt to use copy feature when original not found. ^a", 494 pathname_ (archive_dir, archive_name)); 495 go to COMRETN; 496 end; 497 if archive_dir = my_wdir then do; 498 call com_err_ (0, moi, "Attempt to copy onto original. ^a", 499 pathname_ (archive_dir, archive_name)); 500 goto COMRETN; 501 end; 502 new_archive_dir = my_wdir; /* force new archive to wdir */ 503 end; 504 505 else new_archive_dir = archive_dir; /* force new archive to replace old */ 506 507 508 if lastarg < 3 then if action = 1 then do; 509 call hcs_$star_list_ (my_wdir, "**", 2, null, dcount, lcount, null, null, code); 510 if dcount+lcount > 113 then do; 511 call hcs_$make_seg ("", "", "", 01010b, sp, code); 512 if code ^= 0 then do; 513 call com_err_ (code, moi); 514 go to COMRETN; end; 515 end; 516 end; 517 518 if lastarg * NONGLOBAL_ELEMENT_SIZE > size (stack_space) then do; 519 call hcs_$make_seg ("", "", "", 01010b, sp, code); 520 if sp = null then do; 521 call com_err_ (code, moi); 522 go to COMRETN; end; 523 do i = 1 to lastarg-2; 524 component_code (i) = 0; 525 flags (i) = 0; 526 ngtype (i) = ""b; 527 end; 528 end; 529 530 do i = 3 to lastarg; /* get all component names */ 531 call cu_$arg_ptr_rel (i, pathptr, pathlen, code, arglist_ptr); 532 if code ^= 0 then go to BADARG; 533 if pathlen = 0 then go to NEXTARG; /* this might be wrong */ 534 535 if action = 0 | action = 3 then do; /* table or delete */ 536 component_name (last+1) = patharg; /* not a pathname */ 537 goto CHECKARG; 538 end; 539 540 call expand_pathname_ (patharg, component_path (last + 1), component_name (last + 1), code); 541 if code ^= 0 then do; 542 BADARG: call com_err_ (code, moi, patharg); 543 goto NEXTARG; 544 end; 545 CHECKARG: do j = last to 1 by -1 while (component_name (j) ^= component_name (last+1));end; 546 if j ^= 0 then do; 547 call com_err_ ((0), moi, "Duplicated request for this component. ^a", component_name (last+1)); 548 goto NEXTARG; 549 end; 550 last = last + 1; 551 NEXTARG: 552 end; 553 554 if ^key_template.zero_arg_ok then if last = 0 then do; 555 call com_err_ ((0), moi, "Some component names must be specified with this key - ^a", key); 556 go to COMRETN; 557 end; 558 559 if lastarg >= 3 /* From cu_$arg_count */ 560 then if last = 0 /* Null args, or expand_path_ errors */ 561 then go to COMRETN; /* Don't perform global operations */ 562 if action ^= 0 then archive_data_$active = "1"b; /* protect against recursion */ 563 564 go to FANOUT (action); 565 566 567 568 569 FANOUT (0): 570 TABLE_HANDLER: 571 572 do while (p1 ^= null); /* loop through entire archive */ 573 574 if last ^= 0 then do; /* check for match with input argument */ 575 do i = last to 1 by -1 while (component_name (i) ^= p1 -> archive.name);end; 576 if i = 0 then go to TNXT; 577 flags (i) = 1; 578 end; 579 580 if ^header_printed then do; 581 call ioa_ ("^/^-^a^/", pathname_ (archive_dir, archive_name)); 582 if long then call ioa_ (" name^3- updated mode^-modified^- length^/"); 583 else call ioa_ (" updated^2- name^/"); 584 header_printed = "1"b; 585 end; 586 587 if long then call ioa_ ("^32a^17a^5a^16a^a", 588 p1 -> archive.name, 589 p1 -> archive.timeup, 590 p1 -> archive.mode, 591 p1 -> archive.time, 592 p1 -> archive.bcnt); 593 else call ioa_ ("^20a^a", p1 -> archive.timeup, p1 -> archive.name); 594 595 TNXT: 596 call archive_util_$next_element (p1, code); 597 if code = 2 then go to FERROR; 598 end; 599 call ioa_ (""); 600 601 go to NOT_FOUND_CHECKER; /* issue diagnostics and return */ 602 603 FANOUT (1): 604 REPLACE_HANDLER: 605 606 607 if p1 = null then if last = 0 then do; 608 code = error_table_$noentry; 609 go to NOARCHIVE; /* no archive found */ 610 end; 611 612 call date_time_ ((clock_ ()), timenow); /* get time */ 613 614 if last = 0 then do; 615 call archive_aux_$listwdir (auxw_ptr, code); 616 if code ^= 0 then do; 617 call com_err_ (code, moi, "^a", pathname_ (archive_dir, archive_name)); 618 go to COMRETN; 619 end; 620 end; 621 622 if savecode = 1 then p1 = null; /* archive was empty */ 623 624 do while (p1 ^= null); 625 if last = 0 then do; /* full replace */ 626 call rcmp; 627 end; 628 else do; 629 do i = last to 1 by -1 while (component_name (i) ^= p1 -> archive.name);end; 630 if i = 0 then do; 631 call ccmp; 632 end; 633 else do; 634 if append then do; 635 flags (i) = 5; 636 call ccmp; 637 end; 638 else do; 639 flags (i) = 1; 640 call rcmp; 641 end; 642 end; 643 end; 644 call archive_util_$next_element (p1, code); 645 if code = 2 then go to FERROR; 646 end; 647 648 if update then goto MOVE_ARCHIVE; /* do no appending */ 649 do i = 1 to last; 650 if flags (i) = 0 then do; 651 call rcmp; 652 if flags (i) = 0 then flags (i) = 4; /* change to was appended code */ 653 end; 654 end; 655 656 /* Move archive and perform deletions if necessary */ 657 658 MOVE_ARCHIVE: 659 if dontcopy ^= 0 then do; 660 call hcs_$set_bc (new_archive_dir, archive_name, gbct, code); 661 if code ^= 0 then do; 662 call com_err_ (code, moi, "^a", pathname_ (archive_dir, archive_name)); 663 go to COMRETN; 664 end; 665 call hcs_$terminate_noname (p2, fix17); 666 if code = 0 then if delete then go to DELT; 667 else go to NOT_FOUND_CHECKER; 668 end; 669 670 if amsw = 0 then go to NOT_FOUND_CHECKER; /* did not modify original */ 671 672 if ^addr (amode) -> modeb.w then do; /* if archive is protected by no w access */ 673 query_info.status_code = error_table_$moderr; 674 call ask_question; /* find out if it's ok to change it */ 675 seg_acl.userid = get_group_id_ (); /* wants to update */ 676 seg_acl.access = "101"b; /* give user rw */ 677 seg_acl.ex_access = "0"b; 678 call hcs_$add_acl_entries (new_archive_dir, archive_name, addr (seg_acl), 1, mcode); 679 if mcode ^= 0 then go to MOVE_ERROR; 680 else mustreprotect = "1"b; 681 end; 682 683 orig_words = bc_to_rec (orig_bc) * 1024; 684 new_words = bc_to_rec (gbct) * 1024; 685 686 if new_words > orig_words then do; /* remember they're rounded to a page */ 687 on record_quota_overflow begin; 688 mcode = error_table_$rqover; 689 call hcs_$truncate_seg (p1_orig, orig_words, 0); /* back to original length */ 690 go to MOVE_ERROR; 691 end; 692 693 offset_words = orig_words; /* copy just the part beyond orig, as a test of quota */ 694 p1_orig -> contents = ptr (p2, 0) -> contents; 695 revert record_quota_overflow; 696 end; 697 698 offset_words = 0; /* now copy whole thing */ 699 p1_orig -> contents = ptr (p2, 0) -> contents; 700 701 if "0"b then do; /* only hit this via goto's */ 702 MOVE_ERROR: call com_err_ (mcode, moi, "Archive ^a not updated.", pathname_ (archive_dir, archive_name)); 703 call hcs_$set_bc_seg (tptr, gbct, code); 704 call hcs_$chname_seg (tptr, temp_name, archive_name, code); 705 if code = 0 then tptr = null; /* force temp.archive to be remade */ 706 archive_dir = get_pdir_ (); 707 if code ^= 0 then archive_name = "temp.archive"; 708 call ioa_ ("A copy of the updated archive can be found in [pd]>^a", archive_name); 709 go to NOT_FOUND_CHECKER; 710 end; 711 call hcs_$set_bc (new_archive_dir, archive_name, gbct, savecode); 712 if savecode ^= 0 then call com_err_ (savecode, moi, "^a", pathname_ (archive_dir, archive_name)); 713 else if p2 ^= null then call hcs_$truncate_seg (p2, 0, code); /* truncate copy */ 714 715 if new_words < orig_words then call hcs_$truncate_seg (p1_orig, new_words, 0); 716 if mustreprotect then do; /* restore ACL to original state */ 717 delete_acl.userid = seg_acl.userid; /* delete ACL */ 718 call hcs_$delete_acl_entries (new_archive_dir, archive_name, addr (delete_acl), 1, code); 719 if code ^= 0 then do; 720 call com_err_ (code, moi, "^a", pathname_ (archive_dir, archive_name)); 721 goto COMRETN; 722 end; 723 end; 724 cleanup_temp = ""b; /* temporary segment is clean */ 725 if ^delete | savecode ^= 0 then go to NOT_FOUND_CHECKER; 726 727 DELT: ; 728 do i = 1 to max (last, dlast); /* either last or dlast will be zero, we want the other */ 729 if last ^= 0 then do; 730 if flags (i) = 1 | flags (i) = 4 then 731 call delete_seg (component_path (i), component_name (i), ngtype (i), code); 732 end; 733 else do; 734 if gflags (i) = 1 | gflags (i) = 4 then 735 call delete_seg (my_wdir, gcomponent_name (i), gtype (i), code); 736 end; 737 end; 738 if last = 0 then go to COMRETN; 739 740 NOT_FOUND_CHECKER: 741 do i = 1 to last; 742 iflag = flags (i); 743 if iflag = 0 then 744 call com_err_ (0, moi, "^a not found in ^a", 745 component_name (i), pathname_ (archive_dir, archive_name)); 746 else if iflag = 2 then 747 call com_err_ (component_code (i), moi, "Could not append ^a to ^a", 748 pathname_ (component_path (i), component_name (i)), pathname_ (archive_dir, archive_name)); 749 else if iflag = 3 then 750 if update & component_code (i) = 0 then do; 751 if updated_something_sw then call com_err_ (0, moi, 752 "Did not update ^a because latest copy already in ^a", 753 component_name (i), pathname_ (archive_dir, archive_name)); 754 end; 755 else do; 756 if found_something_sw | nonglobal (i).component_code ^= 0 then 757 call com_err_ (nonglobal (i).component_code, moi, "Could not replace ^a in ^a", 758 pathname_ (nonglobal (i).component_path, nonglobal (i).component_name), pathname_ (archive_dir, archive_name)); 759 end; 760 else if iflag = 4 & p1_orig ^= null & ^append then do; 761 call ioa_ ("^[archive: ^;^9x^]^a appended to ^a", first_line_sw, 762 pathname_ (component_path (i), component_name (i)), 763 pathname_ (archive_dir, archive_name)); 764 first_line_sw = "0"b; 765 end; 766 else if iflag = 5 then 767 call com_err_ (0, moi, "Did not append ^a because copy found in ^a", 768 component_name (i), pathname_ (archive_dir, archive_name)); 769 else if iflag = 6 /* Temp, could use 2 if error code were available */ 770 then call com_err_ (0, moi, "Archive segment overflow. Could not ^a ^a in ^a", 771 act_com, pathname_ (component_path (i), component_name (i)), pathname_ (archive_dir, archive_name)); 772 /* else if iflag = 7 then; /* No message, but no delete either */ 773 end; 774 775 if update then 776 if ^found_something_sw then call com_err_ (0, moi, 777 "No matching segments^[ in ^a^;^s^]; no components were updated in archive ^a", 778 last = 0, archive_dir, pathname_ (archive_dir, archive_name)); 779 else if ^updated_something_sw then call com_err_ (0, moi, 780 "Archive ^a contains the latest versions; no components were updated^[ from ^a^].", 781 pathname_ (archive_dir, archive_name), last = 0, archive_dir); 782 783 COMRETN: ; /* return from command */ 784 785 call clean_up; 786 RETURN: return; 787 788 789 /* cleanup handler used at command termination as well */ 790 791 clean_up: proc; 792 793 if sp ^= addr (stack_space) then do; call hcs_$delentry_seg (sp, code); 794 call hcs_$terminate_noname (sp, code); end; 795 if aux_wstructure.mustfree then call archive_aux_$free (auxw_ptr); 796 if p1_orig ^= null then call hcs_$terminate_noname (p1_orig, code); 797 archive_data_$active = ""b; 798 799 end clean_up; 800 801 802 FANOUT (2): 803 XTRACT_HANDLER: 804 805 XTRACT_LOOP: 806 do i = last to 1 by -1 while (component_name (i) ^= p1 -> archive.name);end; 807 if i ^= 0 then nonglobal (i).flags = 1; 808 else if last ^= 0 then do; /* this is not one of the specified components */ 809 if delete then call ccmp; 810 go to XTRACT_NXT; 811 end; 812 if last = 0 then initpath = my_wdir; 813 else initpath = component_path (i); 814 815 bcnt = cv_dec_ (p1 -> archive.bcnt); 816 wdct = divide (bcnt+35, 36, 17, 0); 817 818 if wdct > max_length then go to FERROR; 819 820 if p1 -> archive.mode = "" then mode = 01010b; /* compatibility */ 821 else do; /* convert ascii rewa to mode */ 822 mode = 0; /* initialize */ 823 if substr (p1 -> archive.mode, 1, 1) = "r" then mode = 01000b; 824 if substr (p1 -> archive.mode, 2, 1) = "e" then mode = mode + 00100b; 825 if substr (p1 -> archive.mode, 3, 1) = "w" then mode = mode + 00010b; 826 end; 827 828 MAKEIT: ; 829 call hcs_$make_seg (initpath, p1 -> archive.name, "", 01011b, cptr, code); 830 if cptr = null then do; 831 if code = error_table_$incorrect_access then 832 call com_err_ (error_table_$no_append, moi, "^a", initpath); 833 else call com_err_ (code, moi, "^a", pathname_ (initpath, p1 -> archive.name)); 834 835 if nonglobal (i).flags = 1 then do; /* found an existing archive component */ 836 if delete then do; 837 nonglobal (i).flags = 7; /* indicate that no delete */ 838 call ccmp; /* copy this existing component in temp archive */ 839 end; 840 end; 841 842 nonglobal (i).component_code = code; /* save error code for printing an error message */ 843 goto XTRACT_NXT; 844 end; 845 846 if delete then do; 847 amsw = 1; /* we're modifying the archive */ 848 if i ^= 0 then nonglobal (i).flags = 1; 849 end; 850 851 if code ^= 0 then do; 852 if ^force then call nd_handler_ (moi, initpath, p1 -> archive.name, code); 853 else do; 854 call hcs_$status_minf (initpath, p1 -> archive.name, 0, typef, j, code); 855 call delete_seg (initpath, p1 -> archive.name, bit (typef, 2), code); 856 end; 857 if code = 0 then do; 858 call hcs_$make_seg (initpath, p1 -> archive.name, "", 01011b, cptr, code); 859 if code ^= 0 then do; 860 if code = error_table_$incorrect_access then code = error_table_$no_append; 861 call com_err_ (code, moi, "^a", initpath); 862 if cptr ^= null then call hcs_$terminate_noname (cptr, code); 863 SKIP_COMPONENT: if delete then call ccmp; /* don't delete the component */ 864 go to XTRACT_NXT; 865 end; 866 end; 867 else go to SKIP_COMPONENT; 868 end; 869 870 cptr -> array = addr (p1 -> archive.begin) -> array; 871 call hcs_$set_bc (initpath, p1 -> archive.name, bcnt, code); 872 if mode ^= 01010b then do; 873 seg_acl.userid = get_group_id_$tag_star (); 874 seg_acl.access = bit (bin (mode, 4), 4); /* convert old style access modes to new style */ 875 seg_acl.ex_access = "0"b; 876 call hcs_$add_acl_entries (initpath, p1 -> archive.name, addr (seg_acl), 1, code); 877 end; 878 call hcs_$terminate_seg (cptr, 0, code); 879 880 XTRACT_NXT: 881 call archive_util_$next_element (p1, code); 882 if code = 2 then go to FERROR; 883 if p1 ^= null then go to XTRACT_LOOP; 884 885 if delete then do; 886 delete = "0"b; /* don't want MOVE_ARCHIVE to delete the segs we made */ 887 go to CHECK_DELETED; 888 end; 889 else go to NOT_FOUND_CHECKER; 890 891 FANOUT (3): 892 DELETE_HANDLER: 893 894 do while (p1 ^= null); 895 do i = last to 1 by -1 while (component_name (i) ^= p1 -> archive.name);end; 896 if i = 0 then do; call ccmp; end; 897 else do;amsw = 1; flags (i) = 1;end; 898 899 call archive_util_$next_element (p1, code); 900 if code = 2 then go to FERROR; 901 end; 902 903 CHECK_DELETED: 904 if p2 = null then do; /* get segment made */ 905 call makenew; 906 do i = 1 to last while (nonglobal (i).component_code = 0); end; 907 if i > last then 908 call ioa_ ("archive: All components of ^a have been deleted.", 909 pathname_ (archive_dir, archive_name)); 910 end; 911 go to MOVE_ARCHIVE; 912 913 914 /* Internal procedure to replace an archive component */ 915 916 rcmp: proc; 917 if last ^= 0 then do; 918 nonglobal (i).component_code = 0; 919 char32 = nonglobal (i).component_name; 920 initpath = nonglobal (i).component_path; 921 end; 922 else do; /* global case */ 923 char32 = p1 -> archive.name; 924 initpath = my_wdir; 925 if ^archive_aux_$inwdir (auxw_ptr, p1 -> archive.name, dtm, entry_type) then goto MUSTCOPY; 926 end; 927 928 call initiate_file_ (initpath, char32, R_ACCESS, optr, bcnt, code); 929 if code ^= 0 then do; 930 if last = 0 then call com_err_ (code, moi, "^a", pathname_ (initpath, char32)); 931 else nonglobal (i).component_code = code; 932 end; 933 934 if optr = p1_orig then do; /* can't replace the archive in itself */ 935 flags (i) = 3; 936 go to MUSTCOPY; 937 end; 938 if optr = null then 939 do; 940 MUSTCOPY: 941 if last ^= 0 then 942 if append then flags (i) = 2; 943 else flags (i) = 3; 944 MUSTCOPY2: 945 if p1 ^= null then do; /* copy the original component */ 946 call ccmp; 947 end; 948 return; 949 end; 950 951 found_something_sw = "1"b; 952 953 call hcs_$fs_get_mode (optr, mode, code); /* get current mode */ 954 if code = 0 then if ^modeb.r then code = error_table_$moderr; 955 if code ^= 0 then do; 956 REPLERR: if last = 0 then call com_err_ (code, moi, "^a", pathname_ (initpath, char32)); 957 else component_code (i) = code; 958 call hcs_$terminate_noname (optr, code); 959 go to MUSTCOPY; 960 end; 961 962 call hcs_$status_long (initpath, char32, 0, addr (stat), null, code); 963 if code ^= 0 & code ^= error_table_$no_s_permission then go to REPLERR; /* print error code (or store it) */ 964 if last ^= 0 then ngtype (i) = stat.type; /* save the entry type */ 965 if stat.type = "00"b then do; /* chase link */ 966 call hcs_$status_long (initpath, char32, 1, addr (stat), null, code); 967 if code ^= 0 & code ^= error_table_$no_s_permission then go to REPLERR; 968 end; 969 if last ^= 0 then dtm = stat.dtm; 970 curlen = fixed (stat.cur, 12); 971 if bc_to_rec (bcnt) < curlen then do; 972 call com_err_ (0, moi, "Bit count is inconsistent with current length for ^a^[>^]^a", 973 initpath, initpath ^= ">", char32); 974 if last = 0 then call ioa_$ioa_switch (iox_$error_output, "Component was not updated in ^a", 975 pathname_ (archive_dir, archive_name)); 976 go to MUSTCOPY; 977 end; 978 call date_time_$fstime (addr (dtm) -> fix35, time); 979 if update then do; 980 if p1 ^= null then 981 if convert_time (time) <= convert_time (p1 -> archive.time) then do; /* check dtm's */ 982 call hcs_$terminate_noname (optr, code); 983 go to MUSTCOPY; 984 end; 985 updated_something_sw = "1"b; 986 end; 987 if delete then /* save names for deletion */ 988 if last = 0 then do; 989 dlast = dlast + 1; 990 if dlast * GLOBAL_ELEMENT_SIZE > size (stack_space) then do; /* need more room */ 991 call hcs_$make_seg ("", "", "", 01010b, new_sp, code); 992 if new_sp = null then do; 993 call com_err_ (code, moi); 994 go to COMRETN; 995 end; 996 do k = 1 to dlast - 1; /* copy from stack_space to allocated seg */ 997 new_sp -> global (k) = sp -> global (k); 998 end; 999 sp = new_sp; 1000 end; 1001 gflags (dlast) = 1; 1002 gtype (dlast) = entry_type; /* save the entry type */ 1003 gcomponent_name (dlast) = char32; 1004 end; 1005 1006 if p2 = null then call makenew; /* get segment made */ 1007 1008 wdct = divide (bcnt+35, 36, 17, 0); 1009 1010 if (bin (rel (p2), 18, 0) + wdct + header_length) > max_length 1011 then do; 1012 1013 if last = 0 /* Global update/replace? */ 1014 then do; 1015 1016 if copy then dn = new_archive_dir; 1017 else dn = archive_dir; 1018 call com_err_ (0, moi, "Archive segment overflow. Could not ^a ^a in ^a", 1019 act_com, char32, pathname_ (dn, archive_name)); 1020 if dlast = 0 then dlast = 1; 1021 gflags (dlast) = 7; /* No message, but no delete */ 1022 go to MUSTCOPY2; 1023 1024 end; 1025 1026 iflag = flags (i); 1027 flags (i) = 6; /* Temp until "seglarge" error code? */ 1028 if iflag = 0 /* Appending? */ 1029 then go to RCMPRTN; 1030 1031 go to MUSTCOPY2; /* Don't update "flags" */ 1032 1033 1034 end; 1035 1036 amsw = 1; /* mark for updating */ 1037 1038 p2 -> archive.pad, p2 -> archive.pad1 = " "; 1039 p2 -> archive.hbgn = archive_data_$ident; 1040 p2 -> archive.hend = archive_data_$fence; 1041 p2 -> archive.name = char32; 1042 1043 char8 = bcnt; 1044 p2 -> archive.bcnt = char8; 1045 p2 -> archive.timeup = timenow; 1046 p2 -> archive.time = time; 1047 1048 p2 -> archive.mode = ""; 1049 if modeb.r then substr (p2 -> archive.mode, 1, 1) = "r"; 1050 if modeb.e then substr (p2 -> archive.mode, 2, 1) = "e"; 1051 if modeb.w then substr (p2 -> archive.mode, 3, 1) = "w"; 1052 1053 p2 = addrel (p2, header_length); 1054 gbct = gbct + header_length_bits; 1055 p2 -> array = optr -> array; 1056 maskl = wdct*36 - bcnt; 1057 if maskl ^= 0 then addrel (p2, wdct-1) -> mask.kill = ""b; 1058 p2 = addrel (p2, wdct); 1059 gbct = gbct + wdct*36; 1060 1061 if update & last = 0 then do; 1062 if copy then dn = new_archive_dir; 1063 else dn = archive_dir; 1064 call ioa_ ("^[archive: ^;^9x^]^a updated in ^a", first_line_sw, char32, 1065 pathname_ (dn, archive_name)); 1066 first_line_sw = "0"b; 1067 end; 1068 1069 RCMPRTN: call hcs_$terminate_noname (optr, code); 1070 end rcmp; 1071 1072 /* Internal procedure to copy the current archive component to the new archive */ 1073 ccmp: proc; 1074 1075 if p2 = null then call makenew; /* get temp seg */ 1076 1077 bcnt = cv_dec_ (p1 -> archive.bcnt) + header_length_bits; /* get bit count of current component */ 1078 wdct = divide (bcnt+35, 36, 17, 0); /* convert to word count */ 1079 1080 if wdct > max_length then go to FERROR; /* max length of the current component is greater the actual */ 1081 1082 if (bin (rel (p2), 18, 0) + wdct) > max_length 1083 then do; 1084 1085 call com_err_ (0, moi, "Archive segment overflow while copying ^a in ^a 1086 Archive not updated.", p1 -> archive.name, pathname_ (archive_dir, archive_name)); 1087 1088 go to COMRETN; /* Abort */ 1089 1090 end; 1091 1092 p2 -> array = p1 -> array; /* copy header + data */ 1093 gbct = gbct + wdct*36; /* update global bit count */ 1094 p2 = addrel (p2, wdct); /* step current component pointer */ 1095 1096 end ccmp; 1097 1098 /* Internal procedure to create a new output archive segment */ 1099 1100 makenew: proc; 1101 1102 dcl error fixed bin (35); 1103 1104 if copy | p1_orig = null then do; 1105 dontcopy = 1; 1106 CREATE: call hcs_$make_seg (new_archive_dir, archive_name, "", 01011b, p2, error); 1107 if error ^= 0 then do; 1108 if error = error_table_$namedup | error = error_table_$segknown then do; 1109 call nd_handler_ (moi, new_archive_dir, archive_name, error); 1110 if error = 0 then go to CREATE; 1111 call hcs_$terminate_noname (p2, code); 1112 p2 = null; 1113 go to COMRETN; 1114 end; 1115 call com_err_ (error, moi, "^a", pathname_ (new_archive_dir, archive_name)); 1116 go to COMRETN; /* non local go to */ 1117 end; 1118 1119 call fs_util_$get_max_length (new_archive_dir, archive_name, max_length, error); 1120 if code ^= 0 then do; 1121 call com_err_ (error, moi, "^a", pathname_ (new_archive_dir, archive_name)); 1122 go to COMRETN; /* non local go to */ 1123 end; 1124 if orig_bc = 0 then orig_bc = max_length * 36; 1125 1126 if ^copy then do; 1127 call ioa_ ("archive: Creating ^a", pathname_ (archive_dir, archive_name)); 1128 p1_orig = p2; /* let p1_orig points to the newly created output archive segment */ 1129 end; 1130 else call ioa_ ("archive: Copying ^a", pathname_ (archive_dir, archive_name)); 1131 1132 return; 1133 end; 1134 1135 1136 if tptr = null then do; /* make the temp */ 1137 call hcs_$make_seg ("", temp_name, "", 01011b, tptr, error); 1138 if tptr = null then do; /* cant make it */ 1139 call com_err_ (error, moi, "[pd]>^a", temp_name); 1140 go to COMRETN; /* non local go to */ 1141 end; 1142 end; 1143 else if cleanup_temp then call hcs_$truncate_seg (tptr, 0, error); 1144 1145 p2 = tptr; 1146 cleanup_temp = "1"b; /* mark temp dirty */ 1147 1148 end makenew; 1149 1150 1151 bc_to_rec: proc (P_bc) returns (fixed bin); 1152 1153 dcl P_bc fixed bin (24); 1154 1155 if P_bc = 0 then return (0); 1156 else return (divide (P_bc - 1, 36 * 1024, 17, 0) + 1); 1157 1158 end bc_to_rec; 1159 1160 1161 1162 delete_seg: proc (path, entry, dtype, dcode); 1163 1164 dcl (path, entry) char (*) aligned, 1165 dtype bit (2), 1166 dcode fixed bin (35); 1167 dcl ccode fixed bin (35); 1168 1169 call term_ (path, entry, dcode); 1170 if dtype = "00"b then do; 1171 call hcs_$initiate (path, entry, "", 0, 1, cptr, dcode); 1172 if cptr = null then return; 1173 call hcs_$delentry_seg (cptr, dcode); 1174 end; 1175 else call hcs_$delentry_file (path, entry, dcode); 1176 if dcode = 0 then return; 1177 1178 if ^force then call dl_handler_ (moi, path, entry, dcode); 1179 else call dl_handler_$noquestion (moi, path, entry, dcode); 1180 1181 if dtype = "00"b then call hcs_$delentry_seg (cptr, ccode); 1182 else call hcs_$delentry_file (path, entry, ccode); 1183 if dcode = 0 then dcode = ccode; 1184 1185 if dcode ^= 0 then call com_err_ (0, moi, "Could not delete ^a", pathname_ (path, entry)); 1186 1187 end delete_seg; 1188 1189 1190 1191 convert_time: proc (P_str) returns (fixed bin (71)); 1192 1193 dcl P_str char (*) aligned; 1194 dcl fixed_time fixed bin (71); 1195 1196 call convert_date_to_binary_ ((P_str), fixed_time, code); 1197 if code ^= 0 then return (0); 1198 else return (fixed_time); 1199 1200 end convert_time; 1201 1202 1203 1204 ask_question: proc; 1205 1206 /* Procedure to ask the user whether to update a protected segment */ 1207 1208 call command_query_ (addr (query_info), buffer, moi, 1209 "Do you want to update the protected segment ^a ?", pathname_ (new_archive_dir, archive_name)); 1210 1211 if substr (buffer, 1, 2) = "no" then goto COMRETN; 1212 1213 end ask_question; 1214 1215 1 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 1216 1217 end archive; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/12/88 1245.0 archive.pl1 >spec>install>1012>archive.pl1 1216 1 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.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. GLOBAL_ELEMENT_SIZE constant fixed bin(17,0) initial dcl 166 ref 990 NONGLOBAL_ELEMENT_SIZE constant fixed bin(17,0) initial dcl 166 ref 518 P_bc parameter fixed bin(24,0) dcl 1153 ref 1151 1155 1156 P_str parameter char dcl 1193 ref 1191 1196 R_ACCESS 000063 constant bit(3) initial unaligned dcl 1-11 set ref 459* 928* access 10 002612 automatic bit(36) level 2 dcl 234 set ref 676* 874* act_com 002436 automatic char(8) dcl 201 set ref 423* 426* 428* 769* 1018* action 002726 automatic fixed bin(2,0) dcl 371 in procedure "ac" set ref 421* 423 508 535 535 562 564 action 1 based bit(2) level 3 in structure "key_template" packed unaligned dcl 125 in procedure "ac" ref 421 addr builtin function dcl 367 ref 397 400 411 463 672 678 678 718 718 793 870 876 876 954 962 962 966 966 978 1049 1050 1051 1208 1208 addrel builtin function dcl 367 ref 1053 1057 1058 1094 amode 002705 automatic fixed bin(5,0) dcl 303 set ref 462* 463 672 amsw 002523 automatic fixed bin(17,0) initial dcl 213 set ref 213* 670 847* 897* 1036* append 002666 automatic bit(1) initial unaligned dcl 255 in procedure "ac" set ref 255* 415* 426 432 634 760 940 append 1(03) based bit(1) level 3 in structure "key_template" packed unaligned dcl 125 in procedure "ac" ref 415 archive based structure level 1 dcl 284 archive_aux_$active 000210 constant entry external dcl 314 ref 376 archive_aux_$free 000206 constant entry external dcl 314 ref 795 archive_aux_$inwdir 000204 constant entry external dcl 314 ref 925 archive_aux_$listwdir 000202 constant entry external dcl 314 ref 615 archive_data_$active 000024 external static bit(1) dcl 90 set ref 376 376* 378 562* 797* archive_data_$fence 000030 external static char(8) dcl 92 ref 1040 archive_data_$ident 000026 external static char(8) dcl 92 ref 1039 archive_dir 002260 automatic char(168) dcl 190 set ref 437* 449* 451* 451* 459* 465* 465* 470* 475* 475* 482* 482* 487* 487* 493* 493* 497 498* 498* 505 581* 581* 617* 617* 662* 662* 702* 702* 706* 712* 712* 720* 720* 743* 743* 746* 746* 751* 751* 756* 756* 761* 761* 766* 766* 769* 769* 775* 775* 775* 779* 779* 779* 907* 907* 974* 974* 1017 1063 1085* 1085* 1127* 1127* 1130* 1130* archive_key_$begin_table 000054 external static structure array level 1 dcl 106 set ref 411 archive_key_$last_index 000052 external static fixed bin(17,0) dcl 104 ref 408 archive_name 002426 automatic char(32) initial dcl 201 set ref 201* 437* 443* 449* 451* 451* 459* 465* 465* 470* 475* 475* 482* 482* 487* 487* 493* 493* 498* 498* 581* 581* 617* 617* 660* 662* 662* 678* 702* 702* 704* 707* 708* 711* 712* 712* 718* 720* 720* 743* 743* 746* 746* 751* 751* 756* 756* 761* 761* 766* 766* 769* 769* 775* 775* 779* 779* 907* 907* 974* 974* 1018* 1018* 1064* 1064* 1085* 1085* 1106* 1109* 1115* 1115* 1119* 1121* 1121* 1127* 1127* 1130* 1130* 1208* 1208* archive_star_ 000212 constant entry external dcl 314 ref 449 archive_util_$first_element 000176 constant entry external dcl 314 ref 473 archive_util_$next_element 000200 constant entry external dcl 314 ref 595 644 880 899 arglist_ptr 002424 automatic pointer dcl 199 set ref 382* 393* 449* 531* array based fixed bin(35,0) array dcl 255 set ref 870* 870 1055* 1055 1092* 1092 aux_wstructure 002524 automatic structure level 1 dcl 217 set ref 400 auxw_ptr 002604 automatic pointer dcl 224 set ref 400* 615* 795* 925* bcnt 000120 automatic fixed bin(24,0) dcl 152 in procedure "ac" set ref 815* 816 871* 928* 971* 1008 1043 1056 1077* 1078 bcnt 25 based char(8) level 2 in structure "archive" dcl 284 in procedure "ac" set ref 587* 815* 1044* 1077* begin 31 based fixed bin(17,0) level 2 dcl 284 set ref 870 bin builtin function dcl 367 ref 421 874 1010 1082 bit builtin function dcl 367 ref 855 855 874 bits 1 based structure level 2 packed unaligned dcl 125 brief_bit 1(12) based bit(1) level 3 packed unaligned dcl 125 ref 419 buffer 002441 automatic varying char(150) dcl 206 set ref 1208* 1211 ccode 003002 automatic fixed bin(35,0) dcl 1167 set ref 1181* 1182* 1183 char32 002674 automatic char(32) dcl 255 set ref 919* 923* 928* 930* 930* 956* 956* 962* 966* 972* 1003 1018* 1041 1064* char8 002672 automatic picture(8) unaligned dcl 255 set ref 1043* 1044 check_star_name_$entry 000060 constant entry external dcl 314 ref 443 cleanup 002712 stack reference condition dcl 369 ref 457 cleanup_temp 000022 internal static bit(1) initial unaligned dcl 215 set ref 724* 1143 1146* clock_ 000062 constant entry external dcl 314 ref 612 code 000107 automatic fixed bin(35,0) dcl 147 set ref 401* 402 430* 431 437* 438 439* 443* 444 445 445 451* 459* 462* 463 463* 464 465* 470* 471 476* 482* 509* 511* 512 513* 519* 521* 531* 532 540* 541 542* 595* 597 608* 615* 616 617* 644* 645 660* 661 662* 666 703* 704* 705 707 713* 718* 719 720* 730* 734* 793* 794* 796* 829* 831 833* 842 851 852* 854* 855* 857 858* 859 860 860* 861* 862* 871* 876* 878* 880* 882 899* 900 928* 929 930* 931 953* 954 954* 955 956* 957 958* 962* 963 963 966* 967 967 982* 991* 993* 1069* 1111* 1120 1196* 1197 com_err_ 000110 constant entry external dcl 314 ref 405 432 433 439 445 451 465 475 482 487 493 498 513 521 542 547 555 617 662 702 712 720 743 746 751 756 766 769 775 779 831 833 861 930 956 972 993 1018 1085 1115 1121 1139 1185 command_query_ 000112 constant entry external dcl 314 ref 1208 component_code 62 based fixed bin(35,0) array level 2 dcl 169 set ref 524* 746* 749 756 756* 842* 906 918* 931* 957* component_name based char(32) array level 2 dcl 169 set ref 536* 540* 545 545 547* 575 629 730* 743* 746* 746* 751* 756* 756* 761* 761* 766* 769* 769* 802 895 919 component_path 10 based char(168) array level 2 dcl 169 set ref 540* 730* 746* 746* 756* 756* 761* 761* 769* 769* 813 920 contents based fixed bin(17,0) array level 2 dcl 305 set ref 694* 694 699* 699 contents_overlay based structure level 1 dcl 305 convert_date_to_binary_ 000214 constant entry external dcl 314 ref 1196 copy 002661 automatic bit(1) initial unaligned dcl 255 in procedure "ac" set ref 255* 413* 476 491 1016 1062 1104 1126 copy 1(04) based bit(1) level 3 in structure "key_template" packed unaligned dcl 125 in procedure "ac" ref 413 cptr 002512 automatic pointer initial dcl 207 set ref 207* 829* 830 858* 862 862* 870 878* 1171* 1172 1173* 1181* cu_$arg_count 000072 constant entry external dcl 314 ref 380 cu_$arg_list_ptr 000066 constant entry external dcl 314 ref 382 cu_$arg_ptr 000064 constant entry external dcl 314 ref 401 430 cu_$arg_ptr_rel 000070 constant entry external dcl 314 ref 531 cur 7 002646 automatic bit(12) level 3 packed unaligned dcl 255 set ref 970 curlen 000117 automatic fixed bin(17,0) dcl 151 set ref 970* 971 cv_dec_ 000222 constant entry external dcl 314 ref 815 1077 date_time_ 000220 constant entry external dcl 314 ref 612 date_time_$fstime 000216 constant entry external dcl 314 ref 978 dcode parameter fixed bin(35,0) dcl 1164 set ref 1162 1169* 1171* 1173* 1175* 1176 1178* 1179* 1183 1183* 1185 dcount 002132 automatic fixed bin(17,0) dcl 164 set ref 509* 510 delete 002662 automatic bit(1) initial unaligned dcl 255 in procedure "ac" set ref 255* 416* 432 666 725 809 836 846 863 885 886* 987 delete 1(05) based bit(1) level 3 in structure "key_template" packed unaligned dcl 125 in procedure "ac" ref 416 delete_acl 002625 automatic structure level 1 dcl 240 set ref 718 718 divide builtin function dcl 367 ref 816 1008 1078 1156 dl_handler_ 000170 constant entry external dcl 314 ref 1178 dl_handler_$noquestion 000172 constant entry external dcl 314 ref 1179 dlast 002667 automatic fixed bin(17,0) initial dcl 255 set ref 255* 728 989* 989 990 996 1001 1002 1003 1020 1020* 1021 dn 002134 automatic char(168) dcl 190 set ref 1016* 1017* 1018* 1018* 1062* 1063* 1064* 1064* dontcopy 002671 automatic fixed bin(17,0) initial dcl 255 set ref 255* 658 1105* dtm 1 002646 automatic bit(36) level 2 in structure "stat" packed unaligned dcl 255 in procedure "ac" set ref 969 dtm 002660 automatic bit(36) dcl 255 in procedure "ac" set ref 925* 969* 978 dtype parameter bit(2) unaligned dcl 1164 ref 1162 1170 1181 dummy_arglist_ptr parameter pointer dcl 389 ref 387 393 dummy_key parameter char unaligned dcl 391 ref 387 dummy_lastarg parameter fixed bin(17,0) dcl 390 ref 387 394 dummy_name parameter char unaligned dcl 391 ref 387 e 0(33) based bit(1) level 2 packed unaligned dcl 296 ref 1050 empty_ok 1(10) based bit(1) level 3 packed unaligned dcl 125 ref 486 entry parameter char dcl 1164 set ref 1162 1169* 1171* 1175* 1178* 1179* 1182* 1185* 1185* entry_type 002637 automatic bit(2) unaligned dcl 245 set ref 925* 1002 eptr 54 002524 automatic pointer initial level 2 dcl 217 set ref 217* error 002764 automatic fixed bin(35,0) dcl 1102 set ref 1106* 1107 1108 1108 1109* 1110 1115* 1119* 1121* 1137* 1139* 1143* error_table_$incorrect_access 000032 external static fixed bin(35,0) dcl 95 ref 831 860 error_table_$moderr 000044 external static fixed bin(35,0) dcl 100 ref 463 673 954 error_table_$namedup 000034 external static fixed bin(35,0) dcl 96 ref 1108 error_table_$no_append 000036 external static fixed bin(35,0) dcl 97 set ref 831* 860 error_table_$no_s_permission 000040 external static fixed bin(35,0) dcl 98 ref 963 967 error_table_$noentry 000042 external static fixed bin(35,0) dcl 99 ref 608 error_table_$rqover 000046 external static fixed bin(35,0) dcl 101 ref 688 error_table_$segknown 000050 external static fixed bin(35,0) dcl 102 ref 1108 ex_access 11 002612 automatic bit(36) level 2 dcl 234 set ref 677* 875* expand_pathname_ 000076 constant entry external dcl 314 ref 540 expand_pathname_$add_suffix 000074 constant entry external dcl 314 ref 437 first_line_sw 000124 automatic bit(1) initial unaligned dcl 156 set ref 156* 761* 764* 1064* 1066* fix17 002645 automatic fixed bin(35,0) dcl 255 set ref 665* fix35 based fixed bin(35,0) dcl 255 set ref 978* fixed builtin function dcl 367 ref 970 fixed_time 003012 automatic fixed bin(71,0) dcl 1194 set ref 1196* 1198 flags 63 based fixed bin(3,0) array level 2 dcl 169 set ref 525* 577* 635* 639* 650 652 652* 730 730 742 807* 835 837* 848* 897* 935* 940* 943* 1026 1027* force 002663 automatic bit(1) initial unaligned dcl 255 in procedure "ac" set ref 255* 417* 852 1178 force 1(06) based bit(1) level 3 in structure "key_template" packed unaligned dcl 125 in procedure "ac" ref 417 found_something_sw 002642 automatic bit(1) initial unaligned dcl 248 set ref 248* 756 775 951* fs_util_$get_max_length 000120 constant entry external dcl 314 ref 470 1119 gbct 000121 automatic fixed bin(24,0) initial dcl 152 set ref 152* 660* 684* 703* 711* 1054* 1054 1059* 1059 1093* 1093 gcomponent_name based char(32) array level 2 dcl 176 set ref 734* 1003* get_group_id_ 000100 constant entry external dcl 314 ref 675 get_group_id_$tag_star 000102 constant entry external dcl 314 ref 873 get_pdir_ 000104 constant entry external dcl 314 ref 706 get_wdir_ 000106 constant entry external dcl 314 ref 456 gflags 10 based fixed bin(3,0) array level 2 dcl 176 set ref 734 734 1001* 1021* global based structure array level 1 dcl 176 set ref 997* 997 gtype 11 based bit(2) array level 2 packed unaligned dcl 176 set ref 734* 1002* hbgn based char(8) level 2 dcl 284 set ref 1039* hcs_$add_acl_entries 000136 constant entry external dcl 314 ref 678 876 hcs_$chname_seg 000142 constant entry external dcl 314 ref 704 hcs_$delentry_file 000156 constant entry external dcl 314 ref 1175 1182 hcs_$delentry_seg 000160 constant entry external dcl 314 ref 476 793 1173 1181 hcs_$delete_acl_entries 000140 constant entry external dcl 314 ref 718 hcs_$fs_get_mode 000154 constant entry external dcl 314 ref 462 953 hcs_$initiate 000122 constant entry external dcl 314 ref 1171 hcs_$make_seg 000130 constant entry external dcl 314 ref 511 519 829 858 991 1106 1137 hcs_$set_bc 000132 constant entry external dcl 314 ref 660 711 871 hcs_$set_bc_seg 000134 constant entry external dcl 314 ref 703 hcs_$star_list_ 000146 constant entry external dcl 314 ref 509 hcs_$status_long 000150 constant entry external dcl 314 ref 962 966 hcs_$status_minf 000152 constant entry external dcl 314 ref 854 hcs_$terminate_noname 000124 constant entry external dcl 314 ref 665 794 796 862 958 982 1069 1111 hcs_$terminate_seg 000126 constant entry external dcl 314 ref 878 hcs_$truncate_seg 000144 constant entry external dcl 314 ref 689 713 715 1143 header_length constant fixed bin(17,0) initial dcl 281 ref 1010 1053 header_length_bits constant fixed bin(17,0) initial dcl 281 ref 1054 1077 header_printed 000123 automatic bit(1) initial unaligned dcl 155 set ref 155* 419* 580 584* hend 27 based char(8) level 2 dcl 284 set ref 1040* i 000112 automatic fixed bin(17,0) dcl 148 set ref 523* 524 525 526* 530* 531* 575* 575* 576 577 629* 629* 630 635 639 649* 650 652 652* 728* 730 730 730 730 730 734 734 734 734* 740* 742 743 746 746 746 746 746 749 751 756 756 756 756 756 756 761 761 761 761 766 769 769 769 769* 802* 802* 807 807 813 835 837 842 848 848 895* 895* 896 897 906* 906* 907 918 919 920 931 935 940 943 957 964 1026 1027 iflag 002522 automatic fixed bin(3,0) dcl 211 set ref 742* 743 746 749 760 766 769 1026* 1028 initiate_file_ 000162 constant entry external dcl 314 ref 459 928 initpath 002206 automatic char(168) dcl 190 set ref 812* 813* 829* 831* 833* 833* 852* 854* 855* 858* 861* 871* 876* 920* 924* 928* 930* 930* 956* 956* 962* 966* 972* 972 ioa_ 000114 constant entry external dcl 314 ref 581 582 583 587 593 599 708 761 907 1064 1127 1130 ioa_$ioa_switch 000116 constant entry external dcl 314 ref 974 iox_$error_output 000056 external static pointer dcl 312 set ref 974* j 000113 automatic fixed bin(17,0) dcl 148 set ref 545* 545* 546 854* k 000114 automatic fixed bin(17,0) dcl 148 set ref 996* 997 997* key 000054 external static char(4) array level 2 in structure "archive_key_$begin_table" dcl 106 in procedure "ac" set ref 408 key 002440 automatic char(4) dcl 201 in procedure "ac" set ref 403* 408 445* 449* 555* key_index 000102 automatic fixed bin(17,0) dcl 144 set ref 408* 408* 409 411 key_l 002420 automatic fixed bin(17,0) dcl 190 set ref 401* 403 403 405 405 key_p 002422 automatic pointer dcl 190 set ref 401* 403 405 key_template based structure level 1 dcl 125 keyb based char unaligned dcl 190 set ref 403 405* keyp 000104 automatic pointer dcl 144 set ref 411* 413 414 415 416 417 418 419 421 445 481 486 554 kill based bit level 2 packed unaligned dcl 251 set ref 1057* last 002670 automatic fixed bin(17,0) initial dcl 255 set ref 255* 536 540 540 545 545 547 550* 550 554 559 574 575 603 614 625 629 649 728 729 738 740 775 779 802 808 812 895 906 907 917 930 940 956 964 969 974 987 1013 1061 lastarg 000116 automatic fixed bin(17,0) dcl 150 set ref 380* 394* 449* 508 518 523 530 559 lcount 002133 automatic fixed bin(17,0) dcl 164 set ref 509* 510 len 7 002646 automatic structure level 2 packed unaligned dcl 255 long 002664 automatic bit(1) initial unaligned dcl 255 in procedure "ac" set ref 255* 418* 582 587 long 1(07) based bit(1) level 3 in structure "key_template" packed unaligned dcl 125 in procedure "ac" ref 418 mask based structure level 1 dcl 251 maskl 002644 automatic fixed bin(17,0) dcl 254 set ref 1056* 1057 1057 1057 max builtin function dcl 367 ref 728 max_length 000111 automatic fixed bin(35,0) dcl 147 set ref 470* 818 1010 1080 1082 1119* 1124 mcode 000106 automatic fixed bin(35,0) dcl 147 set ref 678* 679 688* 702* mode 002704 automatic fixed bin(5,0) dcl 296 in procedure "ac" set ref 820* 822* 823* 824* 824 825* 825 872 874 953* 954 1049 1050 1051 mode 17 based char(4) level 2 in structure "archive" dcl 284 in procedure "ac" set ref 587* 820 823 824 825 1048* 1049* 1050* 1051* modeb based structure level 1 dcl 296 moi 000100 automatic char(8) initial dcl 87 set ref 87* 405* 432* 432* 433* 433* 439* 445* 451* 465* 475* 482* 487* 493* 498* 513* 521* 542* 547* 555* 617* 662* 702* 712* 720* 743* 746* 751* 756* 766* 769* 775* 779* 831* 833* 852* 861* 930* 956* 972* 993* 1018* 1085* 1109* 1115* 1121* 1139* 1178* 1179* 1185* 1208* mustfree 002524 automatic bit(1) initial level 2 dcl 217 set ref 217* 795 mustreprotect 002636 automatic bit(1) initial unaligned dcl 244 set ref 244* 680* 716 my_wdir 2 002524 automatic char(168) level 2 dcl 217 set ref 456* 497 502 509* 734* 812 924 name 3 based char(32) level 2 dcl 284 set ref 575 587* 593* 629 802 829* 833* 833* 852* 854* 855* 858* 871* 876* 895 923 925* 1041* 1085* nd_handler_ 000174 constant entry external dcl 314 ref 852 1109 new_archive_dir 002332 automatic char(168) dcl 190 set ref 502* 505* 660* 678* 711* 718* 1016 1062 1106* 1109* 1115* 1115* 1119* 1121* 1121* 1208* 1208* new_sp 002130 automatic pointer dcl 163 set ref 991* 992 997 999 new_words 002707 automatic fixed bin(21,0) dcl 310 set ref 684* 686 694 699 715 715* ngtype 64 based bit(2) array level 2 packed unaligned dcl 169 set ref 526* 730* 964* no_orig_ok 1(11) based bit(1) level 3 packed unaligned dcl 125 ref 481 nonglobal based structure array level 1 dcl 169 noroomsw 000122 automatic bit(1) initial unaligned dcl 154 set ref 154* nptr 56 002524 automatic pointer initial level 2 dcl 217 set ref 217* null builtin function dcl 367 ref 207 207 207 209 209 217 217 461 476 481 492 509 509 509 509 509 509 520 569 603 622 624 705 713 760 796 830 862 883 891 903 938 944 962 962 966 966 980 992 1006 1075 1104 1112 1136 1138 1172 offset_words 002710 automatic fixed bin(21,0) dcl 310 set ref 693* 694 694 694 698* 699 699 699 optr 002510 automatic pointer initial dcl 207 set ref 207* 928* 934 938 953* 958* 982* 1055 1069* orig_bc 002706 automatic fixed bin(24,0) dcl 309 set ref 459* 683* 1124 1124* orig_words 002711 automatic fixed bin(21,0) dcl 310 set ref 683* 686 689* 693 715 p1 002516 automatic pointer initial dcl 209 set ref 209* 459* 460 461 462* 473* 481 492 569 575 587 587 587 587 587 593 593 595* 603 622* 624 629 644* 802 815 820 823 824 825 829 833 833 852 854 855 858 870 871 876 880* 883 891 895 899* 923 925 944 980 980 1077 1085 1092 p1_orig 002514 automatic pointer initial dcl 207 set ref 207* 460* 689* 694 699 715* 760 796 796* 934 1104 1128* p2 002520 automatic pointer initial dcl 209 set ref 209* 476 476* 665* 694 699 713 713* 903 1006 1010 1038 1038 1039 1040 1041 1044 1045 1046 1048 1049 1050 1051 1053* 1053 1055 1057 1058* 1058 1075 1082 1092 1094* 1094 1106* 1111* 1112* 1128 1145* pad 24 based char(4) level 2 dcl 284 set ref 1038* pad1 2 based char(4) level 2 dcl 284 set ref 1038* path parameter char dcl 1164 set ref 1162 1169* 1171* 1175* 1178* 1179* 1182* 1185* 1185* patharg based char unaligned dcl 190 set ref 437* 439* 536 540* 542* pathlen 002414 automatic fixed bin(17,0) dcl 190 set ref 430* 437 437 439 439 531* 533 536 540 540 542 542 pathname_ 000164 constant entry external dcl 314 ref 451 451 465 465 475 475 482 482 487 487 493 493 498 498 581 581 617 617 662 662 702 702 712 712 720 720 743 743 746 746 746 746 751 751 756 756 756 756 761 761 761 761 766 766 769 769 769 769 775 775 779 779 833 833 907 907 930 930 956 956 974 974 1018 1018 1064 1064 1085 1085 1115 1115 1121 1121 1127 1127 1130 1130 1185 1185 1208 1208 pathptr 002416 automatic pointer dcl 190 set ref 430* 437 439 531* 536 540 542 ptr builtin function dcl 367 ref 694 699 query_info 002606 automatic structure level 1 dcl 226 set ref 1208 1208 r 0(32) based bit(1) level 2 packed unaligned dcl 296 ref 463 954 1049 record_quota_overflow 002720 stack reference condition dcl 369 ref 687 695 rel builtin function dcl 367 ref 1010 1082 savecode 000110 automatic fixed bin(35,0) dcl 147 set ref 473* 474 486 622 711* 712 712* 725 seg_acl 002612 automatic structure level 1 dcl 234 set ref 678 678 876 876 size builtin function dcl 367 ref 518 990 sp 002126 automatic pointer dcl 163 set ref 397* 511* 519* 520 524 525 526 536 540 540 545 545 547 575 577 629 635 639 650 652 652 730 730 730 730 730 734 734 734 734 742 743 746 746 746 746 746 749 751 756 756 756 756 756 756 761 761 761 761 766 769 769 769 769 793 793* 794* 802 807 813 835 837 842 848 895 897 906 918 919 920 931 935 940 943 957 964 997 999* 1001 1002 1003 1021 1026 1027 stack_space 000125 automatic fixed bin(35,0) initial array dcl 161 set ref 161* 397 518 793 990 star_ok 1(09) based bit(1) level 3 packed unaligned dcl 125 ref 445 stars_found 002641 automatic bit(1) initial unaligned dcl 247 set ref 247* 395* stat 002646 automatic structure level 1 packed unaligned dcl 255 set ref 962 962 966 966 status_code 2 002606 automatic fixed bin(35,0) level 2 dcl 226 set ref 673* substr builtin function dcl 367 set ref 823 824 825 1049* 1050* 1051* 1211 supress_name_sw 1(01) 002606 automatic bit(1) initial level 2 packed unaligned dcl 226 set ref 226* temp_name 000010 internal static char(32) initial dcl 201 set ref 704* 1137* 1139* term_ 000166 constant entry external dcl 314 ref 1169 time 002404 automatic char(16) dcl 190 in procedure "ac" set ref 978* 980* 1046 time 20 based char(16) level 2 in structure "archive" dcl 284 in procedure "ac" set ref 587* 980* 1046* timenow 002410 automatic char(16) dcl 190 set ref 612* 1045 timeup 13 based char(16) level 2 dcl 284 set ref 587* 593* 1045* tptr 000020 internal static pointer initial dcl 208 set ref 703* 704* 705* 1136 1137* 1138 1143* 1145 type 002646 automatic bit(2) level 2 packed unaligned dcl 255 set ref 964 965 typef 002640 automatic fixed bin(2,0) dcl 246 set ref 854* 855 855 update 002665 automatic bit(1) initial unaligned dcl 255 in procedure "ac" set ref 255* 414* 423 648 749 775 979 1061 update 1(02) based bit(1) level 3 in structure "key_template" packed unaligned dcl 125 in procedure "ac" ref 414 updated_something_sw 002643 automatic bit(1) initial unaligned dcl 249 set ref 249* 751 779 985* userid 002612 automatic char(32) level 2 in structure "seg_acl" dcl 234 in procedure "ac" set ref 675* 717 873* userid 002625 automatic char(32) level 2 in structure "delete_acl" dcl 240 in procedure "ac" set ref 717* version 002606 automatic fixed bin(17,0) initial level 2 dcl 226 set ref 226* w 0(34) based bit(1) level 2 packed unaligned dcl 296 ref 672 1051 wdct 000115 automatic fixed bin(19,0) dcl 149 set ref 816* 818 870 1008* 1010 1055 1056 1057 1058 1059 1078* 1080 1082 1092 1093 1094 yes_or_no_sw 1 002606 automatic bit(1) initial level 2 packed unaligned dcl 226 set ref 226* zero_arg_ok 1(08) based bit(1) level 3 packed unaligned dcl 125 ref 554 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 1-33 E_ACCESS internal static bit(3) initial unaligned dcl 1-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 M_ACCESS internal static bit(3) initial unaligned dcl 1-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 N_ACCESS internal static bit(3) initial unaligned dcl 1-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 REW_ACCESS internal static bit(3) initial unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial unaligned dcl 1-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RW_ACCESS internal static bit(3) initial unaligned dcl 1-11 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SA_ACCESS internal static bit(3) initial unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial unaligned dcl 1-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SM_ACCESS internal static bit(3) initial unaligned dcl 1-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 S_ACCESS internal static bit(3) initial unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 W_ACCESS internal static bit(3) initial unaligned dcl 1-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 NAMES DECLARED BY EXPLICIT CONTEXT. BADARG 003050 constant label dcl 542 ref 532 CHECKARG 003075 constant label dcl 545 ref 537 CHECK_DELETED 007201 constant label dcl 903 ref 887 COMRETN 006135 constant label dcl 783 ref 477 483 488 495 500 514 522 556 559 618 663 721 738 994 1088 1113 1116 1122 1140 1211 CREATE 011210 constant label dcl 1106 ref 1110 DELETE_HANDLER 007124 constant label dcl 891 DELT 004737 constant label dcl 727 ref 666 ERROR_RETURN 001752 constant label dcl 465 ref 471 FANOUT 000000 constant label array(0:3) dcl 569 ref 564 FERROR 002065 constant label dcl 475 ref 597 645 818 882 900 1080 KEYERR 001107 constant label dcl 405 ref 409 MAKEIT 006301 constant label dcl 828 MOVE_ARCHIVE 003771 constant label dcl 658 ref 648 911 MOVE_ERROR 004300 constant label dcl 702 ref 679 690 MUSTCOPY 007573 constant label dcl 940 ref 925 936 959 976 983 MUSTCOPY2 007614 constant label dcl 944 ref 1022 1031 NARG 001272 constant label dcl 432 ref 402 NEXTARG 003160 constant label dcl 551 ref 533 543 548 NOARCHIVE 002167 constant label dcl 482 ref 609 NOT_FOUND_CHECKER 005056 constant label dcl 740 ref 601 667 670 709 725 885 RCMPRTN 011026 constant label dcl 1069 ref 1028 REPLACE_HANDLER 003516 constant label dcl 603 REPLERR 007651 constant label dcl 956 ref 963 967 RETURN 006142 constant label dcl 786 ref 406 434 440 453 467 SKIPENTRY 001052 constant label dcl 397 ref 383 SKIP_COMPONENT 006746 constant label dcl 863 ref 857 TABLE_HANDLER 003235 constant label dcl 569 TNXT 003467 constant label dcl 595 ref 576 XTRACT_HANDLER 006143 constant label dcl 802 XTRACT_LOOP 006143 constant label dcl 802 ref 883 XTRACT_NXT 007100 constant label dcl 880 ref 810 843 864 ac 000742 constant entry external dcl 48 archive 000752 constant entry external dcl 48 ask_question 012411 constant entry internal dcl 1204 ref 674 bc_to_rec 011731 constant entry internal dcl 1151 ref 683 684 971 ccmp 011040 constant entry internal dcl 1073 ref 631 636 809 838 863 896 946 clean_up 007271 constant entry internal dcl 791 ref 457 785 convert_time 012334 constant entry internal dcl 1191 ref 980 980 delete_seg 011744 constant entry internal dcl 1162 ref 730 734 855 makenew 011177 constant entry internal dcl 1100 ref 905 1006 1075 rcmp 007363 constant entry internal dcl 916 ref 626 640 651 star_entry 001021 constant entry external dcl 387 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 13472 13716 12541 13502 Length 14362 12541 224 430 731 14 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ac 2236 external procedure is an external procedure. on unit on line 457 64 on unit on unit on line 687 74 on unit clean_up 72 internal procedure is called by several nonquick procedures. rcmp internal procedure shares stack frame of external procedure ac. ccmp internal procedure shares stack frame of external procedure ac. makenew internal procedure shares stack frame of external procedure ac. bc_to_rec internal procedure shares stack frame of external procedure ac. delete_seg internal procedure shares stack frame of external procedure ac. convert_time internal procedure shares stack frame of external procedure ac. ask_question internal procedure shares stack frame of external procedure ac. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 temp_name ac 000020 tptr ac 000022 cleanup_temp ac STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ac 000100 moi ac 000102 key_index ac 000104 keyp ac 000106 mcode ac 000107 code ac 000110 savecode ac 000111 max_length ac 000112 i ac 000113 j ac 000114 k ac 000115 wdct ac 000116 lastarg ac 000117 curlen ac 000120 bcnt ac 000121 gbct ac 000122 noroomsw ac 000123 header_printed ac 000124 first_line_sw ac 000125 stack_space ac 002126 sp ac 002130 new_sp ac 002132 dcount ac 002133 lcount ac 002134 dn ac 002206 initpath ac 002260 archive_dir ac 002332 new_archive_dir ac 002404 time ac 002410 timenow ac 002414 pathlen ac 002416 pathptr ac 002420 key_l ac 002422 key_p ac 002424 arglist_ptr ac 002426 archive_name ac 002436 act_com ac 002440 key ac 002441 buffer ac 002510 optr ac 002512 cptr ac 002514 p1_orig ac 002516 p1 ac 002520 p2 ac 002522 iflag ac 002523 amsw ac 002524 aux_wstructure ac 002604 auxw_ptr ac 002606 query_info ac 002612 seg_acl ac 002625 delete_acl ac 002636 mustreprotect ac 002637 entry_type ac 002640 typef ac 002641 stars_found ac 002642 found_something_sw ac 002643 updated_something_sw ac 002644 maskl ac 002645 fix17 ac 002646 stat ac 002660 dtm ac 002661 copy ac 002662 delete ac 002663 force ac 002664 long ac 002665 update ac 002666 append ac 002667 dlast ac 002670 last ac 002671 dontcopy ac 002672 char8 ac 002674 char32 ac 002704 mode ac 002705 amode ac 002706 orig_bc ac 002707 new_words ac 002710 offset_words ac 002711 orig_words ac 002726 action ac 002764 error makenew 003002 ccode delete_seg 003012 fixed_time convert_time THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_char_temp call_ext_out_desc call_ext_out call_int_this call_int_other return_mac tra_ext_1 enable_op shorten_stack ext_entry ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. archive_aux_$active archive_aux_$free archive_aux_$inwdir archive_aux_$listwdir archive_star_ archive_util_$first_element archive_util_$next_element check_star_name_$entry clock_ com_err_ command_query_ convert_date_to_binary_ cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr cu_$arg_ptr_rel cv_dec_ date_time_ date_time_$fstime dl_handler_ dl_handler_$noquestion expand_pathname_ expand_pathname_$add_suffix fs_util_$get_max_length get_group_id_ get_group_id_$tag_star get_pdir_ get_wdir_ hcs_$add_acl_entries hcs_$chname_seg hcs_$delentry_file hcs_$delentry_seg hcs_$delete_acl_entries hcs_$fs_get_mode hcs_$initiate hcs_$make_seg hcs_$set_bc hcs_$set_bc_seg hcs_$star_list_ hcs_$status_long hcs_$status_minf hcs_$terminate_noname hcs_$terminate_seg hcs_$truncate_seg initiate_file_ ioa_ ioa_$ioa_switch nd_handler_ pathname_ term_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. archive_data_$active archive_data_$fence archive_data_$ident archive_key_$begin_table archive_key_$last_index error_table_$incorrect_access error_table_$moderr error_table_$namedup error_table_$no_append error_table_$no_s_permission error_table_$noentry error_table_$rqover error_table_$segknown iox_$error_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 87 000655 152 000657 154 000660 155 000662 156 000663 161 000664 201 000677 207 000702 209 000706 213 000710 217 000711 226 000714 244 000722 247 000723 248 000724 249 000725 255 000726 48 000741 376 000760 378 000772 380 000776 382 001004 383 001013 387 001014 393 001042 394 001046 395 001050 397 001052 400 001054 401 001056 402 001075 403 001077 405 001107 406 001146 408 001147 408 001163 409 001166 411 001170 413 001175 414 001201 415 001205 416 001211 417 001215 418 001221 419 001225 421 001231 423 001234 426 001243 428 001250 430 001252 431 001270 432 001272 433 001327 434 001357 437 001360 438 001416 439 001420 440 001444 443 001445 444 001462 445 001464 449 001526 451 001560 453 001630 456 001631 457 001640 459 001662 460 001717 461 001721 462 001725 463 001740 464 001750 465 001752 467 002022 470 002023 471 002047 473 002051 474 002062 475 002065 476 002137 477 002156 481 002157 482 002167 483 002237 486 002240 487 002246 488 002322 491 002323 492 002325 493 002331 495 002403 497 002404 498 002410 500 002462 502 002463 503 002466 505 002467 508 002472 509 002500 510 002556 511 002562 512 002617 513 002621 514 002636 518 002637 519 002643 520 002700 521 002704 522 002721 523 002722 524 002733 525 002736 526 002737 527 002741 530 002743 531 002753 532 002772 533 002774 535 002776 536 003002 537 003012 540 003013 541 003046 542 003050 543 003074 545 003075 545 003116 546 003121 547 003123 548 003156 550 003157 551 003160 554 003162 555 003170 556 003221 559 003222 562 003227 564 003234 569 003235 574 003242 575 003244 575 003261 576 003264 577 003266 580 003273 581 003275 582 003335 583 003354 584 003373 587 003375 593 003443 595 003467 597 003500 598 003503 599 003504 601 003515 603 003516 608 003524 609 003527 612 003530 614 003554 615 003556 616 003567 617 003571 618 003641 622 003642 624 003647 625 003654 626 003656 627 003657 629 003660 629 003675 630 003700 631 003702 632 003703 634 003704 635 003706 636 003713 637 003714 639 003715 640 003722 644 003723 645 003734 646 003737 648 003740 649 003742 650 003751 651 003755 652 003756 654 003767 658 003771 660 003773 661 004020 662 004022 663 004072 665 004073 666 004104 667 004110 670 004111 672 004113 673 004116 674 004121 675 004122 676 004131 677 004133 678 004134 679 004171 680 004173 683 004175 684 004202 686 004207 687 004211 688 004225 689 004230 690 004243 693 004246 694 004250 695 004262 698 004263 699 004264 701 004276 702 004300 703 004354 704 004367 705 004413 706 004420 707 004427 708 004434 709 004454 711 004455 712 004502 713 004555 715 004575 716 004614 717 004616 718 004621 719 004656 720 004660 721 004730 724 004731 725 004733 727 004737 728 004740 729 004753 730 004755 732 005013 734 005014 737 005052 738 005054 740 005056 742 005065 743 005072 746 005154 749 005257 751 005266 754 005350 756 005351 759 005456 760 005457 761 005467 764 005561 765 005563 766 005564 769 005650 773 005754 775 005756 779 006047 783 006135 785 006136 786 006142 802 006143 806 006161 807 006164 808 006174 809 006176 810 006201 812 006202 813 006210 815 006217 816 006235 818 006241 820 006243 822 006254 823 006255 824 006263 825 006272 828 006301 829 006302 830 006341 831 006345 833 006400 835 006450 836 006457 837 006461 838 006464 842 006465 843 006473 846 006474 847 006476 848 006500 851 006507 852 006511 854 006542 855 006600 857 006632 858 006634 859 006674 860 006676 861 006703 862 006731 863 006746 864 006751 870 006752 871 006761 872 007006 873 007011 874 007020 875 007025 876 007026 878 007064 880 007100 882 007111 883 007114 885 007120 886 007122 887 007123 891 007124 895 007130 895 007145 896 007150 896 007152 896 007153 897 007154 897 007156 899 007164 900 007175 901 007200 903 007201 905 007205 906 007206 906 007221 907 007223 911 007267 791 007270 793 007276 793 007306 794 007316 795 007330 796 007342 797 007360 799 007362 916 007363 917 007364 918 007366 919 007372 920 007376 921 007402 923 007403 924 007407 925 007412 928 007434 929 007471 930 007473 931 007546 934 007554 935 007560 936 007566 938 007567 940 007573 943 007606 944 007614 946 007620 948 007621 951 007622 953 007624 954 007637 955 007647 956 007651 957 007724 958 007732 959 007743 962 007744 963 010005 964 010012 965 010023 966 010026 967 010070 969 010075 970 010101 971 010104 972 010111 974 010157 976 010226 978 010227 979 010244 980 010246 982 010275 983 010306 985 010307 987 010311 989 010315 990 010316 991 010322 992 010357 993 010363 994 010400 996 010401 997 010411 998 010421 999 010423 1001 010425 1002 010433 1003 010437 1006 010443 1008 010450 1010 010454 1013 010462 1016 010464 1017 010472 1018 010475 1020 010556 1021 010562 1022 010567 1026 010570 1027 010576 1028 010600 1031 010602 1036 010603 1038 010605 1039 010611 1040 010617 1041 010624 1043 010627 1044 010636 1045 010641 1046 010647 1048 010655 1049 010657 1050 010666 1051 010673 1053 010700 1054 010702 1055 010704 1056 010712 1057 010717 1058 010732 1059 010735 1061 010737 1062 010743 1063 010751 1064 010754 1066 011024 1069 011026 1070 011037 1073 011040 1075 011041 1077 011046 1078 011067 1080 011072 1082 011074 1085 011101 1088 011160 1092 011161 1093 011170 1094 011173 1096 011176 1100 011177 1104 011200 1105 011206 1106 011210 1107 011247 1108 011251 1109 011256 1110 011302 1111 011304 1112 011315 1113 011317 1115 011320 1116 011367 1119 011370 1120 011414 1121 011416 1122 011466 1124 011467 1126 011474 1127 011476 1128 011542 1129 011544 1130 011545 1132 011606 1136 011607 1137 011614 1138 011651 1139 011656 1140 011704 1142 011705 1143 011706 1145 011723 1146 011726 1148 011730 1151 011731 1155 011733 1156 011737 1162 011744 1169 011762 1170 012005 1171 012013 1172 012057 1173 012064 1174 012076 1175 012077 1176 012121 1178 012125 1179 012156 1181 012204 1182 012224 1183 012246 1185 012253 1187 012333 1191 012334 1196 012345 1197 012376 1198 012405 1204 012411 1208 012412 1211 012471 1213 012475 ----------------------------------------------------------- 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