COMPILATION LISTING OF SEGMENT gcos_pull_tapefile Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1119.16_Tue_mdt Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 gcos_pull_tapefile: gcpt: pull: proc; 7 8 /* This command copies files from a GCOS tape into the Multics storage system. 9* Since it was designed to read files from a total system tape, from which the 10* gcos simulator libraries are built, it accepts records longer than 320 words. 11* It reads the header label preceeding each file, prints the name and file 12* sequence number, and asks the user if the file is to be copied. If the answer 13* is yes, it asks for a pathname, and copies the file into it. Then it continues 14* with the next file. This process is terminated either by a reply of "cancel", or 15* "quit", or "q" to the question, or an end-of-reel label or partial label 16* being encountered on the tape. 17* 18* USAGE: gcpt tape_number {-control_args} 19* 20* tape_number 21* 22* is a character string used in the mount message to the Multics operator. 23* It need not match any field in the tape labels. See -attached, below. 24* 25* -attached, -att 26* 27* may be given in place of tape_number to indicate that the tape has been 28* retained (see -retain, below) from a previous use of this command, and 29* is therefore already mounted. 30* 31* -retain, -ret 32* 33* causes the tape to remain mounted when processing by this command is completed. 34* This saves work for the Multics operator, if several attempts to read the tape 35* are to be made. 36* 37* -detach, -det 38* 39* causes the tape to be detached and dismounted, before any attempt is 40* made to attach the currently specified tape. If this is the only argument given, 41* the tape will be detached and no other processing will take place. 42* 43* -skip n 44* 45* causes n files to be skipped over before the user is asked if files are to 46* be copied. (Questioning starts with the n+1st file.) 47* 48* -gsr 49* 50* Allows standard size (320 word or less) records to be copied into the Multics 51* storage system in a format readable by other Multics tools that manipulate 52* GCOS files. Records shorter than 320 words are padded out to 320 words, allowing 53* a read of 320 words to obtain exectly one record. This argument should not be 54* used when reading a total system tape. 55* 56* -dcw 57* 58* Requests program to assume files are tape format System Loadable Files, 59* as produced by SYSEDIT, and to interpret the DCW blocks, verifying their 60* consistency with the data records, and adjusting record lengths, if necessary, 61* before writing them to the output file. 62* 63* -no_label, -nl 64* 65* Indicates that there are no header or trailer labels, and that every file 66* is to be treated as data. 67* 68* -brief, -bf 69* 70* Causes certain warning messages and informative messages not to be printed. 71* 72* -long, -lg 73* 74* Causes hardware status, labels, and length and first word of all data records, 75* to be printed on the terminal. 76* 77* -long_brief, -lb 78* 79* Causes hardware status and labels, but NOT length and first word of data records, 80* to be printed on the terminal. 81* 82* -debug, -db 83* 84* Causes db to be called after the call to com_err_ and before the call 85* to cleanup_proc, when any errors occur. 86* 87* -block n 88* 89* Allows tape buffer size to be increased from the default of 3842 words, 90* up to a maximum of 4096 words. 91* 92* -density 93* 94* Allows tape density to be specified. Default is 1600. 95* 96* WRITTEN BY T. CASEY AUGUST 1974 97* MODIFIED BY T.CASEY NOVEMBER 1974 TO FIX BUGS 98* Modified: Ron Barstad 2.0 83-02-28 Changed incl query_info_ to query_info 99* Added version indicator (start with 2.0) 100* Modified: Ron Barstad 2.1 83-04-15 Added -density, -block and changed defaults. 101* 102**/ 103 104 /* D E C L A R A T I O N S */ 105 1 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 1 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 1 3 /* version number changed to 4, 08/10/78 WOS */ 1 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 1 5 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 1 6 1 7 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 1 8 2 version fixed bin, /* version of this structure - must be set, see below */ 1 9 2 switches aligned, /* various bit switch values */ 1 10 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 1 11 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 1 12 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 1 13 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 1 14 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 1 15 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 1 16 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 1 17 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 1 18 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 1 19 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 1 20 1 21 /* Limit of data defined for version 2 */ 1 22 1 23 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 1 24 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 1 25 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 1 26 /* minimum of 30 seconds required for repeat */ 1 27 /* otherwise, no repeat will occur */ 1 28 /* Limit of data defined for version 4 */ 1 29 1 30 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 1 31 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 1 32 1 33 dcl query_info_version_3 fixed bin int static options (constant) init (3); 1 34 dcl query_info_version_4 fixed bin int static options (constant) init (4); 1 35 dcl query_info_version_5 fixed bin int static options (constant) init (5); 1 36 dcl query_info_version_6 fixed bin int static options (constant) init (6); /* the current version number */ 1 37 1 38 /* END INCLUDE FILE query_info.incl.pl1 */ 106 107 108 /* External Entries */ 109 110 111 dcl com_err_ ext entry options (variable); 112 dcl command_query_ ext entry options (variable); 113 dcl cu_$arg_count ext entry (fixed bin); 114 dcl cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)); 115 dcl cv_dec_check_ ext entry (char (*), fixed bin (35)) returns (fixed bin); 116 dcl db ext entry; 117 dcl decode_nstd_status_ ext entry (bit (72) aligned, char (*) varying); 118 dcl gcos_cv_gebcd_ascii_ ext entry (ptr, fixed bin, ptr, fixed bin(21)); 119 dcl ioa_ ext entry options (variable); 120 121 dcl ios_$attach ext entry 122 (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 123 dcl ios_$detach ext entry 124 (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 125 dcl ios_$order ext entry 126 (char (*) aligned, char (*) aligned, ptr, bit (72) aligned); 127 dcl ios_$read ext entry 128 (char (*) aligned, ptr, fixed bin(21), fixed bin(21), fixed bin(21), bit (72) aligned); 129 dcl ios_$seek ext entry 130 (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, bit (72) aligned); 131 dcl ios_$setsize ext entry 132 (char (*) aligned, fixed bin, bit (72) aligned); 133 dcl ios_$tell ext entry 134 (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin(21), bit (72) aligned); 135 dcl ios_$write ext entry 136 (char (*) aligned, ptr, fixed bin(21), fixed bin(21), fixed bin(21), bit (72) aligned); 137 138 dcl (error_table_$noarg, error_table_$badopt, error_table_$inconsistent, error_table_$ioname_not_found, error_table_$bad_arg) 139 ext static fixed bin (35); 140 141 /* Work Variables */ 142 143 /* Argument processing */ 144 dcl nargs fixed bin; 145 dcl argp ptr; 146 dcl argl fixed bin; 147 dcl arg char (argl) based (argp); 148 dcl argno fixed bin; 149 150 /* Character strings */ 151 152 dcl buf_arg char (32) varying; 153 dcl buffer char (16384) aligned; /* 4096 words */ 154 dcl den_arg char (32) varying; 155 dcl err_msg char (200) varying; 156 dcl pname char (168) aligned; /* pathname to copy into, given by user */ 157 dcl err_path char (168) varying; 158 dcl answer char (168) varying; 159 dcl intape char (32) varying; /* tape number to read from */ 160 dcl tape_request char (64) aligned; 161 dcl me char (24) int static options(constant) init ("gcos_pull_tapefile (2.1)"); 162 dcl ascii_name char (12) aligned; 163 dcl valid_den (5) char (4) int static options(constant) init ("200", "556", "800", "1600", "6250"); 164 165 /* Switches - init off */ 166 167 dcl ( 168 longsw /* print codes or labels or length and word one */ 169 , long_brief /* do not print length and wordone */ 170 ) bit (1) aligned int static init ("0"b); /* keep for -attach invocation */ 171 172 dcl ( 173 attached /* -attached given */ 174 , briefsw /* -brief given */ 175 , debugsw /* -debug given - call db if any errors occur */ 176 , dcwsw /* -dcw given - interpret dcw blocks and delete extra words */ 177 , detach /* -detach given */ 178 , eorsw /* end of reel, or user said "quit" */ 179 , gsr /* -gsr given */ 180 , no_label /* no_label given: tape has no labels */ 181 , notdcw /* on after inconsistent dcw block found in file */ 182 , out_of_synch /* on if initial tape position not at header label */ 183 , print_hdwr_status /* hardware status returned from nstd_ */ 184 , retain /* -retain given */ 185 , skipit /* user said -skip n and we are not yet at file n+1 */ 186 , tape_is_attached /* either -attached given, or we attached a tape */ 187 ) bit (1) aligned init ("0"b); 188 189 /* Fixed bin */ 190 191 dcl bufsize fixed bin (21); 192 193 dcl ( /* fixed bin init (0) */ 194 dcw_block_len /* computed length of dcw or data block */ 195 , dcw_index /* index of current dcw in block */ 196 , dcw_word_count /* sum of dcw.counts */ 197 , expected_arg /* says which of -skip n or -block n was given */ 198 , filecount /* which file are we at */ 199 , i /* just an index counter */ 200 , in_elements /* elements read from input */ 201 , out_elements /* elements written to output */ 202 , ndcw /* number of dcws in block */ 203 , numeric_arg /* value of n after -skip or -block */ 204 , read_count /* to help get back into synch */ 205 , rec_count /* counter for tape records in one file */ 206 , skipcount /* number of files user said to skip */ 207 , word_count /* sum of reloc and data word counts in dcw block */ 208 )fixed bin (21) init (0); 209 210 /* To keep track of what we are expecting next from the tape */ 211 212 dcl (expected_input, next_expected_input, unexpected_input) fixed bin; 213 214 /* Names for things we are expecting, for program readability */ 215 216 dcl ( 217 data_to_be_copied init (1) 218 , header_label init (2) 219 , trailer_label init (3) 220 , eof_after_header init (4) 221 , eof_after_trailer init (5) 222 , eof_after_forward_file init (6) 223 , eof init (7) 224 , label init (8) 225 , data init (9) 226 , next_file init (10) 227 )fixed bin int static options(constant); 228 229 230 /* Bit string */ 231 dcl st bit (72) aligned; 232 233 /* Based */ 234 dcl code fixed bin (35) aligned based (addr (st)); 235 236 dcl 1 stat_word based (addr (st)), 237 2 hdwr_status bit (1) unaligned, 238 2 fill bit (25) unaligned, 239 2 major bit (4) unaligned, 240 2 minor bit (6) unaligned, 241 2 word2 bit (36) aligned; /* to allow printing of second half */ 242 243 dcl 1 label_model aligned based (buffp), 244 2 filler (8) fixed bin, 245 2 filename bit (72); 246 247 dcl 1 partial_label aligned based (buffp), 248 2 fill (4) bit (36) aligned, 249 2 zero_words (6) bit (36) aligned, /* if all zero, this is a partial label */ 250 2 fill2 (4) bit (36) aligned; 251 252 dcl 1 preface aligned based (buffp), /* dcw block - called preface for historical reasons */ 253 2 (data_check, rel_chekc, rel_abs) fixed bin (35), 254 2 name bit (36), 255 2 (entry, origin) bit (18) unaligned, 256 2 (reloc_words, data_words) fixed bin (17) unaligned, 257 2 dcw (ndcw), 258 3 data_addr bit (18) unaligned, 259 3 zero bit (3) unaligned, 260 3 action bit (3) unaligned, 261 3 count bit (12) unaligned; 262 263 264 dcl w (4096) bit (36) aligned based (buffp); 265 266 dcl wordone bit (36) aligned based (buffp); /* overlay for first word of buffer */ 267 268 /* Pointer */ 269 dcl buffp pointer; 270 271 /* Builtin */ 272 dcl (addr, divide, fixed, hbound, mod, null, rtrim, substr, unspec) builtin; 273 274 dcl cleanup condition; 275 276 277 /* P R O C E D U R E */ 278 279 280 buffp = addr (buffer); 281 on condition (cleanup) call cleanup_proc; 282 283 call cu_$arg_count (nargs); 284 285 /* Initialize */ 286 287 den_arg = "1600"; 288 buf_arg = "3842"; 289 bufsize = 3842; 290 intape = ""; 291 tape_request = ""; 292 293 /* IF NO ARGS, PRINT USAGE MESSAGE AND QUIT */ 294 295 if nargs = 0 then do; 296 code = error_table_$noarg; 297 err_msg = "Usage: gcpt REEL_NUMBER OR -attached {-control_args}"; 298 goto call_com_err; 299 end; 300 301 arg_loop: do argno = 1 to nargs; 302 303 call cu_$arg_ptr (argno, argp, argl, code); 304 305 if code ^= 0 then do; 306 err_msg = arg; 307 call_com_err: call com_err_ (code, me, err_msg, err_path, numeric_arg); 308 if print_hdwr_status then 309 call ioa_ ("(^a)", answer); 310 311 if debugsw then do; 312 call ioa_ ("CALLING DB:"); 313 call db; 314 end; 315 316 clean_out: call cleanup_proc; 317 return; 318 end; 319 320 err_path = arg; /* in case of arg error */ 321 code = 0; 322 323 if expected_arg ^= 0 then do; 324 numeric_arg = cv_dec_check_ (arg, code); 325 326 if expected_arg = 1 then do; /* -skip n */ 327 expected_arg = 0; 328 if code ^= 0 then do; 329 code = error_table_$bad_arg; /* cv_dec_check_ does not return an error_table_ code */ 330 err_msg = "bad skip count: ^a"; 331 goto call_com_err; 332 end; 333 skipcount = numeric_arg; 334 end; 335 336 else if expected_arg = 2 then do; /* -block n */ 337 expected_arg = 0; 338 if code ^= 0 then do; 339 code = error_table_$bad_arg; 340 bad_buf_size: err_msg = "bad buffer size: ^a"; 341 goto call_com_err; 342 end; 343 if numeric_arg > 4096 then 344 goto bad_buf_size; 345 bufsize = numeric_arg; 346 buf_arg = arg; 347 end; 348 349 else if expected_arg = 3 then do; /* -density n */ 350 den_arg = ""; 351 expected_arg = 0; 352 if code ^= 0 then do; 353 code = error_table_$bad_arg; 354 err_msg = "tape density missing or contains non-numerics: ^a"; 355 goto call_com_err; 356 end; 357 do i = 1 to hbound(valid_den,1); 358 if arg = valid_den(i) 359 then den_arg = arg; 360 end; 361 if den_arg = "" then do; 362 code = error_table_$bad_arg; 363 err_msg = "not a known tape density: ^a"; 364 goto call_com_err; 365 end; 366 end; 367 368 else do; 369 err_msg = "program bug"; 370 goto call_com_err; 371 end; 372 end; /* end of expected arg do group */ 373 374 else if substr (arg, 1, 1) ^= "-" then do; /* must be tape number */ 375 if intape ^= "" then do; /* if it was already given */ 376 err_msg = "unknown non-control argument: ^a"; 377 goto call_com_err; 378 end; 379 intape = arg; 380 end; /* end of tape number do group */ 381 382 else do; /* control arg */ 383 if arg = "-att" | arg = "-attached" then do; 384 attached = "1"b; 385 tape_is_attached = "1"b; 386 end; 387 else if arg = "-bk" | arg = "-block" then 388 expected_arg = 2; 389 else if arg = "-db" | arg = "-debug" then 390 debugsw = "1"b; 391 else if arg = "-den" | arg = "-density" then 392 expected_arg = 3; 393 else if arg = "-dcw" then 394 dcwsw = "1"b; 395 else if arg = "-det" | arg = "-detach" then 396 detach = "1"b; 397 else if arg = "-gsr" then 398 gsr = "1"b; 399 else if arg = "-lg" | arg = "-long" then do; 400 longsw = "1"b; 401 long_brief = "0"b; 402 end; 403 else if arg = "-lb" | arg = "-long_brief" then 404 longsw, long_brief = "1"b; 405 else if arg = "-nl" | arg = "-no_label" | arg = "-no_labels" then 406 no_label = "1"b; 407 else if arg = "-ret" | arg = "-retain" then 408 retain = "1"b; 409 else if arg = "-skip" then 410 expected_arg = 1; 411 else if arg = "-bf" | arg = "-brief" then 412 briefsw = "1"b; 413 else do; 414 code = error_table_$badopt; 415 err_msg = "^a"; 416 goto call_com_err; 417 end; 418 end; /* end control arg do group */ 419 420 end arg_loop; 421 422 /* Check correctness of args */ 423 424 if expected_arg ^= 0 then do; 425 err_msg = "after ^a"; 426 code = error_table_$noarg; 427 goto call_com_err; 428 end; 429 430 if attached then do; /* tape attached already */ 431 if intape ^= "" then do; /* can't give tape number too */ 432 err_msg = "tape_number and -attached"; 433 inconsistent: code = error_table_$inconsistent; 434 goto call_com_err; 435 end; 436 if detach then do; 437 err_msg = "-detach and -attached"; 438 goto inconsistent; 439 end; 440 end; /* end tape attached do group */ 441 442 else do; /* tape not already attached */ 443 if detach then do; 444 call ios_$detach ("gcpt_input", "", "", st); 445 if code ^= 0 then 446 if code ^= error_table_$ioname_not_found then do; /* don't blow up if there was no tape attached */ 447 err_msg = "from ios_$detach the previously retained tape"; 448 goto tape_error; 449 end; 450 if nargs = 1 then return; /* if that's all there is to do */ 451 detach = "0"b; /* don't detach the next tape */ 452 end; 453 if intape = "" then do; /* tape number must be given */ 454 err_msg = "tape_number"; 455 code = error_table_$noarg; 456 goto call_com_err; 457 end; 458 end; /* end tape not attached do group */ 459 460 /* Attach input tape */ 461 462 if ^attached then do; 463 tape_request = rtrim(intape||",den="||den_arg||",block="||buf_arg); 464 err_path = "tape " || intape; /* for error messages */ 465 call ios_$attach ("gcpt_input", "nstd_", tape_request, "r", st); 466 if code ^= 0 then do; 467 err_msg = "from ios_$attach ^a"; 468 tape_error: /* come here from other tape errors */ 469 if hdwr_status then do; 470 call decode_nstd_status_ (st, answer); 471 print_hdwr_status = "1"b; /* rember to print it after main error message */ 472 end; 473 474 else if code = error_table_$ioname_not_found then 475 tape_is_attached = "0"b; /* tell cleanup_proc that tape was not there */ 476 goto call_com_err; 477 end; /* end code ^= 0 do group */ 478 tape_is_attached = "1"b; /* for the information of cleanup_proc */ 479 end; /* end ^attached do group */ 480 481 else /* tape is attached */ 482 err_path = "the retained tape"; /* best we can do for error messages */ 483 /* Initialize */ 484 485 /* Initialize */ 486 query_info.suppress_name_sw = "1"b; 487 if no_label then /* if tape has no labels */ 488 expected_input = next_file; /* first record will be data */ 489 else expected_input = header_label; /* otherwise it will be a header label */ 490 491 /* Main read and write loop */ 492 493 copyloop: do while (^eorsw); /* keep reading until end of reel 494* or until user says "quit" */ 495 496 if expected_input = eof_after_forward_file then /* if user does not want file copied */ 497 call ios_$order ("gcpt_input", "forward_file", null, st); 498 /* skip over all data records at once, to save time */ 499 else do; 500 call ios_$read ("gcpt_input", buffp, 0, bufsize, in_elements, st); 501 /* else read data or label record */ 502 read_count = read_count + 1; /* count reads, to help get into synch, 503* in case initial tape position is not at header label */ 504 end; 505 506 if longsw then do; 507 if code ^= 0 then do; 508 call decode_nstd_status_ (st, answer); 509 call ioa_ ("status = ^w ^w (^a)", code, word2, answer); 510 end; 511 else do; 512 if in_elements ^= 14 then do; /* if not a label */ 513 if ^long_brief then /* let user turn this off separately */ 514 call dumper (1); /* print length and bcw of record */ 515 end; 516 517 else call dumper (2); /* this is probably a label - dump 14 words */ 518 end; 519 end; 520 521 if code ^= 0 then do; 522 523 if hdwr_status /* is it hadrware status */ 524 & major = "0100"b /* is it an end of file mark */ 525 & (minor = "001111"b /* eof 7track (17 octal) */ 526 | minor = "010011"b) then do; /* eof 9track (23 octal) */ 527 /* it was end of file */ 528 if expected_input = eof_after_header then 529 expected_input = next_expected_input; /* either data_to_be_copied, 530* or eof_after_forward_file, depending on user's reply */ 531 532 else if expected_input = eof_after_trailer then 533 expected_input = header_label; 534 535 else if expected_input = eof_after_forward_file then do; 536 if no_label then /* if tape has no labels */ 537 expected_input = next_file; /* next record will be first of next file */ 538 else expected_input = trailer_label; /* otherwise it will be a trailer label */ 539 end; 540 541 else if expected_input = data_to_be_copied then do; /* eof after data records */ 542 call ios_$tell ("gcpt_output", "write", "first", out_elements, st); /* see how much we wrote */ 543 if code ^= 0 then do; 544 err_msg = "from ios_$tell write ^a"; 545 goto file_error; 546 end; 547 if mod (out_elements, 1024) ^= 0 then out_elements = out_elements+1024; /* get it in pages */ 548 out_elements = divide (out_elements, 1024, 17, 0); 549 /* tell user */ 550 call ioa_ ("^d tape records read, ^d Multics records (pages) written", rec_count, out_elements); 551 rec_count = 0; /* reset it for next file */ 552 call ios_$detach ("gcpt_output", "", "", st); /* detach output file */ 553 if code ^= 0 then do; 554 err_msg = "from ios_$detach ^a"; 555 goto file_error; 556 end; 557 if no_label then /* if tape has no labels */ 558 expected_input = next_file; /* next record will be first of next file */ 559 else expected_input = trailer_label; /* otherwise it will be trailer label */ 560 end; 561 562 else if expected_input = header_label then do; 563 if read_count = 1 then do; /* first read - tape was not at header to start */ 564 call ioa_ ("^a: Filemark encountered when header label expected.", me); 565 unexpected_input = eof; 566 tape_out_of_synch: 567 out_of_synch = "1"b; 568 call ioa_ ("Initial tape position was incorrect. 569 Answer ""no"" to the following question to request search for next header label. 570 Answer ""quit"" to terminate processing."); 571 goto ask; 572 end; 573 574 else if out_of_synch then 575 if unexpected_input = eof then 576 goto double_eof; 577 578 end; 579 else if expected_input = trailer_label | expected_input = next_file then do; 580 double_eof: call com_err_ (0, me, "Consecutive end of file marks encountered. 581 Enter ""no"" to continue reading tape, or ""quit"" to stop."); 582 goto ask; 583 end; 584 585 end; /* end of end-of-file do group */ 586 587 /* Since nstd_ retries reads 10 times after errors, before returning 588* to the caller, there is no point in our retrying again. It is hopeless. */ 589 590 else do; 591 if expected_input = eof_after_forward_file then 592 err_msg = "From ios_$order forward_file ^a"; 593 else err_msg = "From ios_$read ^a"; 594 goto tape_error; 595 end; 596 597 end; /* end of code ^= 0 do group */ 598 599 600 else if in_elements >= bufsize then do; 601 err_msg = "record too long on tape ^a (^d words)"; 602 numeric_arg = in_elements; 603 goto call_com_err; 604 end; 605 606 else if expected_input = eof_after_header 607 | expected_input = eof_after_trailer then do; 608 /* if it had been there, we would have detected it above, 609* as hardware status */ 610 err_msg = "no filemark after label record on tape ^a"; 611 goto tape_error; 612 end; 613 614 else if expected_input = next_file then do; /* no labels on tape */ 615 616 skipit = "0"b; /* duplicate some of header label processing code */ 617 filecount = filecount + 1; 618 if filecount <= skipcount then skipit = "1"b; 619 if ^skipit then do; 620 call ioa_ ("File ^d.", filecount); 621 622 if ^longsw then /* if user has seen nothing about file yet */ 623 call dumper (3); /* print everything */ 624 625 else do; /* user has seen dump, if 14 word record, 626* or length and bcw, if ^14words and ^long_brief */ 627 if long_brief then do; /* user has not seen length */ 628 if in_elements ^= 14 then /* and not dump either */ 629 call dumper (3); /* so print both */ 630 end; /* dump without header implies 14 word length */ 631 632 else do; /* user has seen something */ 633 if in_elements ^= 14 then /* it was length and bcw */ 634 call dumper (2); /* so dump first 14 words */ 635 end; 636 637 end; /* having told user something about the file */ 638 goto ask_copy; /* go ask if it should be copied */ 639 640 end; /* end ^skipit do group */ 641 642 end; /* end expecting next file do group */ 643 644 else if expected_input = header_label then do; /* if expecting header label */ 645 check_for_header: if in_elements = 14 & wordone = "010111010101010000010000000110000000"b then do; /* (GE/b/b60) */ 646 out_of_synch = "0"b; /* just in case it was on */ 647 expected_input = eof_after_header; 648 /* translate filename to ascii */ 649 call gcos_cv_gebcd_ascii_ (addr (label_model.filename), 12, addr (ascii_name), out_elements); 650 skipit = "0"b; 651 filecount = filecount+1; /* bump file number */ 652 if unspec (partial_label.zero_words) = ""b then do; 653 skipit, eorsw = "1"b; /* partial label indicates end of tape */ 654 call ioa_ ("Partial label (end of tape)."); 655 end; 656 if filecount <= skipcount then 657 skipit = "1"b; 658 if ^briefsw | ^skipit then 659 if ^eorsw then call ioa_ ("File ^d. is ""^a""", filecount, ascii_name); 660 661 /* Ask user if he wants to copy this file */ 662 if ^skipit then do; 663 ask_copy: err_msg = "Copy?"; 664 ask: call command_query_ (addr (query_info), answer, me, err_msg); 665 end; 666 if skipit | answer = "no" | answer = "n" then do; 667 if no_label then /* if unlabeled tape */ 668 expected_input = eof_after_forward_file; /* skip to next file */ 669 else next_expected_input = eof_after_forward_file; /* else get past eof after header first */ 670 end; 671 672 else if answer = "cancel" | answer = "quit" | answer = "q" then 673 eorsw = "1"b; /* pretend we hit end of reel */ 674 675 else if answer ^= "yes" & answer ^= "y" then do; 676 err_msg = "Please answer ""yes"", ""no"", or ""quit"":"; 677 goto ask; 678 end; 679 680 else do; 681 next_expected_input = data_to_be_copied; 682 683 if dcwsw then do; /* initialize dcw processing for new file */ 684 notdcw = "0"b; 685 ndcw = 0; 686 end; 687 688 call command_query_ (addr (query_info), answer, me, 689 "Pathname of file to copy to:"); 690 pname = answer; /* varying string to fixed length string */ 691 692 call ios_$attach ("gcpt_output", "file_", pname, "", st); /* attach file */ 693 if code ^= 0 then do; 694 err_msg = "from ios_$attach ^a"; 695 file_error: /* come here from other output file errors */ 696 err_path = pname; 697 goto call_com_err; 698 end; 699 call ios_$setsize ("gcpt_output", 36, st); /* set element size to 1 word */ 700 if code ^= 0 then do; 701 err_msg = "from ios_$setsize 36 ^a"; 702 goto file_error; 703 end; 704 call ios_$seek ("gcpt_output", "last", "first", 0, st); /* start at beginning of file */ 705 if code ^= 0 then do; 706 err_msg = "from ios_$seek last first ^a"; 707 goto file_error; 708 end; 709 710 if no_label then /* if no labels, we have the first data record */ 711 goto copy_data; /* so go copy it */ 712 713 end; /* end answer = yes */ 714 end; /* end header label given */ 715 716 else do; /* expected header label not found */ 717 if read_count = 1 then do; 718 if in_elements = 14 then 719 unexpected_input = label; 720 else unexpected_input = data; 721 call ioa_ ("^a: Unknown record (^d words) encountered when header label expected.", 722 me, in_elements); 723 goto tape_out_of_synch; 724 end; 725 else if ^out_of_synch then 726 call ioa_ (" ^a: Expected header label not found; will read until found", me); 727 else if in_elements ^= 14 then /* if not some kind of label record */ 728 expected_input = eof_after_forward_file; /* then forward space to save time */ 729 end; 730 end; /* end header label expected */ 731 732 else if expected_input = trailer_label then do; /* if eof after file was read */ 733 /* then we are expecting and EOF or EOR label record */ 734 if in_elements = 14 & wordone = "010000010101100110010110010000010000"b then do; /* "/bEOF/b/b"? */ 735 call ioa_ ("End of File"); 736 expected_input = eof_after_trailer; 737 end; 738 739 else if in_elements = 14 & wordone = "010000010101100110101001010000010000"b then do; /* "/bEOR/b/b"? */ 740 call ioa_ ("End of Reel"); 741 eorsw = "1"b; /* remember eor */ 742 end; 743 744 else do; /* neither EOR nor EOF - what is it? */ 745 if out_of_synch then do; 746 if in_elements = 14 then /* might be header label! */ 747 goto check_for_header; 748 else expected_input = eof_after_forward_file; 749 end; 750 else call ioa_ ("^a trailer label missing. processing continues.", me); 751 end; 752 end; /* end trailer label expected */ 753 754 else if expected_input = data_to_be_copied then do; /* if we were expecting a data record, copy it */ 755 copy_data: rec_count = rec_count + 1; /* count tape records copied to file */ 756 if gsr then /* if user so requested */ 757 if in_elements < 320 then /* we will pad short records */ 758 in_elements = 320; /* out to 320 words */ 759 760 /* When the argument -dcw is given, this code assumes a tape format system 761* loadable file, as produced by SYSEDIT, determines what the record lengths 762* should be by looking at the dcw blocks, and whenever it finds an input record 763* one word longer than it should be, it subtracts 1 from the length before writing it. */ 764 765 if dcwsw /* if user said -dcw */ 766 then if ^notdcw /* and we have not found inconsistencies already */ 767 then do; /* then interpret dcw blocks */ 768 769 if ndcw = 0 then do; /* if we are expecting a dcw block */ 770 dcw_index = 1; 771 if in_elements > 64 then do; /* too long to be a dcw block */ 772 call ioa_ ("not dcw block: ^d words.", in_elements); 773 goto not_dcw_block; 774 end; 775 776 else do; /* length ok for dcw block */ 777 dcw_word_count = 0; /* sum of dcw.counts */ 778 do ndcw = 1 to 58; /* max of 58 dcws, plus 6 others, for 64 word max */ 779 dcw_word_count = dcw_word_count + fixed (dcw (ndcw).count); 780 if dcw (ndcw).action = "000"b then goto end_dcw_list; 781 end; 782 end_dcw_list: 783 dcw_block_len = ndcw + 6; 784 if in_elements ^= dcw_block_len then do; 785 if in_elements = dcw_block_len + 1 /* the case we are looking for */ 786 then in_elements = dcw_block_len; /* fix it */ 787 else do; /* otherwise we don't know what's happening */ 788 call ioa_ ("not dcw block: actual block length = ^d, 789 computed block length = ^d (^d dcws)", 790 in_elements, dcw_block_len, ndcw); 791 goto not_dcw_block; 792 end; 793 794 end; 795 796 word_count = preface.reloc_words + preface.data_words; 797 if dcw_word_count ^= word_count then do; 798 call ioa_ ("not dcw block: sum of dcw.counts = ^d, 799 but reloc + data words = ^d (^d + ^d)", 800 dcw_word_count, word_count, preface.reloc_words, preface.data_words); 801 goto not_dcw_block; 802 end; 803 804 end; 805 806 end; 807 808 else do; /* expecting data block */ 809 810 dcw_block_len = fixed (dcw (dcw_index).count); 811 if in_elements ^= dcw_block_len then do; 812 if in_elements = dcw_block_len + 1 then /* the case we are looking for */ 813 in_elements = dcw_block_len; 814 else do; /* ??? */ 815 call ioa_ ("record length = ^d, dcw.count = ^d", in_elements, dcw_block_len); 816 goto not_dcw_block; 817 end; 818 end; 819 820 dcw_index = dcw_index + 1; 821 if dcw_index > ndcw then /* if we just used the last dcw */ 822 ndcw = 0; /* expect a dcw block next */ 823 824 end; /* end expecting data block */ 825 826 goto write_output; 827 828 not_dcw_block: 829 notdcw = "1"b; 830 call ioa_ ("will continue copying with no further attempts to interpret dcws"); 831 832 end; /* end of entire dcw block interpreting code */ 833 834 write_output: 835 836 call ios_$write ("gcpt_output", buffp, 0, in_elements, out_elements, st); /* write out record into file */ 837 if code ^= 0 then do; 838 err_msg = "from ios_$write ^a"; 839 goto file_error; 840 end; 841 if in_elements ^= out_elements then do; 842 err_msg = "wrong number of words written to ^a (^d words)"; 843 numeric_arg = out_elements; 844 goto file_error; 845 end; 846 end; /* end of copy record do group */ 847 848 else call ioa_ ("Program bug."); /* can't be else, unless the programmer blew it */ 849 end copyloop; /* end of main loop */ 850 851 /* We fall thru here when eorsw is "1"b - i.e. an end of reel record was read 852* (or the user said to quit and we turned it on before the end of the tape) */ 853 854 if retain then 855 call ioa_ ("^a: input tape will remain attached.", me); 856 else do; 857 call ios_$detach ("gcpt_input", "", "", st); 858 if code ^= 0 then do; 859 err_msg = "from ios_$detach ^a"; 860 goto tape_error; 861 end; 862 end; 863 864 return; /* normal return */ 865 866 867 /* END OF MAIN PROCEDURE */ 868 869 cleanup_proc: proc; /* called on cleanup condition, and after 870* any error in argument processing or I/O */ 871 if retain then do; /* if user said retain */ 872 if tape_is_attached then /* and we do have a tape attached */ 873 call ioa_ ("^a: input tape will remain attached", me); /* let him know it's there */ 874 end; /* and don't detach it */ 875 else call ios_$detach ("gcpt_input", "", "", st); 876 call ios_$detach ("gcpt_output", "", "", st); 877 return; 878 end cleanup_proc; 879 880 dumper: proc (sw); 881 dcl sw fixed bin; 882 883 if sw = 1 | sw = 3 then /* print length and bcw */ 884 call ioa_ ("reclen = ^d, wordone = ^w", in_elements, wordone); 885 886 if sw = 2 | sw = 3 then /* dump first 14 words of record */ 887 call ioa_ ("^3(^4(^w ^)^/^)^w ^w", 888 w (1), w (2), w (3), w (4), w (5), w (6), w (7), 889 w (8), w (9), w (10), w (11), w (12), w (13), w (14)); 890 891 return; 892 end dumper; 893 894 /* Allow user to hit QUIT, change the long or long_brief mode, and resume processing */ 895 896 gcpt_long: gcptlg: entry; 897 898 dcl state char (8) aligned; 899 900 buffp = addr (buffer); 901 long_brief = "0"b; 902 longsw = ^longsw; 903 if longsw then do; 904 state = "on"; 905 end; 906 else do; 907 set_off: state = "off"; 908 end; 909 print_state: call ioa_ ("gcpt long mode set to ^a", state); 910 return; 911 912 gcpt_long_brief: gcptlb: entry; 913 914 buffp = addr (buffer); 915 long_brief = ^long_brief; 916 if long_brief then do; 917 longsw = "1"b; 918 state = "brief"; 919 goto print_state; 920 end; 921 else do; 922 longsw = "0"b; 923 goto set_off; 924 end; 925 926 end gcos_pull_tapefile; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1119.1 gcos_pull_tapefile.pl1 >udd>sm>ds>w>ml>gcos_pull_tapefile.pl1 106 1 03/11/83 1304.3 query_info.incl.pl1 >ldd>incl>query_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. action 6(21) based bit(3) array level 3 packed packed unaligned dcl 252 ref 780 addr builtin function dcl 272 ref 280 296 303 305 307 321 324 328 329 338 339 352 353 362 414 426 433 445 445 455 466 468 474 507 509 509 521 523 523 523 523 543 553 649 649 649 649 664 664 688 688 693 700 705 837 858 900 914 answer 010354 automatic varying char(168) dcl 158 set ref 308* 470* 508* 509* 664* 666 666 672 672 672 675 675 688* 690 answer_iocbp 6 000100 automatic pointer initial level 2 dcl 1-7 set ref 1-7* arg based char packed unaligned dcl 147 set ref 306 320 324* 346 358 358 374 379 383 383 387 387 389 389 391 391 393 395 395 397 399 399 403 403 405 405 405 407 407 409 411 411 argl 000120 automatic fixed bin(17,0) dcl 146 set ref 303* 306 320 324 324 346 358 358 374 379 383 383 387 387 389 389 391 391 393 395 395 397 399 399 403 403 405 405 405 407 407 409 411 411 argno 000121 automatic fixed bin(17,0) dcl 148 set ref 301* 303* argp 000116 automatic pointer dcl 145 set ref 303* 306 320 324 346 358 358 374 379 383 383 387 387 389 389 391 391 393 395 395 397 399 399 403 403 405 405 405 407 407 409 411 411 ascii_name 010460 automatic char(12) dcl 162 set ref 649 649 658* attached 010463 automatic bit(1) initial dcl 172 set ref 172* 384* 430 462 briefsw 010464 automatic bit(1) initial dcl 172 set ref 172* 411* 658 buf_arg 000122 automatic varying char(32) dcl 152 set ref 288* 346* 463 buffer 000133 automatic char(16384) dcl 153 set ref 280 900 914 buffp 010526 automatic pointer dcl 269 set ref 280* 500* 645 649 649 652 734 739 779 780 796 796 798 798 810 834* 883 886 886 886 886 886 886 886 886 886 886 886 886 886 886 900* 914* bufsize 010501 automatic fixed bin(21,0) dcl 191 set ref 289* 345* 500* 600 cleanup 010530 stack reference condition dcl 274 ref 281 code based fixed bin(35,0) dcl 234 set ref 296* 303* 305 307* 321* 324* 328 329* 338 339* 352 353* 362* 414* 426* 433* 445 445 455* 466 474 507 509* 521 543 553 693 700 705 837 858 com_err_ 000012 constant entry external dcl 111 ref 307 580 command_query_ 000014 constant entry external dcl 112 ref 664 688 count 6(24) based bit(12) array level 3 packed packed unaligned dcl 252 ref 779 810 cp_escape_control 1(02) 000100 automatic bit(2) initial level 3 packed packed unaligned dcl 1-7 set ref 1-7* cu_$arg_count 000016 constant entry external dcl 113 ref 283 cu_$arg_ptr 000020 constant entry external dcl 114 ref 303 cv_dec_check_ 000022 constant entry external dcl 115 ref 324 data constant fixed bin(17,0) initial dcl 216 ref 720 data_to_be_copied constant fixed bin(17,0) initial dcl 216 ref 541 681 754 data_words 5(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 252 set ref 796 798* db 000024 constant entry external dcl 116 ref 313 dcw 6 based structure array level 2 dcl 252 dcw_block_len 010502 automatic fixed bin(21,0) initial dcl 193 set ref 193* 782* 784 785 785 788* 810* 811 812 812 815* dcw_index 010503 automatic fixed bin(21,0) initial dcl 193 set ref 193* 770* 810 820* 820 821 dcw_word_count 010504 automatic fixed bin(21,0) initial dcl 193 set ref 193* 777* 779* 779 797 798* dcwsw 010466 automatic bit(1) initial dcl 172 set ref 172* 393* 683 765 debugsw 010465 automatic bit(1) initial dcl 172 set ref 172* 311 389* decode_nstd_status_ 000026 constant entry external dcl 117 ref 470 508 den_arg 010133 automatic varying char(32) dcl 154 set ref 287* 350* 358* 361 463 detach 010467 automatic bit(1) initial dcl 172 set ref 172* 395* 436 443 451* divide builtin function dcl 272 ref 548 eof constant fixed bin(17,0) initial dcl 216 ref 565 574 eof_after_forward_file constant fixed bin(17,0) initial dcl 216 ref 496 535 591 667 669 727 748 eof_after_header constant fixed bin(17,0) initial dcl 216 ref 528 606 647 eof_after_trailer constant fixed bin(17,0) initial dcl 216 ref 532 606 736 eorsw 010470 automatic bit(1) initial dcl 172 set ref 172* 493 653* 658 672* 741* err_msg 010144 automatic varying char(200) dcl 155 set ref 297* 306* 307* 330* 340* 354* 363* 369* 376* 415* 425* 432* 437* 447* 454* 467* 544* 554* 591* 593* 601* 610* 663* 664* 676* 694* 701* 706* 838* 842* 859* err_path 010301 automatic varying char(168) dcl 157 set ref 307* 320* 464* 481* 695* error_table_$bad_arg 000064 external static fixed bin(35,0) dcl 138 ref 329 339 353 362 error_table_$badopt 000056 external static fixed bin(35,0) dcl 138 ref 414 error_table_$inconsistent 000060 external static fixed bin(35,0) dcl 138 ref 433 error_table_$ioname_not_found 000062 external static fixed bin(35,0) dcl 138 ref 445 474 error_table_$noarg 000054 external static fixed bin(35,0) dcl 138 ref 296 426 455 expected_arg 010505 automatic fixed bin(21,0) initial dcl 193 set ref 193* 323 326 327* 336 337* 349 351* 387* 391* 409* 424 expected_input 010520 automatic fixed bin(17,0) dcl 212 set ref 487* 489* 496 528 528* 532 532* 535 536* 538* 541 557* 559* 562 579 579 591 606 606 614 644 647* 667* 727* 732 736* 748* 754 explanation_len 14 000100 automatic fixed bin(21,0) initial level 2 dcl 1-7 set ref 1-7* explanation_ptr 12 000100 automatic pointer initial level 2 dcl 1-7 set ref 1-7* filecount 010506 automatic fixed bin(21,0) initial dcl 193 set ref 193* 617* 617 618 620* 651* 651 656 658* filename 10 based bit(72) level 2 dcl 243 set ref 649 649 fixed builtin function dcl 272 ref 779 810 gcos_cv_gebcd_ascii_ 000030 constant entry external dcl 118 ref 649 gsr 010471 automatic bit(1) initial dcl 172 set ref 172* 397* 756 hbound builtin function dcl 272 ref 357 hdwr_status based bit(1) level 2 packed packed unaligned dcl 236 ref 468 523 header_label constant fixed bin(17,0) initial dcl 216 ref 489 532 562 644 i 010507 automatic fixed bin(21,0) initial dcl 193 set ref 193* 357* 358* in_elements 010510 automatic fixed bin(21,0) initial dcl 193 set ref 193* 500* 512 600 602 628 633 645 718 721* 727 734 739 746 756 756* 771 772* 784 785 785* 788* 811 812 812* 815* 834* 841 883* intape 010427 automatic varying char(32) dcl 159 set ref 290* 375 379* 431 453 463 464 ioa_ 000032 constant entry external dcl 119 ref 308 312 509 550 564 568 620 654 658 721 725 735 740 750 772 788 798 815 830 848 854 872 883 886 909 ios_$attach 000034 constant entry external dcl 121 ref 465 692 ios_$detach 000036 constant entry external dcl 123 ref 444 552 857 875 876 ios_$order 000040 constant entry external dcl 125 ref 496 ios_$read 000042 constant entry external dcl 127 ref 500 ios_$seek 000044 constant entry external dcl 129 ref 704 ios_$setsize 000046 constant entry external dcl 131 ref 699 ios_$tell 000050 constant entry external dcl 133 ref 542 ios_$write 000052 constant entry external dcl 135 ref 834 label constant fixed bin(17,0) initial dcl 216 ref 718 label_model based structure level 1 dcl 243 literal_sw 1(05) 000100 automatic bit(1) initial level 3 packed packed unaligned dcl 1-7 set ref 1-7* long_brief 000011 internal static bit(1) initial dcl 167 set ref 401* 403* 513 627 901* 915* 915 916 longsw 000010 internal static bit(1) initial dcl 167 set ref 400* 403* 506 622 902* 902 903 917* 922* major 0(26) based bit(4) level 2 packed packed unaligned dcl 236 ref 523 me 000005 constant char(24) initial packed unaligned dcl 161 set ref 307* 564* 580* 664* 688* 721* 725* 750* 854* 872* minor 0(30) based bit(6) level 2 packed packed unaligned dcl 236 ref 523 523 mod builtin function dcl 272 ref 547 nargs 000115 automatic fixed bin(17,0) dcl 144 set ref 283* 295 301 450 ndcw 010512 automatic fixed bin(21,0) initial dcl 193 set ref 193* 685* 769 778* 779 780* 782 788* 821 821* next_expected_input 010521 automatic fixed bin(17,0) dcl 212 set ref 528 669* 681* next_file constant fixed bin(17,0) initial dcl 216 ref 487 536 557 579 614 no_label 010472 automatic bit(1) initial dcl 172 set ref 172* 405* 487 536 557 667 710 notdcw 010473 automatic bit(1) initial dcl 172 set ref 172* 684* 765 828* null builtin function dcl 272 ref 496 496 1-7 1-7 1-7 numeric_arg 010513 automatic fixed bin(21,0) initial dcl 193 set ref 193* 307* 324* 333 343 345 602* 843* out_elements 010511 automatic fixed bin(21,0) initial dcl 193 set ref 193* 542* 547 547* 547 548* 548 550* 649* 834* 841 843 out_of_synch 010474 automatic bit(1) initial dcl 172 set ref 172* 566* 574 646* 725 745 padding 1(07) 000100 automatic bit(29) initial level 3 packed packed unaligned dcl 1-7 set ref 1-7* partial_label based structure level 1 dcl 247 pname 010227 automatic char(168) dcl 156 set ref 690* 692* 695 preface based structure level 1 dcl 252 print_hdwr_status 010475 automatic bit(1) initial dcl 172 set ref 172* 308 471* prompt_after_explanation 1(06) 000100 automatic bit(1) initial level 3 packed packed unaligned dcl 1-7 set ref 1-7* query_code 3 000100 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* query_info 000100 automatic structure level 1 dcl 1-7 set ref 664 664 688 688 question_iocbp 4 000100 automatic pointer initial level 2 dcl 1-7 set ref 1-7* read_count 010514 automatic fixed bin(21,0) initial dcl 193 set ref 193* 502* 502 563 717 rec_count 010515 automatic fixed bin(21,0) initial dcl 193 set ref 193* 550* 551* 755* 755 reloc_words 5 based fixed bin(17,0) level 2 packed packed unaligned dcl 252 set ref 796 798* repeat_time 10 000100 automatic fixed bin(71,0) initial level 2 dcl 1-7 set ref 1-7* retain 010476 automatic bit(1) initial dcl 172 set ref 172* 407* 854 871 rtrim builtin function dcl 272 ref 463 skipcount 010516 automatic fixed bin(21,0) initial dcl 193 set ref 193* 333* 618 656 skipit 010477 automatic bit(1) initial dcl 172 set ref 172* 616* 618* 619 650* 653* 656* 658 662 666 st 010524 automatic bit(72) dcl 231 set ref 296 303 305 307 321 324 328 329 338 339 352 353 362 414 426 433 444* 445 445 455 465* 466 468 470* 474 496* 500* 507 508* 509 509 521 523 523 523 523 542* 543 552* 553 692* 693 699* 700 704* 705 834* 837 857* 858 875* 876* stat_word based structure level 1 unaligned dcl 236 state 010536 automatic char(8) dcl 898 set ref 904* 907* 909* 918* status_code 2 000100 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* substr builtin function dcl 272 ref 374 suppress_name_sw 1(01) 000100 automatic bit(1) initial level 3 packed packed unaligned dcl 1-7 set ref 486* 1-7* suppress_spacing 1(04) 000100 automatic bit(1) initial level 3 packed packed unaligned dcl 1-7 set ref 1-7* sw parameter fixed bin(17,0) dcl 881 ref 880 883 883 886 886 switches 1 000100 automatic structure level 2 dcl 1-7 tape_is_attached 010500 automatic bit(1) initial dcl 172 set ref 172* 385* 474* 478* 872 tape_request 010440 automatic char(64) dcl 160 set ref 291* 463* 465* trailer_label constant fixed bin(17,0) initial dcl 216 ref 538 559 579 732 unexpected_input 010522 automatic fixed bin(17,0) dcl 212 set ref 565* 574 718* 720* unspec builtin function dcl 272 ref 652 valid_den 000000 constant char(4) initial array packed unaligned dcl 163 ref 357 358 w based bit(36) array dcl 264 set ref 886* 886* 886* 886* 886* 886* 886* 886* 886* 886* 886* 886* 886* 886* word2 1 based bit(36) level 2 dcl 236 set ref 509* word_count 010517 automatic fixed bin(21,0) initial dcl 193 set ref 193* 796* 797 798* wordone based bit(36) dcl 266 set ref 645 734 739 883* yes_or_no_sw 1 000100 automatic bit(1) initial level 3 packed packed unaligned dcl 1-7 set ref 1-7* zero_words 4 based bit(36) array level 2 dcl 247 ref 652 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. query_info_version_3 internal static fixed bin(17,0) initial dcl 1-33 query_info_version_4 internal static fixed bin(17,0) initial dcl 1-34 query_info_version_5 internal static fixed bin(17,0) initial dcl 1-35 query_info_version_6 internal static fixed bin(17,0) initial dcl 1-36 NAMES DECLARED BY EXPLICIT CONTEXT. arg_loop 001326 constant label dcl 301 ask 003612 constant label dcl 664 ref 571 582 677 ask_copy 003605 constant label dcl 663 ref 638 bad_buf_size 001572 constant label dcl 340 ref 343 call_com_err 001367 constant label dcl 307 ref 298 331 341 355 364 370 377 416 427 434 456 476 603 697 check_for_header 003456 constant label dcl 645 ref 746 clean_out 001465 constant label dcl 316 cleanup_proc 005167 constant entry internal dcl 869 ref 281 316 copy_data 004371 constant label dcl 755 ref 710 copyloop 002562 constant label dcl 493 double_eof 003272 constant label dcl 580 ref 574 dumper 005303 constant entry internal dcl 880 ref 513 517 622 628 633 end_dcw_list 004462 constant label dcl 782 ref 780 file_error 004042 constant label dcl 695 ref 545 555 702 707 839 844 gcos_pull_tapefile 001235 constant entry external dcl 6 gcpt 001225 constant entry external dcl 6 gcpt_long 005062 constant entry external dcl 896 gcpt_long_brief 005142 constant entry external dcl 912 gcptlb 005132 constant entry external dcl 912 gcptlg 005052 constant entry external dcl 896 inconsistent 002222 constant label dcl 433 ref 438 not_dcw_block 004644 constant label dcl 828 set ref 773 791 801 816 print_state 005105 constant label dcl 909 ref 919 pull 001215 constant entry external dcl 6 set_off 005103 constant label dcl 907 ref 923 tape_error 002506 constant label dcl 468 ref 448 594 611 860 tape_out_of_synch 003241 constant label dcl 566 set ref 723 write_output 004662 constant label dcl 834 ref 826 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5774 6062 5462 6004 Length 6350 5462 66 252 312 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME pull 4650 external procedure is an external procedure. on unit on line 281 64 on unit cleanup_proc 104 internal procedure is called by several nonquick procedures. dumper internal procedure shares stack frame of external procedure pull. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 longsw pull 000011 long_brief pull STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME pull 000100 query_info pull 000115 nargs pull 000116 argp pull 000120 argl pull 000121 argno pull 000122 buf_arg pull 000133 buffer pull 010133 den_arg pull 010144 err_msg pull 010227 pname pull 010301 err_path pull 010354 answer pull 010427 intape pull 010440 tape_request pull 010460 ascii_name pull 010463 attached pull 010464 briefsw pull 010465 debugsw pull 010466 dcwsw pull 010467 detach pull 010470 eorsw pull 010471 gsr pull 010472 no_label pull 010473 notdcw pull 010474 out_of_synch pull 010475 print_hdwr_status pull 010476 retain pull 010477 skipit pull 010500 tape_is_attached pull 010501 bufsize pull 010502 dcw_block_len pull 010503 dcw_index pull 010504 dcw_word_count pull 010505 expected_arg pull 010506 filecount pull 010507 i pull 010510 in_elements pull 010511 out_elements pull 010512 ndcw pull 010513 numeric_arg pull 010514 read_count pull 010515 rec_count pull 010516 skipcount pull 010517 word_count pull 010520 expected_input pull 010521 next_expected_input pull 010522 unexpected_input pull 010524 st pull 010526 buffp pull 010536 state pull THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this call_int_other return_mac mdfx1 enable_op shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ command_query_ cu_$arg_count cu_$arg_ptr cv_dec_check_ db decode_nstd_status_ gcos_cv_gebcd_ascii_ ioa_ ios_$attach ios_$detach ios_$order ios_$read ios_$seek ios_$setsize ios_$tell ios_$write THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$badopt error_table_$inconsistent error_table_$ioname_not_found error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1 7 001126 172 001156 193 001174 6 001214 280 001243 281 001245 283 001267 287 001276 288 001302 289 001305 290 001307 291 001310 295 001313 296 001315 297 001320 298 001325 301 001326 303 001335 305 001352 306 001356 307 001367 308 001420 311 001441 312 001443 313 001460 316 001465 317 001471 320 001472 321 001503 323 001504 324 001506 326 001534 327 001537 328 001540 329 001544 330 001547 331 001554 333 001555 334 001557 336 001560 337 001562 338 001563 339 001567 340 001572 341 001577 343 001600 345 001603 346 001604 347 001615 349 001616 350 001620 351 001621 352 001622 353 001626 354 001631 355 001636 357 001637 358 001645 360 001664 361 001666 362 001673 363 001676 364 001703 366 001704 369 001705 370 001712 372 001713 374 001714 375 001720 376 001725 377 001732 379 001733 380 001743 383 001744 384 001755 385 001757 386 001760 387 001761 389 001774 391 002007 393 002022 395 002031 397 002044 399 002053 400 002063 401 002066 402 002067 403 002070 405 002105 407 002124 409 002137 411 002146 414 002161 415 002164 416 002170 420 002171 424 002173 425 002175 426 002202 427 002205 430 002206 431 002210 432 002215 433 002222 434 002225 436 002226 437 002230 438 002235 440 002236 443 002237 444 002241 445 002271 447 002276 448 002303 450 002304 451 002307 453 002310 454 002315 455 002322 456 002325 462 002326 463 002330 464 002413 465 002435 466 002477 467 002501 468 002506 470 002513 471 002530 472 002532 474 002533 476 002540 478 002541 479 002543 481 002544 486 002551 487 002553 489 002560 493 002562 496 002564 500 002627 502 002667 506 002670 507 002673 508 002675 509 002711 510 002741 512 002742 513 002745 515 002753 517 002754 521 002760 523 002764 528 003004 532 003012 535 003017 536 003021 538 003026 539 003030 541 003031 542 003033 543 003074 544 003076 545 003103 547 003104 548 003112 550 003115 551 003140 552 003141 553 003172 554 003174 555 003201 557 003202 559 003207 560 003211 562 003212 563 003214 564 003217 565 003237 566 003241 568 003243 571 003257 574 003260 578 003265 579 003266 580 003272 582 003317 585 003320 591 003321 593 003332 594 003337 597 003340 600 003341 601 003344 602 003351 603 003353 606 003354 610 003361 611 003366 614 003367 616 003371 617 003372 618 003373 619 003400 620 003402 622 003421 627 003431 628 003433 630 003442 633 003443 638 003452 642 003453 644 003454 645 003456 646 003464 647 003465 649 003467 650 003513 651 003514 652 003515 653 003522 654 003525 656 003541 658 003546 662 003603 663 003605 664 003612 666 003641 667 003655 669 003662 670 003664 672 003665 675 003707 676 003721 677 003726 681 003727 683 003731 684 003733 685 003734 688 003735 690 003767 692 003773 693 004033 694 004035 695 004042 697 004047 699 004050 700 004100 701 004102 702 004107 704 004110 705 004153 706 004155 707 004162 710 004163 714 004165 717 004166 718 004171 720 004177 721 004201 723 004225 725 004226 727 004251 730 004256 732 004257 734 004261 735 004271 736 004306 737 004310 739 004311 740 004316 741 004334 742 004336 745 004337 746 004341 748 004343 749 004345 750 004346 752 004366 754 004367 755 004371 756 004372 765 004401 769 004405 770 004407 771 004411 772 004414 773 004437 777 004440 778 004441 779 004447 780 004454 781 004460 782 004462 784 004465 785 004467 788 004475 791 004523 796 004524 797 004535 798 004537 801 004573 806 004574 810 004575 811 004602 812 004604 815 004612 816 004635 820 004636 821 004637 826 004643 828 004644 830 004646 834 004662 837 004723 838 004725 839 004732 841 004733 842 004736 843 004743 844 004745 846 004746 848 004747 849 004764 854 004765 857 005010 858 005040 859 005042 860 005047 864 005050 896 005051 900 005070 901 005072 902 005074 903 005077 904 005100 905 005102 907 005103 909 005105 910 005130 912 005131 914 005150 915 005152 916 005156 917 005157 918 005161 919 005163 922 005164 923 005165 869 005166 871 005174 872 005177 874 005220 875 005221 876 005250 877 005302 880 005303 883 005305 886 005336 891 005434 ----------------------------------------------------------- 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