COMPILATION LISTING OF SEGMENT gcos_fms Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/10/84 1141.2 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 gcos_fms: gfms: proc; 7 8 /* Display information, excluding data files, from a 9* gcos user or master save tape. 10* 11* Author: Dave Ward 09/30/80 12* Change: Dave Ward 10/04/80 arguments. 13* Change: Dave Ward 10/15/80 -den, -gf, -tr, -tll. 14* Change: Dave Ward 10/19/80 -file, -no_file and -input_file 15* Change: Dave Ward 10/27/80 added -scan_ss option. 16* Change: Dave Ward 11/25/80 revised control arguments. 17* Change: Dave Ward 01/27/81 provide gfms_return condition. 18* Change: Dave Ward 02/02/81 print_calling_sequence_ 19* Change: Dave Ward 04/22/81 print big tape blocks not available. 20* Change: Scott C. Akers 02/08/82 Add -spn, -drm, -rest control_args. 21* Convert all names to gfms_. 22* Change: Ron Barstad 83-04-05 Make usage message standard, dcl builtins, delete unused dcls 23* Change: Ron Barstad 83-06-03 Add -den spec to attach description 24* Change: Ron Barstad 84-11-16 Forced tape reel number to upper case 25**/ 26 call cu_$af_return_arg ( /* Obtain reference to caller's input arguments. */ 27 na /* (output) number of arguments. */ 28 , rsp /* (output) pointer to return argument. */ 29 , rsl /* (output) length of return argument. */ 30 , code /* (output) status. */ 31 ); 32 if code = 0 then do; /* 1) Called as an active function. */ 33 get_arg = cu_$af_arg_ptr; /* Use active function argument getter. */ 34 put_err = active_fnc_err_; 35 end; 36 else 37 rsp = addr (rsx); /* Default return string. */ 38 rsl = 5; /* Default length. */ 39 if code = error_table_$not_act_fnc then do; /* 2) Not called as active function. */ 40 get_arg = cu_$arg_ptr; /* Use "normal" argument getter. */ 41 put_err = com_err_; 42 end; 43 else do; 44 call com_err_ ( /* 3) Could not obtain args. */ 45 code 46 , "gcos_fms" 47 , "^/Could not obtain argument information. Quitting." 48 ); 49 return; 50 end; 51 52 if gcos_big_tape_blocks_ () then do; 53 rs = "false"; 54 return; 55 end; 56 57 if na<1 then do; 58 wrong_number_args: ; 59 call put_err ( /* Wrong number arguments. */ 60 error_table_$noarg 61 , "gcos_fms ("||version||")" 62 , "^/Usage:^-gfms REEL_NUMBER {-CONTROL_ARGS}" 63 ); 64 65 /* DON'T Print in error output cryptic form of calling sequence. (following is kept as a comment 66* call gfms_calling_sequence_ ( 67* "arg:" 68* , " -den n|Tape density is n (default dynamic)." 69* , " -dump|Exhaustive display of tape info." 70* , " -file name...|Accept only files named (default is all files)." 71* , " -if file|File names in segment (with suffix .gfms)." 72* ||" One name per line, may be prefixed with ^ for not." 73* , " -no_ga|Do not supply gtss file attributes (default is to supply)." 74* , " -no_tll|Don't print total llinks (default is to print)." 75* , " -no_unload|Do not unload files (default is to unload)." 76* , " -not_file name...|Accept no file named." 77* , " -prfn|Print sorted list of file names (default is not)." 78* , " -scan_ss|Only print substructure records (default is not)." 79* , " -tk n|Tape is n track (default is 9)." 80* , " -restore UMC_NAME|Restore only UMC specified." 81* , " -rest UMC_NAME|Same as -restore." 82* , " -smc_pathname path|Specify where to do the restore. (Default is working_dir.)" 83* , " -spn path|Same as -smc_pathname." 84* , " -directory_mapping DRM_RULE|Specify whether to place files in working_dir," 85* ||" >udd>UMC_NAME, or SMC pathname. (Default is ""wd"")" 86* , " -drm DRM_RULE|Same as -directory_mapping." 87* ); 88**/ 89 return; 90 end; 91 92 call init_routine; 93 94 /* Obtain temp segments for description tree, file names lists. */ 95 96 call get_temp_segments_ ( 97 "gfms" 98 , tsp 99 , code 100 ); 101 if code ^= 0 then do; 102 call put_err ( 103 code 104 , "gfms" 105 , "Obtaining 3 temp segments." 106 ); 107 return; 108 end; 109 110 /* Process caller's arguments. */ 111 do i = 1 to na; 112 call get_arg (i, ap, al, code); /* Obtain the next argument (arg). */ 113 if code ^= 0 then do; 114 call put_err ( 115 code 116 , "gfms" 117 , "Argument ^i." 118 , i 119 ); 120 goto error_exit; 121 end; 122 123 if al<1 then do; /* Argument is zero length string. */ 124 call put_err ( 125 error_table_$smallarg 126 , "gfms" 127 , "Argument ^i zero length. Quitting." 128 , i 129 ); 130 goto error_exit; 131 end; 132 133 if substr (arg, 1, 1) = "-" then do; /* Control argument. */ 134 if last_was_file & (file_name_count = 0) then do; 135 call put_err ( 136 0 137 , "gfms" 138 , "File name control argument not followed by file name." 139 ); 140 goto error_exit; 141 end; 142 last_was_file = "0"b; 143 file_name_count = -1; 144 145 l = hbound (control_arg, 1); 146 do f = 1 to l; /* Search for control arg name. */ 147 if substr (arg, 2) = control_arg (f).name then do; 148 last_was_file = "0"b; 149 goto carg (control_arg (f).val); 150 end; 151 end; 152 call put_err ( /* Unknown control arg. */ 153 error_table_$badopt 154 , "gfms" 155 , "Arg ^i ""^a"". Quitting." 156 , i 157 , arg 158 ); 159 goto error_exit; 160 end; 161 162 if file_name_count >= 0 then do; 163 file_name_count = file_name_count+1; 164 if gfms_file_name_ (not_file, arg) then arg_err = "1"b; 165 goto next_arg; 166 end; 167 168 if need_input_file then do; 169 need_input_file = "0"b; 170 if gfms_input_file_list_ (arg) then arg_err = "1"b; 171 goto next_arg; 172 end; 173 174 if need_track then do; 175 need_track = "0"b; 176 if arg = "7" then tape_track = "7"; 177 else 178 if arg = "9" then tape_track = "9"; 179 else do; 180 call put_err ( 181 0 182 , "gfms" 183 , "Only 7 or 9 track provided for. Quitting." 184 ); 185 goto error_exit; 186 end; 187 goto next_arg; 188 end; 189 190 if need_density then do; 191 need_density = "0"b; 192 do k = lbound (tape_densities, 1) to hbound (tape_densities, 1); 193 if arg = tape_densities (k) then do; 194 ftd, ltd = k; /* Use density table entry k. */ 195 den_arg = arg; 196 goto next_arg; 197 end; 198 end; 199 call put_err ( 200 error_table_$bad_density 201 , "gfms" 202 , "Only densities ^a provided for. Quitting." 203 , string (tape_densities) 204 ); 205 goto error_exit; 206 end; 207 208 if need_umc_name 209 then do; 210 need_umc_name = "0"b; 211 gfms_ext$umc_name = arg; 212 goto next_arg; 213 end; 214 215 if need_mapping_rule 216 then do; 217 need_mapping_rule = "0"b; 218 if arg = "wd" 219 | arg = "smc" 220 | arg = "umc" 221 then do; 222 gfms_ext$mapping_rule = arg; 223 224 if arg = "smc" 225 & ^got_smc_path 226 then need_smc_path = "1"b; 227 228 if arg = "umc" 229 then gfms_ext$working_dir = ">udd"; 230 231 if arg = "wd" 232 then gfms_ext$working_dir = rtrim (get_wdir_ ()); 233 234 goto next_arg; 235 end; 236 237 else do; 238 239 call put_err (error_table_$badopt, 240 "gfms", 241 "^/Mapping Rules are:^-WD^-SMC^-UMC"); 242 243 goto error_exit; 244 end; 245 end; 246 247 if need_smc_path 248 then do; 249 need_smc_path = "0"b; 250 call expand_pathname_ ((arg), dname, ename, code); 251 252 if code = 0 253 then do; 254 gfms_ext$working_dir = rtrim (dname) || ">" || ename; 255 goto next_arg; 256 end; 257 else do; 258 call put_err (code, "gfms", 259 "^/Illegal SMC pathname: ^/^a", arg); 260 goto error_exit; 261 end; 262 end; 263 264 /* Tape reel number. */ 265 reel_number = translate(arg,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"); 266 goto next_arg; 267 268 carg (01): ; 269 270 /* density */ 271 need_density = "1"b; 272 goto next_arg; 273 274 carg (02): ; 275 276 /* "dump" */ 277 dump = "1"b; /* Do dump tape information. */ 278 gfms_ext$print_routines.ioa = ioa_; 279 gfms_ext$print_routines.ioa_nnl = ioa_$nnl; 280 goto next_arg; 281 282 carg (03): ; 283 284 /* "file" */ 285 file_name_count = 0; /* 0 => obtain names. */ 286 not_file = "0"b; 287 last_was_file = "1"b; 288 goto next_arg; 289 290 carg (04): ; 291 292 /* "input_file" */ 293 need_input_file = "1"b; 294 goto next_arg; 295 296 carg (05): ; 297 298 /* not gtss file attributes. */ 299 gf = "0"b; 300 goto next_arg; 301 302 carg (06): ; 303 304 /* no total llinks. */ 305 tll = "0"b; 306 goto next_arg; 307 308 carg (07): ; 309 310 /* "no_unload" */ 311 unload = "0"b; 312 goto next_arg; 313 314 carg (08): ; 315 316 /* not_file. */ 317 file_name_count = 0; /* 0 => obtain names. */ 318 not_file = "1"b; 319 last_was_file = "1"b; 320 goto next_arg; 321 322 carg (09): ; 323 324 /* "pr_file_names" */ 325 prfn = "1"b; 326 goto next_arg; 327 328 carg (10): ; 329 scan_ss = "1"b; 330 goto next_arg; 331 332 carg (11): ; 333 334 /* track n */ 335 need_track = "1"b; 336 goto next_arg; 337 338 carg (12): ; 339 340 /* smc smc_path */ 341 need_smc_path = "1"b; 342 goto next_arg; 343 344 carg (13): ; 345 346 /* drm mapping_rule */ 347 need_mapping_rule = "1"b; 348 goto next_arg; 349 350 carg (14): ; 351 352 /* restore umc*/ 353 need_umc_name = "1"b; 354 goto next_arg; 355 356 not_provided: ; 357 call ioa_ ("Control arg ""^a"" ^i not yet provided." 358 , control_arg (f).name 359 , i 360 ); 361 goto next_arg; 362 363 next_arg: ; 364 end; 365 366 if (number_names>0) & dump then 367 call gfms_dump_do_files_; 368 369 if leftovers () /* If any args are left hanging */ 370 | arg_err 371 then do; 372 error_exit: ; 373 call release_temp_segs; 374 rs = "false"; 375 return; 376 end; 377 378 /* Store the attach description. */ 379 attach_description = 380 "tape_nstd_ " /* name of I/O module. */ 381 ||rtrim(reel_number) 382 ||" -bk 15624" /* => up to 3906 words (file content records largest). */ 383 ||" -tk "||tape_track 384 ; 385 if den_arg ^= "" 386 then attach_description = rtrim(attach_description)||" -den "||rtrim(den_arg); 387 388 389 /* Establish "on" conditions. */ 390 on cond (gfms_fail) begin; 391 call put_err ( 392 0 393 , "gfms" 394 , "FAILED." 395 ); 396 call clean_up; 397 goto exit; 398 end; 399 400 on cond (cleanup) call clean_up; 401 402 on cond (gfms_return) goto exit; 403 404 /* Process the tape. */ 405 string (tape_reel_information) = ""; 406 call gfms_header_label_ (); /* display tape label. */ 407 call gfms_serial_number_record_ (); /* display tape serial number record. */ 408 call gfms_task_block_record_ (master_save); /* display tape block record (tbr). */ 409 if master_save then 410 call gfms_smc_records_ (); 411 call gfms_substructure_records_ (); 412 call gfms_file_content_records_ (); 413 414 /* Close and detach the tape. */ 415 call clean_up; 416 417 exit: ; 418 return; 419 420 clean_up: proc; 421 call release_temp_segs; 422 423 /* Perform close and detach (cleanup condition) 424* activities. 425**/ 426 if gfms_close_ () then return; 427 call gfms_detach_; 428 return; 429 end clean_up; 430 431 init_routine: proc; 432 433 /* Performs all the initialization. */ 434 435 436 /* Set default options. */ 437 arg_err = "0"b; /* No argument errors yet. */ 438 tape_track = "9"; 439 close, detach = "0"b; /* Don't close or detach. */ 440 gf = "1"b; /* provide gtss file attributes. */ 441 tll = "1"b; /* print file total llinks. */ 442 dump = "0"b; /* Do not dump tape information. */ 443 prfn = "0"b; /* Don't print file names. */ 444 unload = "1"b; /* Do unload files. */ 445 ftd = lbound (tape_densities, 1); 446 ltd = hbound (tape_densities, 1); /* upper bound of tape densities table. */ 447 two_words = "0"b; 448 nlp = addr (two_words); 449 gfms_ext$print_routines.ioa = null_proc; 450 gfms_ext$print_routines.ioa_nnl = null_proc; 451 gfms_ext$working_dir = rtrim (get_wdir_ ()); 452 gfms_ext$mapping_rule = "wd"; 453 gfms_ext$umc_name = ""; 454 455 last_was_file 456 , got_smc_path 457 , need_density 458 , need_input_file 459 , need_mapping_rule 460 , need_smc_path 461 , need_track 462 , need_umc_name 463 , scan_ss 464 = "0"b; 465 file_name_count = -1; /* -1 => no file name needed. */ 466 reel_number = ""; 467 den_arg = ""; 468 469 return; 470 471 end init_routine; 472 473 leftovers: proc () returns (bit(1)); 474 475 if reel_number = "" 476 then do; 477 call put_err ( 478 error_table_$noarg 479 , "gfms" 480 , "Tape reel number has not been supplied." 481 ); 482 return ("1"b); 483 end; 484 485 if need_input_file 486 then do; 487 call put_err ( 488 error_table_$noarg 489 , "gfms" 490 , "-input_file control argument not followed by input file name." 491 ); 492 return ("1"b); 493 end; 494 495 if need_density 496 then do; 497 call put_err ( 498 error_table_$noarg 499 , "gfms" 500 , "-density control argument not followed by density value." 501 ); 502 return ("1"b); 503 end; 504 505 if need_track 506 then do; 507 call put_err ( 508 error_table_$noarg 509 , "gfms" 510 , "-track control argument not followed by track value." 511 ); 512 return ("1"b); 513 end; 514 515 if file_name_count = 0 516 then do; 517 call put_err ( 518 error_table_$noarg 519 , "gfms" 520 , "-file control argument not followed by file names." 521 ); 522 return ("1"b); 523 end; 524 525 if need_mapping_rule 526 then do; 527 call put_err ( 528 error_table_$noarg 529 , "gfms" 530 , "Mapping rule not given." 531 || "^/Mapping Rules are:^-WD^-SMC^-UMC" 532 ); 533 return ("1"b); 534 end; 535 536 if need_umc_name 537 then do; 538 call put_err ( 539 error_table_$noarg 540 , "gfms" 541 , "UMC name not given." 542 ); 543 return ("1"b); 544 end; 545 546 if need_smc_path 547 then do; 548 call put_err ( 549 error_table_$noarg 550 , "gfms" 551 , "SMC pathname not given." 552 ); 553 return ("1"b); 554 end; 555 556 return ("0"b); /* All is well so far. */ 557 558 end leftovers; 559 560 release_temp_segs: proc; 561 562 /* Release temp segment for description tree. */ 563 call release_temp_segments_ ( 564 "gfms" 565 , tsp 566 , code 567 ); 568 if code ^= 0 then 569 call put_err ( 570 code 571 , "gfms" 572 , "Releasing 3 temp segments." 573 ); 574 return; 575 end release_temp_segs; 576 577 null_proc: proc;return;end; /* Procedure that does nothing. */ 578 579 580 581 /* Variables for gcos_fms: */ 582 /* IDENTIFIER ATTRIBUTES */ 583 dcl active_fnc_err_ entry() options(variable); 584 dcl addr builtin; 585 dcl al fixed bin; 586 dcl ap ptr; 587 dcl arg char(al)unal based(ap); 588 dcl arg_err bit(1); 589 dcl cleanup condition ext; 590 dcl code fixed bin(35); 591 dcl com_err_ entry() options(variable); 592 dcl cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)); 593 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35)); 594 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)); 595 dcl den_arg char (8); 596 dcl dname char (168); 597 dcl ename char (32); 598 dcl error_table_$badopt fixed bin(35) ext static; 599 dcl error_table_$bad_density fixed bin(35) ext static; 600 dcl error_table_$noarg fixed bin(35) ext static; 601 dcl error_table_$not_act_fnc fixed bin(35) ext static; 602 dcl error_table_$smallarg fixed bin(35) ext static; 603 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)); 604 dcl f fixed bin; 605 dcl file_name_count fixed bin; 606 dcl gcos_big_tape_blocks_ entry() returns(bit(1)); 607 dcl get_arg entry(fixed bin,ptr,fixed bin,fixed bin(35)) variable auto; 608 dcl get_temp_segments_ entry (char(*), (*)ptr, fixed bin(35)); 609 dcl gfms_close_ entry() returns(bit(1)); 610 dcl gfms_detach_ entry options(variable); 611 dcl gfms_dump_do_files_ entry; 612 dcl gfms_fail condition ext; 613 dcl gfms_file_content_records_ entry(); 614 dcl gfms_file_name_ entry (bit(1), char(*)) returns(bit(1)); 615 dcl gfms_header_label_ entry(); 616 dcl gfms_input_file_list_ entry (char(*)) returns(bit(1)); 617 dcl gfms_return condition ext; 618 dcl gfms_serial_number_record_ entry(); 619 dcl gfms_smc_records_ entry(); 620 dcl gfms_substructure_records_ entry(); 621 dcl gfms_task_block_record_ entry(bit(1)); 622 dcl got_smc_path bit(1); 623 dcl hbound builtin; 624 dcl i fixed bin; 625 dcl ioa_ entry() options(variable); 626 dcl ioa_$nnl entry() options(variable); 627 dcl k fixed bin; 628 dcl l fixed bin; 629 dcl last_was_file bit(1); 630 dcl lbound builtin; 631 dcl master_save bit(1); 632 dcl na fixed bin; 633 dcl need_density bit(1); 634 dcl need_input_file bit(1); 635 dcl need_mapping_rule bit(1); 636 dcl need_smc_path bit(1); 637 dcl need_track bit(1); 638 dcl need_umc_name bit(1); 639 dcl not_file bit(1); 640 dcl put_err entry variable options(variable); 641 dcl reel_number char(7); 642 dcl release_temp_segments_ entry (char(*), (*)ptr, fixed bin(35)); 643 dcl rs char(rsl)var based(rsp); 644 dcl rsl fixed bin(21); 645 dcl rsp ptr; 646 dcl rsx char(5)var; 647 dcl rtrim builtin; 648 dcl string builtin; 649 dcl substr builtin; 650 dcl tape_track char(1); 651 dcl tsp (3)aligned ptr based(addr(gfms_ext$temp_segs)); 652 dcl two_words bit(72)aligned; 653 dcl get_wdir_ entry() returns(char(168)); 654 655 dcl 1 control_arg (23) static int options(constant) 656 , 3 name char(20)init( 657 /* 01 01 */ "den" 658 ,/* 02 01 */ "density" 659 ,/* 03 02 */ "dump" 660 ,/* 04 03 */ "file" 661 ,/* 05 04 */ "if" 662 ,/* 06 04 */ "input_file" 663 ,/* 07 05 */ "no_ga" 664 ,/* 08 05 */ "no_gtss_attributes" 665 ,/* 09 06 */ "no_tll" 666 ,/* 10 06 */ "no_total_llinks" 667 ,/* 11 07 */ "no_unload" 668 ,/* 12 08 */ "not_file" 669 ,/* 13 09 */ "prfn" 670 ,/* 14 09 */ "print_file_names" 671 ,/* 15 10 */ "scan_ss" 672 ,/* 16 11 */ "tk" 673 ,/* 17 11 */ "track" 674 ,/* 18 12 */ "spn" 675 ,/* 19 12 */ "smc_pathname" 676 ,/* 20 13 */ "drm" 677 ,/* 21 13 */ "directory_mapping" 678 ,/* 22 14 */ "rest" 679 ,/* 23 14 */ "restore" 680 ) 681 , 3 val fixed bin init( 682 /* 01 */ 01 /* "den" */ 683 ,/* 02 */ 01 /* "density" */ 684 ,/* 03 */ 02 /* "dump" */ 685 ,/* 04 */ 03 /* "file" */ 686 ,/* 05 */ 04 /* "if" */ 687 ,/* 06 */ 04 /* "input_file" */ 688 ,/* 07 */ 05 /* "no_ga" */ 689 ,/* 08 */ 05 /* "no_gtss_attributes" */ 690 ,/* 09 */ 06 /* "no_tll" */ 691 ,/* 10 */ 06 /* "no_total_llinks" */ 692 ,/* 11 */ 07 /* "no_unload" */ 693 ,/* 12 */ 08 /* "not_file" */ 694 ,/* 13 */ 09 /* "prfn" */ 695 ,/* 14 */ 09 /* "print_file_names" */ 696 ,/* 15 */ 10 /* "scan_ss" */ 697 ,/* 16 */ 11 /* "tk" */ 698 ,/* 17 */ 11 /* "track" */ 699 ,/* 18 */ 12 /* "spn" */ 700 ,/* 19 */ 12 /* "smc_pathname"*/ 701 ,/* 20 */ 13 /* "drm"*/ 702 ,/* 21 */ 13 /* "directory_mapping"*/ 703 ,/* 22 */ 14 /* "rest"*/ 704 ,/* 23 */ 14 /* "restore"*/ 705 706 ) 707 ; 708 1 1 /* BEGIN INCLUDE FILE gfms_version.incl.pl1 */ 1 2 dcl version char(3)static int options(constant) init( 1 3 "3.0" ); 1 4 1 5 /* END INCLUDE FILE gfms_version.incl.pl1 */ 709 710 2 1 /* BEGIN INCLUDE FILE gfms_tape_densities.incl.pl1 (Wardd Multics) 10/18/80 1059.7 mst Sat */ 2 2 dcl tape_densities (5)char(5)static int options(constant)init("6250","1600","800","556","200"); 2 3 2 4 /* END INCLUDE FILE gfms_tape_densities.incl.pl1 */ 711 712 3 1 /* BEGIN INCLUDE FILE gfms_ext.incl.pl1 (Wardd Multics) 10/07/80 2142.2 mst Tue */ 3 2 /* Modified by: S. C. Akers 02/08/82 Add gfms_ext$working_dir, 3 3* mapping_rule, 3 4* umc_name 3 5* Modified Ron Barstad 83-06-03 attach_desc from 40 to 80 char 3 6**/ 3 7 3 8 dcl 1 gfms_ext$print_routines aligned ext 3 9 , 3 ioa entry variable options(variable) 3 10 , 3 ioa_nnl entry variable options(variable) 3 11 ; 3 12 3 13 dcl 1 gfms_ext$temp_segs aligned ext 3 14 , 3 dtp ptr 3 15 , 3 nlp ptr 3 16 , 3 inp ptr 3 17 ; 3 18 3 19 dcl 1 gfms_ext$tape_file aligned ext 3 20 , 3 cbp ptr 3 21 , 3 attach_description char(80)unal 3 22 , 3 density 3 23 , 4 ftd fixed bin /* First tape density to attempt. */ 3 24 , 4 ltd fixed bin /* Last tape density to attempt. */ 3 25 , 3 tape_reel_information 3 26 , 4 reel_serial_num char(6) 3 27 , 4 file_serial_num char(6) 3 28 , 4 reel_sequence_num char(6) 3 29 ; 3 30 3 31 dcl 1 gfms_ext$options aligned ext 3 32 , 3 close bit(1)unal /* perform iox close. */ 3 33 , 3 detach bit(1)unal /* perform iox detach. */ 3 34 , 3 dump bit(1)unal /* dump tape records/information. */ 3 35 , 3 gf bit(1)unal /* provide gtss file attributes. */ 3 36 , 3 prfn bit(1)unal /* print file names. */ 3 37 , 3 scan_ss bit(1)unal /* scan substructure, display, quit. */ 3 38 , 3 tll bit(1)unal /* print totals of llinks. */ 3 39 , 3 unload bit(1)unal /* unload files. */ 3 40 , 3 NOT_IN_USE bit(28)unal 3 41 ; 3 42 3 43 dcl gfms_ext$working_dir char (168) var ext static; /* Where to restore the files. 3 44* It may be the user's working 3 45* directory, or the UMC or SMC directory. */ 3 46 3 47 dcl gfms_ext$mapping_rule char(3) external static; 3 48 3 49 dcl gfms_ext$umc_name char(12) external static; 3 50 3 51 /* END INCLUDE FILE gfms_ext.incl.pl1 */ 713 714 4 1 /* BEGIN INCLUDE FILE gfms_do_files.incl.pl1 (Wardd Multics) 10/19/80 2212.5 mst Sun */ 4 2 4 3 /* Hash list of files specified in -file, -no_file 4 4* control arguments and in the file designated by 4 5* the -input_file. 4 6**/ 4 7 dcl 1 file_names aligned based(inp) 4 8 , 3 number_names fixed bin 4 9 , 3 cat_start (0:1020)fixed bin 4 10 , 3 file_start (0:1020)fixed bin 4 11 , 3 file_name (4500) 4 12 , 4 not bit(1)unal 4 13 , 4 fill bit(17)unal 4 14 , 4 link fixed bin(17)unal 4 15 , 4 name char(168)var 4 16 ; 4 17 4 18 /* END INCLUDE FILE gfms_do_files.incl.pl1 */ 715 716 end gcos_fms; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/10/84 1021.5 gcos_fms.pl1 >spec>on>7105>gcos_fms.pl1 709 1 12/10/84 1023.1 gfms_version.incl.pl1 >spec>on>7105>gfms_version.incl.pl1 711 2 03/27/82 0424.8 gfms_tape_densities.incl.pl1 >ldd>include>gfms_tape_densities.incl.pl1 713 3 10/24/83 1642.4 gfms_ext.incl.pl1 >ldd>include>gfms_ext.incl.pl1 715 4 03/27/82 0424.8 gfms_do_files.incl.pl1 >ldd>include>gfms_do_files.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. active_fnc_err_ 000010 constant entry external dcl 583 ref 34 addr builtin function dcl 584 ref 36 96 448 563 al 000100 automatic fixed bin(17,0) dcl 585 set ref 112* 123 133 147 152 152 164 164 170 170 176 177 193 195 211 218 218 218 222 224 228 231 250 258 258 265 ap 000102 automatic pointer dcl 586 set ref 112* 133 147 152 164 170 176 177 193 195 211 218 218 218 222 224 228 231 250 258 265 arg based char unaligned dcl 587 set ref 133 147 152* 164* 170* 176 177 193 195 211 218 218 218 222 224 228 231 250 258* 265 arg_err 000104 automatic bit(1) unaligned dcl 588 set ref 164* 170* 369 437* attach_description 2 000104 external static char(80) level 2 packed unaligned dcl 3-19 set ref 379* 385* 385 cleanup 000106 stack reference condition dcl 589 ref 400 close 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 439* code 000114 automatic fixed bin(35,0) dcl 590 set ref 26* 32 39 44* 96* 101 102* 112* 113 114* 250* 252 258* 563* 568 568* com_err_ 000012 constant entry external dcl 591 ref 41 44 control_arg 000016 constant structure array level 1 unaligned dcl 655 set ref 145 cu_$af_arg_ptr 000014 constant entry external dcl 592 ref 33 cu_$af_return_arg 000016 constant entry external dcl 593 ref 26 cu_$arg_ptr 000020 constant entry external dcl 594 ref 40 den_arg 000116 automatic char(8) unaligned dcl 595 set ref 195* 385 385 467* density 26 000104 external static structure level 2 dcl 3-19 detach 0(01) 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 439* dname 000120 automatic char(168) unaligned dcl 596 set ref 250* 254 dump 0(02) 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 277* 366 442* ename 000172 automatic char(32) unaligned dcl 597 set ref 250* 254 error_table_$bad_density 000024 external static fixed bin(35,0) dcl 599 set ref 199* error_table_$badopt 000022 external static fixed bin(35,0) dcl 598 set ref 152* 239* error_table_$noarg 000026 external static fixed bin(35,0) dcl 600 set ref 59* 477* 487* 497* 507* 517* 527* 538* 548* error_table_$not_act_fnc 000030 external static fixed bin(35,0) dcl 601 ref 39 error_table_$smallarg 000032 external static fixed bin(35,0) dcl 602 set ref 124* expand_pathname_ 000034 constant entry external dcl 603 ref 250 f 000202 automatic fixed bin(17,0) dcl 604 set ref 146* 147 149* 357 file_name_count 000203 automatic fixed bin(17,0) dcl 605 set ref 134 143* 162 163* 163 285* 317* 465* 515 file_names based structure level 1 dcl 4-7 ftd 26 000104 external static fixed bin(17,0) level 3 dcl 3-19 set ref 194* 445* gcos_big_tape_blocks_ 000036 constant entry external dcl 606 ref 52 get_arg 000204 automatic entry variable dcl 607 set ref 33* 40* 112 get_temp_segments_ 000040 constant entry external dcl 608 ref 96 get_wdir_ 000076 constant entry external dcl 653 ref 231 451 gf 0(03) 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 299* 440* gfms_close_ 000042 constant entry external dcl 609 ref 426 gfms_detach_ 000044 constant entry external dcl 610 ref 427 gfms_dump_do_files_ 000046 constant entry external dcl 611 ref 366 gfms_ext$mapping_rule 000112 external static char(3) unaligned dcl 3-47 set ref 222* 452* gfms_ext$options 000106 external static structure level 1 dcl 3-31 gfms_ext$print_routines 000100 external static structure level 1 dcl 3-8 gfms_ext$tape_file 000104 external static structure level 1 dcl 3-19 gfms_ext$temp_segs 000102 external static structure level 1 dcl 3-13 set ref 96 563 gfms_ext$umc_name 000114 external static char(12) unaligned dcl 3-49 set ref 211* 453* gfms_ext$working_dir 000110 external static varying char(168) dcl 3-43 set ref 228* 231* 254* 451* gfms_fail 000210 stack reference condition dcl 612 ref 390 gfms_file_content_records_ 000050 constant entry external dcl 613 ref 412 gfms_file_name_ 000052 constant entry external dcl 614 ref 164 gfms_header_label_ 000054 constant entry external dcl 615 ref 406 gfms_input_file_list_ 000056 constant entry external dcl 616 ref 170 gfms_return 000216 stack reference condition dcl 617 ref 402 gfms_serial_number_record_ 000060 constant entry external dcl 618 ref 407 gfms_smc_records_ 000062 constant entry external dcl 619 ref 409 gfms_substructure_records_ 000064 constant entry external dcl 620 ref 411 gfms_task_block_record_ 000066 constant entry external dcl 621 ref 408 got_smc_path 000224 automatic bit(1) unaligned dcl 622 set ref 224 455* hbound builtin function dcl 623 ref 145 192 446 i 000225 automatic fixed bin(17,0) dcl 624 set ref 111* 112* 114* 124* 152* 357* inp 4 000102 external static pointer level 2 dcl 3-13 set ref 366 ioa 000100 external static entry variable level 2 dcl 3-8 set ref 278* 449* ioa_ 000070 constant entry external dcl 625 ref 278 357 ioa_$nnl 000072 constant entry external dcl 626 ref 279 ioa_nnl 4 000100 external static entry variable level 2 dcl 3-8 set ref 279* 450* k 000226 automatic fixed bin(17,0) dcl 627 set ref 192* 193 194* l 000227 automatic fixed bin(17,0) dcl 628 set ref 145* 146 last_was_file 000230 automatic bit(1) unaligned dcl 629 set ref 134 142* 148* 287* 319* 455* lbound builtin function dcl 630 ref 192 445 ltd 27 000104 external static fixed bin(17,0) level 3 dcl 3-19 set ref 194* 446* master_save 000231 automatic bit(1) unaligned dcl 631 set ref 408* 409 na 000232 automatic fixed bin(17,0) dcl 632 set ref 26* 57 111 name 000016 constant char(20) initial array level 2 packed unaligned dcl 655 set ref 147 357* need_density 000233 automatic bit(1) unaligned dcl 633 set ref 190 191* 271* 455* 495 need_input_file 000234 automatic bit(1) unaligned dcl 634 set ref 168 169* 293* 455* 485 need_mapping_rule 000235 automatic bit(1) unaligned dcl 635 set ref 215 217* 347* 455* 525 need_smc_path 000236 automatic bit(1) unaligned dcl 636 set ref 224* 247 249* 341* 455* 546 need_track 000237 automatic bit(1) unaligned dcl 637 set ref 174 175* 335* 455* 505 need_umc_name 000240 automatic bit(1) unaligned dcl 638 set ref 208 210* 353* 455* 536 nlp 2 000102 external static pointer level 2 dcl 3-13 set ref 448* not_file 000241 automatic bit(1) unaligned dcl 639 set ref 164* 286* 318* number_names based fixed bin(17,0) level 2 dcl 4-7 ref 366 prfn 0(04) 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 325* 443* put_err 000242 automatic entry variable dcl 640 set ref 34* 41* 59 102 114 124 135 152 180 199 239 258 391 477 487 497 507 517 527 538 548 568 reel_number 000246 automatic char(7) unaligned dcl 641 set ref 265* 379 466* 475 release_temp_segments_ 000074 constant entry external dcl 642 ref 563 rs based varying char dcl 643 set ref 53* 374* rsl 000250 automatic fixed bin(21,0) dcl 644 set ref 26* 38* 53 374 rsp 000252 automatic pointer dcl 645 set ref 26* 36* 53 374 rsx 000254 automatic varying char(5) dcl 646 set ref 36 rtrim builtin function dcl 647 ref 231 254 379 385 385 451 scan_ss 0(05) 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 329* 455* string builtin function dcl 648 set ref 199 199 405* substr builtin function dcl 649 ref 133 147 tape_densities 000230 constant char(5) initial array unaligned dcl 2-2 ref 192 192 193 199 199 445 446 tape_reel_information 30 000104 external static structure level 2 dcl 3-19 set ref 405* tape_track 000257 automatic char(1) unaligned dcl 650 set ref 176* 177* 379 438* tll 0(06) 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 305* 441* tsp based pointer array dcl 651 set ref 96* 563* two_words 000260 automatic bit(72) dcl 652 set ref 447* 448 unload 0(07) 000106 external static bit(1) level 2 packed unaligned dcl 3-31 set ref 311* 444* val 5 000016 constant fixed bin(17,0) initial array level 2 dcl 655 ref 149 version 000237 constant char(3) initial unaligned dcl 1-2 ref 59 NAMES DECLARED BY EXPLICIT CONTEXT. carg 000000 constant label array(14) dcl 268 ref 149 clean_up 002770 constant entry internal dcl 420 ref 396 400 415 error_exit 002417 constant label dcl 372 ref 120 130 140 159 185 205 243 260 exit 002765 constant label dcl 417 ref 397 402 gcos_fms 000721 constant entry external dcl 6 gfms 000712 constant entry external dcl 6 init_routine 003022 constant entry internal dcl 431 ref 92 leftovers 003145 constant entry internal dcl 473 ref 369 next_arg 002373 constant label dcl 363 ref 165 171 187 196 212 234 255 266 272 280 288 294 300 306 312 320 326 330 336 342 348 354 361 not_provided 002343 constant label dcl 356 null_proc 003625 constant entry internal dcl 577 ref 449 450 release_temp_segs 003543 constant entry internal dcl 560 ref 373 421 wrong_number_args 001051 constant label dcl 58 NAME DECLARED BY CONTEXT OR IMPLICATION. translate builtin function ref 265 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4554 4672 4060 4564 Length 5240 4060 116 332 473 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gfms 426 external procedure is an external procedure. on unit on line 390 84 on unit on unit on line 400 64 on unit on unit on line 402 64 on unit clean_up 70 internal procedure is called by several nonquick procedures. init_routine internal procedure shares stack frame of external procedure gfms. leftovers internal procedure shares stack frame of external procedure gfms. release_temp_segs 96 internal procedure is called by several nonquick procedures. null_proc 64 internal procedure is assigned to an entry variable. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gfms 000100 al gfms 000102 ap gfms 000104 arg_err gfms 000114 code gfms 000116 den_arg gfms 000120 dname gfms 000172 ename gfms 000202 f gfms 000203 file_name_count gfms 000204 get_arg gfms 000224 got_smc_path gfms 000225 i gfms 000226 k gfms 000227 l gfms 000230 last_was_file gfms 000231 master_save gfms 000232 na gfms 000233 need_density gfms 000234 need_input_file gfms 000235 need_mapping_rule gfms 000236 need_smc_path gfms 000237 need_track gfms 000240 need_umc_name gfms 000241 not_file gfms 000242 put_err gfms 000246 reel_number gfms 000250 rsl gfms 000252 rsp gfms 000254 rsx gfms 000257 tape_track gfms 000260 two_words gfms THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_var_desc call_var call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_arg_ptr cu_$af_return_arg cu_$arg_ptr expand_pathname_ gcos_big_tape_blocks_ get_temp_segments_ get_wdir_ gfms_close_ gfms_detach_ gfms_dump_do_files_ gfms_file_content_records_ gfms_file_name_ gfms_header_label_ gfms_input_file_list_ gfms_serial_number_record_ gfms_smc_records_ gfms_substructure_records_ gfms_task_block_record_ ioa_ ioa_$nnl release_temp_segments_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_density error_table_$badopt error_table_$noarg error_table_$not_act_fnc error_table_$smallarg gfms_ext$mapping_rule gfms_ext$options gfms_ext$print_routines gfms_ext$tape_file gfms_ext$temp_segs gfms_ext$umc_name gfms_ext$working_dir LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000711 26 000726 32 000742 33 000744 34 000751 35 000754 36 000755 38 000757 39 000761 40 000765 41 000771 42 000774 44 000775 49 001022 52 001023 53 001034 54 001045 57 001046 58 001051 59 001052 89 001114 92 001116 96 001117 101 001142 102 001144 107 001171 111 001172 112 001201 113 001215 114 001217 120 001251 123 001252 124 001255 130 001307 133 001310 134 001315 135 001321 140 001347 142 001350 143 001351 145 001353 146 001355 147 001363 148 001400 149 001401 151 001403 152 001405 159 001446 162 001447 163 001451 164 001452 165 001502 168 001503 169 001505 170 001506 171 001533 174 001534 175 001536 176 001537 177 001547 180 001556 185 001604 187 001605 190 001606 191 001610 192 001611 193 001617 194 001626 195 001633 196 001636 198 001637 199 001641 205 001676 208 001677 210 001701 211 001702 212 001710 215 001711 217 001713 218 001714 222 001731 224 001737 228 001747 231 001760 234 002014 239 002015 243 002043 247 002044 249 002046 250 002047 252 002103 254 002106 255 002153 258 002155 260 002211 265 002212 266 002224 268 002226 271 002227 272 002231 274 002232 277 002233 278 002236 279 002243 280 002247 282 002250 285 002251 286 002252 287 002254 288 002256 290 002257 293 002260 294 002262 296 002263 299 002264 300 002267 302 002270 305 002271 306 002274 308 002275 311 002276 312 002301 314 002302 317 002303 318 002304 319 002306 320 002310 322 002311 325 002312 326 002315 328 002316 329 002317 330 002322 332 002323 335 002324 336 002326 338 002327 341 002330 342 002332 344 002333 347 002334 348 002336 350 002337 353 002340 354 002342 356 002343 357 002344 361 002372 363 002373 364 002374 366 002376 369 002411 372 002417 373 002420 374 002424 375 002435 379 002436 385 002517 390 002576 391 002613 396 002641 397 002646 400 002651 402 002673 405 002712 406 002717 407 002723 408 002730 409 002737 411 002747 412 002754 415 002761 417 002765 418 002766 420 002767 421 002775 426 003002 427 003014 428 003021 431 003022 437 003023 438 003024 439 003026 440 003033 441 003035 442 003037 443 003041 444 003043 445 003045 446 003050 447 003052 448 003054 449 003057 450 003063 451 003066 452 003116 453 003120 455 003124 465 003136 466 003140 467 003142 469 003144 473 003145 475 003147 477 003154 482 003202 485 003210 487 003212 492 003240 495 003246 497 003250 502 003276 505 003304 507 003306 512 003334 515 003342 517 003344 522 003372 525 003400 527 003402 533 003430 536 003436 538 003440 543 003471 546 003477 548 003501 553 003527 556 003535 560 003542 563 003550 568 003573 574 003623 577 003624 577 003632 ----------------------------------------------------------- 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