COMPILATION LISTING OF SEGMENT rtq_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phx. Az., Sys-M Compiled on: 07/28/87 1524.5 mst Tue Options: optimize map 1 /****^ ******************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* ******************************************** */ 6 7 8 /****^ HISTORY COMMENTS: 9* 1) change(87-05-28,TLNguyen), approve(87-05-28,MCR7692), 10* audit(87-07-15,Blair), install(87-07-28,MR12.1-1048): 11* convert read_tape_and_query (rtq) nonstandard subsystem to a standard 12* ssu_ subsystem. 13* 2) change(87-07-14,TLNguyen), approve(87-07-14,MCR7701), 14* audit(87-07-15,Blair), install(87-07-28,MR12.1-1048): 15* bug fixes. 16* 3) change(87-07-14,TLNguyen), approve(87-07-14,MCR7727), 17* audit(87-07-15,Blair), install(87-07-28,MR12.1-1048): 18* add two new requests: "eof" and "rif". 19* 4) change(87-07-28,TLNguyen), approve(87-07-28,PBF7701), 20* audit(87-07-28,Blair), install(87-07-28,MR12.1-1050): 21* PBF to ID1048: expand file names'declaration from char (32) to char 22* (168) and attach output description (specified by -ods) from char (64) to 23* char (200). 24* END HISTORY COMMENTS */ 25 26 rtq_: proc (); 27 28 /* formated by default */ 29 30 /* external entries */ 31 dcl bcd_to_ascii_ entry (bit (*), char (*)); 32 dcl comp_8_to_ascii_ entry (bit (*), char (*)); 33 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 34 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 35 dcl date_time_ entry (fixed bin (71), char (*)); 36 dcl ebcdic_to_ascii_ entry (char (*), char (*)); 37 dcl ebcdic8_to_ascii_ entry (bit (*), char (*)); 38 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); 39 dcl ioa_ entry options (variable); 40 dcl ioa_$rsnnl entry options (variable); 41 dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35)); 42 dcl iox_$close entry (ptr, fixed bin (35)); 43 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); 44 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); 45 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); 46 dcl iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 47 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 48 dcl iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 49 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 50 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 51 dcl ssu_$abort_line entry () options (variable); 52 dcl ssu_$abort_subsystem entry () options (variable); 53 dcl ssu_$arg_count entry (ptr, fixed bin); 54 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin); 55 dcl ssu_$get_subsystem_and_request_name entry (ptr) returns (char (72) var); 56 dcl ssu_$print_message entry () options (variable); 57 58 /* condition */ 59 dcl (cleanup, conversion, program_interrupt) condition; 60 61 /* builtin */ 62 dcl (addr, addrel, bin, char, currentsize, divide, fixed, hbound, index, length, ltrim, mod, null, rtrim, 63 revert, search, substr, translate, unspec) builtin; 64 65 /* automatic storage */ 66 dcl BINARY_MODE fixed bin static options (constant) init (1); 67 dcl LABEL (0:6) char (9) int static options (constant) init 68 ("unlabeled", "Multics", "Multics", "GCOS", "IBM", "ANSI", "CP5"); 69 dcl NL char (1) int static options (constant) init (" 70 "); 71 dcl NINE_MODE fixed bin static options (constant) init (3); 72 dcl NUMB_OF_CHARS_PER_WORD fixed bin static options (constant) init (4); 73 dcl YES_FLG bit (1) aligned; 74 dcl Nargs fixed bin; /* number of input arguments */ 75 dcl al fixed bin; /* argument length */ 76 dcl ansid bit (1) aligned; /* ANSI db format */ 77 dcl ansi_mode fixed bin; /* ANSI mode */ 78 dcl ap ptr; /* argument pointer */ 79 dcl arg_dex fixed bin; 80 dcl att_desc char (200); /* 168 chars for pathname + 32 chars for "vfile_ " */ 81 dcl attach_desc_output char (200) varying; 82 dcl bcnt fixed bin (24); /* block count */ 83 dcl binck bit (1) aligned; /* binary card */ 84 dcl blocksize fixed bin (35); /* block size */ 85 dcl (c_b_a, 86 c_c_a, 87 c_e_a, 88 cont, 89 cp5) bit (1) aligned; /* convert bcd; comp8; ebcdic; continuing ; cp5 */ 90 dcl code fixed bin (35); 91 dcl dec_sw bit (1) aligned; /* DEC switch */ 92 dcl direction bit (1) aligned; 93 dcl eoj_card char (14) static options (constant) init 94 ("$ endjob 95 "); 96 dcl first_record_flg bit (1) aligned; 97 dcl g_label bit (72) int static options (constant) init /* = "ge 600 btl " in bcd */ 98 ("272520200600002022634320"b3); 99 dcl gssf bit (1) aligned; /* Gcos standard system format */ 100 dcl (i, j) fixed bin; /* indices */ 101 dcl ibm_label fixed bin int static options (constant) init (4); 102 dcl ibmv bit (1) aligned; /* IBM vb format */ 103 dcl imcv bit (1) aligned; /* suffix name of $ snumb card in Gcos standard format */ 104 dcl it_cnt fixed bin; /* count it */ 105 dcl iterations fixed bin (35); 106 dcl l_cnt fixed bin (35); /* loop count */ 107 dcl l_rec bit (1) aligned; /* logical record */ 108 dcl l_rec_len fixed bin (35); /* logical record length */ 109 dcl last_record_flg bit (1) aligned; 110 dcl lrp ptr; /* logical record pointer */ 111 dcl mode (3) char (7) int static options (constant) init 112 ("binary", "bcd", "nine"); 113 dcl mssf bit (1) aligned; /* Multics standard system format */ 114 dcl nchars fixed bin (21); /* number of characters */ 115 dcl nnl_sw bit (1) aligned; /* no new line switch */ 116 dcl n_ops fixed bin; /* number of operations */ 117 dcl nunits fixed bin (35); /* number of units */ 118 dcl nwds fixed bin (35); /* number of words to dump */ 119 dcl open_mode fixed bin; 120 dcl order char (16); 121 dcl pname char (19) int static options (constant) init 122 ("read_tape_and_query"); 123 dcl rf bit (1) aligned; /* file requests (e.g. bsf, fsf) */ 124 dcl rpt bit (1) aligned; /* space requests (e.g. bsf, bsr, fsf, fsr) */ 125 dcl rtq_info_ptr ptr; 126 dcl s_filename char (32) varying; /* source file name */ 127 dcl save_status_code fixed bin (35); 128 dcl sci_ptr ptr; 129 dcl scode fixed bin (35); 130 dcl schar fixed bin (35); /* skip characters */ 131 dcl spill fixed bin (21); 132 dcl status_story char (100) varying; 133 dcl t_stat bit (12) aligned; /* tape status */ 134 dcl temp_logical_rec_len fixed bin (21); 135 dcl time_string char (24); 136 dcl tr_cnt fixed bin (35); /* truncate count */ 137 dcl trim_trailing_blanks_log_rec_len fixed bin (21); 138 dcl trunc_sw bit (1) aligned; /* truncate switch */ 139 dcl who_asked char (32) varying; 140 141 /* external static */ 142 dcl (error_table_$end_of_info, 143 error_table_$not_closed, 144 error_table_$not_detached, 145 error_table_$tape_error) fixed bin (35) ext; 146 147 dcl iox_$user_output ptr ext; 148 dcl sys_info$max_seg_size fixed bin (35) ext static; 149 dcl tape_status_table_$tape_status_table_ ext static; 150 151 /* based */ 152 dcl 1 ansi_db_lrec based (rtq_info.rptr) unaligned, /* template for ansi "DB" formated records */ 153 2 lrl char (4), /* log rec length in ascii chars */ 154 2 alrd char (l_rec_len), /* log rec data */ 155 2 nxt_lrec bit (0); /* to get to nxt record */ 156 157 dcl 1 conv_buf based (lrp), /* conversion buffer, no logical records */ 158 2 skip_char char (schar), /* characters to skip */ 159 2 conv_dta char (rtq_info.rec_len - schar + 1); /* good char data */ 160 161 dcl 1 cp5_phy_rec based (rtq_info.tptr) aligned, /* cp5 standard tape record */ 162 ( 2 pbs fixed bin (18) unsigned, /* previous block size */ 163 2 nky fixed bin (18) unsigned, /* number of log records in this block */ 164 2 first bit (1)) unaligned;/* to get to first log record */ 165 166 dcl 1 cp5_log_rec based (rtq_info.rptr) aligned, /* cp5 variable logical record */ 167 ( 2 pad1 bit (36), /* not used - yet */ 168 2 pad2 fixed bin, /* ditto */ 169 2 rlen fixed bin (18) unsigned, /* size of record in bytes */ 170 2 cp5_log_rec_data char (1 refer (cp5_log_rec.rlen))) unaligned; /* data bytes in EBCDIC */ 171 172 dcl 1 dec_mult (it_cnt) based (lrp) aligned, /* convert DEC to Multics word */ 173 ( 2 first_32 bit (32), /* first 32 bits */ 174 2 last_4 bit (4)) unaligned;/* last four bits */ 175 176 dcl 1 dec_tape_raw based (rtq_info.tptr) aligned, /* strange format for DEC tape */ 177 2 ps_wd (it_cnt) unaligned,/* pseudo DEC word (40 bits) */ 178 3 first_32 bit (32), /* first 32 bits of word */ 179 3 pad bit (4), /* next 4 bits ignored */ 180 3 last_4 bit (4); /* last 4 bits */ 181 182 dcl 1 ibm_log_rec based (rtq_info.rptr) unaligned, /* IBM VB log record */ 183 2 rdw, /* record data word */ 184 3 pad1 bit (1), 185 3 msl bit (8), /* most sign. 8 bits of length */ 186 3 pad2 bit (1), 187 3 lsl bit (8), /* least sign. 8 bits of length */ 188 3 pad3 bit (18), 189 2 ilrd char (l_rec_len), /* ebcdic data */ 190 2 nxt_lrec bit (0); /* to get to nxt log record */ 191 192 dcl 1 ibm_phy_rec based (rtq_info.tptr) aligned, /* IBM VB phy record */ 193 ( 2 bdw, /* block data word */ 194 3 pad1 bit (1), 195 3 msl bit (8), /* most sign. 8 bits of length */ 196 3 pad2 bit (1), 197 3 lsl bit (8), /* least sign. 8 bits of length */ 198 3 pad3 bit (18), 199 2 iprd char (blocksize - 4)) unaligned; 200 201 dcl 1 lrec_cbuf based (lrp), /* logical record template */ 202 2 skip_char char (schar), 203 2 chcv_buf (it_cnt) char (l_rec_len); 204 205 dcl 1 mult based (rtq_info.tptr) unaligned, 206 2 lab_id bit (36), /* this will be 670314355245 in octal */ 207 2 pad (7) bit (36), /* we ignore this */ 208 2 vol_info like volume_identifier; /* mstr.incl.pl1 must be included */ 209 210 dcl 1 gcos based (rtq_info.tptr) unaligned, 211 2 lab_id bit (72), /* this will be "GE 600 BTL " in bcd */ 212 2 pad bit (36), /* we ignore this */ 213 2 vol_id bit (36); /* this is in bcd */ 214 215 dcl 1 ibm_ansi based (rtq_info.tptr) unaligned, /* IBM or ANSI label structure */ 216 2 lab_id bit (32), /* this will be "VOL1" in ebcdic or 8 bit ascii */ 217 2 vol_id bit (48); /* this is in ebcdic or 8 bit ascii */ 218 219 dcl 1 cp5_lab based (rtq_info.tptr) unaligned, /* CP5 label structure */ 220 2 lab_id bit (32), /* This will be ":LBL" in 8 bit ebcdic */ 221 2 vol_id bit (32); /* this is 8 bit ebcdic */ 222 223 dcl arg char (al) based (ap); 224 225 dcl bit_buf bit (rtq_info.bits) based (rtq_info.tptr); /* tape buffer in bits pointed by tape pointer */ 226 227 dcl char_buf char (rtq_info.rec_len) based (rtq_info.tptr); /* tape buffer in characters pointed by tape pointer */ 228 229 dcl cdkbuf char (136) based (rtq_info.cdkp); 230 231 dcl cbuf char (rtq_info.buf_size) based (rtq_info.cbufp); 232 233 dcl cv_buf char (rtq_info.cvbl) based (rtq_info.cvbp); 234 235 dcl gssf_ascii char (gc_log_rec.rcw.rsize * 4) based (rtq_info.cvp); 236 237 dcl lab_buf char (rtq_info.rec_len) based (rtq_info.lblp); 238 239 dcl mult_move char (rtq_info.clen) based; 240 241 dcl 1 rtq_info aligned like rtq_structure_info based (rtq_info_ptr); 242 243 dcl rtq_area area based (rtq_info.rtq_area_ptr); 244 245 dcl sentinel char (4) based (rtq_info.lblp); 246 247 /* like statement */ 248 dcl 1 ai like area_info aligned; 249 250 /***************************************************************************/ 251 252 set_up: entry (sci_ptr, rtq_info_ptr, code); 253 254 /* initiate variables and area info block. Establish */ 255 /* cleanup and program_interrupt conditions. Get an area and save its */ 256 /* pointer. Get temporary segments for rtq subsubsystem. Attach and */ 257 /* open tape using the "tape_nstd_" i/o module. Set conversion buffer */ 258 /* to maximum size. Determine an user's density. If the density is */ 259 /* valid then report to an user and determine the tape types. Report */ 260 /* the tape type to users. Invoke "check_mode" internal procedure if */ 261 /* the tape type is either IBM label or ANSI label. Perform the */ 262 /* "forward_record" control order to the HDR2 label record and read it */ 263 /* in by invoking "read_tape_record" internal procedure. Check the */ 264 /* input/output eof argument value. If not end of file then report to */ 265 /* users and invoke the "valid_label_record". Report to user, perform */ 266 /* the "forward_file" control order and return. If end of file */ 267 /* encountered, report to users, perform the "rewind" control order and */ 268 /* return. If the given density is invalid then set the density to the */ 269 /* default density, report to users, and return. */ 270 271 /* constant */ 272 dcl NUMB_OF_BITS_PER_BYTE fixed bin static options (constant) init (9); 273 dcl NUMB_OF_BYTES_PER_WORD fixed bin static options (constant) init (4); 274 dcl CP5_label bit (32) int static options (constant) init /* ":LBL" in 8 bit ebcdic */ 275 ("72D3C2D3"b4); 276 277 dcl a_label bit (32) int static options (constant) init /* "VOL1" in 8 bit ascii (ansi stand label) */ 278 ("564F4C31"b4); 279 280 dcl ansi_label fixed bin int static options (constant) init (5); 281 dcl cp5_label fixed bin int static options (constant) init (6); 282 dcl i_label bit (32) int static options (constant) init /* "VOL1" in 8 bit ebcdic (ibm stand label) */ 283 ("E5D6D3F1"b4); 284 285 dcl (v1_mult_label init (1), 286 v3_mult_label init (2)) fixed bin int static options (constant); 287 288 /* automatic storage */ 289 dcl get_line_length fixed bin; 290 dcl rcd_volid char (32); 291 dcl terminate_read_sw bit (1); 292 293 /* base */ 294 dcl blab (0:15) bit (9) unaligned based (addr (rcd_volid)); 295 296 /* external entry */ 297 dcl define_area_ entry (ptr, fixed bin (35)); 298 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); 299 dcl get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin); 300 301 302 /* begin coding */ 303 mssf = "0"b; /* initialize Multics standard system format flag */ 304 rcd_volid = ""; 305 unspec (ai) = "0"b; /* clear out area info */ 306 ai.version = area_info_version_1; /* set up area info block */ 307 ai.control.extend = "1"b; 308 ai.control.zero_on_alloc = "1"b; 309 ai.owner = pname; 310 ai.size = sys_info$max_seg_size; 311 ai.version_of_area = area_info_version_1; 312 ai.areap = null; 313 314 /* set up clean up handler */ 315 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 316 317 /* establish program_interrupt (pi) handler */ 318 on program_interrupt goto SET_UP_EXIT; 319 320 /* find terminal line length */ 321 get_line_length = get_line_length_$switch (null, scode); 322 if get_line_length < 118 & scode = 0 then 323 rtq_info.short_output_flg = "1"b; /* set short output switch */ 324 else rtq_info.short_output_flg = "0"b; /* otherwise long output */ 325 326 /* get an area */ 327 call define_area_ (addr (ai), code); 328 if code ^= 0 then do; 329 call ssu_$print_message (sci_ptr, code, "Cannot define an area"); 330 return; 331 end; 332 333 rtq_info.rtq_area_ptr = ai.areap; 334 335 /* get a temporary segment for our tape buffer */ 336 call get_temp_segment_ (pname, rtq_info.tptr, code); 337 if code ^= 0 then do; /* can't alocate buffer */ 338 call ssu_$print_message (sci_ptr, code, "Getting temporary tape buffer segment"); 339 call detach_tape_file (sci_ptr, rtq_info_ptr); 340 return; 341 end; 342 343 344 /* allocate intermediate buffers */ 345 allocate cv_buf in (rtq_area); 346 allocate cdkbuf in (rtq_area); 347 allocate cbuf in (rtq_area); 348 349 /* attach and open tape using the "tape_nstd_" io module */ 350 TRY_AGAIN: 351 call iox_$attach_name ("tape_sw", rtq_info.tiocb_ptr, (rtq_info.tape_atd), null, code); 352 if code ^= 0 then do; 353 if code = error_table_$not_detached then do; 354 call iox_$detach_iocb (rtq_info.tiocb_ptr, code); 355 if code ^= error_table_$not_closed then do; 356 call ssu_$print_message (sci_ptr, code); 357 return; 358 end; 359 else do; 360 call iox_$close (rtq_info.tiocb_ptr, (0)); 361 goto TRY_AGAIN; 362 end; 363 end; 364 else do; 365 call ssu_$print_message (sci_ptr, code, "^/ Attempting to attach tape."); 366 call detach_tape_file (sci_ptr, rtq_info_ptr); /* go cleanup */ 367 return; 368 end; 369 end; 370 371 call iox_$open (rtq_info.tiocb_ptr, Sequential_input, "0"b, code); /* open for seq. input */ 372 if code ^= 0 then do; 373 call ssu_$print_message (sci_ptr, code, "^/Opening tape for sequential input"); 374 call detach_tape_file (sci_ptr, rtq_info_ptr); 375 return; 376 end; 377 378 /* set conversion buffer to max size */ 379 rtq_info.cvbl = divide (rtq_info.buf_size * NUMB_OF_BITS_PER_BYTE, NUMB_OF_BYTES_PER_WORD, 21, 0); 380 381 /* loop through the array index from 1 to 5 to find the matched density value if an user specifies a density value */ 382 j = hbound (rtq_info.density, 1); 383 terminate_read_sw = "0"b; 384 do i = 1 to j while (^terminate_read_sw); 385 call iox_$control (rtq_info.tiocb_ptr, (rtq_info.density (i)), null, scode); 386 if scode = 0 then do; 387 call iox_$read_record (rtq_info.tiocb_ptr, rtq_info.tptr, rtq_info.buf_size, rtq_info.rec_len, code); 388 if code ^= error_table_$tape_error then do; /* if some other type of error, then warn users */ 389 if (code ^= 0) & (code ^= error_table_$end_of_info) then 390 call ssu_$print_message (sci_ptr, code, "^/Attempting to determine density of tape volume ^a", rtq_info.tape_name); 391 392 terminate_read_sw = "1"b;/* set terminate condition */ 393 end; 394 call iox_$control (rtq_info.tiocb_ptr, "rewind", null, scode); 395 end; /* scode = 0 */ 396 end; /* do i = 1 to 5 */ 397 398 /* use the default density if could not find the valid density; otherwise, get it */ 399 rtq_info.tmr = terminate_read_sw; 400 401 if ^rtq_info.tmr | (code ^= 0 & code ^= error_table_$end_of_info) then do; 402 if rtq_info.ddec ^= 0 then rtq_info.c_den = "d" || ltrim (char (rtq_info.ddec)); /* if density was specified.. */ 403 else rtq_info.c_den = rtq_info.density (1); /* otherwise use default */ 404 /* perform a density control order on an i/o switch */ 405 call iox_$control (rtq_info.tiocb_ptr, (rtq_info.c_den), null, scode); 406 /* display a warning message */ 407 call ssu_$print_message (sci_ptr, 0, 408 "Unable to determine density of tape volume ^a.^/ Density is currently set to ^a (bpi).", 409 rtq_info.tape_name, substr (rtq_info.c_den, 2)); 410 411 code = 0; 412 scode = 0; /* since it is not an error, so want to continue */ 413 end; 414 415 /* report the density to users and determine the tape label types */ 416 else do; 417 rtq_info.c_den = rtq_info.density (i - 1); /* save current density */ 418 419 call ioa_ ("Tape density is ^a bpi", substr (rtq_info.density (i - 1), 2)); 420 421 call determine_tape_label_types; 422 423 if rtq_info.return_subsys_loop_flg then do; 424 rtq_info.return_subsys_loop_flg = "0"b; 425 return; 426 end; 427 end; 428 429 SET_UP_EXIT: 430 431 return; 432 433 434 /***************************************************************************/ 435 436 bof_request: entry (sci_ptr, rtq_info_ptr); 437 438 /* Establish cleanup and program_interrupt conditions. Invoke the */ 439 /* "ssu_$arg_count" standard system subroutine. Print out an usage */ 440 /* message if users specify any control arguments. Invoke the */ 441 /* "process_control_order" internal procedure to the beginning of the file */ 442 443 /* begin coding */ 444 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 445 446 on program_interrupt goto BOF_EXIT; 447 448 call ssu_$arg_count (sci_ptr, Nargs); 449 if Nargs ^= 0 then do; 450 call ssu_$print_message (sci_ptr, 0, "Usage: bof"); 451 return; 452 end; 453 454 /* initialization */ 455 scode = 0; 456 l_cnt = 1; 457 rf, rpt = "1"b; 458 direction = "0"b; 459 order = "begin_file"; 460 461 /* process control order */ 462 call process_control_order (order, rpt, direction, rf, l_cnt); 463 464 BOF_EXIT: 465 return; 466 467 /***************************************************************************/ 468 469 bsf_request: entry (sci_ptr, rtq_info_ptr); 470 471 /* Establish cleanup and program_interrupt handlers. Invoke the */ 472 /* "ssu_$arg_count" standard system subroutine. Print out an usage */ 473 /* message if users specify two or more control arguments. */ 474 /* Process the specified control argument. Invoke the */ 475 /* "process_control_order" internal procedure to backspace N files. */ 476 /* The default is to backspace 1 file. */ 477 478 /* begin coding */ 479 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 480 481 on program_interrupt goto BSF_EXIT; 482 483 /* initialization */ 484 l_cnt = 1; 485 scode = 0; 486 rf, rpt = "1"b; 487 direction = "0"b; 488 order = "backspace_file"; 489 490 /* find number of input arguments */ 491 call ssu_$arg_count (sci_ptr, Nargs); 492 if Nargs >= 2 then do; 493 ERROR_BSF: 494 call ssu_$print_message (sci_ptr, scode, "^/ Usage: bsf {n}"); 495 return; 496 end; 497 498 /* then validate them */ 499 do arg_dex = 1 to Nargs; 500 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 501 l_cnt = cv_dec_check_ (arg, scode); 502 if scode ^= 0 then goto ERROR_BSF; 503 end; 504 505 /* go process control order */ 506 call process_control_order (order, rpt, direction, rf, l_cnt); 507 508 /* must reset the flag fields of the "rtq_info" structure before returning to rtq request loop */ 509 rtq_info.eof, rtq_info.eov, rtq_info.one_eof, rtq_info.two_eofs = "0"b; 510 511 BSF_EXIT: 512 return; 513 514 /***************************************************************************/ 515 516 bsr_request: entry (sci_ptr, rtq_info_ptr); 517 518 /* Establish cleanup and program_interrupt handlers. Invoke the */ 519 /* "ssu_$arg_count" standard system subroutine. Print out an usage */ 520 /* message if users specify two or more 2 control arguments. */ 521 /* Process the specified control argument. Invoke the */ 522 /* "process_control_order" internal procedure to backspace N records. */ 523 /* The default is to backspace 1 record. */ 524 525 /* begin coding */ 526 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 527 528 on program_interrupt goto BSR_EXIT; 529 530 /* initialization */ 531 l_cnt = 1; 532 scode = 0; 533 rpt = "1"b; 534 rf, direction = "0"b; 535 order = "backspace_record"; 536 537 /* find number of input arguments */ 538 call ssu_$arg_count (sci_ptr, Nargs); 539 if Nargs >= 2 then do; 540 ERROR_BSR: 541 call ssu_$print_message (sci_ptr, scode, "Usage: bsr {N}"); 542 return; 543 end; 544 545 /* then validate them */ 546 do arg_dex = 1 to Nargs; 547 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 548 l_cnt = cv_dec_check_ (arg, scode); 549 if scode ^= 0 then goto ERROR_BSR; 550 else ; 551 end; 552 553 /* go process control order */ 554 call process_control_order (order, rpt, direction, rf, l_cnt); 555 556 BSR_EXIT: 557 return; 558 559 /***************************************************************************/ 560 561 562 density_request: entry (sci_ptr, rtq_info_ptr); 563 564 /* Establish cleanup and program_interrupt handlers. Invoke the */ 565 /* "ssu_$arg_count" standard system subroutine. Print out an usage */ 566 /* message if users specify no CA or two or more control arguments. */ 567 /* Validate the control argument which is the density. Display an usage */ 568 /* message for the invalid density. Otherwise, invoke the */ 569 /* "process_control_order" internal procedure to perform the specified */ 570 /* density control order. */ 571 572 573 dcl array_index fixed bin; 574 dcl match bit (1) aligned; 575 576 /* begin coding */ 577 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 578 579 on program_interrupt goto DENSITY_EXIT; 580 581 /* initialization */ 582 l_cnt = 1; 583 match = "0"b; 584 scode = 0; 585 rpt, rf, direction = "0"b; /* reset command flags */ 586 587 /* find the number of input arguments */ 588 call ssu_$arg_count (sci_ptr, Nargs); 589 if Nargs = 0 | Nargs >= 2 then do; 590 ERROR_DENSITY: 591 call ssu_$print_message (sci_ptr, scode, "Usage: density (den) <6250 | 1600 | 800 | 556 | 200>"); 592 return; 593 end; 594 595 /* then validate the tape density */ 596 call ssu_$arg_ptr (sci_ptr, Nargs, ap, al); 597 do array_index = 1 to 5 while (^match); 598 if arg = substr (rtq_info.density (array_index), 2, 4) then 599 match = "1"b; 600 end; 601 if ^match then 602 goto ERROR_DENSITY; 603 else do; 604 rtq_info.ddec = cv_dec_check_ (arg, scode); 605 if scode ^= 0 then goto ERROR_DENSITY; 606 else rtq_info.c_den, order = "d" || ltrim (char (rtq_info.ddec)); 607 end; 608 609 /* go process control order */ 610 call process_control_order (order, rpt, direction, rf, l_cnt); 611 612 DENSITY_EXIT: 613 614 return; 615 616 /***************************************************************************/ 617 618 dot_request: entry (sci_ptr, rtq_info_ptr); 619 620 /* displays the request name read_tape_and_query with its short name, rtq, */ 621 /* in parentheses. */ 622 623 /* begin coding */ 624 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 625 626 on program_interrupt goto RETURNS_TO_SUBSYS; 627 628 /* find number of input arguments */ 629 call ssu_$arg_count (sci_ptr, Nargs); 630 if Nargs ^= 0 then do; 631 call ssu_$print_message (sci_ptr, 0, "No argument is allowed for this request."); 632 return; 633 end; 634 635 /* response to user's request */ 636 call ioa_ ("read_tape_and_query (rtq): Reading tape volume ""^a"" in ""^a"" mode.^/ Currently positioned to Physical file ^d, record ^d.", 637 rtq_info.tape_name, mode (rtq_info.c_mode), rtq_info.c_file, rtq_info.c_rec); 638 639 RETURNS_TO_SUBSYS: 640 641 return; 642 643 /***************************************************************************/ 644 645 dump_record_request: entry (sci_ptr, rtq_info_ptr); 646 647 /* Establish cleanup and program_interrupt handlers. Initialize */ 648 /* intermediate variables. Get optional control arguments and process */ 649 /* them by invoking the "set_dump_fmt" internal procedure. */ 650 /* Dump the tape record in the requested format by invoking the */ 651 /* "dump_segment_" standard system subroutine. */ 652 653 /* external entry */ 654 dcl dump_segment_ entry (ptr, ptr, fixed bin, fixed bin (35), fixed bin (35), bit (*)); 655 656 /* automatic storage */ 657 dcl NUMB_OF_BITS_PER_CHAR fixed bin static options (constant) init (9); 658 dcl NUMB_OF_BITS_PER_WORD fixed bin static options (constant) init (36); 659 dcl doffset fixed bin; /* dump off set */ 660 dcl dump_index fixed bin; 661 dcl format (4) bit (11); 662 dcl n_words_specified_flg bit (1) aligned; 663 dcl ndumps fixed bin; /* number of dumps */ 664 dcl offset_specified_flg bit (1) aligned; 665 666 /* begin coding */ 667 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 668 669 on program_interrupt goto WANTS_TO_EXIT; 670 671 /* validate data */ 672 if ^rtq_info.buf_ful then do; /* we don't have any data yet */ 673 call ssu_$print_message (sci_ptr, 0, "Record buffer empty"); 674 return; 675 end; 676 677 /* set up for dump request */ 678 scode = 0; 679 ndumps = 1; /* set defaults first (entire buffer in octal format) */ 680 doffset = 0; 681 format (1) = "01000000000"b; 682 nwds = divide (rtq_info.rec_len * NUMB_OF_BITS_PER_CHAR + 35, NUMB_OF_BITS_PER_WORD, 35, 0); 683 offset_specified_flg, n_words_specified_flg = "0"b; 684 685 /* find number of arguments */ 686 call ssu_$arg_count (sci_ptr, Nargs); 687 688 /* then validate them */ 689 do arg_dex = 1 to Nargs; /* user specifies some input args */ 690 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al);/* process each argument */ 691 if substr (arg, 1, 1) ^= "-" then do; /* some number spec */ 692 693 if ^offset_specified_flg then do; /* offset spec must be first */ 694 offset_specified_flg = "1"b; /* set switch so we don't come back */ 695 doffset = cv_oct_check_ (arg, scode); /* convert ascii to oct */ 696 if scode ^= 0 then do; 697 ERROR_DUMP: 698 call ssu_$print_message (sci_ptr, scode, 699 "^/ Usage: dump {offset (oct)} {n_words (oct)} {-bcd} {-ascii} {-ebcdic} {-hex}"); 700 return; 701 end; 702 703 nwds = nwds - doffset; /* correct number of words to dump */ 704 end; /* if ^offset_specified_flg then do */ 705 706 else if ^n_words_specified_flg then do; /* user wants to specify number of words */ 707 n_words_specified_flg = "1"b; /* set switch so we won't be back */ 708 nwds = cv_oct_check_ (arg, scode); 709 if scode ^= 0 then goto ERROR_DUMP; /* tell user what to do, he goofed */ 710 end; /* else if ^n_words_specified_flg */ 711 712 else goto ERROR_DUMP; /* ditto */ 713 end; /* if substr (arg, 1, 1) ^= "-" */ 714 715 else if arg = "-bcd" then /* requesting bcd dump */ 716 call set_dump_fmt ("01010000000"b); 717 718 else if arg = "-ascii" then /* user requesting ascii dump */ 719 call set_dump_fmt ("01001000000"b); 720 721 else if arg = "-ebcdic" then do; /* user wants ebcdic dump */ 722 if rtq_info.c_mode = 3 then /* if in 9 bit mode */ 723 call set_dump_fmt ("01000010000"b); 724 else call set_dump_fmt ("01000001000"b); /* else 8 bit mode */ 725 end; 726 727 else if arg = "-hex" then do; /* user wants hex dump */ 728 if rtq_info.c_mode = 3 then /* if in 9 bit mode */ 729 call set_dump_fmt ("01000000001"b); 730 else call set_dump_fmt ("01000000010"b); /* else 8 bit mode */ 731 end; 732 733 else goto ERROR_DUMP; /* user goofed tell him how to use dump request */ 734 end; /* do arg_dex = 1 to Nargs */ 735 736 if ndumps > 1 then ndumps = ndumps - 1; /* correct number of dumps */ 737 738 do dump_index = 1 to ndumps; /* dump requested number of formats */ 739 call ioa_ (" "); 740 call dump_segment_ (iox_$user_output, addrel (rtq_info.tptr, doffset), 0, 0, nwds, format (dump_index)); 741 end; 742 743 WANTS_TO_EXIT: 744 745 return; 746 747 748 749 set_dump_fmt: proc (fmt); 750 751 /* sets dump type */ 752 753 dcl fmt bit (11); 754 755 /* begin coding */ 756 format (ndumps) = fmt; /* set desired format */ 757 ndumps = ndumps + 1; /* increment number of dumps to do */ 758 759 if ndumps > (hbound (format, 1) + 1) then /* user wants to many */ 760 goto ERROR_DUMP; /* tell him what he can do */ 761 762 end set_dump_fmt; 763 764 /***************************************************************************/ 765 766 eof_request: entry (sci_ptr, rtq_info_ptr); 767 768 /* positions to the end of the current physical tape file, after the last */ 769 /* record. Establish cleanup and program_interrupt handlers. No */ 770 /* optional control arguments are allowed. Perform "forward_record" */ 771 /* control orders until end of file encountered. Note that the current */ 772 /* record is incremented by one until end of file reached. */ 773 /* Then perform "backspace_record" order to position before end of file */ 774 /* mark since the last forward record order positioned the tape after end */ 775 /* of file mark. Report to users after the request is successfully done. */ 776 777 /* begin coding */ 778 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 779 780 on program_interrupt goto SUBSYSTEM_RETURNED; 781 782 /* display an error message if any optional control argument is specified */ 783 call ssu_$arg_count (sci_ptr, Nargs); 784 785 if Nargs ^= 0 then do; 786 call ssu_$print_message (sci_ptr, 0, "Usage: eof"); 787 return; 788 end; 789 790 /* initialization */ 791 rtq_info.eof_request_flg = "1"b; 792 scode = 0; 793 order = "forward_record"; 794 rpt = "1"b; 795 direction = "1"b; 796 rf = "0"b; 797 l_cnt = 1; 798 799 /* perform several "forward_record" orders until end of current file reached */ 800 do while (scode ^= error_table_$end_of_info); 801 call process_control_order (order, rpt, direction, rf, l_cnt); 802 803 if scode = 0 then 804 rtq_info.c_rec = rtq_info.c_rec + 1; /* to find the last record in the current file */ 805 806 if scode = error_table_$tape_error then do; /* exit loop if tape error occured */ 807 call ssu_$print_message (sci_ptr, scode, 808 "Attempting to perform ""forward_record"" order"); 809 rtq_info.eof_request_flg = "0"b; 810 return; 811 end; 812 end; 813 814 /* perform the "backspace_record" control order to position to the end of the current file */ 815 direction = "0"b; /* must reset intermediate variables */ 816 rpt = "0"b; 817 rf = "0"b; 818 l_cnt = 1; 819 order = "backspace_record"; 820 821 call process_control_order (order, rpt, direction, rf, l_cnt); 822 823 /* report to users after the "eof" request is successfully done */ 824 if rtq_info.c_rec = 1 then 825 /* case of an empty file or a file has no data record */ 826 call ssu_$print_message (sci_ptr, 0, 827 "Positioned the tape to the beginning of the current file # ^d which has no data record.", rtq_info.c_file); 828 829 /* case of a file contains 1 data record or more */ 830 else call ssu_$print_message (sci_ptr, 0, 831 "Positioned the tape to the end of the current file # ^d, after the last record # ^d.", 832 rtq_info.c_file, rtq_info.c_rec - 1); 833 834 rtq_info.one_eof = "0"b; /* must reset these flags before returning to rtq request loop */ 835 rtq_info.eof_request_flg = "0"b; 836 837 SUBSYSTEM_RETURNED: 838 return; 839 840 /****************************************************************************/ 841 842 fsf_request: entry (sci_ptr, rtq_info_ptr); 843 844 /* Establish cleanup and program_interrupt handlers. Invoke the */ 845 /* "ssu_$arg_count" standard system subroutine. Print out an usage */ 846 /* message if users specify at least 2 control arguments. */ 847 /* Process the specified control argument. Invoke the */ 848 /* "process_control_order" internal procedure to forward space N files. */ 849 /* The default is to forward space 1 file. */ 850 851 /* begin coding */ 852 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 853 854 on program_interrupt goto RETURNS_TO_REQUEST_LOOP; 855 856 /* initialization */ 857 scode = 0; 858 l_cnt = 1; 859 direction, rpt, rf = "1"b; 860 order = "forward_file"; 861 862 /* find number of input arguments */ 863 call ssu_$arg_count (sci_ptr, Nargs); 864 if Nargs >= 2 then do; 865 ERROR_FSF: 866 call ssu_$print_message (sci_ptr, scode, "Usage: fsf {N}"); 867 return; 868 end; 869 870 /* then validate them */ 871 do arg_dex = 1 to Nargs; 872 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 873 l_cnt = cv_dec_check_ (arg, scode); 874 if scode ^= 0 then goto ERROR_FSF; 875 else ; 876 end; 877 878 /* go process control order */ 879 call process_control_order (order, rpt, direction, rf, l_cnt); 880 881 RETURNS_TO_REQUEST_LOOP: 882 883 return; 884 885 /*****************************************************************************/ 886 887 fsr_request: entry (sci_ptr, rtq_info_ptr); 888 889 /* Establish cleanup and program_interrupt handlers. Invoke the */ 890 /* "ssu_$arg_count" standard system subroutine. Print out an usage */ 891 /* message if users specify more than one control arguments. */ 892 /* Process the specified control argument. Invoke the */ 893 /* "process_control_order" internal procedure to forward space N record. */ 894 /* The default is to forward space 1 record. */ 895 896 /* begin coding */ 897 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); /* set up clean up handler */ 898 899 on program_interrupt goto FSR_RETURN; 900 901 /* initialization */ 902 scode = 0; 903 l_cnt = 1; 904 direction, rpt = "1"b; 905 rf = "0"b; 906 order = "forward_record"; 907 908 /* find number of input arguments */ 909 call ssu_$arg_count (sci_ptr, Nargs); 910 if Nargs >= 2 then do; 911 ERROR_FSR: 912 call ssu_$print_message (sci_ptr, scode, "Usage: fsr {N}"); 913 return; 914 end; 915 916 /* then validate them */ 917 do arg_dex = 1 to Nargs; 918 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 919 l_cnt = cv_dec_check_ (arg, scode); 920 if scode ^= 0 then goto ERROR_FSR; 921 else ; 922 end; 923 924 /* go process control order */ 925 call process_control_order (order, rpt, direction, rf, l_cnt); 926 927 FSR_RETURN: 928 return; 929 930 /*****************************************************************************/ 931 932 list_tape_contents: entry (sci_ptr, rtq_info_ptr); 933 934 /* Establish cleanup and program_interrupt handlers. Initialize both */ 935 /* intermediate global and local variables. Find terminal line length. */ 936 /* Get optional control arguments and process them. Position tape to the */ 937 /* beginning of tape if not already there. If the tape type is either */ 938 /* MULTICS or GCOS tape then set mode to binary mode. Set to nine mode for */ 939 /* IBM or ANSI tape. Report the mode to users. Read in each tape record in */ 940 /* the tape until end of tape is encountered: this can be done by invoking */ 941 /* the "read_tape_record" internal procedure. Set up nessary things if */ 942 /* want to return to subsystem request loop. If not end of file then if */ 943 /* this is the first record of the file then report the current file read to */ 944 /* users. Determine the record type. If the record read is not a label */ 945 /* record then if the record read is the first record of the file then */ 946 /* assign the number of bits to last record length, reset the number of */ 947 /* records to zero, and increment logical file number by one. Report to */ 948 /* users if tape type is a label tape or Multics tape. If the number of */ 949 /* bits of the record read is the same as the last record length then */ 950 /* increment the number of record by one. Otherwise, report to users. */ 951 /* If the record read is a nonlabel record then assign zero to the last */ 952 /* record length. If end of file is encountered then report to user, reset */ 953 /* record number and logical file flag and set up appropriate mode for the */ 954 /* next file to be read. When end of tape is encountered, perform the */ 955 /* "rewind" control order to the beginning of tape and then report to users. */ 956 957 dcl logical_file_num fixed bin; 958 dcl label_flg bit (1) aligned; 959 dcl last_length fixed bin; 960 dcl logical_file_flg bit (1) aligned; 961 dcl long_list_flg bit (1) aligned; 962 dcl nrecords fixed bin (35); 963 dcl unlabeled fixed bin int static options (constant) init (0); 964 965 /* begin coding */ 966 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 967 968 on program_interrupt goto SUBSYSTEM_REQUEST_LOOP; 969 970 /* clear global switches */ 971 scode = 0; 972 mssf = "0"b; 973 iterations = 1; /* set default iterations to 1 */ 974 rtq_info.eof, rtq_info.eov, rtq_info.one_eof, rtq_info.set_bin, rtq_info.set_nine, rtq_info.two_eofs = "0"b; 975 976 /* initialize local flags and variables */ 977 long_list_flg, label_flg, logical_file_flg = "0"b; 978 logical_file_num, last_length, nrecords = 0; 979 980 /* find number of input arguments */ 981 call ssu_$arg_count (sci_ptr, Nargs); 982 983 /* process optional control arguments */ 984 do arg_dex = 1 to Nargs; 985 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al);/* process them */ 986 987 if arg = "-long" | arg = "-lg" then long_list_flg = "1"b; /* user wants long list */ 988 989 else if arg = "-label" | arg = "-lbl" then 990 if rtq_info.l_type = unlabeled then do; /* illegal on unlabeled tapes */ 991 call ssu_$print_message (sci_ptr, 0, """-label"" argument not allowed on unlabeled tapes"); 992 return; 993 end; 994 else label_flg = "1"b; /* user only wants label rcds */ 995 996 else do; 997 call ssu_$print_message (sci_ptr, 0, "Usage: list_tape_contents (ltc) {-long (-lg)} {-label (-lbl)}"); 998 return; 999 end; 1000 end; /* do arg_dex = 1 to Nargs */ 1001 1002 /* position to bot if not already there */ 1003 if rtq_info.c_rec ^= 1 | rtq_info.c_file ^= 1 then 1004 call process_control_order ("rewind", "0"b, "0"b, "0"b, 1); 1005 else ; 1006 1007 /* for Multics or Gcos tape, set to binary mode */ 1008 if rtq_info.l_type > 0 & rtq_info.l_type <= 3 then 1009 call check_mode (BINARY_MODE); 1010 1011 /* for IBM or ANSI tape, set to nine mode */ 1012 else if rtq_info.l_type > 3 then 1013 call check_mode (NINE_MODE); 1014 1015 /* report to users */ 1016 call ioa_ ("Listing tape contents of tape volume ^a in ^a mode.^/ Starting at BOT (physical file# 1, record# 1)^/ ", 1017 rtq_info.tape_name, mode (rtq_info.c_mode)); 1018 1019 /* read until the end of tape is encountered */ 1020 do while (^rtq_info.two_eofs); 1021 call read_tape_record ("skip", rtq_info.eof, "1"b, mssf); /* read next record */ 1022 1023 if rtq_info.return_subsys_loop_flg then do; 1024 rtq_info.return_subsys_loop_flg = "0"b; 1025 revert cleanup; 1026 call ssu_$abort_line (sci_ptr); 1027 end; 1028 1029 if ^rtq_info.eof then do; /* if not end of file */ 1030 1031 if rtq_info.c_rec = 2 then /* if first record of this file */ 1032 call ioa_ ("Physical tape file # ^d.", rtq_info.c_file); 1033 1034 if ^valid_label_record (long_list_flg) then do; /* and not label record */ 1035 1036 if rtq_info.c_rec = 2 then do; /* if this is first record of file */ 1037 last_length = rtq_info.bits; /* set for equal record processing */ 1038 nrecords = 0; 1039 logical_file_num = logical_file_num + 1; /* increment logical file number */ 1040 1041 if rtq_info.l_type > 1 then do; /* if not unlabeled or Multics tape */ 1042 call ioa_ ("Logical tape file # ^d.^[^/ ^]", logical_file_num, ^label_flg); 1043 logical_file_flg = "1"b; 1044 end; 1045 else call ioa_ (" "); /* otherwise just write blank line */ 1046 end; /* first record of the file */ 1047 1048 if last_length = rtq_info.bits then /* this record length is the same as the last record length */ 1049 nrecords = nrecords + 1; /* just tally it */ 1050 else do; /* otherwise, display a message */ 1051 if nrecords = 0 then nrecords = 1; /* set up for at least 1 record */ 1052 1053 if ^label_flg then call record_information (nrecords, (last_length), "1"b); 1054 1055 last_length = rtq_info.bits; /* restart tally */ 1056 nrecords = 0; 1057 end; /* the current record length is different from the last record length */ 1058 end; /* if ^valid_label_record (long_list_flg) */ 1059 1060 else last_length = 0; /* a label record */ 1061 end; /* if ^eof */ 1062 else do; /* tape end of file */ 1063 if last_length > 0 & ^rtq_info.two_eofs then do; /* only display valid records */ 1064 if nrecords = 0 then nrecords = 1; /* set up for at least 1 record */ 1065 1066 if ^label_flg then call record_information (nrecords, (last_length), "1"b); 1067 end; 1068 1069 call ioa_ ("End of physical tape file # ^d, ^[(^a # ^d),^[^/ ^; ^]^;^3s^]^a: ^d.^/ ", 1070 rtq_info.c_file - 1, logical_file_flg, "logical tape file", logical_file_num, 1071 rtq_info.short_output_flg, "total records read", rtq_info.c_rec - 1); 1072 1073 logical_file_flg = "0"b; 1074 rtq_info.c_rec = 1; /* reset record number */ 1075 1076 if rtq_info.set_bin & ^label_flg then do; /* if we need to switch next file to bin mode */ 1077 call check_mode (BINARY_MODE); 1078 call ioa_ (" "); /* write blank line */ 1079 rtq_info.set_bin = "0"b; /* reset switch */ 1080 end; 1081 else if rtq_info.set_nine & ^label_flg then do; /* switch back to nine mode */ 1082 call check_mode (NINE_MODE); 1083 call ioa_ (" "); /* write blank line */ 1084 rtq_info.set_nine = "0"b;/* reset switch */ 1085 end; /* else if */ 1086 end; /* eof */ 1087 end; /* do while (^two_eofs) */ 1088 1089 /* position to beginning of tape (bot) */ 1090 call process_control_order ("rewind", "0"b, "0"b, "0"b, 1); 1091 1092 /* report to users */ 1093 call ioa_ ("Logical end of tape, positioning to BOT"); 1094 1095 SUBSYSTEM_REQUEST_LOOP: 1096 1097 return; 1098 1099 /*****************************************************************************/ 1100 1101 1102 mode_request: entry (sci_ptr, rtq_info_ptr); 1103 1104 /* Establish cleanup and program_interrupt handlers. Get and process the */ 1105 /* optional control argument. Perform the specified mode control order by */ 1106 /* invoking the "process_control_order" internal procedure. Note that if */ 1107 /* control argument is given then set "binary" mode as the defaulf mode. */ 1108 1109 dcl mode_dex fixed bin; 1110 1111 /* begin coding */ 1112 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 1113 1114 on program_interrupt goto WANTS_TO_RETURN; 1115 1116 /* initialization */ 1117 scode = 0; 1118 l_cnt = 1; /* 1 iteration default */ 1119 rpt, rf, direction = "0"b; /* reset command flags */ 1120 1121 /* find number of input arguments */ 1122 call ssu_$arg_count (sci_ptr, Nargs); 1123 if Nargs >= 2 then do; 1124 ERROR_MODE: 1125 call ssu_$print_message (sci_ptr, 0, "Usage: mode "); 1126 return; 1127 end; 1128 1129 /* then validate them */ 1130 if Nargs = 0 then do; 1131 order = "binary"; /* default mode */ 1132 rtq_info.c_mode = 1; /* subscript of "bin" mode value */ 1133 end; 1134 else ; 1135 1136 do arg_dex = 1 to Nargs; 1137 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 1138 if arg = "bcd" | arg = "bin" | arg = "nine" then do; 1139 do mode_dex = 1 to 3; /* try to find the right mode */ 1140 if substr (arg, 1, 3) = substr (mode (mode_dex), 1, 3) then 1141 rtq_info.c_mode = mode_dex; 1142 else ; 1143 end; 1144 order = mode (rtq_info.c_mode); 1145 end; 1146 else goto ERROR_MODE; 1147 end; 1148 1149 /* go process control order */ 1150 call process_control_order (order, rpt, direction, rf, l_cnt); 1151 1152 WANTS_TO_RETURN: 1153 1154 return; 1155 1156 /***************************************************************************/ 1157 1158 position_request: entry (sci_ptr, rtq_info_ptr); 1159 1160 /* The rtq "position" request displays the current physical tape file and */ 1161 /* record position to the user. */ 1162 1163 /* begin coding */ 1164 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 1165 1166 on program_interrupt goto SUBSYS_QUERY; 1167 1168 /* find number of input arguments */ 1169 call ssu_$arg_count (sci_ptr, Nargs); 1170 if Nargs ^= 0 then do; 1171 call ssu_$print_message (sci_ptr, 0, "No argument is allowed for this request."); 1172 return; 1173 end; 1174 1175 /* response to user's request */ 1176 call ssu_$print_message (sci_ptr, 0, 1177 "Reading tape volume ""^a"" in ""^a"" mode.^/Currently positioned to physical file ^d, record ^d.", 1178 rtq_info.tape_name, mode (rtq_info.c_mode), rtq_info.c_file, rtq_info.c_rec); 1179 1180 SUBSYS_QUERY: 1181 1182 return; 1183 1184 /*****************************************************************************/ 1185 1186 1187 quit_request: entry (sci_ptr, rtq_info_ptr); 1188 1189 /* returns to the command line */ 1190 1191 call ssu_$abort_subsystem (sci_ptr, 0); 1192 1193 return; 1194 1195 /*****************************************************************************/ 1196 1197 read_file_request: entry (sci_ptr, rtq_info_ptr); 1198 1199 /* reads the current tape file into the segment described by the optional */ 1200 /* control argument: Initialize intermediate global and local variables. */ 1201 /* Detach the file if already attached. Get and process optional control */ 1202 /* arguments. Check for argument inconsistencies. Perform the */ 1203 /* "begin_file" control order to position to the beginning of the file if */ 1204 /* not already there. Do 1 to multilple files if was asked while not end of */ 1205 /* tape mark. Note that read in one file (by default). Report the */ 1206 /* current file which will be read in to the user. Set the open mode to the */ 1207 /* default mode. If the user wants output attach description then query the */ 1208 /* user for it by invoking the "get_output_descript_and_attach" internal */ 1209 /* procedure. Invoke the " read_in_the_entire_file" internal procedure */ 1210 /* to read in the entire current file. Check essential flags. If we have */ 1211 /* written file already then increment file name by one, expand this file */ 1212 /* name and reset the written file switch. Read in the next file and do */ 1213 /* the same operations until end of tape mark is encountered. Finally, */ 1214 /* invoke the "detach_file_if_attached" internal procedure if the "-extend" */ 1215 /* is specified to detach the file if already attached. Return to the */ 1216 /* subsystem request. */ 1217 1218 dcl conversion_flg bit (1) aligned; 1219 1220 /* begin coding */ 1221 conversion_flg, first_record_flg, last_record_flg = "0"b; 1222 1223 /* set up cleanup handler and program_interrupt (pi) command */ 1224 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 1225 1226 on program_interrupt goto RETURN; 1227 1228 rtq_info.return_subsys_loop_flg = "0"b; /* make the read_record request happy */ 1229 1230 /* the following flgs of "rtq_info" structure must reset so that if users already deleted some data record */ 1231 /* in specified files then his can read them back beyond the tape mark */ 1232 rtq_info.eov, rtq_info.one_eof, rtq_info.two_eofs = "0"b; 1233 1234 rtq_info.atd_sw, rtq_info.extend_sw, rtq_info.fw_file, rtq_info.last_job_deck_flg, rtq_info.set_bin = "0"b; 1235 rtq_info.filename = ""; 1236 1237 /* find number of arguments */ 1238 call ssu_$arg_count (sci_ptr, Nargs); 1239 1240 /* set up for processing input arguments */ 1241 scode = 0; 1242 iterations = 1; /* set default iteration set to 1 */ 1243 s_filename = ""; 1244 prptr, lrp = rtq_info.tptr; /* set equivilent pointers */ 1245 n_ops, schar = 0; 1246 cont, trunc_sw, cp5, ibmv, ansid, dec_sw, gssf, mssf, nnl_sw, l_rec, c_e_a, c_b_a, c_c_a, imcv = "0"b; 1247 1248 /* just in case we had a file attached */ 1249 call detach_file_if_attached; 1250 1251 /* process optional control arguments */ 1252 call read_file_get_control_args; 1253 if scode ^= 0 | rtq_info.return_subsys_loop_flg then 1254 goto SUBSYSTEM_LOOP_RETURN; 1255 1256 /* check for argument inconsistancies */ 1257 if (n_ops > 1) & ^(l_rec & (c_e_a | c_b_a | c_c_a)) then do; 1258 call ssu_$print_message (sci_ptr, 0, "Inconsistent combination of optional control arguments."); 1259 return; 1260 end; 1261 1262 /* position to the beginning of the tape file */ 1263 if rtq_info.c_rec > 1 then 1264 call process_control_order ("begin_file", "1"b, "0"b, "1"b, 1); 1265 1266 /* read multiple files if required */ 1267 do nunits = 1 to iterations while (^rtq_info.two_eofs); 1268 1269 call ioa_ ("Reading tape file # ^d in ^a mode", rtq_info.c_file, mode (rtq_info.c_mode)); 1270 1271 open_mode = Stream_output; /* set open mode to default mode */ 1272 /* if users want output attach description then ask for it */ 1273 if (rtq_info.atd_sw & rtq_info.fw_file) | (rtq_info.atd_sw & nunits = 1) then do; 1274 call get_output_descript_and_attach; 1275 1276 if rtq_info.return_subsys_loop_flg then 1277 goto SUBSYSTEM_LOOP_RETURN; 1278 end; 1279 1280 /* read in the entire tape file */ 1281 call read_in_the_entire_file; 1282 1283 if conversion_flg then return; 1284 1285 if rtq_info.return_subsys_loop_flg then do; 1286 1287 SUBSYSTEM_LOOP_RETURN: 1288 rtq_info.return_subsys_loop_flg = "0"b; 1289 return; 1290 end; 1291 1292 /* if we have written file already */ 1293 if rtq_info.fw_file & ^rtq_info.extend_sw then do; 1294 1295 if s_filename = "" then 1296 s_filename = rtq_info.filename; /* save filename on first iteration */ 1297 1298 rtq_info.filename = rtrim (s_filename) || "." || ltrim (char (nunits + 1)); /* increment file name */ 1299 1300 if ^valid_pathname ((rtq_info.filename), "") then do; 1301 call ssu_$print_message (sci_ptr, scode, 1302 "^/ Expanding pathname for file name ""^a""", rtq_info.filename); 1303 return; 1304 end; 1305 1306 rtq_info.fw_file = "0"b; /* reset switch */ 1307 end; /* if fw_file & ^extend_sw */ 1308 1309 end; /* do nunits = 1 to iterations while (^two_eofs) */ 1310 1311 /* if this is end, detach it */ 1312 if rtq_info.extend_sw then 1313 call detach_file_if_attached; /* just in case we had a file attached */ 1314 1315 RETURN: 1316 return; 1317 1318 /***************************************************************************/ 1319 1320 read_record_request: entry (sci_ptr, rtq_info_ptr); 1321 1322 /* reads the current record into a temporary buffer. */ 1323 /* Establish cleanup and program_interrupt handlers. Initialize */ 1324 /* intermediate global and local variables. Find the terminal line */ 1325 /* length. Get and process optional control arguments. */ 1326 /* Do 1 to N records while not end of tape mark . */ 1327 /* Report the current record of the file to user before reading it in. */ 1328 /* Invoke the "read_tape_record" internal procedure to read in the tape */ 1329 /* record. If not end of file then report information of each record read */ 1330 /* to user. Read in the next record and do the same operations until */ 1331 /* end of tape mark is encountered. Return to the subsystem request. */ 1332 1333 /* begin coding */ 1334 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 1335 1336 on program_interrupt goto SUBSYS_REQUEST_LOOP; 1337 1338 rtq_info.return_subsys_loop_flg = "0"b; /* make the read_record request happy */ 1339 1340 /* the following flgs of "rtq_info" structure must be reset so that if users already deleted some data record */ 1341 /* from specified files then he can read them back beyond the tape mark */ 1342 rtq_info.eov, rtq_info.one_eof, rtq_info.two_eofs = "0"b; 1343 1344 /* initialize global variables */ 1345 scode = 0; /* must initialize scode value */ 1346 mssf = "0"b; /* reset Multics standard system format flag */ 1347 iterations = 1; /* set default iteration set to 1 */ 1348 1349 /* find number of input arguments */ 1350 call ssu_$arg_count (sci_ptr, Nargs); 1351 1352 /* then process them */ 1353 do arg_dex = 1 to Nargs; 1354 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 1355 if arg = "-count" | arg = "-ct" then do; /* user wants to read mutiple rcds */ 1356 if arg_dex < Nargs then do; 1357 arg_dex = arg_dex + 1; 1358 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 1359 iterations = cv_dec_check_ (arg, scode); /* check for rdrec iterations */ 1360 if scode ^= 0 then goto ERROR_RDREC; 1361 end; 1362 else goto ERROR_RDREC; /* missing N for -count */ 1363 end; /* -count (-cnt) */ 1364 else do; /* no other control arg allowed */ 1365 ERROR_RDREC: 1366 call ssu_$print_message (sci_ptr, scode, "^/ Usage: read_record (rdrec) {-count (-ct) N}"); 1367 return; 1368 end; 1369 1370 end; /* do arg_dex = 1 to Nargs */ 1371 1372 do nunits = 1 to iterations while (^rtq_info.two_eofs); 1373 1374 call ssu_$print_message (sci_ptr, 0, "Reading record ^d, File ^d in ^a mode", rtq_info.c_rec, 1375 rtq_info.c_file, mode (rtq_info.c_mode)); 1376 1377 call read_tape_record ("stop", rtq_info.eof, "0"b, mssf); /* go read tape record */ 1378 1379 if rtq_info.return_subsys_loop_flg then do; 1380 rtq_info.return_subsys_loop_flg = "0"b; 1381 return; 1382 end; 1383 1384 if ^rtq_info.eof then 1385 call record_information (1, rtq_info.bits, "0"b); /* display record length info */ 1386 end; /* do nunits = 1 to iterations while (^two_eofs) */ 1387 1388 SUBSYS_REQUEST_LOOP: 1389 return; 1390 1391 /***************************************************************************/ 1392 1393 records_in_file_request: entry (sci_ptr, rtq_info_ptr); 1394 1395 /* is a request which will report to users the number of records in the */ 1396 /* current file. Establish cleanup and program_interrupt handlers. */ 1397 /* Report to users if any optional control argument is specified. */ 1398 /* Set up for reading records in the current file. Read them in until */ 1399 /* end of file encountered. Report the total records counted and the tape */ 1400 /* position to users. Invoke the "process_control_order" existing */ 1401 /* internal procedure to backspace to the original tape position. Reset */ 1402 /* the "one_eof" and "records_in_file_flg" flag fields of the "rtq_info" */ 1403 /* structure before returning to the rtq request loop. */ 1404 1405 dcl end_file_flg bit (1) aligned; 1406 dcl numb_of_recs_to_be_backspaced fixed bin; 1407 dcl save_current_record fixed bin; 1408 dcl save_current_file fixed bin; 1409 1410 /* begin coding */ 1411 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 1412 1413 on program_interrupt goto RETURNED; 1414 1415 call ssu_$arg_count (sci_ptr, Nargs); 1416 if Nargs ^= 0 then do; 1417 call ssu_$print_message (sci_ptr, 0, "Usage: records_in_file, rif"); 1418 return; 1419 end; 1420 1421 /* set up for reading records of the current file */ 1422 rtq_info.eov, rtq_info.two_eofs, rtq_info.one_eof = "0"b; /* must reset in case they were previously set */ 1423 scode = 0; 1424 rtq_info.records_in_file_flg = "1"b; 1425 rtq_info.return_subsys_loop_flg = "0"b; /* make the records_in_file request happy */ 1426 save_current_record = rtq_info.c_rec; 1427 save_current_file = rtq_info.c_file; 1428 end_file_flg = "0"b; 1429 mssf = "0"b; 1430 1431 /* read in each record in the current file until end of file encountered */ 1432 do while (^end_file_flg); 1433 call read_tape_record ("skip", end_file_flg, "1"b, mssf); 1434 end; 1435 1436 /* report the number of records counted in the current file */ 1437 call ioa_ ("The current file # ^d contains ^d record^[s^]." || 1438 "^/Repositioned the tape to its original position: record # ^d, file # ^d.", save_current_file, 1439 rtq_info.c_rec - 1, (rtq_info.c_rec > 1), save_current_record, save_current_file); 1440 1441 rtq_info.c_file = rtq_info.c_file - 1; /* the actual current file number */ 1442 1443 /* perform the "backspace_record" control order to its original position */ 1444 order = "backspace_record"; 1445 rpt = "1"b; 1446 direction = "0"b; 1447 rf = "0"b; 1448 numb_of_recs_to_be_backspaced = rtq_info.c_rec - save_current_record; 1449 1450 /* case of file containing no data record */ 1451 if numb_of_recs_to_be_backspaced = 0 then 1452 call iox_$control (rtq_info.tiocb_ptr, order, null, (0)); 1453 1454 /* case of a file containing 1 data record or more */ 1455 else call process_control_order (order, rpt, direction, rf, (numb_of_recs_to_be_backspaced)); 1456 1457 rtq_info.one_eof = "0"b; /* reset after the tape is repositioned to its original position */ 1458 1459 rtq_info.records_in_file_flg = "0"b; /* reset this flg after the request is done. */ 1460 1461 RETURNED: 1462 return; 1463 1464 /***************************************************************************/ 1465 1466 rewind_request: entry (sci_ptr, rtq_info_ptr); 1467 1468 /* Establish cleanup and program_interrupt handlers. Display an usage */ 1469 /* message if any control argument is given. Perform the "rewind" control */ 1470 /* order by invoking the "process_control_order" internal procedure. */ 1471 /* Return to the subsystem request loop. */ 1472 1473 /* begin coding */ 1474 on cleanup call detach_tape_file (sci_ptr, rtq_info_ptr); 1475 1476 on program_interrupt goto PI_RETURN; 1477 1478 call ssu_$arg_count (sci_ptr, Nargs); 1479 if Nargs ^= 0 then do; 1480 call ssu_$print_message (sci_ptr, 0, "Usage: rewind (rew)"); 1481 return; 1482 end; 1483 1484 /* initialization */ 1485 scode = 0; 1486 l_cnt = 1; /* 1 iteration default */ 1487 rpt, rf, direction = "0"b; /* reset command flags */ 1488 order = "rewind"; 1489 1490 call process_control_order (order, rpt, direction, rf, l_cnt); /* go process control order */ 1491 1492 /* must reset the following flags if they were previously set */ 1493 rtq_info.eof, rtq_info.eov, rtq_info.one_eof, rtq_info.two_eofs = "0"b; 1494 1495 PI_RETURN: 1496 return; 1497 1498 /****************************************************************************/ 1499 1500 ANSI_DB_records: proc (conversion_flg); 1501 1502 /* process each ANSI DB record of the input tape file for the "rdfile" request */ 1503 1504 dcl conversion_flg bit (*) aligned; 1505 1506 /* begin coding */ 1507 nchars = 0; 1508 rtq_info.rptr = rtq_info.tptr; /* set first log record ptr */ 1509 1510 on conversion begin; 1511 call ssu_$print_message (sci_ptr, 0, 1512 "Conversion condition detected attempting to convert ANSI log rec len (""^a"") to binary", 1513 ansi_db_lrec.lrl); 1514 1515 conversion_flg = "1"b; 1516 goto BACK_TO_RTQ_REQUEST_LOOP; /* return to rtq subsystem request loop */ 1517 end; 1518 1519 do while (nchars < rtq_info.rec_len - 3); /* process entire block */ 1520 l_rec_len = bin (ansi_db_lrec.lrl) - NUMB_OF_CHARS_PER_WORD; /* compute logical record size */ 1521 1522 if l_rec_len = 0 then do; /* if null record, write empty line */ 1523 call write_file (addr (NL), 1, s_filename); 1524 1525 if rtq_info.return_subsys_loop_flg then return; 1526 end; 1527 else do; /* record contains data */ 1528 if c_e_a then /* if ebcdic record */ 1529 call ebcdic_to_ascii_ (ansi_db_lrec.alrd, rtq_info.cbufp -> cbuf); 1530 else rtq_info.cbufp -> cbuf = ansi_db_lrec.alrd; /* otherwise, copy it */ 1531 1532 trim_trailing_blanks_log_rec_len = length (rtrim (rtq_info.cbufp -> cbuf)); 1533 1534 if ^nnl_sw then do; /* add New Line character to each record */ 1535 trim_trailing_blanks_log_rec_len = trim_trailing_blanks_log_rec_len + 1; 1536 substr (rtq_info.cbufp -> cbuf, trim_trailing_blanks_log_rec_len, 1) = NL; 1537 end; 1538 1539 call write_file (rtq_info.cbufp, trim_trailing_blanks_log_rec_len, s_filename); /* write out log record */ 1540 1541 if rtq_info.return_subsys_loop_flg then return; 1542 end; /* record contains data */ 1543 1544 rtq_info.rptr = addr (ansi_db_lrec.nxt_lrec); 1545 nchars = nchars + l_rec_len + NUMB_OF_CHARS_PER_WORD; /* increment total # of chars */ 1546 1547 end; /* do while ... */ 1548 1549 BACK_TO_RTQ_REQUEST_LOOP: 1550 return; 1551 1552 end ANSI_DB_records; 1553 1554 /****************************************************************************/ 1555 1556 CP5_variable_length_records: proc (); 1557 1558 /* process each logical record of the input tape file in the CP5 standard */ 1559 /* system format for the read_file request. */ 1560 1561 /* begin coding */ 1562 rtq_info.rptr = addr (cp5_phy_rec.first); /* get ptr to first record */ 1563 1564 do i = 1 to cp5_phy_rec.nky; 1565 call ebcdic_to_ascii_ (cp5_log_rec.cp5_log_rec_data, rtq_info.cbufp -> cbuf); 1566 1567 substr (rtq_info.cbufp -> cbuf, cp5_log_rec.rlen + 1, 1) = NL; /* add new line char to end */ 1568 1569 call write_file (rtq_info.cbufp, cp5_log_rec.rlen + 1, s_filename); /* write out this logical record */ 1570 1571 if rtq_info.return_subsys_loop_flg then 1572 return; 1573 1574 rtq_info.rptr = addrel (rtq_info.rptr, currentsize (cp5_log_rec)); /* go to next one */ 1575 end; 1576 1577 return; 1578 1579 end CP5_variable_length_records; 1580 1581 /****************************************************************************/ 1582 1583 DEC_tape_records: proc (); 1584 1585 /* process each record of the input tape file in DEC standard system format */ 1586 /* for the read_file request. */ 1587 1588 dcl DEC_40_bits_per_word fixed bin static options (constant) init (40); 1589 1590 /* convert DEC to MULTICS standard words */ 1591 it_cnt = divide (rtq_info.bits, DEC_40_bits_per_word, 17, 0); /* get number of 40 bit words */ 1592 1593 do i = 1 to it_cnt; /* each record is 512 40 bit words */ 1594 dec_mult (i).first_32 = dec_tape_raw.ps_wd (i).first_32; /* copy 1st 32 bits */ 1595 1596 dec_mult (i).last_4 = dec_tape_raw.ps_wd (i).last_4; /* copy last 4 bits */ 1597 end; 1598 1599 call write_file (lrp, it_cnt * 4, s_filename); /* write out this record */ 1600 1601 return; 1602 1603 end DEC_tape_records; 1604 1605 /****************************************************************************/ 1606 1607 IBM_VB_records: proc (); 1608 1609 /* process each IBM VB_formated variable_length record of the input tape */ 1610 /* file for the "rdfile" request. */ 1611 1612 /* begin coding */ 1613 nchars = 0; 1614 blocksize = bin (bdw.msl || bdw.lsl) - NUMB_OF_CHARS_PER_WORD; 1615 rtq_info.rptr = addr (ibm_phy_rec.iprd); /* set first logical record ptr */ 1616 1617 do while (nchars < blocksize); /* process entire block */ 1618 l_rec_len = bin (rdw.msl || rdw.lsl) - NUMB_OF_CHARS_PER_WORD; /* compute logical record size */ 1619 1620 if c_e_a then /* if ebcdic record */ 1621 call ebcdic_to_ascii_ (ibm_log_rec.ilrd, rtq_info.cbufp -> cbuf); 1622 else rtq_info.cbufp -> cbuf = ibm_log_rec.ilrd; /* otherwise, copy it */ 1623 1624 trim_trailing_blanks_log_rec_len = length (rtrim (substr (rtq_info.cbufp -> cbuf, 1, rtq_info.rec_len))); 1625 1626 if ^nnl_sw then do; /* add new line character to each record */ 1627 trim_trailing_blanks_log_rec_len = trim_trailing_blanks_log_rec_len + 1; 1628 substr (rtq_info.cbufp -> cbuf, trim_trailing_blanks_log_rec_len, 1) = NL; 1629 end; 1630 1631 call write_file (rtq_info.cbufp, trim_trailing_blanks_log_rec_len, s_filename); /* write out log record */ 1632 1633 if rtq_info.return_subsys_loop_flg then 1634 return; 1635 1636 rtq_info.rptr = addr (ibm_log_rec.nxt_lrec); 1637 nchars = nchars + l_rec_len + NUMB_OF_CHARS_PER_WORD; /* increment total # of chars */ 1638 end; 1639 1640 return; 1641 1642 end IBM_VB_records; 1643 1644 /****************************************************************************/ 1645 1646 GCOS_ssf: proc (cont, imcv, nchars, binck, first_record_flg, s_filename); 1647 1648 /* process GCOS standard system format records. */ 1649 1650 dcl binck bit (1) aligned; 1651 dcl card_cnt fixed bin; 1652 dcl cont bit (1) aligned; 1653 dcl dkend_card bit (1) aligned; 1654 dcl eoc bit (1) aligned; 1655 dcl (fc, fl) bit (1) aligned; 1656 dcl first_record_flg bit (1) aligned; 1657 dcl gcos_trans (9) char (6) static options (constant) init 1658 ("gmap ", "355map", "355sim", "algol ", "forta ", "forty ", "cobol ", "cob68 ", "jovial"); 1659 dcl imcv bit (1) aligned; 1660 dcl nchars fixed bin (21); /* will reference in get_file_name procedure */ 1661 dcl obj_card bit (1) aligned; 1662 dcl p_arg char (168) varying init (""); 1663 dcl s_filename char (32) var; /* save for calling write_file procedure */ 1664 1665 /* based */ 1666 dcl 1 comdk aligned based (rtq_info.cdptr), /* structure of a comdeck card */ 1667 ( 2 type bit (12), /* bin card type, "5005"b3 for comdeck */ 1668 2 bin_seq bit (24), /* binary sequence number */ 1669 2 ckeck_sum bit (36), /* check sum word */ 1670 2 data bit (21 * 36), /* 21 data words */ 1671 2 h_seq (4) bit (12), /* holorith seq number */ 1672 2 pad bit (12)) unaligned; 1673 1674 dcl 1 com_fld unaligned based (rtq_info.cfptr), /* template for compression */ 1675 2 f_len bit (6), /* field length */ 1676 2 s_len bit (6), /* string length */ 1677 2 bcd_str bit (fixed (com_fld.s_len, 6) * 6), /* bcd char string */ 1678 2 nxt bit (6), /* field or card fence */ 1679 2 nxt_fld bit (6); /* to get to next field */ 1680 1681 /* begin coding */ 1682 if ^first_record_flg then do; /* if first record of file */ 1683 bcnt = gc_phy_rec.bcw.bsn; /* load block serial number */ 1684 first_record_flg = "1"b; 1685 end; 1686 else do; /* if not first record, check block serial number */ 1687 bcnt = bcnt + 1; /* increment our block count */ 1688 if gc_phy_rec.bcw.bsn ^= bcnt then do; /* something wrong here */ 1689 call ssu_$print_message (sci_ptr, 0, 1690 "Block serial number error; BSN was ^d, S/B ^d", gc_phy_rec.bcw.bsn, bcnt); 1691 1692 YES_FLG = command_query_yes_no ("Do you want to stop and return to the rtq request loop? Answer ""yes"" or ""no"".", "Stop?"); 1693 1694 if YES_FLG then do; /* users want to stop */ 1695 call detach_file_if_attached; /* just in case we had a file attached */ 1696 1697 rtq_info.return_subsys_loop_flg = "1"b; /* users want to return to subsystem request loop */ 1698 1699 return; 1700 end; 1701 else bcnt = gc_phy_rec.bcw.bsn; /* reset block number */ 1702 end; /* something wrong */ 1703 end; /* not first record */ 1704 1705 if gc_phy_rec.bcw.blk_size > rtq_info.wd_buf_size then do; /* is our buffer big enough? */ 1706 call ssu_$print_message (sci_ptr, 0, "Phyical record size (^d) is larger than buffer size (^d)", 1707 gc_phy_rec.bcw.blk_size, rtq_info.wd_buf_size); 1708 1709 YES_FLG = command_query_yes_no ("Do you want to stop and return to the rtq request loop? Answer ""yes"" or ""no"".", "Stop?"); 1710 1711 if YES_FLG then do; /* users want to stop */ 1712 call detach_file_if_attached; /* just in case we had a file attached */ 1713 1714 rtq_info.return_subsys_loop_flg = "1"b; /* users want to return to subsystem request loop */ 1715 1716 return; 1717 end; 1718 end; /* our buffer is big enough */ 1719 1720 lrptr = addr (gc_phy_rec.gc_phy_rec_data (1)); /* get pointer to first logical record */ 1721 nwds = 0; /* initialize number of words */ 1722 card_cnt = 1; /* set initial card count for this block */ 1723 obj_card, dkend_card = "0"b; /* clear bin card indicators */ 1724 1725 do while (nwds < gc_phy_rec.bcw.blk_size); /* iterate through all logical records */ 1726 if ^cont then rtq_info.cbufp -> cbuf = ""; 1727 go to media_type (rcw.media_code); /* take appropriate action */ 1728 1729 /* media code 1 is binary card image */ 1730 1731 media_type (1): /* Binary card image */ 1732 rtq_info.cdptr = addr (gc_log_rec.gc_log_rec_data); /* set ptr to data */ 1733 if comdk.type = "5005"b3 then do; /* compressed deck? */ 1734 rtq_info.cfptr = addr (comdk.data);/* lets decompress it */ 1735 fc = "0"b; /* reset terminate condition */ 1736 1737 do while (^fc); /* go through entire card */ 1738 if ^cont then do; /* not continuing from last card */ 1739 nchars = 1; /* set line position to 1 */ 1740 rtq_info.cbufp -> cbuf = ""; /* add blanks to line buffer */ 1741 end; 1742 1743 fl = "0"b; 1744 do while (^fl & ^fc); /* decompress each line */ 1745 i = fixed (f_len, 6); /* get field length */ 1746 j = fixed (s_len, 6); /* get string length */ 1747 1748 if f_len = "77"b3 then do; /* end of line */ 1749 cont = "0"b; /* reset continue */ 1750 fl = "1"b; 1751 rtq_info.cfptr = addr (com_fld.s_len); /* skip over it */ 1752 end; /* end of line */ 1753 1754 else if i < j | (i = 0 & j = 0) then do; /* end of card */ 1755 eoc, fc = "1"b; 1756 cont = "0"b; /* turn off continue flag */ 1757 end; /* end of card */ 1758 1759 else do; 1760 eoc = "0"b; 1761 if j ^= 0 then do; 1762 rtq_info.cdkp -> cdkbuf = ""; 1763 call bcd_to_ascii_ (bcd_str, rtq_info.cdkp -> cdkbuf); /* convert string to ascii */ 1764 substr (rtq_info.cbufp -> cbuf, nchars + (i - j), j) = rtq_info.cdkp -> cdkbuf; /* set string in position */ 1765 end; /* not end of line and not end of card */ 1766 1767 nchars = nchars + i; /* update line position */ 1768 1769 if com_fld.nxt = "76"b3 then do; /* end of compressed deck */ 1770 fc = "1"b; 1771 cont = "0"b; /* turn off continue so we will write this line */ 1772 end; /* end of compressed deck */ 1773 1774 else if com_fld.nxt = "77"b3 then do; /* end of this line */ 1775 fl = "1"b; /* set terminate condition */ 1776 cont = "0"b; /* not a continued line */ 1777 rtq_info.cfptr = addr (com_fld.nxt_fld); /* set ptr to skip line fence */ 1778 end; /* end of this line */ 1779 1780 else if com_fld.nxt = "00"b3 then /* line continued in next card */ 1781 cont, fc = "1"b; 1782 1783 else rtq_info.cfptr = addr (com_fld.nxt); /* otherwise just go to nxt field */ 1784 end; /* not end of line and not end of card */ 1785 end; /* do while ^fl &^fc */ 1786 1787 if ^cont & ^eoc then do; /* line continues on next card */ 1788 substr (rtq_info.cbufp -> cbuf, nchars, 1) = NL; /* add new line to end of line */ 1789 call write_file (rtq_info.cbufp, nchars, s_filename); /* write out the line */ 1790 end; /* if line continues on next card */ 1791 end; /* do while not end of card */ 1792 end; /* compressed deck */ 1793 else do; /* user wants copy */ 1794 1795 ck_obj: 1796 if obj_card then do; /* we have passed a $ object card */ 1797 obj_card = "0"b; 1798 if card_cnt ^= 2 then do;/* not first card of blk */ 1799 call ssu_$print_message (sci_ptr, 0, "$ object card not first card of blk"); 1800 rtq_info.return_subsys_loop_flg = "1"b; 1801 return; /* return to subsystem */ 1802 end; 1803 1804 /* nchars = current card size + prev card size + bcw */ 1805 nchars = (rtq_info.cvp -> rcw.rsize + rcw.rsize + 3) * NUMB_OF_CHARS_PER_WORD; 1806 rtq_info.cvp = addrel (rtq_info.cvp, -1); /* don't forget bcw */ 1807 end; /* if we have passed a $ object card */ 1808 1809 else if card_cnt = 1 then do; /* include only bcw */ 1810 nchars = (rcw.rsize + 2) * NUMB_OF_CHARS_PER_WORD; 1811 rtq_info.cvp = addrel (lrptr, -1); 1812 end; 1813 1814 else do; /* include just this card */ 1815 nchars = (rcw.rsize + 1) * NUMB_OF_CHARS_PER_WORD; 1816 rtq_info.cvp = lrptr; 1817 end; 1818 1819 call write_file (rtq_info.cvp, nchars, s_filename); 1820 1821 if dkend_card then do; /* if last card of deck */ 1822 dkend_card = "0"b; 1823 1824 call detach_file_if_attached; /* just in case we had a file attached */ 1825 end; /* last card of deck */ 1826 end; /* user wants copy */ 1827 1828 go to gssf_end; 1829 1830 /* media codes 0, 2, 3, and 9 - bcd records */ 1831 1832 media_type (0): /* Not a media conversion record */ 1833 media_type (2): /* BCD card image */ 1834 media_type (3): /* BCD print line image */ 1835 media_type (9): /* Bcd print line image (with user defined rpt code) */ 1836 1837 call bcd_to_ascii_ (gc_log_rec_bits, rtq_info.cbufp -> cbuf); /* convert bcd to ascii */ 1838 rtq_info.cbufp -> cbuf = translate (rtq_info.cbufp -> cbuf, "='+)(", "#@&]%"); /* take care of stange conversion chars */ 1839 if rcw.media_code = 2 then do; /* if bcd card */ 1840 nchars = length (rtrim (substr (rtq_info.cbufp -> cbuf, 1, 80))) + 1; /* set max length to 80 char */ 1841 if substr (rtq_info.cbufp -> cbuf, 1, 13) = "$ object" then do; /* and object card */ 1842 obj_card = "1"b; 1843 rtq_info.cvp = addrel (lrptr, currentsize (gc_log_rec)); /* look at nxt card */ 1844 if rtq_info.cvp -> rcw.media_code = 1 then do; /* if binary card */ 1845 binck = "1"b; /* set flag so we don't come back */ 1846 call detach_file_if_attached; /* this should not happen but ... */ 1847 1848 call get_file_name ("obj", nchars); /* get filename */ 1849 if rtq_info.return_subsys_loop_flg then 1850 return; /* return to subsystem */ 1851 1852 go to gssf_end;/* card will be written with next one */ 1853 end; /* binary card */ 1854 end; /* object card */ 1855 1856 else if substr (rtq_info.cbufp -> cbuf, 1, 12) = "$ dkend" then /* dkend card */ 1857 if binck then do; /* process only if we have been doing something with bin cards */ 1858 if substr (rtq_info.cbufp -> cbuf, 16, 8) ^= "continue" then /* if continue card keep on going */ 1859 dkend_card = "1"b; 1860 go to ck_obj; /* copy this one too */ 1861 end; 1862 else ; 1863 1864 else if substr (rtq_info.cbufp -> cbuf, 1, 12) = "$ snumb" then do; /* snumb card */ 1865 i = search (substr (rtq_info.cbufp -> cbuf, 16, 6), ","); /* if any commas, find out */ 1866 if i = 0 then /* no commas, use name as is */ 1867 p_arg = substr (rtq_info.cbufp -> cbuf, 16, 6); /* generate filename */ 1868 else p_arg = substr (rtq_info.cbufp -> cbuf, 16, i - 1); /* don't like commas in seg names */ 1869 1870 if ^valid_pathname ((p_arg), "imcv") then do; 1871 rtq_info.return_subsys_loop_flg = "1"b; 1872 return; /* return to subsystem */ 1873 end; 1874 1875 call detach_file_if_attached; /* detach old file, if attached */ 1876 1877 imcv = "1"b; /* set indicator switch */ 1878 rtq_info.fw_file, cont = "0"b; /* reset so file name will appear on terminal */ 1879 end; /* snumb card */ 1880 1881 else if ^imcv then do; /* a $ language card */ 1882 rtq_info.tmr = "0"b; /* reset terminate condition */ 1883 do i = 1 to hbound (gcos_trans, 1) while (^rtq_info.tmr); 1884 if substr (rtq_info.cbufp -> cbuf, 8, 6) = gcos_trans (i) then rtq_info.tmr = "1"b; 1885 end; 1886 if rtq_info.tmr then do; /* found a valid language card */ 1887 if rtq_info.f_attached then do; /* if we had a file attached before... */ 1888 call write_file (addr (eoj_card), length (eoj_card), s_filename); /* complete jcl */ 1889 1890 if rtq_info.return_subsys_loop_flg then 1891 return; 1892 1893 call detach_file_if_attached; 1894 end; 1895 1896 call get_file_name ("ascii", nchars); /* get filename */ 1897 1898 if rtq_info.return_subsys_loop_flg then 1899 return; 1900 1901 rtq_info.last_job_deck_flg = "1"b; /* set flag for last job deck */ 1902 call ioa_$rsnnl ("$ snumb ^a^/$ ident^/^a^/$ limits 8,64k,,50000^/", 1903 rtq_info.cbufp -> cbuf, rtq_info.clen, substr (rtq_info.filename, 1, 3), 1904 substr (rtq_info.cbufp -> cbuf, 1, nchars)); 1905 1906 call write_file (rtq_info.cbufp, rtq_info.clen, s_filename); /* write out jcl */ 1907 1908 cont = "0"b; /* reset continue flag */ 1909 1910 if rtq_info.return_subsys_loop_flg then 1911 return; 1912 1913 go to gssf_end; 1914 end; /* a valid language card */ 1915 end; /* a $ language card */ 1916 end; /* a bcd card */ 1917 1918 else if rcw.media_code = 9 then do; /* if user rpt code present */ 1919 rtq_info.cbufp -> cbuf = substr (rtq_info.cbufp -> cbuf, 3); /* wipe it out */ 1920 nchars = length (rtrim (substr (rtq_info.cbufp -> cbuf, 1, rcw.rsize * 6))) - 2; /* get length of string */ 1921 end; /* user rpt code */ 1922 1923 else nchars = length (rtrim (substr (rtq_info.cbufp -> cbuf, 1, rcw.rsize * 6))) + 1; /* get length of string */ 1924 1925 substr (rtq_info.cbufp -> cbuf, nchars, 1) = NL; /* append new line to end of string */ 1926 1927 call write_file (rtq_info.cbufp, nchars, s_filename); /* write out this logical record */ 1928 1929 if rtq_info.return_subsys_loop_flg then 1930 return; 1931 1932 go to gssf_end; 1933 1934 /* media codes 6, 7, 10, and 13 are ascii records */ 1935 1936 media_type (6): /* ssf ascii */ 1937 media_type (7): /* Ascii print line image */ 1938 media_type (10): /* Ascii card image */ 1939 media_type (13): /* Ascii print line image (with user defined rpt code) */ 1940 1941 rtq_info.cvp = addr (gc_log_rec.gc_log_rec_data); 1942 if rcw.nchar_used ^= 0 then /* if we have a partial word */ 1943 nchars = ((rcw.rsize - 1) * NUMB_OF_CHARS_PER_WORD) + rcw.nchar_used + 1; 1944 else nchars = rcw.rsize * NUMB_OF_CHARS_PER_WORD + 1; 1945 1946 rtq_info.cbufp -> cbuf = substr (gssf_ascii, 1, nchars - 1) || NL; 1947 if rcw.media_code = 13 then do; /* if user rpt code present */ 1948 rtq_info.cbufp -> cbuf = substr (rtq_info.cbufp -> cbuf, 3); /* wipe it out */ 1949 nchars = nchars - 2; 1950 end; 1951 1952 call write_file (rtq_info.cbufp, nchars, s_filename); /* write out this logical record */ 1953 1954 if rtq_info.return_subsys_loop_flg then 1955 return; /* return to subsystem */ 1956 1957 go to gssf_end; 1958 1959 1960 /* media codes 4, 5, 11, 12, 14, and 15 are illegal media codes */ 1961 1962 media_type (4): /* Reserved for user */ 1963 media_type (5): /* Tss ascii (before release E) */ 1964 media_type (11): /* Illegal media code */ 1965 media_type (12): /* Illegal media code */ 1966 media_type (14): /* Illegal media code */ 1967 media_type (15): /* Illegal media code */ 1968 1969 call ssu_$print_message (sci_ptr, 0, "Illegal media code ^o detected in card number ^d of block ^d", 1970 rcw.media_code, card_cnt, bcnt); 1971 rtq_info.return_subsys_loop_flg = "1"b; 1972 return; /* this is not a gcos deck, return */ 1973 1974 1975 media_type (8): /* tss info record, ignore */ 1976 1977 gssf_end: 1978 nwds = nwds + rcw.rsize + 1; /* increment number of words */ 1979 rtq_info.cvp = lrptr; /* save ptr to current logical record */ 1980 lrptr = addrel (lrptr, currentsize (gc_log_rec)); /* set next logical record */ 1981 card_cnt = card_cnt + 1; /* increment card count */ 1982 1983 end; /* do while nwds < gc_phy_rec.bcw.blk_size */ 1984 1985 end GCOS_ssf; 1986 1987 /****************************************************************************/ 1988 1989 MULT_ssf: proc (first_record_flg, last_record_flg, s_filename); 1990 1991 /* process MULTICS standard system format records. */ 1992 1993 dcl first_record_flg bit (1) aligned; 1994 dcl last_record_flg bit (1) aligned; 1995 dcl s_filename char (32) varying; /* save for calling write_file procedure */ 1996 1997 dcl 1 mult_buf based (rtq_info.tptr) aligned, /* buffer for MULTICS standard tape record */ 1998 2 cur_rec (1040) bit (36), /* storage for current record */ 1999 2 last_rec char (rtq_info.clen); /* storage for last record read */ 2000 2001 /* begin coding */ 2002 mstrp = rtq_info.tptr; /* set Multics standard record ptr */ 2003 2004 if ^first_record_flg then do; /* if this is the first rcd set flag */ 2005 first_record_flg = "1"b; 2006 bcnt = mstr.head.rec_within_file; /* set initial record number within file */ 2007 end; 2008 2009 else if ^mstr.head.flags.repeat then do; /* if not repeat record */ 2010 bcnt = bcnt + 1; /* increment record counter */ 2011 if bcnt ^= mstr.head.rec_within_file & ^last_record_flg then do; /* sequence error */ 2012 call ssu_$print_message (sci_ptr, 0, 2013 "Record sequence number error; Record sequence number was ^d; S/B ^d", 2014 mstr.head.rec_within_file, bcnt); 2015 2016 YES_FLG = command_query_yes_no ("Do you want to stop and return to the rtq request loop? Answer ""yes"" or ""no"".", "Stop?"); 2017 2018 if YES_FLG then do; /* users want to stop */ 2019 call detach_file_if_attached; /* just in case we had a file attached */ 2020 2021 rtq_info.return_subsys_loop_flg = "1"b; /* users want to return to subsystem request loop */ 2022 2023 return; 2024 end; 2025 else bcnt = mstr.head.rec_within_file; /* reset block number */ 2026 end; /* sequential error */ 2027 2028 call write_file (addr (mult_buf.last_rec), rtq_info.clen, s_filename); /* write out last record */ 2029 2030 if rtq_info.return_subsys_loop_flg then return; 2031 2032 end; /* not repeat record */ 2033 2034 if ^last_record_flg then do; /* if current record is not eof */ 2035 rtq_info.clen = divide (mstr.head.data_bits_used, 9, 17, 0); /* get char length */ 2036 addr (mult_buf.last_rec) -> mult_move = addr (mstr.data) -> mult_move; /* move it */ 2037 end; 2038 2039 end MULT_ssf; 2040 2041 /****************************************************************************/ 2042 2043 attach_and_open_output_file: proc; 2044 2045 /* attach file */ 2046 RETRY: 2047 call iox_$attach_name ("file_sw", rtq_info.fiocb_ptr, att_desc, null, scode); 2048 if scode ^= 0 then do; 2049 2050 if scode = error_table_$not_detached then do; 2051 call iox_$detach_iocb (rtq_info.fiocb_ptr, scode); 2052 if scode ^= error_table_$not_closed then 2053 goto ERR_ATTACHED; 2054 else do; 2055 call iox_$close (rtq_info.fiocb_ptr, scode); 2056 goto RETRY; 2057 end; 2058 end; 2059 else do; /* display error messages */ 2060 2061 ERR_ATTACHED: 2062 call ssu_$print_message (sci_ptr, scode, 2063 "^/ Attempting to attach file.^/ Attach description: ^a", att_desc); 2064 2065 rtq_info.return_subsys_loop_flg = "1"b; 2066 return; 2067 end; 2068 end; /* scode ^= 0 */ 2069 2070 rtq_info.f_attached = "1"b; /* set attached switch */ 2071 2072 /* open file */ 2073 call iox_$open (rtq_info.fiocb_ptr, open_mode, "0"b, scode); 2074 2075 if scode ^= 0 then do; 2076 call ssu_$print_message (sci_ptr, scode, 2077 "^/ Opening ^a for ^a", att_desc, iox_modes (open_mode)); 2078 2079 call detach_file_if_attached; /* just in case we had a file attached */ 2080 2081 rtq_info.return_subsys_loop_flg = "1"b; 2082 return; 2083 end; 2084 2085 2086 end attach_and_open_output_file; 2087 2088 /****************************************************************************/ 2089 2090 check_mode: proc (a_mode); 2091 2092 /* check and set tape dim in a specified reading mode. */ 2093 2094 dcl a_mode fixed bin; 2095 2096 /* set desired mode if required and tell user what we have done */ 2097 if rtq_info.c_mode ^= a_mode then do; 2098 rtq_info.c_mode = a_mode; 2099 2100 call ioa_ ("Setting tape dim to read in ^a mode", mode (rtq_info.c_mode)); 2101 2102 call process_control_order (mode (rtq_info.c_mode), "0"b, "0"b, "0"b, 1); 2103 end; 2104 2105 end check_mode; 2106 2107 /**************************************************************************/ 2108 2109 command_query_no_entrypoint: proc (explain_to_users, ask_users_question) returns (char (200) varying); 2110 2111 2112 dcl ask_users_question char (*); 2113 dcl explain_to_users char (*); 2114 dcl get_users_answer char (64); 2115 2116 /* external entry */ 2117 dcl command_query_ entry options (variable); 2118 2119 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 */ 2120 2121 2122 /* begin coding */ 2123 who_asked = ssu_$get_subsystem_and_request_name (sci_ptr); 2124 2125 unspec (query_info) = "0"b; /* clear out query_info structure */ 2126 2127 query_info.version = query_info_version_6; 2128 query_info.prompt_after_explanation = "1"b; 2129 query_info.question_iocbp, query_info.answer_iocbp = null; 2130 query_info.explanation_ptr = addr (explain_to_users); 2131 query_info.explanation_len = length (explain_to_users); 2132 2133 call command_query_ (addr (query_info), get_users_answer, (who_asked), ask_users_question); 2134 2135 return (rtrim (get_users_answer)); 2136 2137 end command_query_no_entrypoint; 2138 2139 /**************************************************************************/ 2140 2141 command_query_yes_no: proc (interpretation_string, query_string) returns (bit (1) aligned); 2142 2143 /* ask users for a yes or no answer. */ 2144 2145 dcl A_YES_OR_NO_ANSWER bit (1) aligned; 2146 dcl interpretation_string char (95); 2147 dcl query_string char (28); 2148 2149 /* external entry */ 2150 dcl command_query_$yes_no entry options (variable); 2151 2152 /* begin coding */ 2153 A_YES_OR_NO_ANSWER = "0"b; 2154 2155 who_asked = ssu_$get_subsystem_and_request_name (sci_ptr); 2156 2157 call command_query_$yes_no (A_YES_OR_NO_ANSWER, 0, (who_asked), interpretation_string, query_string); 2158 2159 return (A_YES_OR_NO_ANSWER); 2160 2161 end command_query_yes_no; 2162 2163 /**************************************************************************/ 2164 2165 detach_file_if_attached: proc (); 2166 2167 /* detach an old file if it was already attached. */ 2168 2169 /* begin coding */ 2170 if rtq_info.f_attached then do; 2171 call iox_$close (rtq_info.fiocb_ptr, (0)); 2172 call iox_$detach_iocb (rtq_info.fiocb_ptr, (0)); 2173 rtq_info.last_job_deck_flg, rtq_info.f_attached = "0"b; 2174 end; 2175 2176 end detach_file_if_attached; 2177 2178 /***************************************************************************/ 2179 2180 detach_tape_file: proc (sci_ptr, rtq_info_ptr); 2181 2182 /* detach and close tape and file. */ 2183 2184 dcl release_area_ entry (ptr); 2185 dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); 2186 dcl (rtq_info_ptr, sci_ptr) ptr; 2187 2188 /* close and detach tape switch which was attached and opened earlier */ 2189 if rtq_info.tiocb_ptr ^= null then do; 2190 call iox_$close (rtq_info.tiocb_ptr, (0)); 2191 call iox_$detach_iocb (rtq_info.tiocb_ptr, (0)); 2192 rtq_info.tiocb_ptr = null; 2193 end; 2194 2195 /* release temp segment if already allocated */ 2196 if rtq_info.tptr ^= null then 2197 call release_temp_segment_ (pname, rtq_info.tptr, (0)); /* release our tape buffer */ 2198 2199 /* release an area which already assigned */ 2200 if rtq_info.rtq_area_ptr ^= null then do; 2201 call release_area_ (rtq_info.rtq_area_ptr); 2202 ai.areap = null; 2203 end; 2204 2205 /* if file was attached then detach it */ 2206 call detach_file_if_attached; 2207 2208 return; 2209 2210 end detach_tape_file; 2211 2212 /**************************************************************************/ 2213 2214 determine_tape_label_types: proc (); 2215 2216 /* determine the tape label type and then process the specified tape type */ 2217 /* (e.g. MULTICS, GCOS, IBM, ANSI) */ 2218 2219 /* begin code */ 2220 if rtq_info.tptr -> mult.lab_id = header_c1 then do; /* Multics standard tape */ 2221 rcd_volid = rtq_info.tptr -> mult.tape_reel_id; /* copy volume id directly */ 2222 rtq_info.l_type = v1_mult_label; 2223 end; /* MULTICS standard tape */ 2224 2225 else if rtq_info.tptr -> mult.lab_id = label_c1 then do; /* is this a bootable MST? */ 2226 2227 if (rtq_info.tptr -> mst_label.head.c1 = header_c1) & (rtq_info.tptr -> mst_label.head.label) then do; 2228 rcd_volid = rtq_info.tptr -> mst_label.tape_reel_id; /* copy volume id directly */ 2229 rtq_info.l_type = v3_mult_label; 2230 end; 2231 end; 2232 2233 else if rtq_info.tptr -> gcos.lab_id = g_label then do; /* GCOS standard tape */ 2234 call bcd_to_ascii_ (rtq_info.tptr -> gcos.vol_id, rcd_volid); /* convert bcd */ 2235 rtq_info.l_type = 3; /* gcos_label value */ 2236 end; /* GCOS standard tape */ 2237 2238 else if rtq_info.tptr -> ibm_ansi.lab_id = i_label then do; /* IBM standard tape */ 2239 call ebcdic8_to_ascii_ (rtq_info.tptr -> ibm_ansi.vol_id, rcd_volid); /* convert packed ebcdic to ascii */ 2240 rtq_info.l_type = ibm_label; 2241 end; /* IBM standard tape */ 2242 2243 else if rtq_info.tptr -> ibm_ansi.lab_id = a_label then do; /* ANSI standard tape */ 2244 do i = 0 to 5; /* unpack 8bit ascii to 9bit ascii */ 2245 blab (i) = "0"b || substr (rtq_info.tptr -> ibm_ansi.vol_id, (i * 8) + 1, 8); 2246 end; 2247 rtq_info.l_type = ansi_label; 2248 end; /* ANSI standard tape */ 2249 2250 else if rtq_info.tptr -> cp5_lab.lab_id = CP5_label then do; /* cp5 stand tape */ 2251 call ebcdic8_to_ascii_ (rtq_info.tptr -> cp5_lab.vol_id, rcd_volid); /* convert tape name */ 2252 rtq_info.l_type = cp5_label; 2253 end; /* CP5 standard tape */ 2254 2255 else do; /* unlabeled tape */ 2256 call ioa_ ("Tape ^a is ^a or has unrecognized label.^/Tape will remain positioned at BOT.", 2257 rtq_info.tape_name, LABEL (rtq_info.l_type)); 2258 2259 return; 2260 end; 2261 2262 call ioa_ ("Tape ^a is a labeled ^a tape.^/Volume name recorded on tape label is ^a.", 2263 rtq_info.tape_name, LABEL (rtq_info.l_type), rcd_volid); 2264 2265 if rtq_info.l_type = ibm_label | rtq_info.l_type = ansi_label then do; /* if IBM or ANSI tape */ 2266 call check_mode (NINE_MODE); /* set reading mode to nine */ 2267 2268 call process_control_order ("forward_record", "1"b, "1"b, "0"b, 2); /* space to HDR2 record */ 2269 2270 call read_tape_record ("stop", rtq_info.eof, "0"b, mssf); /* and read it in */ 2271 2272 if rtq_info.return_subsys_loop_flg then 2273 return; 2274 2275 if ^rtq_info.eof then do; /* if no error */ 2276 2277 call ioa_ ("First data file format:"); 2278 2279 if ^valid_label_record ("0"b) then /* if hdr2 rcd does not exist */ 2280 2281 call ssu_$print_message (sci_ptr, 0, "Could not find ^a HDR2 record.", LABEL (rtq_info.l_type)); 2282 end; /* if ^eof */ 2283 else do; /* error reading hdr2 record */ 2284 call ssu_$print_message (sci_ptr, 0, "Error reading HDR2 record, tape will be rewound to BOT"); 2285 2286 call process_control_order ("rewind", "0"b, "0"b, "0"b, 1); 2287 2288 return; 2289 end; /* else do */ 2290 end; /* if l_type = ibm_label | l_type = ansi_label */ 2291 2292 call ioa_ ("Positioning to beginning of physical tape file # 2, (logical file # 1)"); 2293 2294 call process_control_order ("forward_file", "1"b, "1"b, "1"b, 1); 2295 2296 return; 2297 2298 end determine_tape_label_types; 2299 2300 /***************************************************************************/ 2301 2302 get_file_name: proc (dtype, nchars); 2303 2304 /* get file name from gcos card or query user. */ 2305 2306 dcl dtype char (5); 2307 dcl nchars fixed bin (21); 2308 dcl output_filename char (168) aligned; 2309 2310 /* begin coding */ 2311 if nchars >= 73 then /* if full card */ 2312 if substr (rtq_info.cbufp -> cbuf, 73, 4) ^= "" | 2313 substr (rtq_info.cbufp -> cbuf, 73, 4) ^= "0000" then do; /* and not garbage */ 2314 rtq_info.filename = rtrim (substr (rtq_info.cbufp -> cbuf, 73, 4)); /* extract name */ 2315 i = index (rtq_info.filename, NL); /* check for imbedded newline */ 2316 if i ^= 0 then /* remove it if so */ 2317 substr (rtq_info.filename, i) = substr (rtq_info.filename, i + 1); 2318 end; 2319 else ; 2320 else do; /* name not on card, query user */ 2321 call ioa_ ("^a", substr (rtq_info.cbufp -> cbuf, 1, 80)); /* display card image for user */ 2322 2323 rtq_info.tmr = "0"b; /* initialize terminate condition */ 2324 output_filename = ""; 2325 do while (^rtq_info.tmr); /* if no filename */ 2326 output_filename = command_query_no_entrypoint ("Please enter an output file name.", "Ouput file name: "); 2327 2328 rtq_info.tmr = valid_pathname ((output_filename), ""); 2329 if ^rtq_info.tmr then 2330 goto PATHNAME_ERROR; 2331 end; /* do while ^rtq_info.tmr */ 2332 end; /* else do */ 2333 2334 if ^valid_pathname ((rtq_info.filename), dtype) then do; 2335 2336 PATHNAME_ERROR: 2337 call ssu_$print_message (sci_ptr, scode, "Expanding pathname for file name ""^a""", rtq_info.filename); 2338 rtq_info.return_subsys_loop_flg = "1"b; 2339 return; /* return subsystem */ 2340 end; 2341 2342 rtq_info.fw_file = "0"b; /* reset switch so we get message */ 2343 2344 end get_file_name; 2345 2346 /***************************************************************************/ 2347 2348 get_output_descript_and_attach: proc (); 2349 2350 /* query users for the output attach description and an opening mode */ 2351 /* before invoke "attach_and_open_output_file" internal procedure. */ 2352 2353 /* if file not attached already */ 2354 if ^rtq_info.f_attached then do; 2355 2356 attach_desc_output = command_query_no_entrypoint ("Please enter an output attach description.", "Output attach description: "); 2357 2358 att_desc = attach_desc_output; /* copy attach description */ 2359 2360 attach_desc_output = command_query_no_entrypoint ("Please enter an opening mode.", "Opening mode: "); 2361 2362 /* loop throught two given arrays of modes to find a matched mode */ 2363 do i = 1 to hbound (iox_modes, 1) 2364 while (attach_desc_output ^= iox_modes (i) & attach_desc_output ^= short_iox_modes (i)); 2365 end; 2366 2367 if i > hbound (iox_modes, 1) then do; /* invalid mode specification */ 2368 call ssu_$print_message (sci_ptr, 0, "Invalid opening mode specification ""^a""", attach_desc_output); 2369 2370 rtq_info.return_subsys_loop_flg = "1"b; 2371 return; 2372 end; 2373 2374 /* set opening mode to user's specified mode */ 2375 open_mode = i; 2376 2377 /* attach file now to make sure i/o module exists */ 2378 call attach_and_open_output_file; 2379 end; /* if ^rtq_info.f_attached */ 2380 2381 return; 2382 2383 end get_output_descript_and_attach; 2384 2385 /***************************************************************************/ 2386 2387 get_tape_status: proc; 2388 2389 /* get octal and English description of tape error. */ 2390 2391 dcl analyze_device_stat_$rsnnl entry (char (*) var, ptr, bit (72) aligned, bit (18) aligned); 2392 2393 /* begin coding */ 2394 status_story = ""; /* clear old description first */ 2395 call iox_$control (rtq_info.tiocb_ptr, "saved_status", addr (t_stat), scode); 2396 2397 call analyze_device_stat_$rsnnl (status_story, addr (tape_status_table_$tape_status_table_), (t_stat), ("0"b)); 2398 2399 end get_tape_status; 2400 2401 /****************************************************************************/ 2402 2403 process_control_order: proc (a_order, a_rpt, a_dir, a_rf, a_cnt); 2404 2405 /* process control orders (non-data xfer tape commands) */ 2406 2407 dcl a_cnt fixed bin (35); 2408 dcl a_dir bit (1) aligned; 2409 dcl a_order char (*); 2410 dcl a_rf bit (1) aligned; 2411 dcl a_rpt bit (1) aligned; 2412 dcl backspace_file_flg bit (1) aligned init ("0"b); 2413 dcl count fixed bin (35); 2414 dcl i fixed bin (35); 2415 dcl order char (16); 2416 2417 /* begin coding */ 2418 order = a_order; /* copy control order */ 2419 count = a_cnt; /* copy count arg */ 2420 backspace_file_flg = "0"b; /* reset backspace file flag if set */ 2421 2422 if a_rpt then do; /* if space cmd */ 2423 if ^a_dir then do; /* backspace cmd */ 2424 if a_rf then do; /* file cmd */ 2425 if rtq_info.c_file - count < 1 then do; /* can't backspace that far */ 2426 2427 call ioa_ ("Tape will be positioned at BOT"); 2428 2429 call process_control_order ("rewind", "0"b, "0"b, "0"b, 1); /* call ourselves recursively */ 2430 return; 2431 end; 2432 else do; /* backspace file, or begin file */ 2433 rtq_info.c_rec = 1; /* deterimine the first record in the file */ 2434 2435 if order = "begin_file" then do; /* if begin file operation */ 2436 order = "backspace_file"; 2437 backspace_file_flg = "1"b; /* set backspace file flag */ 2438 end; 2439 else do; /* a real backspace file */ 2440 /* decrement file number to "count" time(s) and go back count + 1 files */ 2441 rtq_info.c_file = rtq_info.c_file - count; 2442 2443 if rtq_info.c_file > 1 then 2444 backspace_file_flg = "1"b; 2445 2446 count = count + 1; /* really going back n + 1 files */ 2447 end; /* else do */ 2448 end; /* else do */ 2449 end; /* a_rf */ 2450 else if rtq_info.c_rec - count < 1 then do; /* record cmd */ 2451 call ioa_ ("Tape will be positioned at beginning of file ^d", rtq_info.c_file); 2452 2453 call process_control_order ("begin_file", "1"b, "0"b, "1"b, 1); /* call ourselves recursively */ 2454 return; 2455 end; /* else if c_rec - count < 1 */ 2456 else rtq_info.c_rec = rtq_info.c_rec - count; /* bsr ok, reset position */ 2457 2458 end; /* ^a_dir */ 2459 else do; /* a_dir means a forward space cmd */ 2460 if a_rf then do; /* file cmd */ 2461 rtq_info.c_rec = 1; /* reset position counters */ 2462 rtq_info.c_file = rtq_info.c_file + count; 2463 end; 2464 else if ^rtq_info.eof_request_flg then 2465 rtq_info.c_rec = rtq_info.c_rec + count; /* fsr cmd */ 2466 end; /* else do */ 2467 end; /* if a_rpt means a space cmd */ 2468 2469 if order = "rewind" then /* if order is rewind */ 2470 rtq_info.c_rec, rtq_info.c_file = 1; /* reset position */ 2471 2472 do i = 1 to count; /* iterate control order requested times */ 2473 call iox_$control (rtq_info.tiocb_ptr, order, null, scode); 2474 2475 if scode ^= 0 then do; 2476 if scode = error_table_$end_of_info & rtq_info.records_in_file_flg then do; 2477 scode = 0; /* must reset to zero so that the next if statement will false */ 2478 i = i - 1; /* want to reposition back to the original position */ 2479 end; 2480 2481 if ^rtq_info.eof_request_flg & scode ^= 0 then do; 2482 2483 save_status_code = scode; 2484 call get_tape_status; /* get English desc of tape error */ 2485 2486 call ssu_$print_message (sci_ptr, save_status_code, 2487 "^/Tape status = ^4.3b.^/^[ ""^a""^;,^1s^] while executing iteration # ^d of ^a control order", 2488 t_stat, (status_story ^= ""), status_story, i, a_order); 2489 return; 2490 end; 2491 end; /* scode ^= 0 */ 2492 end; /* do i = 1 to count */ 2493 2494 if backspace_file_flg then do; /* if a backspace file operation */ 2495 call iox_$control (rtq_info.tiocb_ptr, "forward_file", null, scode); /* position to beginning of next file */ 2496 if scode ^= 0 then do; 2497 save_status_code = scode; 2498 call get_tape_status; /* get English desc of tape error */ 2499 2500 call ssu_$print_message (sci_ptr, save_status_code, 2501 "^/Tape status = ^4.3b.^/^[ ""^a""^;,^1s^] while forward spacing to beginning of file ^d", 2502 t_stat, (status_story ^= ""), status_story, rtq_info.c_file); 2503 return; 2504 end; 2505 end; /* a bsf command */ 2506 2507 end process_control_order; 2508 2509 /***************************************************************************/ 2510 2511 process_logical_record_length: proc (); 2512 2513 /* users want each physical tape record to be written into several logical */ 2514 /* records of a specified length. So do it. */ 2515 2516 /* begin coding */ 2517 it_cnt = divide (rtq_info.rec_len - schar, l_rec_len, 17, 0); /* determine # of logical records */ 2518 spill = mod (rtq_info.rec_len - schar, l_rec_len);/* get spill over if any */ 2519 2520 do i = 1 to it_cnt; 2521 rtq_info.cbufp -> cbuf = chcv_buf (i); /* copy logical record */ 2522 temp_logical_rec_len = l_rec_len; 2523 2524 if open_mode = Stream_output | open_mode = Stream_input_output then do; 2525 substr (rtq_info.cbufp -> cbuf, l_rec_len + 1, 1) = NL; /* add NL to its end */ 2526 temp_logical_rec_len = temp_logical_rec_len + 1; 2527 end; 2528 2529 call write_file (rtq_info.cbufp, temp_logical_rec_len, s_filename); /* and write it out */ 2530 2531 if rtq_info.return_subsys_loop_flg then 2532 return; 2533 2534 end; 2535 2536 if spill ^= 0 then do; /* if some left over */ 2537 it_cnt = it_cnt + 1; /* need 1 more subsrcipt for spill */ 2538 rtq_info.cbufp -> cbuf = substr (chcv_buf (it_cnt), 1, spill); 2539 2540 if open_mode = Stream_output | open_mode = Stream_input_output then do; 2541 substr (rtq_info.cbufp -> cbuf, spill + 1, 1) = NL; /* copy spillover */ 2542 spill = spill + 1; /* for the NL */ 2543 end; 2544 2545 call write_file (rtq_info.cbufp, spill, s_filename); /* and write it out too */ 2546 2547 if rtq_info.return_subsys_loop_flg then 2548 return; 2549 2550 end; /* process some record left over */ 2551 2552 return; 2553 2554 end process_logical_record_length; 2555 2556 /***************************************************************************/ 2557 2558 read_file_get_control_args: proc (); 2559 2560 /* process optional input control arguments for "read_file" request */ 2561 2562 do arg_dex = 1 to Nargs; 2563 call ssu_$arg_ptr (sci_ptr, arg_dex, ap, al); 2564 if arg = "-gcos" | arg = "-gc" then do; /* file in gcos standard system format */ 2565 gssf = "1"b; 2566 call check_mode (BINARY_MODE); /* must read data in binary mode */ 2567 n_ops = n_ops + 1; /* increment for inconsistancy check */ 2568 end; 2569 2570 else if arg = "-multics" | arg = "-mult" then do; /* file in multics standard system format */ 2571 mssf = "1"b; 2572 call check_mode (BINARY_MODE); /* must read data in binary mode */ 2573 n_ops = n_ops + 1; /* increment for inconsistancy check */ 2574 end; 2575 2576 else if arg = "-extend" then /* if file extend option desired */ 2577 rtq_info.extend_sw = "1"b; 2578 2579 else if arg = "-nnl" then /* if user don't want new line on raw File */ 2580 nnl_sw = "1"b; 2581 2582 else if arg = "-output_description" | arg = "-ods" then /* user wants to attach spec device */ 2583 rtq_info.atd_sw = "1"b; 2584 2585 else if arg = "-cp5" then do; /* cp5 variable length records */ 2586 cp5 = "1"b; /* set flag */ 2587 call check_mode (NINE_MODE); /* must read data in nine bit mode */ 2588 n_ops = n_ops + 1; /* increment for inconsistancy check */ 2589 end; 2590 2591 else if arg = "-dec" then do; /* DEC 40 bit word records */ 2592 lrp = rtq_info.cvbp; /* set conversion buffer pointer */ 2593 dec_sw = "1"b; /* set flag */ 2594 call check_mode (BINARY_MODE); /* must read data in binary mode */ 2595 n_ops = n_ops + 1; /* increment for inconsistancy check */ 2596 end; 2597 2598 else if arg = "-ibm_vb" then do; /* IBM "VB" records */ 2599 ibmv = "1"b; /* set flag */ 2600 if arg_dex < Nargs then do; 2601 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2602 if substr (arg, 1, 1) ^= "-" then do; 2603 arg_dex = arg_dex + 1; 2604 if arg = "binary" | arg = "bin" then 2605 rtq_info.set_bin = "1"b; 2606 else if arg = "ebcdic" then 2607 c_e_a = "1"b; 2608 else if arg ^= "ascii" then do; 2609 IBM_VB_ERROR: 2610 call ssu_$print_message (sci_ptr, 0, 2611 " Usage: read_file (rdfile) {-ibm_vb {ascii | binary (bin) | ebcdic}}"); 2612 goto GET_CONTROL_ARG_ERROR; 2613 end; /* else if arg ^= "ascii" */ 2614 end; /* if substr (arg, 1, 1) ^= "-" */ 2615 else c_e_a = "1"b; /* ebcdic conversion by default */ 2616 end; /* arg_dex < Nargs */ 2617 else if arg_dex = Nargs then 2618 c_e_a = "1"b; /* ebcdic conversion by default */ 2619 else goto IBM_VB_ERROR; 2620 if rtq_info.set_bin then /* if we need to read in binary mode */ 2621 call check_mode (BINARY_MODE);/* go set it */ 2622 else call check_mode (NINE_MODE); /* otherwise read in nine mode */ 2623 n_ops = n_ops + 1; /* for inconsistancy check */ 2624 end; /* else if arg = "-ibm_vb" */ 2625 2626 else if arg = "-ansi_db" then do; /* ANSI "DB" records */ 2627 ansid = "1"b; /* set flag */ 2628 if arg_dex < Nargs then do; 2629 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2630 if substr (arg, 1, 1) ^= "-" then do; 2631 arg_dex = arg_dex + 1; /* advance argument index */ 2632 if arg = "binary" | arg = "bin" then 2633 rtq_info.set_bin = "1"b; 2634 else if arg = "ebcdic" then 2635 c_e_a = "1"b; 2636 else if arg ^= "ascii" then do; 2637 ANSI_DB_ERROR: 2638 call ssu_$print_message (sci_ptr, 0, 2639 "Usage: read_file (rdfile) {-ansi_db {ascii | binary (bin) | ebcdic}}"); 2640 goto GET_CONTROL_ARG_ERROR; 2641 end; 2642 end; /* if substr (arg, 1, 1) ^= "-" */ 2643 end; /* arg_dex < Nargs */ 2644 else if arg_dex > Nargs then 2645 goto ANSI_DB_ERROR; 2646 else ; 2647 if rtq_info.set_bin then /* if we need to read in binary mode */ 2648 call check_mode (BINARY_MODE);/* go set it */ 2649 else call check_mode (NINE_MODE); /* otherwise read in nine mode */ 2650 n_ops = n_ops + 1; /* increment for inconsistancy check */ 2651 end; /* ANSI "DB" record */ 2652 2653 else if arg = "-truncate" | arg = "-tc" then do; /* user wants to truncate phy records */ 2654 if arg_dex < Nargs then do; 2655 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2656 tr_cnt = cv_dec_check_ (arg, scode); 2657 if scode ^= 0 then do; 2658 TC_ERROR: 2659 call ssu_$print_message (sci_ptr, scode, 2660 "^/ Usage: read_file (rdfile) {-truncate (-tc) N}"); 2661 goto GET_CONTROL_ARG_ERROR; 2662 end; 2663 arg_dex = arg_dex + 1; /* advance argument index */ 2664 trunc_sw = "1"b; 2665 end; /* if arg_dex < Nargs */ 2666 else do; 2667 scode = 0; 2668 goto TC_ERROR; 2669 end; 2670 end; /* -truncate (-tc) */ 2671 2672 else if arg = "-logical_record_length" | arg = "-lrl" then do; /* process log records */ 2673 if arg_dex < Nargs then do; 2674 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2675 l_rec_len = cv_dec_check_ (arg, scode); 2676 if scode ^= 0 then do; 2677 LRL_ERROR: 2678 call ssu_$print_message (sci_ptr, scode, 2679 "^/ Usage: read_file (rdfile) {-logical_record_length (-lrl) N}"); 2680 goto GET_CONTROL_ARG_ERROR; 2681 end; 2682 arg_dex = arg_dex + 1; /* advance argument index */ 2683 if l_rec_len > length (rtq_info.cbufp -> cbuf) then do; /* better to tell user of limitation */ 2684 call ssu_$print_message (sci_ptr, 0, 2685 "Logical record lengths > ^d characters not supported", length (rtq_info.cbufp -> cbuf)); 2686 goto GET_CONTROL_ARG_ERROR; 2687 end; 2688 l_rec = "1"b; 2689 n_ops = n_ops + 1; /* increment for inconsistancy check */ 2690 end; /* if arg_dex < Nargs */ 2691 else do; 2692 scode = 0; 2693 goto LRL_ERROR; 2694 end; 2695 end; /* -logical_record_length (-lrl) */ 2696 2697 else if arg = "-count" | arg = "-ct" then do;/* user wants to read multiple files */ 2698 if arg_dex < Nargs then do; 2699 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2700 iterations = cv_dec_check_ (arg, scode); /* check for rdfile iterations */ 2701 if scode ^= 0 then do; 2702 CNT_ERROR: 2703 call ssu_$print_message (sci_ptr, scode, 2704 "^/ Usage: read_file (rdfile) {-count (-ct) N}"); 2705 goto GET_CONTROL_ARG_ERROR; 2706 end; 2707 arg_dex = arg_dex + 1; /* advance argument index */ 2708 end; /* if arg_dex < Nargs */ 2709 else do; /* missing N for -count */ 2710 scode = 0; 2711 goto CNT_ERROR; 2712 end; 2713 end; /* -count (-ct) */ 2714 2715 else if arg = "-skip" then do; /* user wants to skip some initial chars */ 2716 if arg_dex < Nargs then do; 2717 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2718 schar = cv_dec_check_ (arg, scode); 2719 if scode ^= 0 then do; 2720 SKIP_ERROR: 2721 call ssu_$print_message (sci_ptr, scode, 2722 "^/ Usage: read_file (rdfile) {-skip N}"); 2723 goto GET_CONTROL_ARG_ERROR; 2724 end; 2725 arg_dex = arg_dex + 1; /* advance argument index */ 2726 end; /* if arg_dex < Nargs */ 2727 else do; 2728 scode = 0; 2729 goto SKIP_ERROR; 2730 end; 2731 end; /* -skip */ 2732 2733 else if arg = "-convert" | arg = "-conv" then do; /* user wants to do some conversion */ 2734 if arg_dex < Nargs then do; 2735 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2736 arg_dex = arg_dex + 1; /* advance argument index */ 2737 if arg = "ebcdic_to_ascii" | arg = "ebcdic" then 2738 c_e_a = "1"b; /* convert ebcdic */ 2739 else if arg = "bcd_to_ascii" | arg = "bcd" then 2740 c_b_a = "1"b; /* convert bcd */ 2741 else if arg = "comp8_to_ascii" | arg = "comp8" then do; /* convert comp8 to ascii */ 2742 c_c_a = "1"b; 2743 call check_mode (NINE_MODE); /* must read data in nine bit mode */ 2744 end; /* com8_to_ascii (comp8) */ 2745 else do; 2746 CONV_ERROR: 2747 call ssu_$print_message (sci_ptr, 0, 2748 "Usage: read_file (rdfile) {-convert (-conv) ebcdic_to_ascii (ebcdic) | bcd_to_ascii (bcd) | comp8_to_ascii (comp8)}"); 2749 goto GET_CONTROL_ARG_ERROR; 2750 end; 2751 end; /* if arg_dex < Nargs */ 2752 else goto CONV_ERROR; 2753 2754 lrp = rtq_info.cvbp; /* set conversion buffer pointer */ 2755 n_ops = n_ops + 1; /* increment for inconsistancy check */ 2756 end; /* -convert (-conv) */ 2757 2758 else if arg = "-output_file" | arg = "-of" then do; /* user wants output file specified */ 2759 if arg_dex < Nargs then do; 2760 call ssu_$arg_ptr (sci_ptr, arg_dex + 1, ap, al); 2761 if substr (arg, 1, 1) ^= "-" then do; /* don't allow file name to begin with - */ 2762 arg_dex = arg_dex + 1; /* advance argument index */ 2763 2764 if ^valid_pathname ((arg), "") then do; /* error expanding pathname */ 2765 OF_ERROR: 2766 call ssu_$print_message (sci_ptr, scode, 2767 "^/ Usage: read_file (rdfile) {-output_file (-of) FILE_NAME}"); 2768 goto GET_CONTROL_ARG_ERROR; 2769 end; 2770 2771 end; 2772 end; /* arg_dex < Nargs */ 2773 else do; 2774 scode = 0; 2775 goto OF_ERROR; 2776 end; 2777 end; /* -output_file (-of) */ 2778 2779 else do; 2780 call ssu_$print_message (sci_ptr, 0, 2781 "Invalid input optional control argument ""^a""", arg); 2782 goto GET_CONTROL_ARG_ERROR; 2783 end; 2784 end; /* do i = 1 to Nargs */ 2785 2786 return; 2787 2788 GET_CONTROL_ARG_ERROR: 2789 rtq_info.return_subsys_loop_flg = "1"b; 2790 return; 2791 2792 end read_file_get_control_args; 2793 2794 /***************************************************************************/ 2795 2796 read_in_the_entire_file: proc (); 2797 2798 /* depending on the record format, process each record just read in until */ 2799 /* end of file encountered. If the file is in GCOS JCL then invoke */ 2800 /* the "write_file" internal procedure to write end of job card. */ 2801 /* Similarly, invoke the "MULT_ssf" to go flush buffer for Multics file. */ 2802 /* Finally, if not extend the file then invokes the */ 2803 /* "detach_file_if_attached" to detach the file if it was already attached.*/ 2804 2805 /* begin code */ 2806 rtq_info.eof, binck = "0"b; 2807 do while (^rtq_info.eof); /* read entire file */ 2808 2809 call read_tape_record ("skip", rtq_info.eof, "0"b, mssf); /* read the next record */ 2810 2811 if rtq_info.return_subsys_loop_flg then 2812 return; 2813 2814 if ^rtq_info.eof then do; /* if not end of file */ 2815 2816 if valid_label_record ("0"b) then /* if label record */ 2817 goto nxt_rcd; /* then don't process */ 2818 2819 if trunc_sw then 2820 rtq_info.rec_len = tr_cnt; /* wants truncate phy record */ 2821 2822 if gssf then 2823 call GCOS_ssf (cont, imcv, nchars, binck, first_record_flg, s_filename); 2824 2825 else if mssf then 2826 call MULT_ssf (first_record_flg, last_record_flg, s_filename); /* MULTICS standard tape */ 2827 2828 else if cp5 then 2829 call CP5_variable_length_records; 2830 2831 else if dec_sw then 2832 call DEC_tape_records; 2833 2834 else if ibmv then 2835 call IBM_VB_records; 2836 2837 else if ansid then do; 2838 conversion_flg = "0"b; 2839 call ANSI_DB_records (conversion_flg); 2840 if conversion_flg then 2841 return; 2842 end; 2843 2844 else do; /* not known format, check for conversion */ 2845 if c_e_a then do; /* convert ebcdic to ascii */ 2846 2847 if rtq_info.c_mode = NINE_MODE then /* if nine mode */ 2848 call ebcdic_to_ascii_ (rtq_info.tptr -> char_buf, rtq_info.cvbp -> cv_buf); 2849 else do; 2850 rtq_info.rec_len = divide (rtq_info.bits + 8 - 1, 8, 21, 0); /* correct record length */ 2851 2852 call ebcdic8_to_ascii_ (rtq_info.tptr -> bit_buf, rtq_info.cvbp -> cv_buf); 2853 end; 2854 end; /* covert ebcdic to ascii */ 2855 2856 else if c_b_a then do; /* bcd to ascii conversion */ 2857 rtq_info.rec_len = divide (rtq_info.bits + 6 - 1, 6, 21, 0); /* correct record length */ 2858 call bcd_to_ascii_ (rtq_info.tptr -> bit_buf, rtq_info.cvbp -> cv_buf); 2859 end; /* convert bcd to ascii */ 2860 2861 else if c_c_a then do; /* convert comp 8 to ascii */ 2862 rtq_info.rec_len = divide (rtq_info.bits + 4 - 1, 4, 21, 0); /* correct record length */ 2863 call comp_8_to_ascii_ (rtq_info.tptr -> bit_buf, rtq_info.cvbp -> cv_buf); 2864 end; /* convert comp 8 to ascii */ 2865 2866 if l_rec then 2867 call process_logical_record_length; 2868 2869 else if rtq_info.atd_sw | nnl_sw then /* let he writes to what he wants */ 2870 call write_file (addr (conv_buf.conv_dta), rtq_info.rec_len - schar, s_filename); 2871 2872 else do; /* write a raw file by default */ 2873 substr (conv_buf.conv_dta, rtq_info.rec_len - schar + 1, 1) = NL; 2874 /* to prevent string range condition */ 2875 rtq_info.rec_len = (rtq_info.rec_len - schar) + 1; /* set correct record length */ 2876 2877 call write_file (addr (conv_buf.conv_dta), rtq_info.rec_len, s_filename); 2878 end; 2879 end; /* unknown format */ 2880 end; /* if ^rtq_info.eof */ 2881 2882 if rtq_info.return_subsys_loop_flg then 2883 return; 2884 2885 nxt_rcd: 2886 end; /* do while ^rtq_info.eof */ 2887 2888 if gssf then do; 2889 if rtq_info.last_job_deck_flg then do; 2890 2891 call write_file (addr (eoj_card), length (eoj_card), s_filename); /* if gcos jcl, write eoj card */ 2892 2893 if rtq_info.return_subsys_loop_flg then 2894 return; 2895 end; 2896 end; 2897 2898 if mssf then do; /* if Multics standard system format */ 2899 last_record_flg = "1"b; /* don't forget last data in buffer */ 2900 2901 call MULT_ssf (first_record_flg, last_record_flg, s_filename); /* go flush buffer */ 2902 2903 if rtq_info.return_subsys_loop_flg then 2904 return; 2905 end; 2906 2907 if ^rtq_info.extend_sw then /* if not extending this file */ 2908 2909 call detach_file_if_attached; /* just in case we had a file attached */ 2910 2911 end read_in_the_entire_file; 2912 2913 /***************************************************************************/ 2914 2915 read_tape_record: proc (neg, end_file, quiet_sw, mssf); 2916 2917 /* read in the next sequential tape record in the file. If the returned */ 2918 /* scode value is zero then increment the record number by 1, set buffer */ 2919 /* full flag so we can dump the record, calculate the record length in */ 2920 /* bits, and reset the end of file flag. If the returned scode value */ 2921 /* indicates end of file encountered then if end of file flag or end of */ 2922 /* volume flag was previously set then set end of tape flag, else set end */ 2923 /* of file flag. If not suppress output then display appropriate */ 2924 /* messages to users and adjust the record number to the first record in */ 2925 /* the file. Increment file number by 1, adjust the record length in */ 2926 /* bits to zero, and set end_file flag indicating end of file */ 2927 /* encountered. If the returned scode value indicates tape error then */ 2928 /* invoke "get_tape_status" to get tape error number and English */ 2929 /* description. If the tape error record is in Multics format then */ 2930 /* re-try to read it again up to 10 times before reporting to users. */ 2931 /* Ask users whether they want to retry again or to skip that error */ 2932 /* record or to return to the rtq request loop. */ 2933 2934 /* automatic storage */ 2935 dcl auto_retry fixed bin; 2936 dcl end_file bit (1) aligned; 2937 dcl explanation_string char (95); 2938 dcl get_answer char (5) varying; /* max len is 5 characters */ 2939 dcl mssf bit (1) aligned; 2940 dcl neg char (6); 2941 dcl query_flg bit (1) aligned; 2942 dcl question_string char (20); 2943 dcl quiet_sw bit (1) aligned; 2944 2945 2946 /* begin coding */ 2947 if rtq_info.two_eofs then goto gleot; /* if gcos partial header label */ 2948 2949 end_file = "0"b; /* reset eof indicator */ 2950 auto_retry = 0; /* intiialize auto retry count */ 2951 2952 retry_rd: 2953 call iox_$read_record (rtq_info.tiocb_ptr, rtq_info.tptr, rtq_info.buf_size - NUMB_OF_CHARS_PER_WORD, rtq_info.rec_len, scode); 2954 /* minus 4 because must reserve 1 word for appending a New Line character after returning to the caller */ 2955 if scode ^= 0 then do; 2956 2957 if scode ^= error_table_$end_of_info then do; 2958 save_status_code = scode; 2959 call get_tape_status; /* get English desc of tape error */ 2960 2961 if mssf then do; /* reading a Multics standard system format tape */ 2962 auto_retry = auto_retry + 1; 2963 if auto_retry > 10 then do; /* exceeded error threshold */ 2964 call ssu_$print_message (sci_ptr, save_status_code, 2965 "^/Tape status = ^4.3b.^/^[""^a""^;^1s^] ^/ Therefore, skipping record ^d, file ^d, ^a.", 2966 t_stat, (status_story ^= ""), status_story, rtq_info.c_rec, 2967 rtq_info.c_file, "due to unrecoverable read error"); 2968 2969 rtq_info.c_rec = rtq_info.c_rec + 1; /* increment record number */ 2970 end; /* exceeded error threshold */ 2971 else call iox_$control (rtq_info.tiocb_ptr, "backspace_record", null, scode); /* back it up */ 2972 2973 go to retry_rd; /* and go read next record */ 2974 end; /* reading a MULTICS Standard Label tape */ 2975 2976 call ssu_$print_message (sci_ptr, save_status_code, 2977 "Tape status = ^4.3b.^/^[ ""^a""^;,^1s^] while reading record ^d, file ^d", 2978 t_stat, (status_story ^= ""), status_story, rtq_info.c_rec, rtq_info.c_file); 2979 2980 if neg ^= "stop" then do; /* neg = "skip" */ 2981 explanation_string = "Do you want to retry, skip to the next record, or stop? Answer ""retry"", ""skip"", or ""stop""."; 2982 question_string = "Retry, skip or stop?"; 2983 end; 2984 else do; /* neg = "stop" */ 2985 explanation_string = "Do you want to retry or stop? Answer ""retry"" or ""stop""."; 2986 question_string = "Retry or stop?"; 2987 end; 2988 2989 get_answer = command_query_no_entrypoint (explanation_string, question_string); 2990 2991 query_flg = "1"b; 2992 do while (query_flg); 2993 query_flg = "0"b; /* exit do loop */ 2994 if get_answer = "retry" then do; 2995 call iox_$control (rtq_info.tiocb_ptr, "backspace_record", null, scode); 2996 2997 if scode = error_table_$end_of_info then 2998 goto END_OF_INFO_REACHED; 2999 else go to retry_rd; 3000 end; 3001 3002 else if get_answer = "skip" then do; 3003 rtq_info.c_rec = rtq_info.c_rec + 1; /* increment record number */ 3004 go to retry_rd;/* and go read it */ 3005 end; 3006 3007 else if get_answer = "stop" then do; 3008 rtq_info.return_subsys_loop_flg = "1"b; 3009 end_file = "1"b; /* indicate error */ 3010 return; /* return to request loop */ 3011 end; 3012 3013 else do; 3014 get_answer = command_query_no_entrypoint (explanation_string, question_string); 3015 3016 query_flg = "1"b; 3017 end; 3018 end; /* do while */ 3019 end; /* if scode ^= error_table_$end_of_info */ 3020 3021 else do; /* end of file */ 3022 END_OF_INFO_REACHED: 3023 if rtq_info.one_eof | rtq_info.eov then rtq_info.two_eofs = "1"b; /* indicate physical end of tape */ 3024 else rtq_info.one_eof = "1"b; /* no set one eof indicator */ 3025 3026 gleot: 3027 if ^quiet_sw then do; /* if not suppressing output */ 3028 if rtq_info.two_eofs then do; /* if at physical end of tape, tell user */ 3029 call ioa_ ("End of file encountered on file # ^d. No data read.", rtq_info.c_file); 3030 3031 call ioa_ ("Logical end of tape at physical file # ^d", rtq_info.c_file); 3032 end; 3033 else do; 3034 if rtq_info.c_rec = 1 then do; 3035 call ioa_ ("End of file encountered on file # ^d. No data read.", rtq_info.c_file); 3036 3037 call ioa_ ("Positioning to start of file # ^d.", rtq_info.c_file + 1); 3038 end; 3039 else do; 3040 call ioa_ ("End of file after ^d record^[s^] read from tape file # ^d", 3041 rtq_info.c_rec - 1, (rtq_info.c_rec > 2), rtq_info.c_file); 3042 call ioa_ ("Positioning to start of file # ^d.", rtq_info.c_file + 1); 3043 end; 3044 end; 3045 3046 rtq_info.c_rec = 1; /* reset record number */ 3047 end; 3048 3049 rtq_info.c_file = rtq_info.c_file + 1; /* increment file number */ 3050 rtq_info.bits = 0; /* reset number of bits */ 3051 end_file = "1"b; /* and turn on eof indicator */ 3052 end; /* end of file */ 3053 end; /* scode ^= 0 */ 3054 else do; /* scode = 0 */ 3055 rtq_info.c_rec = rtq_info.c_rec + 1; /* no tape errors, increment record number */ 3056 rtq_info.buf_ful = "1"b; /* set buffer ful switch so we can dump record */ 3057 rtq_info.bits = rtq_info.rec_len * 9; /* and calculate bit len of record */ 3058 rtq_info.one_eof = "0"b; /* reset one eof indicatior if set */ 3059 end; 3060 3061 end read_tape_record; 3062 3063 /***************************************************************************/ 3064 3065 record_information: proc (numrecs, nbits, rcd_tally); 3066 3067 /* display a record length in bits, words, nine-bit bytes, eight-bit bytes, */ 3068 /* and in six-bit characters. */ 3069 3070 dcl (bit6, bit8, bit9) fixed bin (35) init (0); 3071 dcl (nbits, numrecs) fixed bin (35); 3072 dcl rcd_tally bit (1); 3073 3074 /* begin coding */ 3075 if ^rcd_tally then /* if called from rdrec request */ 3076 if valid_label_record ("1"b) then return; /* check for valid label record */ 3077 3078 nwds = divide (nbits, 36, 35); 3079 bit9 = divide (nbits, 9, 35); 3080 bit8 = divide (nbits, 8, 35); 3081 bit6 = divide (nbits, 6, 35); 3082 3083 call ioa_ ("^[ ^d record^[s^]:^;^2sRecord^] ^a ^d ^a, ^d ^a, ^d ^a,^[^/ ^-^[^- ^;^6x^]^;^1s ^] ^d ^a, ^d ^a", 3084 rcd_tally, numrecs, (numrecs > 1), "length =", nbits, "bits", nwds, "words", bit9, 3085 "nine bit bytes", rtq_info.short_output_flg, rcd_tally, bit8, "eight bit bytes", bit6, "six bit chars"); 3086 3087 end record_information; 3088 3089 /***************************************************************************/ 3090 3091 valid_label_record: proc (lg_ck) returns (bit (1) aligned); 3092 3093 /* determines that the record is a LABEL/TRAILER record and displays its */ 3094 /* contents if it is. */ 3095 3096 dcl ansi_hdr2_fmt char (108) int static options (constant) init 3097 ("Record format ^a^[^[B^]^;^1s^]; Block length ^d; Record length ^d; Mode ^[ASCII^;EBCDIC^;BINARY^;UNKNOWN^];"); 3098 3099 dcl (eov, lg_ck) bit (1) aligned; 3100 3101 /* begin coding */ 3102 go to lab_type (rtq_info.l_type); /* check for LABEL records first */ 3103 3104 lab_type (1): /* check for MULTICS label records */ 3105 if rtq_info.tptr -> mstr.head.label then do; /* Multics tape label record */ 3106 call ioa_ ("^[^/^] ^a version ^[2^;1^] label record for volume ^a", (rtq_info.c_rec = 2), 3107 LABEL (rtq_info.l_type), (unspec (substr (rtq_info.tptr -> mult.volume_set_id, 1, 1)) ^= "777"b3), rtq_info.tptr -> mult.tape_reel_id); 3108 3109 if lg_ck then do; /* if user wants more info... */ 3110 if substr (rtq_info.tptr -> mstr.head.uid, 18, 1) then /* if uid generated by unique_bits_... */ 3111 call date_time_ (bin (substr (rtq_info.tptr -> mstr.head.uid, 19, 52), 71), time_string); 3112 else call date_time_ (bin (rtq_info.tptr -> mstr.head.uid, 71), time_string); 3113 3114 call ioa_ ("Tape created on:^-^a", time_string); 3115 3116 if rtq_info.tptr -> mult.installation_id ^= "" then /* and this exists then give it to him */ 3117 call ioa_ ("Tape created at:^-^a", rtq_info.tptr -> mult.installation_id); 3118 3119 if unspec (substr (rtq_info.tptr -> mult.volume_set_id, 1, 1)) ^= "777"b3 then /* if version 2 label */ 3120 if rtq_info.tptr -> mult.volume_set_id ^= "" then /* and volume set exists.. */ 3121 3122 call ioa_ ("Volume Set Name:^-^a", rtq_info.tptr -> mult.volume_set_id); 3123 end; /* if log_ck */ 3124 end; /* Multics tape LABEL record */ 3125 3126 else if rtq_info.tptr -> mstr.head.eor then /* if end of reel record */ 3127 call ioa_ ("^[^/^] ^a end of reel record", (rtq_info.c_rec = 2), LABEL (rtq_info.l_type)); 3128 else return ("0"b); /* not Multics tape label record */ 3129 3130 return ("1"b); /* was label record, return true */ 3131 3132 3133 lab_type (2): /* check for version 2 Multics label records */ 3134 if rtq_info.c_file = 1 & rtq_info.tptr -> mst_label.head.label then do; /* if Multics tape label record */ 3135 call ioa_ ("^[^/^] ^a version ^d label record for volume ^a", (rtq_info.c_rec = 2), LABEL (rtq_info.l_type), 3136 rtq_info.tptr -> mst_label.label_version, rtq_info.tptr -> mst_label.tape_reel_id); 3137 3138 if lg_ck then do; /* if user wants more info */ 3139 if substr (rtq_info.tptr -> mst_label.head.uid, 18, 1) then /* if uid generated by unique_bits_... */ 3140 call date_time_ (bin (substr (rtq_info.tptr -> mst_label.head.uid, 19, 52), 71), time_string); 3141 else call date_time_ (bin (rtq_info.tptr -> mst_label.head.uid, 71), time_string); 3142 3143 call ioa_ ("Tape created on:^-^a", time_string); 3144 3145 if rtq_info.tptr -> mst_label.installation_id ^= "" then /* if one exists, print it */ 3146 call ioa_ ("Tape created at:^-^a", rtq_info.tptr -> mst_label.installation_id); 3147 3148 if rtq_info.tptr -> mst_label.userid ^= "" then /* if one exists, print it */ 3149 call ioa_ ("Tape created by:^-^a", rtq_info.tptr -> mst_label.userid); 3150 3151 if rtq_info.tptr -> mst_label.boot_pgm_path ^= "" then /* if one exists, print it */ 3152 call ioa_ ("Boot program path:^-^a", rtq_info.tptr -> mst_label.boot_pgm_path); 3153 3154 if rtq_info.tptr -> mst_label.volume_set_id ^= "" then /* if this exists, print it */ 3155 call ioa_ ("Volume Set Name:^-^a", rtq_info.tptr -> mst_label.volume_set_id); 3156 3157 if rtq_info.tptr -> mst_label.copyright ^= "" then /* if protection notice exits, print it */ 3158 call ioa_ ("Protection Notice:^-^a", rtq_info.tptr -> mst_label.copyright); 3159 end; /* if lg_ck */ 3160 end; /* it is file 1 and it is MULTICS tape Label record */ 3161 3162 else if rtq_info.tptr -> mstr.head.eor then /* if end of reel record */ 3163 call ioa_ ("^[^/^] ^a end of reel record", (rtq_info.c_rec = 2), LABEL (rtq_info.l_type)); 3164 else return ("0"b); /* not Multics tape label record */ 3165 3166 return ("1"b); /* was label record, return true */ 3167 3168 3169 lab_type (3): /* check for GCOS Label records */ 3170 if rtq_info.bits = 504 then do; /* if gcos tape label or eof record */ 3171 call bcd_to_ascii_ (bit_buf, rtq_info.cbufp -> cbuf); /* convert bcd to ascii */ 3172 3173 if gcos.lab_id = g_label then do; /* if header label */ 3174 if substr (bit_buf, 145, 216) = "0"b then do; /* partial hdr label */ 3175 rtq_info.eov, rtq_info.two_eofs = "1"b; /* logical end of tape */ 3176 j = 24; /* set character count */ 3177 end; 3178 else j = 60; /* normal hdr label */ 3179 3180 call ioa_ ("^a ^[Partial ^]^[BTL ^]^a^[; Tape reel # ^a^;^1s^].^[^/(""^a"")^;^1s^]^[^/^]", 3181 LABEL (rtq_info.l_type), eov, (rtq_info.c_file = 1), "header label record", (rtq_info.c_file ^= 1), 3182 substr (rtq_info.cbufp -> cbuf, 19, 6), lg_ck, substr (rtq_info.cbufp -> cbuf, 1, j), eov); 3183 end; /* label header */ 3184 3185 else call ioa_ ("^/^a ""^a"" label record. ^a ^d^[; Next reel # ^a^;^1s^].^[^/(""^a"")^;^1s^]", 3186 LABEL (rtq_info.l_type), substr (rtq_info.cbufp -> cbuf, 2, 3), "Block count of previous file", 3187 bin (substr (bit_buf, 37, 36)), (substr (rtq_info.cbufp -> cbuf, 79, 6) ^= ""), 3188 substr (rtq_info.cbufp -> cbuf, 79, 6), lg_ck, rtq_info.cbufp -> cbuf); 3189 return ("1"b); 3190 end; /* GCOS Label record */ 3191 3192 else return ("0"b); /* not label record */ 3193 3194 3195 lab_type (4): /* check for IBM Label records */ 3196 if rtq_info.rec_len = 80 then do; /* it looks like a label record */ 3197 call ebcdic_to_ascii_ (rtq_info.tptr -> char_buf, rtq_info.cvbp -> cv_buf); /* convert ebcdic to ascii */ 3198 rtq_info.lblp = rtq_info.cvbp; /* set label ptr */ 3199 go to ibm_asc_join; /* go join common code */ 3200 end; 3201 3202 else return ("0"b); /* not label/trailer return false */ 3203 3204 3205 lab_type (5): /* check for ANSI Label records */ 3206 if rtq_info.rec_len = 80 then do; /* it looks like a label/trailer record */ 3207 rtq_info.lblp = rtq_info.tptr; /* set label ptr */ 3208 3209 ibm_asc_join: /* code from now on common for ibm and ansi */ 3210 3211 if substr (lab_buf, 1, 4) = "VOL1" then /* vol1 label */ 3212 call ioa_ ("^[^/^] ^a ^a label record. Volume serial number ^a^[^/(""^a"")^;^1s^]^/", (rtq_info.c_rec = 2), 3213 LABEL (rtq_info.l_type), substr (lab_buf, 1, 4), substr (lab_buf, 5, 6), lg_ck, lab_buf); 3214 3215 else if substr (lab_buf, 1, 4) = "HDR1" then /* hdr1 label */ 3216 call ioa_ ("^[^/^] ^a ^a label record. Data set ID ^a^[^/(""^a"")^;^1s^]^/", (rtq_info.c_rec = 2), 3217 LABEL (rtq_info.l_type), substr (lab_buf, 1, 4), substr (lab_buf, 5, 17), lg_ck, lab_buf); 3218 3219 else if substr (lab_buf, 1, 4) = "HDR2" then do; /* hdr2 label */ 3220 call ioa_ ("^a ^a label record. Next file format:", LABEL (rtq_info.l_type), substr (lab_buf, 1, 4)); 3221 3222 if rtq_info.l_type = ibm_label then do; /* IBM HDR2 Label */ 3223 ibm_hdr2P = rtq_info.lblp; /* set structure ptr */ 3224 call ioa_ ("Record format ^a^a; Block length ^d; Record length ^d;", 3225 ibm_hdr2.format, ibm_hdr2.block_attribute, bin (ibm_hdr2.blksize), bin (ibm_hdr2.lrecl)); 3226 end; 3227 else do; /* ANSI HDR2 Label */ 3228 ansi_hdr2P = rtq_info.lblp; /* set structure ptr */ 3229 ansi_mode = index ("123", ansi_hdr2.mode); /* convert recording mode */ 3230 3231 if ansi_mode = 0 then ansi_mode = 4; /* this is an unknown mode */ 3232 call ioa_ (ansi_hdr2_fmt, ansi_hdr2.format, (ansi_hdr2.blocked = "0" | ansi_hdr2.blocked = "1"), 3233 (ansi_hdr2.blocked = "1"), bin (ansi_hdr2.blklen), bin (ansi_hdr2.reclen), 3234 ansi_mode); 3235 3236 if ansi_mode = 3 then /* if file in binary mode */ 3237 rtq_info.set_bin, rtq_info.set_nine = "1"b; /* set state switches */ 3238 end; /* ANSI HDR2 Label */ 3239 3240 if lg_ck then call ioa_ ("(""^a"")", lab_buf); 3241 end; /* HDR2 Label */ 3242 3243 else if substr (lab_buf, 1, 3) = "EOV" | substr (lab_buf, 1, 3) = "EOF" | 3244 substr (lab_buf, 1, 3) = "UHL" | substr (lab_buf, 1, 3) = "UTL" then do; /* one of these labels */ 3245 call ioa_ ("^[^/^] ^a ^a label record. ^[^/(""^a"")^;^1s^]^/", (rtq_info.c_rec = 2), 3246 LABEL (rtq_info.l_type), substr (lab_buf, 1, 4), lg_ck, lab_buf); 3247 3248 if substr (lab_buf, 1, 3) = "EOV" then eov = "1"b; /* Logical End tape */ 3249 end; /* EOV Label or EOF Label or UHL Label or UTL Label */ 3250 3251 else return ("0"b); /* none of known labels */ 3252 3253 return ("1"b); /* if one of these: VOL1, HDR1, HDR2, EOV, EOF, UHL, and UTL labels */ 3254 end; /* if rtq_info.rec_len = 80 */ 3255 3256 else return ("0"b); /* not a Label or Trailer record */ 3257 3258 3259 lab_type (6): /* check for CP5 Label records */ 3260 if substr (bit_buf, 1, 9) ^= "172"b3 then /* if first char not = ebcdic ":" */ 3261 return ("0"b); /* then its not label record */ 3262 3263 call ebcdic_to_ascii_ (rtq_info.tptr -> char_buf, rtq_info.cvbp -> cv_buf); /* convert ebcdic to ascii */ 3264 rtq_info.lblp = rtq_info.cvbp; /* set label ptr */ 3265 3266 if sentinel = ":LBL" | sentinel = ":ACN" | sentinel = ":BOF" | 3267 sentinel = ":EOV" | sentinel = ":EOR" | sentinel = ":EOF" then do; 3268 call ioa_ ("^[^/^] ^a ^a label record^[; Volume id ^a^;^1s^].^[^/(""^a"")^;^1s^]^/", (rtq_info.c_rec = 2), 3269 LABEL (rtq_info.l_type), sentinel, (sentinel = ":LBL"), substr (lab_buf, 5, 4), lg_ck, lab_buf); 3270 return ("1"b); /* return true */ 3271 end; 3272 else return ("0"b); /* otherwise, return false */ 3273 3274 3275 lab_type (0): /* unlabeled tape, egnore looking at labels */ 3276 return ("0"b); /* not label record */ 3277 3278 end valid_label_record; 3279 3280 /***************************************************************************/ 3281 3282 valid_pathname: proc (pathname_argument, suffix) returns (bit (1) aligned); 3283 3284 /* expands a specified entry name to a directory pathname and appends a */ 3285 /* specified suffix to an entry name. Returns a "1"b indicating success, */ 3286 /* otherwise, returns a "0"b. */ 3287 3288 dcl p_dir char (168); 3289 dcl p_entry char (32); 3290 dcl pathname_argument char (*); 3291 dcl suffix char (*); 3292 3293 /* begin coding */ 3294 call expand_pathname_$add_suffix (pathname_argument, suffix, p_dir, p_entry, scode); 3295 if scode ^= 0 then 3296 return ("0"b); 3297 else do; 3298 rtq_info.filename = p_entry; 3299 rtq_info.filepath = pathname_ (p_dir, p_entry); 3300 return ("1"b); 3301 end; 3302 3303 end valid_pathname; 3304 3305 /***************************************************************************/ 3306 3307 write_file: proc (bufptr, wrtchars, s_file_name); 3308 3309 /* writes logical records to a specified file: If users don't specify a */ 3310 /* file then they will be asked for a file name. If users don't specify a */ 3311 /* file format then displays a warning message and query them before */ 3312 /* we write a raw file. Builds the attach description before attaching */ 3313 /* and opening the file using vfile_ i/o module. Reports to users if the */ 3314 /* output file has not been written yet. Depending on the open mode, */ 3315 /* writes each logical record to the output file. Queries users for */ 3316 /* re-trying to write again if the returned scode value is not a zero */ 3317 /* value. */ 3318 3319 dcl bufptr ptr; 3320 dcl output_filename char (168) aligned; 3321 dcl s_file_name char (32) varying; 3322 dcl wrtchars fixed bin (21); /* written characters */ 3323 3324 /* begin coding */ 3325 if ^rtq_info.f_attached then do; /* if file not attached */ 3326 if rtq_info.filename = "" then do; /* if no filename, go ask for it */ 3327 rtq_info.tmr = "0"b; /* initialize terminate condition */ 3328 do while (^rtq_info.tmr); /* if no filename */ 3329 output_filename = command_query_no_entrypoint ("Please enter an output file name.", "Output file name: "); 3330 3331 rtq_info.tmr = valid_pathname ((output_filename), ""); 3332 if ^rtq_info.tmr then do; 3333 call ssu_$print_message (sci_ptr, scode, 3334 "Expanding pathname while writing to the ouput file name ""^a""", 3335 output_filename); 3336 3337 rtq_info.return_subsys_loop_flg = "1"b; 3338 return; 3339 end; 3340 end; /* do while ^rtq_info.tmr */ 3341 end; /* if rtq_info.filename = "" */ 3342 3343 if ^nnl_sw & n_ops = 0 & s_file_name = "" then do; /* warn user before we write raw file */ 3344 3345 call ioa_ ("Warning: Tape file # ^d will be written to stream file ^a.^/A new line " || 3346 "character (octal 012) will be appended to the end of each physical record.", 3347 rtq_info.c_file, rtq_info.filename); 3348 3349 YES_FLG = command_query_yes_no ("Do you want to add a new line character to each physical record? Answer ""yes"" or ""no"".", "Append a new line character?"); 3350 3351 if ^YES_FLG then do; /* users said no */ 3352 rtq_info.return_subsys_loop_flg = "1"b; 3353 return; 3354 end; 3355 end; /* if ^nnl_sw & n_ops = 0 & s_file_name = "" */ 3356 3357 att_desc = "vfile_ " || rtq_info.filepath; /* build attach description now */ 3358 3359 /* attach and open the output file */ 3360 call attach_and_open_output_file; 3361 end; /* if ^rtq_info.f_attached */ 3362 3363 if ^rtq_info.fw_file then do; /* if first record of file */ 3364 rtq_info.fw_file = "1"b; /* set switch */ 3365 if ^rtq_info.atd_sw then /* if user not using his own attach desc */ 3366 call ioa_ ("Writing file ""^a"".", rtq_info.filepath); 3367 end; 3368 3369 RETRY_WRITE: 3370 if open_mode = Stream_output | open_mode = Stream_input_output then /* if open for "so" or "sio" */ 3371 call iox_$put_chars (rtq_info.fiocb_ptr, bufptr, wrtchars, scode); /* write out logical records */ 3372 else call iox_$write_record (rtq_info.fiocb_ptr, bufptr, wrtchars, scode); /* write out logical records */ 3373 3374 if scode ^= 0 then do; 3375 call ssu_$print_message (sci_ptr, scode, "while writing to ""^a""", att_desc); 3376 3377 YES_FLG = command_query_yes_no ("Do you want to retry? Answer ""yes"" or ""no"".", "Retry?"); 3378 3379 if YES_FLG then /* users want to retry */ 3380 goto RETRY_WRITE; 3381 end; 3382 3383 end write_file; 3384 3385 /***************************************************************************/ 3386 2 1 /* BEGIN INCLUDE FILE: rtq_stucture_info.incl.pl1 */ 2 2 2 3 /****^ HISTORY COMMENTS: 2 4* 1) change(87-06-09,TLNguyen), approve(87-06-09,MCR7692), 2 5* audit(87-07-15,Blair), install(87-07-28,MR12.1-1048): 2 6* implement read_tape_and_query (rtq) nonstandard subsystem as an ssu_ 2 7* standard subsystem. 2 8* END HISTORY COMMENTS */ 2 9 2 10 /* Created by Tai Le Nguyen for use by read_tape_and_query subsystem */ 2 11 2 12 dcl 1 rtq_structure_info aligned, /* aligned because of speed up purpose */ 2 13 2 Version char (8), /* version name is rtq.1 */ 2 14 2 bits fixed bin (35), /* record length in bits */ 2 15 2 block_size fixed bin (35), 2 16 2 buf_size fixed bin (21), /* buffer size */ 2 17 2 c_den char (5), /* current density */ 2 18 2 c_file fixed bin, /* current file */ 2 19 2 c_mode fixed bin, /* current mode */ 2 20 2 c_rec fixed bin, /* current record */ 2 21 2 pointers, 2 22 3 cbufp ptr, /* current buffer pointer */ 2 23 3 cdkp ptr, /* compdeck card pointer */ 2 24 3 cdptr ptr, /* compdeck pointer */ 2 25 3 cfptr ptr, /* compression field pointer */ 2 26 3 cvp ptr, /* conversion pointer */ 2 27 3 cvbp ptr, /* convertion buffer pointer */ 2 28 3 fiocb_ptr ptr, /* file i/o control block pointer */ 2 29 3 lblp ptr, /* label pointer */ 2 30 3 rptr ptr, /* record pointer */ 2 31 3 rtq_area_ptr ptr, /* read tape and query area pointer */ 2 32 3 tiocb_ptr ptr, /* tape i/o control block polinter */ 2 33 3 tptr ptr, /* tape pointer */ 2 34 2 clen fixed bin (21), /* current length */ 2 35 2 cvbl fixed bin (21), /* conversion buffer length */ 2 36 2 ddec fixed bin (35), /* density decimal */ 2 37 2 l_type fixed bin, /* label type */ 2 38 2 density (5) char (5), 2 39 2 flags, 2 40 3 atd_sw bit (1), /* attach description switch */ 2 41 3 buf_ful bit (1), /* buffer full switch */ 2 42 3 eof bit (1), /* end of file */ 2 43 3 eof_request_flg bit (1), /* end of file request flag */ 2 44 3 eov bit (1), /* end of volume */ 2 45 3 extend_sw bit (1), /* extended switch */ 2 46 3 f_attached bit (1), /* file attached */ 2 47 3 fw_file bit (1), /* written file switch */ 2 48 3 last_job_deck_flg bit (1), 2 49 3 one_eof bit (1), 2 50 3 records_in_file_flg bit (1), /* number of records in the current file flag */ 2 51 3 return_subsys_loop_flg bit (1), 2 52 3 set_bin bit (1), /* set binary mode switch */ 2 53 3 set_nine bit (1), /* set nine mode switch */ 2 54 3 short_output_flg bit (1), /* for setting line length on a given i/o switch */ 2 55 3 tmr bit (1), /* terminate read switch */ 2 56 3 two_eofs bit (1), /* end of tape switch */ 2 57 2 tape_name char (8), 2 58 2 rec_len fixed bin (21), /* record length in chars */ 2 59 2 tdec fixed bin (35), /* track decimal */ 2 60 2 wd_buf_size fixed bin, /* word buffer size */ 2 61 2 filename char (32) varying, /* notes that these variables of character varying declaration */ 2 62 2 filepath char (168) varying, /* are placed at the bottom of the structure to avoid being overwritten */ 2 63 2 tape_atd char (200) unaligned varying;/* tape attach description */ 3387 3388 3 1 /* BEGIN INCLUDE FILE: ibm_hdr2.incl.pl1 */ 3 2 /* Modified by J. A. Bush 04/26/83 for use by mtape_ */ 3 3 3 4 /* format: style4 */ 3 5 3 6 dcl ibm_hdr2P ptr; /* pointer on which ibm_hdr2 is based */ 3 7 3 8 dcl 1 ibm_hdr2 unaligned based (ibm_hdr2P), 3 9 2 label_id char (4), /* HDR2/EOF2/EOV2 */ 3 10 2 format char (1), /* U/F/V */ 3 11 2 blksize char (5), /* equivalent to ANSI block length - 32760 maximum */ 3 12 2 lrecl char (5), /* equivalent to ANSI record length - 32760 maximum */ 3 13 /* for VS and VBS, 0 means lrecl > 32756 */ 3 14 2 density char (1), /* no ANSI equivalent */ 3 15 /* 2 = 800 bpi; 3 = 1600 cpi; 4 = 6250 cpi */ 3 16 2 dataset_position char (1), /* no ANSI equivalent */ 3 17 /* 0 = no volume switch has occurred */ 3 18 /* 1 = volume switch has occurred */ 3 19 2 jobstep_id char (17), /* no ANSI equivalent */ 3 20 2 recording_technique char (2), /* no ANSI equivalent - " " = 9 track */ 3 21 2 control_characters char (1), /* no ANSI equivalent */ 3 22 2 reserved1 char (1), /* " " */ 3 23 2 block_attribute char (1), /* no ANSI equivalent */ 3 24 /* "B" - records are blocked */ 3 25 /* "S" - records are spanned */ 3 26 /* "R" - records are blocked and spanned */ 3 27 /* " " - records are neither blocked nor spanned */ 3 28 2 reserved2 char (41); /* " " */ 3 29 3 30 dcl 1 ibm_system_use unaligned based (addr (ibm_hdr2.reserved2)), /* mtape IBM overlay */ 3 31 2 mode char (1), /* 1 - ASCII, 9 mode; 2 - EBCDIC, 9 mode; 3 - binary */ 3 32 2 next_volname char (6); /* Next volume id in EOV2 label */ 3 33 3 34 dcl IBM_L2_ID (3) char (4) int static options (constant) init 3 35 ("HDR2", "EOV2", "EOF2"); 3 36 dcl (IBM_HDR2 init (1), 3 37 IBM_EOV2 init (2), 3 38 IBM_EOF2 init (3)) fixed bin int static options (constant); 3 39 3 40 /* END INCLUDE FILE: ibm_hdr2.incl.pl1 */ 3389 4 1 /* BEGIN INCLUDE FILE: ansi_hdr2.incl.pl1 */ 4 2 /* Modified by J. A. Bush 11/07/82 for use by mtape_ */ 4 3 4 4 /* format: style4 */ 4 5 4 6 dcl ansi_hdr2P ptr; /* pointer on which ansi_hdr2 structure is based */ 4 7 4 8 dcl 1 ansi_hdr2 unaligned based (ansi_hdr2P), 4 9 2 label_id char (4), /* HDR2/EOF2/EOV2 */ 4 10 2 format char (1), /* U, F, D, or S */ 4 11 2 blklen char (5), /* maximum number of characters per block */ 4 12 2 reclen char (5), /* maximum or actual record length - meaning varies with format */ 4 13 2 system_use, /* 35 characters reserved for system-specific use */ 4 14 3 next_volname char (32), /* next volume name - for trailer label */ 4 15 3 blocked char (1), /* blocking attribute: 0 - no / 1 - yes */ 4 16 3 mode char (1), /* data encoding mode */ 4 17 /* 1 - ASCII, 9 mode */ 4 18 /* 2 - EBCDIC, 9 mode */ 4 19 /* 3 - binary */ 4 20 3 system_reserved char (1), /* reserved for future use */ 4 21 2 buffer_offset char (2), /* meaningful only if HDR1 system code ^= "" */ 4 22 2 reserved char (28); /* spaces */ 4 23 4 24 /* Old HDR2 system use field, pre-secure-authentication */ 4 25 4 26 dcl 1 old_ansi_hdr2_system_use based (addr (ansi_hdr2.system_use)), 4 27 2 canonical_next_volname char (6), /* next volume name - for trailer label */ 4 28 2 blocked char (1), /* blocking attribute: 0 - no / 1 - yes */ 4 29 2 mode char (1), /* data encoding mode (same as above) */ 4 30 2 system_reserved char (27); /* blanks */ 4 31 4 32 dcl ANSI_L2_ID (3) char (4) int static options (constant) init 4 33 ("HDR2", "EOV2", "EOF2"); 4 34 dcl (ANSI_HDR2 init (1), 4 35 ANSI_EOV2 init (2), 4 36 ANSI_EOF2 init (3)) fixed bin int static options (constant); 4 37 4 38 /* END INCLUDE FILE: ansi_hdr2.incl.pl1 */ 3390 3391 5 1 5 2 /* Begin include file ...... mstr.incl.pl1 */ 5 3 /* Modified 2/11/74 by N. I. Morris */ 5 4 /* Modified 12/30/80 by J. A. Bush for bootable tape labels */ 5 5 /* Modified 12/14/82 by J. A. Bush to add version number to the record header */ 5 6 5 7 /* format: style4,delnl,insnl,indattr,ifthen,declareind10,dclind10 */ 5 8 dcl mstrp ptr; /* pointer to MST record */ 5 9 5 10 dcl 1 mstr based (mstrp) aligned, /* Multics standard tape mstr */ 5 11 2 head like mstr_header, /* tape record header */ 5 12 2 data bit (36864 refer (mstr.head.data_bit_len)), 5 13 /* record body */ 5 14 2 trail like mstr_trailer; /* record trailer */ 5 15 5 16 dcl 1 mst_label based (mstrp) aligned, /* bootable label structure */ 5 17 2 xfer_vector (4), /* bootload interrupt transfer vector */ 5 18 3 lda_instr bit (36), /* this will be a "LDA 4" instruction */ 5 19 3 tra_instr bit (36), /* a "TRA" instruction to start of boot pgm */ 5 20 2 head like mstr_header, /* standard record header */ 5 21 2 vid like volume_identifier, /* tape volume info */ 5 22 2 fv_overlay (0:31), /* overlay for fault vectors when tape booted */ 5 23 3 scu_instr bit (36), /* an "SCU" instruction to address of fault_data */ 5 24 3 dis_instr bit (36), /* a "DIS" instruction, with Y field = to its own addr */ 5 25 2 fault_data (8) bit (36), /* SCU data for unexpected faults goes here */ 5 26 2 boot_pgm_path char (168) unaligned, /* path name of boot program */ 5 27 2 userid char (32) unaligned, /* Storage for Person.Project.Instance of creator of tape */ 5 28 2 label_version fixed bin, /* defined by LABEL_VERSION constant below */ 5 29 2 output_mode fixed bin, /* mode in which tape was written with */ 5 30 2 boot_pgm_len fixed bin, /* length in words of boot program */ 5 31 2 copyright char (56), /* Protection notice goes here if boot pgm is written */ 5 32 2 pad (13) bit (36), /* pad out to 192 (300 octal) */ 5 33 2 boot_pgm (0 refer (mst_label.boot_pgm_len)) bit (36), 5 34 /* boot program */ 5 35 2 trail like mstr_trailer; /* standard record trailer */ 5 36 5 37 dcl 1 mstr_header based aligned, /* Multics standard tape record header */ 5 38 ( 2 c1 bit (36), /* constant = 670314355245(8) */ 5 39 2 uid bit (72), /* unique ID */ 5 40 2 rec_within_file fixed bin (17), /* phys. rec. # within phys. file */ 5 41 2 phy_file fixed bin (17), /* phys. file # on phys. tape */ 5 42 2 data_bits_used fixed bin (17), /* # of bits of data in record */ 5 43 2 data_bit_len fixed bin (17), /* bit length of data space */ 5 44 2 flags, /* record flags */ 5 45 3 admin bit (1), /* admin record flag */ 5 46 3 label bit (1), /* label record flag */ 5 47 3 eor bit (1), /* end-of-reel record flag */ 5 48 3 pad1 bit (11), 5 49 3 set bit (1), /* ON if any of following items set */ 5 50 3 repeat bit (1), /* repeated record flag */ 5 51 3 padded bit (1), /* record contains padding flag */ 5 52 3 eot bit (1), /* EOT reflector encountered flag */ 5 53 3 drain bit (1), /* synchronous write flag */ 5 54 3 continue bit (1), /* continue on next reel flag */ 5 55 3 pad2 bit (4), 5 56 2 header_version fixed bin (3) unsigned, /* current header version number */ 5 57 2 repeat_count fixed bin (8), /* repetition count */ 5 58 2 checksum bit (36), /* checksum of header and trailer */ 5 59 2 c2 bit (36) 5 60 ) unal; /* constant = 512556146073(8) */ 5 61 5 62 dcl 1 mstr_trailer based aligned, /* Multics standard tape record trailer */ 5 63 ( 2 c1 bit (36), /* constant = 107463422532(8) */ 5 64 2 uid bit (72), /* unique ID (matches header) */ 5 65 2 tot_data_bits fixed bin (35), /* total data bits written on logical tape */ 5 66 2 pad_pattern bit (36), /* padding pattern */ 5 67 2 reel_num fixed bin (11), /* reel sequence # */ 5 68 2 tot_file fixed bin (23), /* phys. file number */ 5 69 2 tot_rec fixed bin (35), /* phys. record # for logical tape */ 5 70 2 c2 bit (36) 5 71 ) unal; /* constant = 265221631704(8) */ 5 72 5 73 dcl 1 volume_identifier based aligned, /* tape volume info */ 5 74 ( 2 installation_id char (32), /* installation that created tape */ 5 75 2 tape_reel_id char (32), /* tape reel name */ 5 76 2 volume_set_id char (32) 5 77 ) unaligned; /* name of the volume set */ 5 78 5 79 dcl ( 5 80 header_c1 init ("670314355245"b3), 5 81 header_c2 init ("512556146073"b3), 5 82 trailer_c1 init ("107463422532"b3), 5 83 trailer_c2 init ("265221631704"b3), 5 84 label_c1 init ("000004235000"b3) 5 85 ) bit (36) static; 5 86 5 87 dcl LABEL_VERSION fixed bin static options (constant) init (3); 5 88 /* current label version */ 5 89 dcl HEADER_VERSION fixed bin static options (constant) init (1); 5 90 /* current header version */ 5 91 5 92 /* End of include file ...... mstr.incl.pl1 */ 5 93 3392 6 1 6 2 /* BEGIN INCLUDE FILE: gcos_ssf_records.incl.pl1 */ 6 3 6 4 /* Created by J. A. Bush 05/07/80 */ 6 5 6 6 dcl prptr ptr; /* GCOS physical record pointer */ 6 7 dcl lrptr ptr; /* GCOS logical record pointer */ 6 8 6 9 dcl 1 gc_phy_rec based (prptr) aligned, /* GCOS ssf format (physical record) */ 6 10 2 bcw unaligned, /* block control word */ 6 11 (3 bsn fixed bin (18), /* block serial number */ 6 12 3 blk_size fixed bin (18)) unsigned, /* block size (-bcw) */ 6 13 2 gc_phy_rec_data (0 refer (gc_phy_rec.bcw.blk_size)) bit (36); 6 14 6 15 dcl 1 gc_log_rec based (lrptr) aligned, /* GCOS ssf logical record format */ 6 16 2 rcw unaligned, /* record control word */ 6 17 (3 rsize fixed bin (18), /* size of rcd (-rcw) */ 6 18 3 nchar_used fixed bin (2), /* characters used in last word */ 6 19 3 file_mark fixed bin (4), /* file mark if rsize = 0 */ 6 20 3 mbz1 fixed bin (2), 6 21 3 media_code fixed bin (4), /* file media code */ 6 22 3 report_code fixed bin (6)) unsigned, /* report code */ 6 23 2 gc_log_rec_data (0 refer (gc_log_rec.rcw.rsize)) bit (36); /* logical record data */ 6 24 6 25 dcl gc_phy_rec_bits bit (gc_phy_rec.bcw.blk_size * 36) based (addr (gc_phy_rec.gc_phy_rec_data)); 6 26 dcl gc_log_rec_bits bit (gc_log_rec.rcw.rsize * 36) based (addr (gc_log_rec.gc_log_rec_data)); 6 27 6 28 /* END INCLUDE FILE: gcos_ssf_records.incl.pl1 */ 3393 3394 7 1 /* Begin include file ..... iox_modes.incl.pl1 */ 7 2 7 3 /* Written by C. D. Tavares, 03/17/75 */ 7 4 /* Updated 10/31/77 by CDT to include short iox mode strings */ 7 5 7 6 dcl iox_modes (13) char (24) int static options (constant) aligned initial 7 7 ("stream_input", "stream_output", "stream_input_output", 7 8 "sequential_input", "sequential_output", "sequential_input_output", "sequential_update", 7 9 "keyed_sequential_input", "keyed_sequential_output", "keyed_sequential_update", 7 10 "direct_input", "direct_output", "direct_update"); 7 11 7 12 dcl short_iox_modes (13) char (4) int static options (constant) aligned initial 7 13 ("si", "so", "sio", "sqi", "sqo", "sqio", "squ", "ksqi", "ksqo", "ksqu", "di", "do", "du"); 7 14 7 15 dcl (Stream_input initial (1), 7 16 Stream_output initial (2), 7 17 Stream_input_output initial (3), 7 18 Sequential_input initial (4), 7 19 Sequential_output initial (5), 7 20 Sequential_input_output initial (6), 7 21 Sequential_update initial (7), 7 22 Keyed_sequential_input initial (8), 7 23 Keyed_sequential_output initial (9), 7 24 Keyed_sequential_update initial (10), 7 25 Direct_input initial (11), 7 26 Direct_output initial (12), 7 27 Direct_update initial (13)) fixed bin int static options (constant); 7 28 7 29 /* End include file ..... iox_modes.incl.pl1 */ 3395 8 1 /* BEGIN INCLUDE FILE area_info.incl.pl1 12/75 */ 8 2 8 3 dcl area_info_version_1 fixed bin static init (1) options (constant); 8 4 8 5 dcl area_infop ptr; 8 6 8 7 dcl 1 area_info aligned based (area_infop), 8 8 2 version fixed bin, /* version number for this structure is 1 */ 8 9 2 control aligned like area_control, /* control bits for the area */ 8 10 2 owner char (32) unal, /* creator of the area */ 8 11 2 n_components fixed bin, /* number of components in the area (returned only) */ 8 12 2 size fixed bin (18), /* size of the area in words */ 8 13 2 version_of_area fixed bin, /* version of area (returned only) */ 8 14 2 areap ptr, /* pointer to the area (first component on multisegment area) */ 8 15 2 allocated_blocks fixed bin, /* number of blocks allocated */ 8 16 2 free_blocks fixed bin, /* number of free blocks not in virgin */ 8 17 2 allocated_words fixed bin (30), /* number of words allocated in the area */ 8 18 2 free_words fixed bin (30); /* number of words free in area not in virgin */ 8 19 8 20 dcl 1 area_control aligned based, 8 21 2 extend bit (1) unal, /* says area is extensible */ 8 22 2 zero_on_alloc bit (1) unal, /* says block gets zerod at allocation time */ 8 23 2 zero_on_free bit (1) unal, /* says block gets zerod at free time */ 8 24 2 dont_free bit (1) unal, /* debugging aid, turns off free requests */ 8 25 2 no_freeing bit (1) unal, /* for allocation method without freeing */ 8 26 2 system bit (1) unal, /* says area is managed by system */ 8 27 2 pad bit (30) unal; 8 28 8 29 /* END INCLUDE FILE area_info.incl.pl1 */ 3396 3397 3398 end rtq_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/28/87 1524.5 rtq_.pl1 >spec>install>1050>rtq_.pl1 2120 1 03/11/83 1204.3 query_info.incl.pl1 >ldd>include>query_info.incl.pl1 3387 2 07/28/87 0936.7 rtq_structure_info.incl.pl1 >ldd>include>rtq_structure_info.incl.pl1 3389 3 10/06/83 1413.5 ibm_hdr2.incl.pl1 >ldd>include>ibm_hdr2.incl.pl1 3390 4 10/06/83 1413.4 ansi_hdr2.incl.pl1 >ldd>include>ansi_hdr2.incl.pl1 3392 5 12/20/82 1113.8 mstr.incl.pl1 >ldd>include>mstr.incl.pl1 3393 6 03/27/82 0437.1 gcos_ssf_records.incl.pl1 >ldd>include>gcos_ssf_records.incl.pl1 3395 7 02/02/78 1229.7 iox_modes.incl.pl1 >ldd>include>iox_modes.incl.pl1 3396 8 06/11/76 1043.4 area_info.incl.pl1 >ldd>include>area_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. A_YES_OR_NO_ANSWER 000100 automatic bit(1) dcl 2145 set ref 2153* 2157* 2159 BINARY_MODE constant fixed bin(17,0) initial dcl 66 set ref 1008* 1077* 2566* 2572* 2594* 2620* 2647* CP5_label 000237 constant bit(32) initial unaligned dcl 274 ref 2250 DEC_40_bits_per_word constant fixed bin(17,0) initial dcl 1588 ref 1591 LABEL 000263 constant char(9) initial array unaligned dcl 67 set ref 2256* 2262* 2279* 3106* 3126* 3135* 3162* 3180* 3185* 3209* 3215* 3220* 3245* 3268* NINE_MODE constant fixed bin(17,0) initial dcl 71 set ref 1012* 1082* 2266* 2587* 2622* 2649* 2743* 2847 NL 000262 constant char(1) initial unaligned dcl 69 set ref 1523 1523 1536 1567 1628 1788 1925 1946 2315 2525 2541 2873 NUMB_OF_BITS_PER_BYTE constant fixed bin(17,0) initial dcl 272 ref 379 NUMB_OF_BITS_PER_CHAR constant fixed bin(17,0) initial dcl 657 ref 682 NUMB_OF_BITS_PER_WORD 032472 constant fixed bin(17,0) initial dcl 658 ref 682 NUMB_OF_BYTES_PER_WORD 000534 constant fixed bin(17,0) initial dcl 273 ref 379 NUMB_OF_CHARS_PER_WORD constant fixed bin(17,0) initial dcl 72 ref 1520 1545 1614 1618 1637 1805 1810 1815 1942 1944 2952 Nargs 000115 automatic fixed bin(17,0) dcl 74 set ref 448* 449 491* 492 499 538* 539 546 588* 589 589 596* 629* 630 686* 689 783* 785 863* 864 871 909* 910 917 981* 984 1122* 1123 1130 1136 1169* 1170 1238* 1350* 1353 1356 1415* 1416 1478* 1479 2562 2600 2617 2628 2644 2654 2673 2698 2716 2734 2759 Sequential_input 000534 constant fixed bin(17,0) initial dcl 7-15 set ref 371* Stream_input_output constant fixed bin(17,0) initial dcl 7-15 ref 2524 2540 3369 Stream_output constant fixed bin(17,0) initial dcl 7-15 ref 1271 2524 2540 3369 YES_FLG 000114 automatic bit(1) dcl 73 set ref 1692* 1694 1709* 1711 2016* 2018 3349* 3351 3377* 3379 a_cnt parameter fixed bin(35,0) dcl 2407 ref 2403 2419 a_dir parameter bit(1) dcl 2408 ref 2403 2423 a_label 000236 constant bit(32) initial unaligned dcl 277 ref 2243 a_mode parameter fixed bin(17,0) dcl 2094 ref 2090 2097 2098 a_order parameter char unaligned dcl 2409 set ref 2403 2418 2486* a_rf parameter bit(1) dcl 2410 ref 2403 2424 2460 a_rpt parameter bit(1) dcl 2411 ref 2403 2422 addr builtin function dcl 62 ref 327 327 1523 1523 1544 1562 1615 1636 1720 1731 1734 1751 1777 1783 1832 1888 1888 1936 2028 2028 2036 2036 2130 2133 2133 2245 2395 2395 2397 2397 2869 2869 2877 2877 2891 2891 addrel builtin function dcl 62 ref 740 740 1574 1806 1811 1843 1980 ai 000432 automatic structure level 1 dcl 248 set ref 305* 327 327 al 000116 automatic fixed bin(17,0) dcl 75 set ref 500* 501 501 547* 548 548 596* 598 604 604 690* 691 695 695 708 708 715 718 721 727 872* 873 873 918* 919 919 985* 987 987 989 989 1137* 1138 1138 1138 1140 1354* 1355 1355 1358* 1359 1359 2563* 2564 2564 2570 2570 2576 2579 2582 2582 2585 2591 2598 2601* 2602 2604 2604 2606 2608 2626 2629* 2630 2632 2632 2634 2636 2653 2653 2655* 2656 2656 2672 2672 2674* 2675 2675 2697 2697 2699* 2700 2700 2715 2717* 2718 2718 2733 2733 2735* 2737 2737 2739 2739 2741 2741 2758 2758 2760* 2761 2764 2780 2780 alrd 1 based char level 2 packed unaligned dcl 152 set ref 1528* 1530 analyze_device_stat_$rsnnl 000130 constant entry external dcl 2391 ref 2397 ansi_db_lrec based structure level 1 packed unaligned dcl 152 ansi_hdr2 based structure level 1 packed unaligned dcl 4-8 ansi_hdr2P 000776 automatic pointer dcl 4-6 set ref 3228* 3229 3232 3232 3232 3232 3232 3232 3232 3232 ansi_hdr2_fmt 000027 constant char(108) initial unaligned dcl 3096 set ref 3232* ansi_label constant fixed bin(17,0) initial dcl 280 ref 2247 2265 ansi_mode 000120 automatic fixed bin(17,0) dcl 77 set ref 3229* 3231 3231* 3232* 3236 ansid 000117 automatic bit(1) dcl 76 set ref 1246* 2627* 2837 answer_iocbp 6 000120 automatic pointer initial level 2 dcl 1-7 set ref 2129* 1-7* ap 000122 automatic pointer dcl 78 set ref 500* 501 547* 548 596* 598 604 690* 691 695 708 715 718 721 727 872* 873 918* 919 985* 987 987 989 989 1137* 1138 1138 1138 1140 1354* 1355 1355 1358* 1359 2563* 2564 2564 2570 2570 2576 2579 2582 2582 2585 2591 2598 2601* 2602 2604 2604 2606 2608 2626 2629* 2630 2632 2632 2634 2636 2653 2653 2655* 2656 2672 2672 2674* 2675 2697 2697 2699* 2700 2715 2717* 2718 2733 2733 2735* 2737 2737 2739 2739 2741 2741 2758 2758 2760* 2761 2764 2780 area_control based structure level 1 dcl 8-20 area_info based structure level 1 dcl 8-7 area_info_version_1 constant fixed bin(17,0) initial dcl 8-3 ref 306 311 areap 16 000432 automatic pointer level 2 dcl 248 set ref 312* 333 2202* arg based char unaligned dcl 223 set ref 501* 548* 598 604* 691 695* 708* 715 718 721 727 873* 919* 987 987 989 989 1138 1138 1138 1140 1355 1355 1359* 2564 2564 2570 2570 2576 2579 2582 2582 2585 2591 2598 2602 2604 2604 2606 2608 2626 2630 2632 2632 2634 2636 2653 2653 2656* 2672 2672 2675* 2697 2697 2700* 2715 2718* 2733 2733 2737 2737 2739 2739 2741 2741 2758 2758 2761 2764 2780* arg_dex 000124 automatic fixed bin(17,0) dcl 79 set ref 499* 500* 546* 547* 689* 690* 871* 872* 917* 918* 984* 985* 1136* 1137* 1353* 1354* 1356 1357* 1357 1358* 2562* 2563* 2600 2601 2603* 2603 2617 2628 2629 2631* 2631 2644 2654 2655 2663* 2663 2673 2674 2682* 2682 2698 2699 2707* 2707 2716 2717 2725* 2725 2734 2735 2736* 2736 2759 2760 2762* 2762* array_index 000470 automatic fixed bin(17,0) dcl 573 set ref 597* 598* ask_users_question parameter char unaligned dcl 2112 set ref 2109 2133* atd_sw 60 based bit(1) level 3 dcl 241 set ref 1234* 1273 1273 2582* 2869 3365 att_desc 000125 automatic char(200) unaligned dcl 80 set ref 2046* 2061* 2076* 2358* 3357* 3375* attach_desc_output 000207 automatic varying char(200) dcl 81 set ref 2356* 2358 2360* 2363 2363 2368* auto_retry 001332 automatic fixed bin(17,0) dcl 2935 set ref 2950* 2962* 2962 2963 backspace_file_flg 000100 automatic bit(1) initial dcl 2412 set ref 2412* 2420* 2437* 2443* 2494 bcd_str 0(12) based bit level 2 packed unaligned dcl 1674 set ref 1763* bcd_to_ascii_ 000010 constant entry external dcl 31 ref 1763 1832 2234 2858 3171 bcnt 000272 automatic fixed bin(24,0) dcl 82 set ref 1683* 1687* 1687 1688 1689* 1701* 1962* 2006* 2010* 2010 2011 2012* 2025* bcw based structure level 2 packed unaligned dcl 6-9 bdw based structure level 2 packed unaligned dcl 192 bin builtin function dcl 62 ref 1520 1614 1618 3110 3110 3112 3112 3139 3139 3141 3141 3185 3185 3224 3224 3224 3224 3232 3232 3232 3232 binck 000273 automatic bit(1) dcl 83 in procedure "rtq_" set ref 2806* 2822* binck parameter bit(1) dcl 1650 in procedure "GCOS_ssf" set ref 1646 1845* 1856 bit6 001402 automatic fixed bin(35,0) initial dcl 3070 set ref 3070* 3081* 3083* bit8 001403 automatic fixed bin(35,0) initial dcl 3070 set ref 3070* 3080* 3083* bit9 001404 automatic fixed bin(35,0) initial dcl 3070 set ref 3070* 3079* 3083* bit_buf based bit unaligned dcl 225 set ref 2852* 2858* 2863* 3171* 3174 3185 3185 3259 bits 2 based fixed bin(35,0) level 2 dcl 241 set ref 1037 1048 1055 1384* 1591 2850 2852 2852 2857 2858 2858 2862 2863 2863 3050* 3057* 3169 3171 3171 3174 3185 3185 3259 blab based bit(9) array unaligned dcl 294 set ref 2245* blk_size 0(18) based fixed bin(18,0) level 3 packed unsigned unaligned dcl 6-9 set ref 1705 1706* 1725 blklen 1(09) based char(5) level 2 packed unaligned dcl 4-8 ref 3232 3232 blksize 1(09) based char(5) level 2 packed unaligned dcl 3-8 ref 3224 3224 block_attribute 11(18) based char(1) level 2 packed unaligned dcl 3-8 set ref 3224* blocked 13(27) based char(1) level 3 packed unaligned dcl 4-8 ref 3232 3232 3232 blocksize 000274 automatic fixed bin(35,0) dcl 84 set ref 1614* 1615 1617 boot_pgm_path 160 based char(168) level 2 packed unaligned dcl 5-16 set ref 3151 3151* bsn based fixed bin(18,0) level 3 packed unsigned unaligned dcl 6-9 set ref 1683 1688 1689* 1701 buf_ful 61 based bit(1) level 3 dcl 241 set ref 672 3056* buf_size 4 based fixed bin(21,0) level 2 dcl 241 set ref 347 347 379 387* 1528 1528 1530 1532 1536 1565 1565 1567 1620 1620 1622 1624 1628 1726 1740 1764 1788 1832 1832 1838 1838 1840 1841 1856 1858 1864 1865 1866 1868 1884 1902 1902 1902 1902 1919 1919 1920 1923 1925 1946 1948 1948 2311 2311 2314 2321 2321 2521 2525 2538 2541 2683 2684 2684 2952 3171 3171 3180 3180 3180 3180 3185 3185 3185 3185 3185 3185 3185 bufptr parameter pointer dcl 3319 set ref 3307 3369* 3372* c1 10 based bit(36) level 3 packed unaligned dcl 5-16 ref 2227 c_b_a 000275 automatic bit(1) dcl 85 set ref 1246* 1257 2739* 2856 c_c_a 000276 automatic bit(1) dcl 85 set ref 1246* 1257 2742* 2861 c_den 5 based char(5) level 2 dcl 241 set ref 402* 403* 405 407 407 417* 606* c_e_a 000277 automatic bit(1) dcl 85 set ref 1246* 1257 1528 1620 2606* 2615* 2617* 2634* 2737* 2845 c_file 7 based fixed bin(17,0) level 2 dcl 241 set ref 636* 824* 830* 1003 1031* 1069 1176* 1269* 1374* 1427 1441* 1441 2425 2441* 2441 2443 2451* 2462* 2462 2469* 2500* 2964* 2976* 3029* 3031* 3035* 3037 3040* 3042 3049* 3049 3133 3180 3180 3345* c_mode 10 based fixed bin(17,0) level 2 dcl 241 set ref 636 722 728 1016 1132* 1140* 1144 1176 1269 1374 2097 2098* 2100 2102 2847 c_rec 11 based fixed bin(17,0) level 2 dcl 241 set ref 636* 803* 803 824 830 1003 1031 1036 1069 1074* 1176* 1263 1374* 1426 1437 1437 1448 2433* 2450 2456* 2456 2461* 2464* 2464 2469* 2964* 2969* 2969 2976* 3003* 3003 3034 3040 3040 3046* 3055* 3055 3106 3126 3135 3162 3209 3215 3245 3268 card_cnt 001104 automatic fixed bin(17,0) dcl 1651 set ref 1722* 1798 1809 1962* 1981* 1981 cbuf based char unaligned dcl 231 set ref 347 1528* 1530* 1532 1536* 1565* 1567* 1620* 1622* 1624 1628* 1726* 1740* 1764* 1788* 1832* 1838* 1838 1840 1841 1856 1858 1864 1865 1866 1868 1884 1902* 1902 1902 1919* 1919 1920 1923 1925* 1946* 1948* 1948 2311 2311 2314 2321 2321 2521* 2525* 2538* 2541* 2683 2684 2684 3171* 3180 3180 3180 3180 3185 3185 3185 3185 3185 3185* cbufp 12 based pointer level 3 dcl 241 set ref 347* 1528 1530 1532 1536 1539* 1565 1567 1569* 1620 1622 1624 1628 1631* 1726 1740 1764 1788 1789* 1832 1838 1838 1840 1841 1856 1858 1864 1865 1866 1868 1884 1902 1902 1902 1906* 1919 1919 1920 1923 1925 1927* 1946 1948 1948 1952* 2311 2311 2314 2321 2321 2521 2525 2529* 2538 2541 2545* 2683 2684 2684 3171 3180 3180 3180 3180 3185 3185 3185 3185 3185 3185 cdkbuf based char(136) unaligned dcl 229 set ref 346 1762* 1763* 1764 cdkp 14 based pointer level 3 dcl 241 set ref 346* 1762 1763 1764 cdptr 16 based pointer level 3 dcl 241 set ref 1731* 1733 1734 cfptr 20 based pointer level 3 dcl 241 set ref 1734* 1745 1746 1748 1751* 1751 1763 1763 1763 1769 1769 1774 1774 1777* 1777 1777 1780 1780 1783* 1783 1783 char builtin function dcl 62 ref 402 606 1298 char_buf based char unaligned dcl 227 set ref 2847* 3197* 3263* chcv_buf based char array level 2 packed unaligned dcl 201 ref 2521 2538 cleanup 000100 stack reference condition dcl 59 ref 315 444 479 526 577 624 667 778 852 897 966 1025 1112 1164 1224 1334 1411 1474 clen 42 based fixed bin(21,0) level 2 dcl 241 set ref 1902* 1906* 2028 2028 2028* 2035* 2036 2036 2036 code parameter fixed bin(35,0) dcl 90 set ref 252 327* 328 329* 336* 337 338* 350* 352 353 354* 355 356* 365* 371* 372 373* 387* 388 389 389 389* 401 401 411* com_fld based structure level 1 packed unaligned dcl 1674 comdk based structure level 1 dcl 1666 command_query_ 000120 constant entry external dcl 2117 ref 2133 command_query_$yes_no 000122 constant entry external dcl 2150 ref 2157 comp_8_to_ascii_ 000012 constant entry external dcl 32 ref 2863 cont 000300 automatic bit(1) dcl 85 in procedure "rtq_" set ref 1246* 2822* cont parameter bit(1) dcl 1652 in procedure "GCOS_ssf" set ref 1646 1726 1738 1749* 1756* 1771* 1776* 1780* 1787 1878* 1908* control 1 000432 automatic structure level 2 dcl 248 conv_buf based structure level 1 packed unaligned dcl 157 conv_dta based char level 2 packed unaligned dcl 157 set ref 2869 2869 2873* 2877 2877 conversion 000000 stack reference condition dcl 59 ref 1510 conversion_flg 000510 automatic bit(1) dcl 1218 in procedure "rtq_" set ref 1221* 1283 2838* 2839* 2840 conversion_flg parameter bit dcl 1504 in procedure "ANSI_DB_records" set ref 1500 1515* copyright 245 based char(56) level 2 dcl 5-16 set ref 3157 3157* count 000101 automatic fixed bin(35,0) dcl 2413 set ref 2419* 2425 2441 2446* 2446 2450 2456 2462 2464 2472 cp5 000301 automatic bit(1) dcl 85 set ref 1246* 2586* 2828 cp5_lab based structure level 1 packed unaligned dcl 219 cp5_label constant fixed bin(17,0) initial dcl 281 ref 2252 cp5_log_rec based structure level 1 dcl 166 set ref 1574 cp5_log_rec_data 2 based char level 2 packed unaligned dcl 166 set ref 1565* cp5_phy_rec based structure level 1 dcl 161 cp_escape_control 1(02) 000120 automatic bit(2) initial level 3 packed unaligned dcl 1-7 set ref 1-7* currentsize builtin function dcl 62 ref 1574 1843 1980 cv_buf based char unaligned dcl 233 set ref 345 2847* 2852* 2858* 2863* 3197* 3263* cv_dec_check_ 000014 constant entry external dcl 33 ref 501 548 604 873 919 1359 2656 2675 2700 2718 cv_oct_check_ 000016 constant entry external dcl 34 ref 695 708 cvbl 43 based fixed bin(21,0) level 2 dcl 241 set ref 345 345 379* 2847 2847 2852 2852 2858 2858 2863 2863 3197 3197 3263 3263 cvbp 24 based pointer level 3 dcl 241 set ref 345* 2592 2754 2847 2852 2858 2863 3197 3198 3263 3264 cvp 22 based pointer level 3 dcl 241 set ref 1805 1806* 1806 1811* 1816* 1819* 1843* 1844 1936* 1946 1979* data 10 based bit level 2 in structure "mstr" dcl 5-10 in procedure "rtq_" set ref 2036 data 2 based bit(756) level 2 in structure "comdk" packed unaligned dcl 1666 in procedure "GCOS_ssf" set ref 1734 data_bit_len 4(18) based fixed bin(17,0) level 3 packed unaligned dcl 5-10 ref 2036 data_bits_used 4 based fixed bin(17,0) level 3 packed unaligned dcl 5-10 ref 2035 date_time_ 000020 constant entry external dcl 35 ref 3110 3112 3139 3141 ddec 44 based fixed bin(35,0) level 2 dcl 241 set ref 402 402 604* 606 dec_mult based structure array level 1 dcl 172 dec_sw 000302 automatic bit(1) dcl 91 set ref 1246* 2593* 2831 dec_tape_raw based structure level 1 dcl 176 define_area_ 000110 constant entry external dcl 297 ref 327 density 46 based char(5) array level 2 dcl 241 ref 382 385 403 417 419 419 598 direction 000303 automatic bit(1) dcl 92 set ref 458* 462* 487* 506* 534* 554* 585* 610* 795* 801* 815* 821* 859* 879* 904* 925* 1119* 1150* 1446* 1455* 1487* 1490* divide builtin function dcl 62 ref 379 682 1591 2035 2517 2850 2857 2862 3078 3079 3080 3081 dkend_card 001105 automatic bit(1) dcl 1653 set ref 1723* 1821 1822* 1858* doffset 000472 automatic fixed bin(17,0) dcl 659 set ref 680* 695* 703 740 740 dtype parameter char(5) unaligned dcl 2306 set ref 2302 2334* dump_index 000473 automatic fixed bin(17,0) dcl 660 set ref 738* 740* dump_segment_ 000116 constant entry external dcl 654 ref 740 ebcdic8_to_ascii_ 000024 constant entry external dcl 37 ref 2239 2251 2852 ebcdic_to_ascii_ 000022 constant entry external dcl 36 ref 1528 1565 1620 2847 3197 3263 end_file parameter bit(1) dcl 2936 set ref 2915 2949* 3009* 3051* end_file_flg 000511 automatic bit(1) dcl 1405 set ref 1428* 1432 1433* eoc 001106 automatic bit(1) dcl 1654 set ref 1755* 1760* 1787 eof 62 based bit(1) level 3 dcl 241 set ref 509* 974* 1021* 1029 1377* 1384 1493* 2270* 2275 2806* 2807 2809* 2814 eof_request_flg 63 based bit(1) level 3 dcl 241 set ref 791* 809* 835* 2464 2481 eoj_card 000256 constant char(14) initial unaligned dcl 93 set ref 1888 1888 1888 1888 2891 2891 2891 2891 eor 5(02) based bit(1) level 4 packed unaligned dcl 5-10 ref 3126 3162 eov 001414 automatic bit(1) dcl 3099 in procedure "valid_label_record" set ref 3180* 3180* 3248* eov 64 based bit(1) level 3 in structure "rtq_info" dcl 241 in procedure "rtq_" set ref 509* 974* 1232* 1342* 1422* 1493* 3022 3175* error_table_$end_of_info 000072 external static fixed bin(35,0) dcl 142 ref 389 401 800 2476 2957 2997 error_table_$not_closed 000074 external static fixed bin(35,0) dcl 142 ref 355 2052 error_table_$not_detached 000076 external static fixed bin(35,0) dcl 142 ref 353 2050 error_table_$tape_error 000100 external static fixed bin(35,0) dcl 142 ref 388 806 expand_pathname_$add_suffix 000026 constant entry external dcl 38 ref 3294 explain_to_users parameter char unaligned dcl 2113 set ref 2109 2130 2131 explanation_len 14 000120 automatic fixed bin(21,0) initial level 2 dcl 1-7 set ref 2131* 1-7* explanation_ptr 12 000120 automatic pointer initial level 2 dcl 1-7 set ref 2130* 1-7* explanation_string 001333 automatic char(95) unaligned dcl 2937 set ref 2981* 2985* 2989* 3014* extend 1 000432 automatic bit(1) level 3 packed unaligned dcl 248 set ref 307* extend_sw 65 based bit(1) level 3 dcl 241 set ref 1234* 1293 1312 2576* 2907 f_attached 66 based bit(1) level 3 dcl 241 set ref 1887 2070* 2170 2173* 2354 3325 f_len based bit(6) level 2 packed unaligned dcl 1674 ref 1745 1748 fc 001107 automatic bit(1) dcl 1655 set ref 1735* 1737 1744 1755* 1770* 1780* filename 106 based varying char(32) level 2 dcl 241 set ref 1235* 1295 1298* 1300 1301* 1902 1902 2314* 2315 2316* 2316 2334 2336* 3298* 3326 3345* filepath 117 based varying char(168) level 2 dcl 241 set ref 3299* 3357 3365* fiocb_ptr 26 based pointer level 3 dcl 241 set ref 2046* 2051* 2055* 2073* 2171* 2172* 3369* 3372* first 1 based bit(1) level 2 packed unaligned dcl 161 set ref 1562 first_32 based bit(32) array level 2 in structure "dec_mult" packed unaligned dcl 172 in procedure "rtq_" set ref 1594* first_32 based bit(32) array level 3 in structure "dec_tape_raw" packed unaligned dcl 176 in procedure "rtq_" ref 1594 first_record_flg parameter bit(1) dcl 1656 in procedure "GCOS_ssf" set ref 1646 1682 1684* first_record_flg 000304 automatic bit(1) dcl 96 in procedure "rtq_" set ref 1221* 2822* 2825* 2901* first_record_flg parameter bit(1) dcl 1993 in procedure "MULT_ssf" set ref 1989 2004 2005* fixed builtin function dcl 62 ref 1745 1746 1763 1763 1769 1774 1777 1780 1783 fl 001110 automatic bit(1) dcl 1655 set ref 1743* 1744 1750* 1775* flags 60 based structure level 2 in structure "rtq_info" dcl 241 in procedure "rtq_" flags 15 based structure level 3 in structure "mst_label" packed unaligned dcl 5-16 in procedure "rtq_" flags 5 based structure level 3 in structure "mstr" packed unaligned dcl 5-10 in procedure "rtq_" fmt parameter bit(11) unaligned dcl 753 ref 749 756 format 1 based char(1) level 2 in structure "ansi_hdr2" packed unaligned dcl 4-8 in procedure "rtq_" set ref 3232* format 1 based char(1) level 2 in structure "ibm_hdr2" packed unaligned dcl 3-8 in procedure "rtq_" set ref 3224* format 000474 automatic bit(11) array unaligned dcl 661 in procedure "rtq_" set ref 681* 740* 756* 759 fw_file 67 based bit(1) level 3 dcl 241 set ref 1234* 1273 1293 1306* 1878* 2342* 3363 3364* g_label 000254 constant bit(72) initial unaligned dcl 97 ref 2233 3173 gc_log_rec based structure level 1 dcl 6-15 set ref 1843 1980 gc_log_rec_bits based bit unaligned dcl 6-26 set ref 1832* gc_log_rec_data 1 based bit(36) array level 2 dcl 6-15 set ref 1731 1832 1936 gc_phy_rec based structure level 1 dcl 6-9 gc_phy_rec_data 1 based bit(36) array level 2 dcl 6-9 set ref 1720 gcos based structure level 1 packed unaligned dcl 210 gcos_trans 000062 constant char(6) initial array unaligned dcl 1657 ref 1883 1884 get_answer 001363 automatic varying char(5) dcl 2938 set ref 2989* 2994 3002 3007 3014* get_line_length 000456 automatic fixed bin(17,0) dcl 289 set ref 321* 322 get_line_length_$switch 000114 constant entry external dcl 299 ref 321 get_temp_segment_ 000112 constant entry external dcl 298 ref 336 get_users_answer 000100 automatic char(64) unaligned dcl 2114 set ref 2133* 2135 gssf 000305 automatic bit(1) dcl 99 set ref 1246* 2565* 2822 2888 gssf_ascii based char unaligned dcl 235 ref 1946 hbound builtin function dcl 62 ref 382 759 1883 2363 2367 head based structure level 2 in structure "mstr" dcl 5-10 in procedure "rtq_" head 10 based structure level 2 in structure "mst_label" dcl 5-16 in procedure "rtq_" header_c1 000234 constant bit(36) initial unaligned dcl 5-79 ref 2220 2227 i 000102 automatic fixed bin(35,0) dcl 2414 in procedure "process_control_order" set ref 2472* 2478* 2478 2486* i 000306 automatic fixed bin(17,0) dcl 100 in procedure "rtq_" set ref 384* 385* 417 419 419 1564* 1593* 1594 1594 1596 1596* 1745* 1754 1754 1764 1767 1865* 1866 1868 1883* 1884* 2244* 2245 2245* 2315* 2316 2316 2316 2363* 2363 2363* 2367 2375 2520* 2521* i_label 000235 constant bit(32) initial unaligned dcl 282 ref 2238 ibm_ansi based structure level 1 packed unaligned dcl 215 ibm_hdr2 based structure level 1 packed unaligned dcl 3-8 ibm_hdr2P 000774 automatic pointer dcl 3-6 set ref 3223* 3224 3224 3224 3224 3224 3224 ibm_label constant fixed bin(17,0) initial dcl 101 ref 2240 2265 3222 ibm_log_rec based structure level 1 packed unaligned dcl 182 ibm_phy_rec based structure level 1 dcl 192 ibmv 000310 automatic bit(1) dcl 102 set ref 1246* 2599* 2834 ilrd 1 based char level 2 packed unaligned dcl 182 set ref 1620* 1622 imcv parameter bit(1) dcl 1659 in procedure "GCOS_ssf" set ref 1646 1877* 1881 imcv 000311 automatic bit(1) dcl 103 in procedure "rtq_" set ref 1246* 2822* index builtin function dcl 62 ref 2315 3229 installation_id 10 based char(32) level 3 in structure "mult" packed unaligned dcl 205 in procedure "rtq_" set ref 3116 3116* installation_id 20 based char(32) level 3 in structure "mst_label" packed unaligned dcl 5-16 in procedure "rtq_" set ref 3145 3145* interpretation_string parameter char(95) unaligned dcl 2146 set ref 2141 2157* ioa_ 000030 constant entry external dcl 39 ref 419 636 739 1016 1031 1042 1045 1069 1078 1083 1093 1269 1437 2100 2256 2262 2277 2292 2321 2427 2451 3029 3031 3035 3037 3040 3042 3083 3106 3114 3116 3119 3126 3135 3143 3145 3148 3151 3154 3157 3162 3180 3185 3209 3215 3220 3224 3232 3240 3245 3268 3345 3365 ioa_$rsnnl 000032 constant entry external dcl 40 ref 1902 iox_$attach_name 000034 constant entry external dcl 41 ref 350 2046 iox_$close 000036 constant entry external dcl 42 ref 360 2055 2171 2190 iox_$control 000040 constant entry external dcl 43 ref 385 394 405 1451 2395 2473 2495 2971 2995 iox_$detach_iocb 000042 constant entry external dcl 44 ref 354 2051 2172 2191 iox_$open 000044 constant entry external dcl 45 ref 371 2073 iox_$put_chars 000050 constant entry external dcl 47 ref 3369 iox_$read_record 000046 constant entry external dcl 46 ref 387 2952 iox_$user_output 000102 external static pointer dcl 147 set ref 740* iox_$write_record 000052 constant entry external dcl 48 ref 3372 iox_modes 000115 constant char(24) initial array dcl 7-6 set ref 2076* 2363 2363 2367 iprd 1 based char level 2 packed unaligned dcl 192 set ref 1615 it_cnt 000312 automatic fixed bin(17,0) dcl 104 set ref 1591* 1593 1599 2517* 2520 2537* 2537 2538 iterations 000313 automatic fixed bin(35,0) dcl 105 set ref 973* 1242* 1267 1347* 1359* 1372 2700* j 000307 automatic fixed bin(17,0) dcl 100 set ref 382* 384 1746* 1754 1754 1761 1764 1764 3176* 3178* 3180 3180 l_cnt 000314 automatic fixed bin(35,0) dcl 106 set ref 456* 462* 484* 501* 506* 531* 548* 554* 582* 610* 797* 801* 818* 821* 858* 873* 879* 903* 919* 925* 1118* 1150* 1486* 1490* l_rec 000315 automatic bit(1) dcl 107 set ref 1246* 1257 2688* 2866 l_rec_len 000316 automatic fixed bin(35,0) dcl 108 set ref 1520* 1522 1528 1528 1530 1544 1545 1618* 1620 1620 1622 1636 1637 2517 2518 2521 2521 2521 2522 2525 2538 2538 2538 2675* 2683 l_type 45 based fixed bin(17,0) level 2 dcl 241 set ref 989 1008 1008 1012 1041 2222* 2229* 2235* 2240* 2247* 2252* 2256 2262 2265 2265 2279 3102 3106 3126 3135 3162 3180 3185 3209 3215 3220 3222 3245 3268 lab_buf based char unaligned dcl 237 set ref 3209 3209 3209 3209 3209 3209* 3215 3215 3215 3215 3215 3215* 3219 3220 3220 3240* 3243 3243 3243 3243 3245 3245 3245* 3248 3268 3268 3268* lab_id based bit(36) level 2 in structure "mult" packed unaligned dcl 205 in procedure "rtq_" ref 2220 2225 lab_id based bit(32) level 2 in structure "ibm_ansi" packed unaligned dcl 215 in procedure "rtq_" ref 2238 2243 lab_id based bit(32) level 2 in structure "cp5_lab" packed unaligned dcl 219 in procedure "rtq_" ref 2250 lab_id based bit(72) level 2 in structure "gcos" packed unaligned dcl 210 in procedure "rtq_" ref 2233 3173 label 5(01) based bit(1) level 4 in structure "mstr" packed unaligned dcl 5-10 in procedure "rtq_" ref 3104 label 15(01) based bit(1) level 4 in structure "mst_label" packed unaligned dcl 5-16 in procedure "rtq_" ref 2227 3133 label_c1 000233 constant bit(36) initial unaligned dcl 5-79 ref 2225 label_flg 000502 automatic bit(1) dcl 958 set ref 977* 994* 1042 1053 1066 1076 1081 label_version 242 based fixed bin(17,0) level 2 dcl 5-16 set ref 3135* last_4 1 based bit(4) array level 3 in structure "dec_tape_raw" packed unaligned dcl 176 in procedure "rtq_" ref 1596 last_4 0(32) based bit(4) array level 2 in structure "dec_mult" packed unaligned dcl 172 in procedure "rtq_" set ref 1596* last_job_deck_flg 70 based bit(1) level 3 dcl 241 set ref 1234* 1901* 2173* 2889 last_length 000503 automatic fixed bin(17,0) dcl 959 set ref 978* 1037* 1048 1053 1055* 1060* 1063 1066 last_rec 2020 based char level 2 dcl 1997 set ref 2028 2028 2036 last_record_flg 000317 automatic bit(1) dcl 109 in procedure "rtq_" set ref 1221* 2825* 2899* 2901* last_record_flg parameter bit(1) dcl 1994 in procedure "MULT_ssf" ref 1989 2011 2034 lblp 30 based pointer level 3 dcl 241 set ref 3198* 3207* 3209 3209 3209 3209 3209 3209 3215 3215 3215 3215 3215 3215 3219 3220 3220 3223 3228 3240 3243 3243 3243 3243 3245 3245 3245 3248 3264* 3266 3266 3266 3266 3266 3266 3268 3268 3268 3268 3268 length builtin function dcl 62 ref 1532 1624 1840 1888 1888 1920 1923 2131 2683 2684 2684 2891 2891 lg_ck parameter bit(1) dcl 3099 set ref 3091 3109 3138 3180* 3185* 3209* 3215* 3240 3245* 3268* literal_sw 1(05) 000120 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* logical_file_flg 000504 automatic bit(1) dcl 960 set ref 977* 1043* 1069* 1073* logical_file_num 000501 automatic fixed bin(17,0) dcl 957 set ref 978* 1039* 1039 1042* 1069* long_list_flg 000505 automatic bit(1) dcl 961 set ref 977* 987* 1034* lrec_cbuf based structure level 1 packed unaligned dcl 201 lrecl 2(18) based char(5) level 2 packed unaligned dcl 3-8 ref 3224 3224 lrl based char(4) level 2 packed unaligned dcl 152 set ref 1511* 1520 lrp 000320 automatic pointer dcl 110 set ref 1244* 1594 1596 1599* 2521 2538 2592* 2754* 2869 2869 2873 2877 2877 lrptr 001004 automatic pointer dcl 6-7 set ref 1720* 1727 1731 1805 1810 1811 1815 1816 1832 1832 1832 1839 1843 1843 1918 1920 1923 1936 1942 1942 1942 1944 1946 1947 1962 1975 1979 1980* 1980 1980 lsl 0(10) based bit(8) level 3 in structure "ibm_phy_rec" packed unaligned dcl 192 in procedure "rtq_" ref 1614 lsl 0(10) based bit(8) level 3 in structure "ibm_log_rec" packed unaligned dcl 182 in procedure "rtq_" ref 1618 ltrim builtin function dcl 62 ref 402 606 1298 match 000471 automatic bit(1) dcl 574 set ref 583* 597 598* 601 media_code 0(26) based fixed bin(4,0) level 3 packed unsigned unaligned dcl 6-15 set ref 1727 1839 1844 1918 1947 1962* mod builtin function dcl 62 ref 2518 mode 000245 constant char(7) initial array unaligned dcl 111 in procedure "rtq_" set ref 636* 1016* 1140 1144 1176* 1269* 1374* 2100* 2102* mode 14 based char(1) level 3 in structure "ansi_hdr2" packed unaligned dcl 4-8 in procedure "rtq_" ref 3229 mode_dex 000507 automatic fixed bin(17,0) dcl 1109 set ref 1139* 1140 1140* msl 0(01) based bit(8) level 3 in structure "ibm_log_rec" packed unaligned dcl 182 in procedure "rtq_" ref 1618 msl 0(01) based bit(8) level 3 in structure "ibm_phy_rec" packed unaligned dcl 192 in procedure "rtq_" ref 1614 mssf 000322 automatic bit(1) dcl 113 in procedure "rtq_" set ref 303* 972* 1021* 1246* 1346* 1377* 1429* 1433* 2270* 2571* 2809* 2825 2898 mssf parameter bit(1) dcl 2939 in procedure "read_tape_record" ref 2915 2961 mst_label based structure level 1 dcl 5-16 mstr based structure level 1 dcl 5-10 mstr_header based structure level 1 dcl 5-37 mstr_trailer based structure level 1 dcl 5-62 mstrp 001000 automatic pointer dcl 5-8 set ref 2002* 2006 2009 2011 2012 2025 2035 2036 mult based structure level 1 packed unaligned dcl 205 mult_buf based structure level 1 dcl 1997 mult_move based char unaligned dcl 239 set ref 2036* 2036 n_ops 000325 automatic fixed bin(17,0) dcl 116 set ref 1245* 1257 2567* 2567 2573* 2573 2588* 2588 2595* 2595 2623* 2623 2650* 2650 2689* 2689 2755* 2755 3343 n_words_specified_flg 000476 automatic bit(1) dcl 662 set ref 683* 706 707* nbits parameter fixed bin(35,0) dcl 3071 set ref 3065 3078 3079 3080 3081 3083* nchar_used 0(18) based fixed bin(2,0) level 3 packed unsigned unaligned dcl 6-15 ref 1942 1942 nchars parameter fixed bin(21,0) dcl 1660 in procedure "GCOS_ssf" set ref 1646 1739* 1764 1767* 1767 1788 1789* 1805* 1810* 1815* 1819* 1840* 1848* 1896* 1902 1902 1920* 1923* 1925 1927* 1942* 1944* 1946 1949* 1949 1952* nchars 000323 automatic fixed bin(21,0) dcl 114 in procedure "rtq_" set ref 1507* 1519 1545* 1545 1613* 1617 1637* 1637 2822* nchars parameter fixed bin(21,0) dcl 2307 in procedure "get_file_name" ref 2302 2311 ndumps 000477 automatic fixed bin(17,0) dcl 663 set ref 679* 736 736* 736 738 756 757* 757 759 neg parameter char(6) unaligned dcl 2940 ref 2915 2980 nky 0(18) based fixed bin(18,0) level 2 packed unsigned unaligned dcl 161 ref 1564 nnl_sw 000324 automatic bit(1) dcl 115 set ref 1246* 1534 1626 2579* 2869 3343 nrecords 000506 automatic fixed bin(35,0) dcl 962 set ref 978* 1038* 1048* 1048 1051 1051* 1053* 1056* 1064 1064* 1066* null builtin function dcl 62 ref 312 321 321 350 350 385 385 394 394 405 405 1451 1451 2046 2046 2129 1-7 1-7 1-7 2189 2192 2196 2200 2202 2473 2473 2495 2495 2971 2971 2995 2995 numb_of_recs_to_be_backspaced 000512 automatic fixed bin(17,0) dcl 1406 set ref 1448* 1451 1455 numrecs parameter fixed bin(35,0) dcl 3071 set ref 3065 3083* 3083 nunits 000326 automatic fixed bin(35,0) dcl 117 set ref 1267* 1273 1298* 1372* nwds 000327 automatic fixed bin(35,0) dcl 118 set ref 682* 703* 703 708* 740* 1721* 1725 1975* 1975 3078* 3083* nxt based bit(6) level 2 packed unaligned dcl 1674 set ref 1769 1774 1780 1783 nxt_fld based bit(6) level 2 packed unaligned dcl 1674 set ref 1777 nxt_lrec based bit level 2 in structure "ansi_db_lrec" packed unaligned dcl 152 in procedure "rtq_" set ref 1544 nxt_lrec based bit level 2 in structure "ibm_log_rec" packed unaligned dcl 182 in procedure "rtq_" set ref 1636 obj_card 001111 automatic bit(1) dcl 1661 set ref 1723* 1795 1797* 1842* offset_specified_flg 000500 automatic bit(1) dcl 664 set ref 683* 693 694* one_eof 71 based bit(1) level 3 dcl 241 set ref 509* 834* 974* 1232* 1342* 1422* 1457* 1493* 3022 3024* 3058* open_mode 000330 automatic fixed bin(17,0) dcl 119 set ref 1271* 2073* 2076 2375* 2524 2524 2540 2540 3369 3369 order 000331 automatic char(16) unaligned dcl 120 in procedure "rtq_" set ref 459* 462* 488* 506* 535* 554* 606* 610* 793* 801* 819* 821* 860* 879* 906* 925* 1131* 1144* 1150* 1444* 1451* 1455* 1488* 1490* order 000103 automatic char(16) unaligned dcl 2415 in procedure "process_control_order" set ref 2418* 2435 2436* 2469 2473* output_filename 000100 automatic char(168) dcl 3320 in procedure "write_file" set ref 3329* 3331 3333* output_filename 001216 automatic char(168) dcl 2308 in procedure "get_file_name" set ref 2324* 2326* 2328 owner 2 000432 automatic char(32) level 2 packed unaligned dcl 248 set ref 309* p_arg 001112 automatic varying char(168) initial dcl 1662 set ref 1662* 1866* 1868* 1870 p_dir 000100 automatic char(168) unaligned dcl 3288 set ref 3294* 3299* p_entry 000152 automatic char(32) unaligned dcl 3289 set ref 3294* 3298 3299* padding 1(07) 000120 automatic bit(29) initial level 3 packed unaligned dcl 1-7 set ref 1-7* pathname_ 000054 constant entry external dcl 50 ref 3299 pathname_argument parameter char unaligned dcl 3290 set ref 3282 3294* pname 000240 constant char(19) initial unaligned dcl 121 set ref 309 336* 2196* pointers 12 based structure level 2 dcl 241 program_interrupt 000106 stack reference condition dcl 59 ref 318 446 481 528 579 626 669 780 854 899 968 1114 1166 1226 1336 1413 1476 prompt_after_explanation 1(06) 000120 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 2128* 1-7* prptr 001002 automatic pointer dcl 6-6 set ref 1244* 1683 1688 1689 1701 1705 1706 1720 1725 ps_wd based structure array level 2 packed unaligned dcl 176 query_code 3 000120 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* query_flg 001366 automatic bit(1) dcl 2941 set ref 2991* 2992 2993* 3016* query_info 000120 automatic structure level 1 dcl 1-7 set ref 2125* 2133 2133 query_info_version_6 constant fixed bin(17,0) initial dcl 1-36 ref 2127 query_string parameter char(28) unaligned dcl 2147 set ref 2141 2157* question_iocbp 4 000120 automatic pointer initial level 2 dcl 1-7 set ref 2129* 1-7* question_string 001367 automatic char(20) unaligned dcl 2942 set ref 2982* 2986* 2989* 3014* quiet_sw parameter bit(1) dcl 2943 ref 2915 3026 rcd_tally parameter bit(1) unaligned dcl 3072 set ref 3065 3075 3083* 3083* rcd_volid 000457 automatic char(32) unaligned dcl 290 set ref 304* 2221* 2228* 2234* 2239* 2245 2251* 2262* rcw based structure level 2 packed unaligned dcl 6-15 rdw based structure level 2 packed unaligned dcl 182 rec_len 103 based fixed bin(21,0) level 2 dcl 241 set ref 387* 682 1519 1624 2517 2518 2819* 2847 2847 2850* 2857* 2862* 2869 2869 2869 2873 2873 2875* 2875 2877 2877 2877* 2952* 3057 3195 3197 3197 3205 3209 3209 3209 3209 3209 3209 3209 3215 3215 3215 3215 3215 3215 3215 3219 3220 3220 3240 3240 3243 3243 3243 3243 3245 3245 3245 3245 3248 3263 3263 3268 3268 3268 3268 rec_within_file 3 based fixed bin(17,0) level 3 packed unaligned dcl 5-10 set ref 2006 2011 2012* 2025 reclen 2(18) based char(5) level 2 packed unaligned dcl 4-8 ref 3232 3232 records_in_file_flg 72 based bit(1) level 3 dcl 241 set ref 1424* 1459* 2476 release_area_ 000124 constant entry external dcl 2184 ref 2201 release_temp_segment_ 000126 constant entry external dcl 2185 ref 2196 repeat 5(15) based bit(1) level 4 packed unaligned dcl 5-10 ref 2009 repeat_time 10 000120 automatic fixed bin(71,0) initial level 2 dcl 1-7 set ref 1-7* return_subsys_loop_flg 73 based bit(1) level 3 dcl 241 set ref 423 424* 1023 1024* 1228* 1253 1276 1285 1287* 1338* 1379 1380* 1425* 1525 1541 1571 1633 1697* 1714* 1800* 1849 1871* 1890 1898 1910 1929 1954 1971* 2021* 2030 2065* 2081* 2272 2338* 2370* 2531 2547 2788* 2811 2882 2893 2903 3008* 3337* 3352* rf 000335 automatic bit(1) dcl 123 set ref 457* 462* 486* 506* 534* 554* 585* 610* 796* 801* 817* 821* 859* 879* 905* 925* 1119* 1150* 1447* 1455* 1487* 1490* rlen 1(18) based fixed bin(18,0) level 2 packed unsigned unaligned dcl 166 ref 1565 1565 1567 1569 1574 rpt 000336 automatic bit(1) dcl 124 set ref 457* 462* 486* 506* 533* 554* 585* 610* 794* 801* 816* 821* 859* 879* 904* 925* 1119* 1150* 1445* 1455* 1487* 1490* rptr 32 based pointer level 3 dcl 241 set ref 1508* 1511 1520 1528 1530 1544* 1544 1562* 1565 1567 1569 1574* 1574 1574 1615* 1618 1618 1620 1622 1636* 1636 rsize based fixed bin(18,0) level 3 packed unsigned unaligned dcl 6-15 ref 1805 1805 1810 1815 1832 1832 1843 1920 1923 1942 1944 1946 1975 1980 rtq_area based area(1024) dcl 243 ref 345 346 347 rtq_area_ptr 34 based pointer level 3 dcl 241 set ref 333* 345 346 347 2200 2201* rtq_info based structure level 1 dcl 241 rtq_info_ptr parameter pointer dcl 125 in procedure "rtq_" set ref 252 315* 322 324 333 336 339* 345 345 345 345 346 346 347 347 347 347 350 350 354 360 366* 371 374* 379 379 382 385 385 387 387 387 387 389 394 399 401 402 402 402 403 403 405 405 407 407 407 417 417 419 419 423 424 436 444* 469 479* 509 509 509 509 516 526* 562 577* 598 604 606 606 618 624* 636 636 636 636 645 667* 672 682 722 728 740 740 766 778* 791 803 803 809 824 824 830 830 834 835 842 852* 887 897* 932 966* 974 974 974 974 974 974 989 1003 1003 1008 1008 1012 1016 1016 1020 1021 1023 1024 1029 1031 1031 1036 1037 1041 1048 1055 1063 1069 1069 1069 1074 1076 1079 1081 1084 1102 1112* 1132 1140 1144 1158 1164* 1176 1176 1176 1176 1187 1197 1224* 1228 1232 1232 1232 1234 1234 1234 1234 1234 1235 1244 1253 1263 1267 1269 1269 1273 1273 1273 1276 1285 1287 1293 1293 1295 1298 1300 1301 1306 1312 1320 1334* 1338 1342 1342 1342 1372 1374 1374 1374 1377 1379 1380 1384 1384 1393 1411* 1422 1422 1422 1424 1425 1426 1427 1437 1437 1441 1441 1448 1451 1457 1459 1466 1474* 1493 1493 1493 1493 1508 1508 1511 1519 1520 1525 1528 1528 1528 1528 1530 1530 1530 1532 1532 1536 1536 1539 1541 1544 1544 1562 1562 1564 1565 1565 1565 1565 1567 1567 1567 1569 1569 1571 1574 1574 1574 1591 1594 1596 1614 1614 1615 1615 1618 1618 1620 1620 1620 1620 1622 1622 1622 1624 1624 1624 1628 1628 1631 1633 1636 1636 1697 1705 1706 1714 1726 1726 1731 1733 1734 1734 1740 1740 1745 1746 1748 1751 1751 1762 1763 1763 1763 1763 1764 1764 1764 1769 1769 1774 1774 1777 1777 1777 1780 1780 1783 1783 1783 1788 1788 1789 1800 1805 1806 1806 1811 1816 1819 1832 1832 1832 1838 1838 1838 1838 1840 1840 1841 1841 1843 1844 1849 1856 1856 1858 1858 1864 1864 1865 1865 1866 1866 1868 1868 1871 1878 1882 1883 1884 1884 1884 1886 1887 1890 1898 1901 1902 1902 1902 1902 1902 1902 1902 1902 1902 1902 1906 1906 1910 1919 1919 1919 1919 1920 1920 1923 1923 1925 1925 1927 1929 1936 1946 1946 1946 1948 1948 1948 1948 1952 1954 1971 1979 2002 2021 2028 2028 2028 2028 2028 2030 2035 2036 2036 2036 2036 2046 2051 2055 2065 2070 2073 2081 2097 2098 2100 2102 2170 2171 2172 2173 2173 2189 2190 2191 2192 2196 2196 2200 2201 2220 2221 2222 2225 2227 2227 2228 2229 2233 2234 2235 2238 2239 2240 2243 2245 2247 2250 2251 2252 2256 2256 2262 2262 2265 2265 2270 2272 2275 2279 2311 2311 2311 2311 2314 2314 2314 2315 2316 2316 2321 2321 2321 2321 2323 2325 2328 2329 2334 2336 2338 2342 2354 2370 2395 2425 2433 2441 2441 2443 2450 2451 2456 2456 2461 2462 2462 2464 2464 2464 2469 2469 2473 2476 2481 2495 2500 2517 2518 2521 2521 2525 2525 2529 2531 2538 2538 2541 2541 2545 2547 2576 2582 2592 2604 2620 2632 2647 2683 2683 2684 2684 2684 2684 2754 2788 2806 2807 2809 2811 2814 2819 2847 2847 2847 2847 2847 2847 2847 2850 2850 2852 2852 2852 2852 2852 2852 2857 2857 2858 2858 2858 2858 2858 2858 2862 2862 2863 2863 2863 2863 2863 2863 2869 2869 2869 2869 2873 2873 2875 2875 2877 2877 2877 2882 2889 2893 2903 2907 2947 2952 2952 2952 2952 2964 2964 2969 2969 2971 2976 2976 2995 3003 3003 3008 3022 3022 3022 3024 3028 3029 3031 3034 3035 3037 3040 3040 3040 3042 3046 3049 3049 3050 3055 3055 3056 3057 3057 3058 3083 3102 3104 3106 3106 3106 3106 3110 3110 3110 3112 3112 3116 3116 3119 3119 3119 3126 3126 3126 3133 3133 3135 3135 3135 3135 3139 3139 3139 3141 3141 3145 3145 3148 3148 3151 3151 3154 3154 3157 3157 3162 3162 3162 3169 3171 3171 3171 3171 3171 3171 3173 3174 3174 3175 3175 3180 3180 3180 3180 3180 3180 3180 3180 3180 3180 3180 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3185 3195 3197 3197 3197 3197 3197 3197 3198 3198 3205 3207 3207 3209 3209 3209 3209 3209 3209 3209 3209 3209 3209 3209 3209 3209 3209 3209 3215 3215 3215 3215 3215 3215 3215 3215 3215 3215 3215 3215 3215 3215 3215 3219 3219 3220 3220 3220 3220 3220 3222 3223 3228 3236 3236 3240 3240 3240 3243 3243 3243 3243 3243 3243 3243 3243 3245 3245 3245 3245 3245 3245 3245 3245 3245 3248 3248 3259 3259 3263 3263 3263 3263 3263 3263 3264 3264 3266 3266 3266 3266 3266 3266 3268 3268 3268 3268 3268 3268 3268 3268 3268 3268 3268 3298 3299 3325 3326 3327 3328 3331 3332 3337 3345 3345 3352 3357 3363 3364 3365 3365 3369 3372 rtq_info_ptr parameter pointer dcl 2186 in procedure "detach_tape_file" ref 2180 rtq_structure_info 000516 automatic structure level 1 dcl 2-12 rtrim builtin function dcl 62 ref 1298 1532 1624 1840 1920 1923 2135 2314 s_file_name parameter varying char(32) dcl 3321 ref 3307 3343 s_filename parameter varying char(32) dcl 1663 in procedure "GCOS_ssf" set ref 1646 1789* 1819* 1888* 1906* 1927* 1952* s_filename 000337 automatic varying char(32) dcl 126 in procedure "rtq_" set ref 1243* 1295 1295* 1298 1523* 1539* 1569* 1599* 1631* 2529* 2545* 2822* 2825* 2869* 2877* 2891* 2901* s_filename parameter varying char(32) dcl 1995 in procedure "MULT_ssf" set ref 1989 2028* s_len 0(06) based bit(6) level 2 packed unaligned dcl 1674 set ref 1746 1751 1763 1763 1769 1774 1777 1780 1783 save_current_file 000514 automatic fixed bin(17,0) dcl 1408 set ref 1427* 1437* 1437* save_current_record 000513 automatic fixed bin(17,0) dcl 1407 set ref 1426* 1437* 1448 save_status_code 000350 automatic fixed bin(35,0) dcl 127 set ref 2483* 2486* 2497* 2500* 2958* 2964* 2976* schar 000352 automatic fixed bin(35,0) dcl 130 set ref 1245* 2517 2518 2521 2538 2718* 2869 2869 2869 2869 2869 2873 2873 2873 2875 2877 2877 2877 2877 sci_ptr parameter pointer dcl 2186 in procedure "detach_tape_file" ref 2180 sci_ptr parameter pointer dcl 128 in procedure "rtq_" set ref 252 315* 329* 338* 339* 356* 365* 366* 373* 374* 389* 407* 436 444* 448* 450* 469 479* 491* 493* 500* 516 526* 538* 540* 547* 562 577* 588* 590* 596* 618 624* 629* 631* 645 667* 673* 686* 690* 697* 766 778* 783* 786* 807* 824* 830* 842 852* 863* 865* 872* 887 897* 909* 911* 918* 932 966* 981* 985* 991* 997* 1026* 1102 1112* 1122* 1124* 1137* 1158 1164* 1169* 1171* 1176* 1187 1191* 1197 1224* 1238* 1258* 1301* 1320 1334* 1350* 1354* 1358* 1365* 1374* 1393 1411* 1415* 1417* 1466 1474* 1478* 1480* 1511* 1689* 1706* 1799* 1962* 2012* 2061* 2076* 2123* 2155* 2279* 2284* 2336* 2368* 2486* 2500* 2563* 2601* 2609* 2629* 2637* 2655* 2658* 2674* 2677* 2684* 2699* 2702* 2717* 2720* 2735* 2746* 2760* 2765* 2780* 2964* 2976* 3333* 3375* scode 000351 automatic fixed bin(35,0) dcl 129 set ref 321* 322 385* 386 394* 405* 412* 455* 485* 493* 501* 502 532* 540* 548* 549 584* 590* 604* 605 678* 695* 696 697* 708* 709 792* 800 803 806 807* 857* 865* 873* 874 902* 911* 919* 920 971* 1117* 1241* 1253 1301* 1345* 1359* 1360 1365* 1423* 1485* 2046* 2048 2050 2051* 2052 2055* 2061* 2073* 2075 2076* 2336* 2395* 2473* 2475 2476 2477* 2481 2483 2495* 2496 2497 2656* 2657 2658* 2667* 2675* 2676 2677* 2692* 2700* 2701 2702* 2710* 2718* 2719 2720* 2728* 2765* 2774* 2952* 2955 2957 2958 2971* 2995* 2997 3294* 3295 3333* 3369* 3372* 3374 3375* search builtin function dcl 62 ref 1865 sentinel based char(4) unaligned dcl 245 set ref 3266 3266 3266 3266 3266 3266 3268* 3268 set_bin 74 based bit(1) level 3 dcl 241 set ref 974* 1076 1079* 1234* 2604* 2620 2632* 2647 3236* set_nine 75 based bit(1) level 3 dcl 241 set ref 974* 1081 1084* 3236* short_iox_modes 000100 constant char(4) initial array dcl 7-12 ref 2363 short_output_flg 76 based bit(1) level 3 dcl 241 set ref 322* 324* 1069* 3083* size 13 000432 automatic fixed bin(18,0) level 2 dcl 248 set ref 310* spill 000353 automatic fixed bin(21,0) dcl 131 set ref 2518* 2536 2538 2541 2542* 2542 2545* ssu_$abort_line 000056 constant entry external dcl 51 ref 1026 ssu_$abort_subsystem 000060 constant entry external dcl 52 ref 1191 ssu_$arg_count 000062 constant entry external dcl 53 ref 448 491 538 588 629 686 783 863 909 981 1122 1169 1238 1350 1415 1478 ssu_$arg_ptr 000064 constant entry external dcl 54 ref 500 547 596 690 872 918 985 1137 1354 1358 2563 2601 2629 2655 2674 2699 2717 2735 2760 ssu_$get_subsystem_and_request_name 000066 constant entry external dcl 55 ref 2123 2155 ssu_$print_message 000070 constant entry external dcl 56 ref 329 338 356 365 373 389 407 450 493 540 590 631 673 697 786 807 824 830 865 911 991 997 1124 1171 1176 1258 1301 1365 1374 1417 1480 1511 1689 1706 1799 1962 2012 2061 2076 2279 2284 2336 2368 2486 2500 2609 2637 2658 2677 2684 2702 2720 2746 2765 2780 2964 2976 3333 3375 status_code 2 000120 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* status_story 000354 automatic varying char(100) dcl 132 set ref 2394* 2397* 2486 2486* 2500 2500* 2964 2964* 2976 2976* substr builtin function dcl 62 set ref 407 407 419 419 598 691 1140 1140 1536* 1567* 1624 1628* 1764* 1788* 1840 1841 1856 1858 1864 1865 1866 1868 1884 1902 1902 1902 1902 1919 1920 1923 1925* 1946 1948 2245 2311 2311 2314 2316* 2316 2321 2321 2525* 2538 2541* 2602 2630 2761 2873* 3106 3110 3110 3110 3119 3139 3139 3139 3174 3180 3180 3180 3180 3185 3185 3185 3185 3185 3185 3185 3209 3209 3209 3209 3209 3215 3215 3215 3215 3215 3219 3220 3220 3243 3243 3243 3243 3245 3245 3248 3259 3268 3268 suffix parameter char unaligned dcl 3291 set ref 3282 3294* suppress_name_sw 1(01) 000120 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* suppress_spacing 1(04) 000120 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* switches 1 000120 automatic structure level 2 dcl 1-7 sys_info$max_seg_size 000104 external static fixed bin(35,0) dcl 148 ref 310 system_use 3(27) based structure level 2 packed unaligned dcl 4-8 t_stat 000406 automatic bit(12) dcl 133 set ref 2395 2395 2397 2486* 2500* 2964* 2976* tape_atd 172 based varying char(200) level 2 dcl 241 ref 350 tape_name 101 based char(8) level 2 dcl 241 set ref 389* 407* 636* 1016* 1176* 2256* 2262* tape_reel_id 30 based char(32) level 3 in structure "mst_label" packed unaligned dcl 5-16 in procedure "rtq_" set ref 2228 3135* tape_reel_id 20 based char(32) level 3 in structure "mult" packed unaligned dcl 205 in procedure "rtq_" set ref 2221 3106* tape_status_table_$tape_status_table_ 000106 external static fixed bin(17,0) dcl 149 set ref 2397 2397 temp_logical_rec_len 000407 automatic fixed bin(21,0) dcl 134 set ref 2522* 2526* 2526 2529* terminate_read_sw 000467 automatic bit(1) unaligned dcl 291 set ref 383* 384 392* 399 time_string 000410 automatic char(24) unaligned dcl 135 set ref 3110* 3112* 3114* 3139* 3141* 3143* tiocb_ptr 36 based pointer level 3 dcl 241 set ref 350* 354* 360* 371* 385* 387* 394* 405* 1451* 2189 2190* 2191* 2192* 2395* 2473* 2495* 2952* 2971* 2995* tmr 77 based bit(1) level 3 dcl 241 set ref 399* 401 1882* 1883 1884* 1886 2323* 2325 2328* 2329 3327* 3328 3331* 3332 tptr 40 based pointer level 3 dcl 241 set ref 336* 387* 740 740 1244 1508 1562 1564 1594 1596 1614 1614 1615 2002 2028 2028 2036 2196 2196* 2220 2221 2225 2227 2227 2228 2233 2234 2238 2239 2243 2245 2250 2251 2847 2852 2858 2863 2952* 3104 3106 3106 3110 3110 3110 3112 3112 3116 3116 3119 3119 3119 3126 3133 3135 3135 3139 3139 3139 3141 3141 3145 3145 3148 3148 3151 3151 3154 3154 3157 3157 3162 3171 3173 3174 3185 3185 3197 3207 3259 3263 tr_cnt 000416 automatic fixed bin(35,0) dcl 136 set ref 2656* 2819 translate builtin function dcl 62 ref 1838 trim_trailing_blanks_log_rec_len 000417 automatic fixed bin(21,0) dcl 137 set ref 1532* 1535* 1535 1536 1539* 1624* 1627* 1627 1628 1631* trunc_sw 000420 automatic bit(1) dcl 138 set ref 1246* 2664* 2819 two_eofs 100 based bit(1) level 3 dcl 241 set ref 509* 974* 1020 1063 1232* 1267 1342* 1372 1422* 1493* 2947 3022* 3028 3175* type based bit(12) level 2 packed unaligned dcl 1666 ref 1733 uid 1 based bit(72) level 3 in structure "mstr" packed unaligned dcl 5-10 in procedure "rtq_" ref 3110 3110 3110 3112 3112 uid 11 based bit(72) level 3 in structure "mst_label" packed unaligned dcl 5-16 in procedure "rtq_" ref 3139 3139 3139 3141 3141 unlabeled constant fixed bin(17,0) initial dcl 963 ref 989 unspec builtin function dcl 62 set ref 305* 2125* 3106 3119 userid 232 based char(32) level 2 packed unaligned dcl 5-16 set ref 3148 3148* v1_mult_label constant fixed bin(17,0) initial dcl 285 ref 2222 v3_mult_label constant fixed bin(17,0) initial dcl 285 ref 2229 version 000120 automatic fixed bin(17,0) level 2 in structure "query_info" dcl 1-7 in procedure "command_query_no_entrypoint" set ref 2127* version 000432 automatic fixed bin(17,0) level 2 in structure "ai" dcl 248 in procedure "rtq_" set ref 306* version_of_area 14 000432 automatic fixed bin(17,0) level 2 dcl 248 set ref 311* vid 20 based structure level 2 dcl 5-16 vol_id 0(32) based bit(32) level 2 in structure "cp5_lab" packed unaligned dcl 219 in procedure "rtq_" set ref 2251* vol_id 3 based bit(36) level 2 in structure "gcos" packed unaligned dcl 210 in procedure "rtq_" set ref 2234* vol_id 0(32) based bit(48) level 2 in structure "ibm_ansi" packed unaligned dcl 215 in procedure "rtq_" set ref 2239* 2245 vol_info 10 based structure level 2 packed unaligned dcl 205 volume_identifier based structure level 1 dcl 5-73 volume_set_id 40 based char(32) level 3 in structure "mst_label" packed unaligned dcl 5-16 in procedure "rtq_" set ref 3154 3154* volume_set_id 30 based char(32) level 3 in structure "mult" packed unaligned dcl 205 in procedure "rtq_" set ref 3106 3119 3119 3119* wd_buf_size 105 based fixed bin(17,0) level 2 dcl 241 set ref 1705 1706* who_asked 000421 automatic varying char(32) dcl 139 set ref 2123* 2133 2155* 2157 wrtchars parameter fixed bin(21,0) dcl 3322 set ref 3307 3369* 3372* yes_or_no_sw 1 000120 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* zero_on_alloc 1(01) 000432 automatic bit(1) level 3 packed unaligned dcl 248 set ref 308* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ANSI_EOF2 internal static fixed bin(17,0) initial dcl 4-34 ANSI_EOV2 internal static fixed bin(17,0) initial dcl 4-34 ANSI_HDR2 internal static fixed bin(17,0) initial dcl 4-34 ANSI_L2_ID internal static char(4) initial array unaligned dcl 4-32 Direct_input internal static fixed bin(17,0) initial dcl 7-15 Direct_output internal static fixed bin(17,0) initial dcl 7-15 Direct_update internal static fixed bin(17,0) initial dcl 7-15 HEADER_VERSION internal static fixed bin(17,0) initial dcl 5-89 IBM_EOF2 internal static fixed bin(17,0) initial dcl 3-36 IBM_EOV2 internal static fixed bin(17,0) initial dcl 3-36 IBM_HDR2 internal static fixed bin(17,0) initial dcl 3-36 IBM_L2_ID internal static char(4) initial array unaligned dcl 3-34 Keyed_sequential_input internal static fixed bin(17,0) initial dcl 7-15 Keyed_sequential_output internal static fixed bin(17,0) initial dcl 7-15 Keyed_sequential_update internal static fixed bin(17,0) initial dcl 7-15 LABEL_VERSION internal static fixed bin(17,0) initial dcl 5-87 Sequential_input_output internal static fixed bin(17,0) initial dcl 7-15 Sequential_output internal static fixed bin(17,0) initial dcl 7-15 Sequential_update internal static fixed bin(17,0) initial dcl 7-15 Stream_input internal static fixed bin(17,0) initial dcl 7-15 area_infop automatic pointer dcl 8-5 gc_phy_rec_bits based bit unaligned dcl 6-25 header_c2 internal static bit(36) initial unaligned dcl 5-79 ibm_system_use based structure level 1 packed unaligned dcl 3-30 iox_$get_line 000000 constant entry external dcl 49 old_ansi_hdr2_system_use based structure level 1 packed unaligned dcl 4-26 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 revert builtin function dcl 62 trailer_c1 internal static bit(36) initial unaligned dcl 5-79 trailer_c2 internal static bit(36) initial unaligned dcl 5-79 NAMES DECLARED BY EXPLICIT CONTEXT. ANSI_DB_ERROR 023556 constant label dcl 2637 ref 2644 ANSI_DB_records 014237 constant entry internal dcl 1500 ref 2839 BACK_TO_RTQ_REQUEST_LOOP 014554 constant label dcl 1549 ref 1516 BOF_EXIT 005372 constant label dcl 464 ref 446 BSF_EXIT 005641 constant label dcl 511 ref 481 BSR_EXIT 006102 constant label dcl 556 ref 528 CNT_ERROR 024200 constant label dcl 2702 ref 2711 CONV_ERROR 024443 constant label dcl 2746 ref 2734 CP5_variable_length_records 014555 constant entry internal dcl 1556 ref 2828 DEC_tape_records 014677 constant entry internal dcl 1583 ref 2831 DENSITY_EXIT 006432 constant label dcl 612 ref 579 END_OF_INFO_REACHED 026121 constant label dcl 3022 ref 2997 ERROR_BSF 005500 constant label dcl 493 ref 502 ERROR_BSR 005747 constant label dcl 540 ref 549 ERROR_DENSITY 006206 constant label dcl 590 ref 601 605 ERROR_DUMP 007053 constant label dcl 697 ref 706 709 727 759 ERROR_FSF 010047 constant label dcl 865 ref 874 ERROR_FSR 010310 constant label dcl 911 ref 920 ERROR_MODE 011640 constant label dcl 1124 ref 1138 ERROR_RDREC 013307 constant label dcl 1365 ref 1356 1360 ERR_ATTACHED 017450 constant label dcl 2061 ref 2052 FSR_RETURN 010442 constant label dcl 927 ref 899 GCOS_ssf 015152 constant entry internal dcl 1646 ref 2822 GET_CONTROL_ARG_ERROR 024670 constant label dcl 2788 ref 2612 2640 2661 2680 2686 2705 2723 2749 2768 2782 IBM_VB_ERROR 023414 constant label dcl 2609 ref 2617 IBM_VB_records 014757 constant entry internal dcl 1607 ref 2834 LRL_ERROR 024020 constant label dcl 2677 ref 2693 MULT_ssf 017135 constant entry internal dcl 1989 ref 2825 2901 OF_ERROR 024574 constant label dcl 2765 ref 2775 PATHNAME_ERROR 021554 constant label dcl 2336 ref 2329 PI_RETURN 014220 constant label dcl 1495 ref 1476 RETRY 017346 constant label dcl 2046 ref 2056 RETRY_WRITE 031577 constant label dcl 3369 ref 3379 RETURN 013074 constant label dcl 1315 ref 1226 RETURNED 014030 constant label dcl 1461 ref 1413 RETURNS_TO_REQUEST_LOOP 010202 constant label dcl 881 ref 854 RETURNS_TO_SUBSYS 006616 constant label dcl 639 ref 626 SET_UP_EXIT 005204 constant label dcl 429 ref 318 SKIP_ERROR 024307 constant label dcl 2720 ref 2729 SUBSYSTEM_LOOP_RETURN 012641 constant label dcl 1287 ref 1253 1276 SUBSYSTEM_REQUEST_LOOP 011536 constant label dcl 1095 ref 968 SUBSYSTEM_RETURNED 007741 constant label dcl 837 ref 780 SUBSYS_QUERY 012225 constant label dcl 1180 ref 1166 SUBSYS_REQUEST_LOOP 013500 constant label dcl 1388 ref 1336 TC_ERROR 023703 constant label dcl 2658 ref 2668 TRY_AGAIN 004276 constant label dcl 350 ref 361 WANTS_TO_EXIT 007340 constant label dcl 743 ref 669 WANTS_TO_RETURN 012030 constant label dcl 1152 ref 1114 attach_and_open_output_file 017341 constant entry internal dcl 2043 ref 2378 3360 bof_request 005211 constant entry external dcl 436 bsf_request 005375 constant entry external dcl 469 bsr_request 005644 constant entry external dcl 516 check_mode 017615 constant entry internal dcl 2090 ref 1008 1012 1077 1082 2266 2566 2572 2587 2594 2620 2622 2647 2649 2743 ck_obj 015732 constant label dcl 1795 ref 1860 command_query_no_entrypoint 017721 constant entry internal dcl 2109 ref 2326 2356 2360 2989 3014 3329 command_query_yes_no 020120 constant entry internal dcl 2141 ref 1692 1709 2016 3349 3377 density_request 006105 constant entry external dcl 562 detach_file_if_attached 020223 constant entry internal dcl 2165 ref 1249 1312 1695 1712 1824 1846 1875 1893 2019 2079 2206 2907 detach_tape_file 020275 constant entry internal dcl 2180 ref 315 339 366 374 444 479 526 577 624 667 778 852 897 966 1112 1164 1224 1334 1411 1474 determine_tape_label_types 020427 constant entry internal dcl 2214 ref 421 dot_request 006435 constant entry external dcl 618 dump_record_request 006621 constant entry external dcl 645 eof_request 007343 constant entry external dcl 766 fsf_request 007744 constant entry external dcl 842 fsr_request 010205 constant entry external dcl 887 get_file_name 021266 constant entry internal dcl 2302 ref 1848 1896 get_output_descript_and_attach 021623 constant entry internal dcl 2348 ref 1274 get_tape_status 022013 constant entry internal dcl 2387 ref 2484 2498 2959 gleot 026135 constant label dcl 3026 ref 2947 gssf_end 017111 constant label dcl 1975 ref 1828 1852 1913 1932 1957 ibm_asc_join 030107 constant label dcl 3209 ref 3199 lab_type 000020 constant label array(0:6) dcl 3104 ref 3102 list_tape_contents 010445 constant entry external dcl 932 media_type 000000 constant label array(0:15) dcl 1731 ref 1727 mode_request 011541 constant entry external dcl 1102 nxt_rcd 025331 constant label dcl 2885 ref 2816 position_request 012033 constant entry external dcl 1158 process_control_order 022116 constant entry internal dcl 2403 ref 462 506 554 610 801 821 879 925 1003 1090 1150 1263 1455 1490 2102 2268 2286 2294 2429 2453 process_logical_record_length 022766 constant entry internal dcl 2511 ref 2866 quit_request 012230 constant entry external dcl 1187 read_file_get_control_args 023147 constant entry internal dcl 2558 ref 1252 read_file_request 012257 constant entry external dcl 1197 read_in_the_entire_file 024676 constant entry internal dcl 2796 ref 1281 read_record_request 013077 constant entry external dcl 1320 read_tape_record 025410 constant entry internal dcl 2915 ref 1021 1377 1433 2270 2809 record_information 026377 constant entry internal dcl 3065 ref 1053 1066 1384 records_in_file_request 013503 constant entry external dcl 1393 retry_rd 025421 constant label dcl 2952 ref 2973 2999 3004 rewind_request 014033 constant entry external dcl 1466 rtq_ 003723 constant entry external dcl 26 set_dump_fmt 014221 constant entry internal dcl 749 ref 715 718 722 724 728 730 set_up 003735 constant entry external dcl 252 valid_label_record 026603 constant entry internal dcl 3091 ref 1034 2279 2816 3075 valid_pathname 031107 constant entry internal dcl 3282 ref 1300 1870 2328 2334 2764 3331 write_file 031235 constant entry internal dcl 3307 ref 1523 1539 1569 1599 1631 1789 1819 1888 1906 1927 1952 2028 2529 2545 2869 2877 2891 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 34114 34246 32505 34124 Length 35204 32505 132 722 1407 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME rtq_ 2044 external procedure is an external procedure. on unit on line 315 72 on unit on unit on line 318 64 on unit on unit on line 444 72 on unit on unit on line 446 64 on unit on unit on line 479 72 on unit on unit on line 481 64 on unit on unit on line 526 72 on unit on unit on line 528 64 on unit on unit on line 577 72 on unit on unit on line 579 64 on unit on unit on line 624 72 on unit on unit on line 626 64 on unit on unit on line 667 72 on unit on unit on line 669 64 on unit set_dump_fmt internal procedure shares stack frame of external procedure rtq_. on unit on line 778 72 on unit on unit on line 780 64 on unit on unit on line 852 72 on unit on unit on line 854 64 on unit on unit on line 897 72 on unit on unit on line 899 64 on unit on unit on line 966 72 on unit on unit on line 968 64 on unit on unit on line 1112 72 on unit on unit on line 1114 64 on unit on unit on line 1164 72 on unit on unit on line 1166 64 on unit on unit on line 1224 72 on unit on unit on line 1226 64 on unit on unit on line 1334 72 on unit on unit on line 1336 64 on unit on unit on line 1411 72 on unit on unit on line 1413 64 on unit on unit on line 1474 72 on unit on unit on line 1476 64 on unit ANSI_DB_records 235 internal procedure enables or reverts conditions. on unit on line 1510 106 on unit CP5_variable_length_records internal procedure shares stack frame of external procedure rtq_. DEC_tape_records internal procedure shares stack frame of external procedure rtq_. IBM_VB_records internal procedure shares stack frame of external procedure rtq_. GCOS_ssf internal procedure shares stack frame of external procedure rtq_. MULT_ssf internal procedure shares stack frame of external procedure rtq_. attach_and_open_output_file 109 internal procedure is called by several nonquick procedures. check_mode internal procedure shares stack frame of external procedure rtq_. command_query_no_entrypoint 126 internal procedure is called by several nonquick procedures. command_query_yes_no 116 internal procedure is called by several nonquick procedures. detach_file_if_attached 72 internal procedure is called by several nonquick procedures. detach_tape_file 86 internal procedure is called by several nonquick procedures. determine_tape_label_types internal procedure shares stack frame of external procedure rtq_. get_file_name internal procedure shares stack frame of external procedure rtq_. get_output_descript_and_attach internal procedure shares stack frame of external procedure rtq_. get_tape_status 90 internal procedure is called by several nonquick procedures. process_control_order 162 internal procedure calls itself recursively. process_logical_record_length internal procedure shares stack frame of external procedure rtq_. read_file_get_control_args internal procedure shares stack frame of external procedure rtq_. read_in_the_entire_file internal procedure shares stack frame of external procedure rtq_. read_tape_record internal procedure shares stack frame of external procedure rtq_. record_information internal procedure shares stack frame of external procedure rtq_. valid_label_record internal procedure shares stack frame of external procedure rtq_. valid_pathname 180 internal procedure is called during a stack extension. write_file 190 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME command_query_no_entrypoint 000100 get_users_answer command_query_no_entrypoint 000120 query_info command_query_no_entrypoint command_query_yes_no 000100 A_YES_OR_NO_ANSWER command_query_yes_no process_control_order 000100 backspace_file_flg process_control_order 000101 count process_control_order 000102 i process_control_order 000103 order process_control_order rtq_ 000114 YES_FLG rtq_ 000115 Nargs rtq_ 000116 al rtq_ 000117 ansid rtq_ 000120 ansi_mode rtq_ 000122 ap rtq_ 000124 arg_dex rtq_ 000125 att_desc rtq_ 000207 attach_desc_output rtq_ 000272 bcnt rtq_ 000273 binck rtq_ 000274 blocksize rtq_ 000275 c_b_a rtq_ 000276 c_c_a rtq_ 000277 c_e_a rtq_ 000300 cont rtq_ 000301 cp5 rtq_ 000302 dec_sw rtq_ 000303 direction rtq_ 000304 first_record_flg rtq_ 000305 gssf rtq_ 000306 i rtq_ 000307 j rtq_ 000310 ibmv rtq_ 000311 imcv rtq_ 000312 it_cnt rtq_ 000313 iterations rtq_ 000314 l_cnt rtq_ 000315 l_rec rtq_ 000316 l_rec_len rtq_ 000317 last_record_flg rtq_ 000320 lrp rtq_ 000322 mssf rtq_ 000323 nchars rtq_ 000324 nnl_sw rtq_ 000325 n_ops rtq_ 000326 nunits rtq_ 000327 nwds rtq_ 000330 open_mode rtq_ 000331 order rtq_ 000335 rf rtq_ 000336 rpt rtq_ 000337 s_filename rtq_ 000350 save_status_code rtq_ 000351 scode rtq_ 000352 schar rtq_ 000353 spill rtq_ 000354 status_story rtq_ 000406 t_stat rtq_ 000407 temp_logical_rec_len rtq_ 000410 time_string rtq_ 000416 tr_cnt rtq_ 000417 trim_trailing_blanks_log_rec_len rtq_ 000420 trunc_sw rtq_ 000421 who_asked rtq_ 000432 ai rtq_ 000456 get_line_length rtq_ 000457 rcd_volid rtq_ 000467 terminate_read_sw rtq_ 000470 array_index rtq_ 000471 match rtq_ 000472 doffset rtq_ 000473 dump_index rtq_ 000474 format rtq_ 000476 n_words_specified_flg rtq_ 000477 ndumps rtq_ 000500 offset_specified_flg rtq_ 000501 logical_file_num rtq_ 000502 label_flg rtq_ 000503 last_length rtq_ 000504 logical_file_flg rtq_ 000505 long_list_flg rtq_ 000506 nrecords rtq_ 000507 mode_dex rtq_ 000510 conversion_flg rtq_ 000511 end_file_flg rtq_ 000512 numb_of_recs_to_be_backspaced rtq_ 000513 save_current_record rtq_ 000514 save_current_file rtq_ 000516 rtq_structure_info rtq_ 000774 ibm_hdr2P rtq_ 000776 ansi_hdr2P rtq_ 001000 mstrp rtq_ 001002 prptr rtq_ 001004 lrptr rtq_ 001104 card_cnt GCOS_ssf 001105 dkend_card GCOS_ssf 001106 eoc GCOS_ssf 001107 fc GCOS_ssf 001110 fl GCOS_ssf 001111 obj_card GCOS_ssf 001112 p_arg GCOS_ssf 001216 output_filename get_file_name 001332 auto_retry read_tape_record 001333 explanation_string read_tape_record 001363 get_answer read_tape_record 001366 query_flg read_tape_record 001367 question_string read_tape_record 001402 bit6 record_information 001403 bit8 record_information 001404 bit9 record_information 001414 eov valid_label_record valid_pathname 000100 p_dir valid_pathname 000152 p_entry valid_pathname write_file 000100 output_filename write_file THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as r_ne_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 mdfx3 enable_op shorten_stack ext_entry int_entry int_entry_desc any_to_any_truncate_divide_fx3 op_alloc_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. analyze_device_stat_$rsnnl bcd_to_ascii_ command_query_ command_query_$yes_no comp_8_to_ascii_ cv_dec_check_ cv_oct_check_ date_time_ define_area_ dump_segment_ ebcdic8_to_ascii_ ebcdic_to_ascii_ expand_pathname_$add_suffix get_line_length_$switch get_temp_segment_ ioa_ ioa_$rsnnl iox_$attach_name iox_$close iox_$control iox_$detach_iocb iox_$open iox_$put_chars iox_$read_record iox_$write_record pathname_ release_area_ release_temp_segment_ ssu_$abort_line ssu_$abort_subsystem ssu_$arg_count ssu_$arg_ptr ssu_$get_subsystem_and_request_name ssu_$print_message THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$end_of_info error_table_$not_closed error_table_$not_detached error_table_$tape_error iox_$user_output sys_info$max_seg_size tape_status_table_$tape_status_table_ LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 26 003722 252 003730 303 003742 304 003743 305 003746 306 003751 307 003753 308 003755 309 003757 310 003762 311 003764 312 003766 315 003770 318 004020 321 004037 322 004054 324 004067 327 004073 328 004106 329 004111 330 004140 333 004141 336 004145 337 004170 338 004173 339 004217 340 004230 345 004231 346 004246 347 004261 350 004276 352 004345 353 004351 354 004354 355 004366 356 004373 357 004407 360 004410 361 004423 365 004424 366 004447 367 004460 371 004461 372 004503 373 004506 374 004532 375 004543 379 004544 382 004554 383 004556 384 004557 385 004567 386 004624 387 004626 388 004650 389 004655 392 004712 394 004714 396 004747 399 004751 401 004756 402 004764 403 005030 405 005035 407 005066 411 005132 412 005134 413 005135 417 005136 419 005145 421 005174 423 005175 424 005202 425 005203 429 005204 436 005205 444 005216 446 005246 448 005265 449 005277 450 005301 451 005331 455 005332 456 005333 457 005335 458 005340 459 005341 462 005344 464 005372 469 005373 479 005402 481 005432 484 005451 485 005453 486 005454 487 005457 488 005460 491 005463 492 005475 493 005500 495 005530 499 005531 500 005537 501 005555 502 005600 503 005602 506 005604 509 005632 511 005641 516 005642 526 005651 528 005701 531 005720 532 005722 533 005723 534 005725 535 005727 538 005732 539 005744 540 005747 542 005777 546 006000 547 006007 548 006025 549 006050 551 006052 554 006054 556 006102 562 006103 577 006112 579 006142 582 006161 583 006163 584 006164 585 006165 588 006170 589 006202 590 006206 592 006233 596 006234 597 006252 598 006261 600 006300 601 006302 604 006304 605 006332 606 006334 607 006403 610 006404 612 006432 618 006433 624 006442 626 006472 629 006511 630 006523 631 006525 632 006553 636 006554 639 006616 645 006617 667 006626 669 006656 672 006675 673 006702 674 006732 678 006733 679 006734 680 006736 681 006737 682 006743 683 006752 686 006754 689 006765 690 006775 691 007013 693 007020 694 007022 695 007024 696 007051 697 007053 700 007100 703 007101 704 007107 706 007110 707 007112 708 007114 709 007137 713 007141 715 007142 718 007154 721 007165 722 007171 724 007204 725 007210 727 007211 728 007215 730 007230 734 007234 736 007236 738 007243 739 007253 740 007266 741 007336 743 007340 766 007341 778 007350 780 007400 783 007417 785 007431 786 007433 787 007463 791 007464 792 007471 793 007472 794 007475 795 007476 796 007477 797 007500 800 007502 801 007506 803 007534 806 007542 807 007545 809 007571 810 007575 812 007576 815 007577 816 007600 817 007601 818 007602 819 007604 821 007607 824 007635 830 007675 834 007734 835 007740 837 007741 842 007742 852 007751 854 010001 857 010020 858 010021 859 010023 860 010027 863 010032 864 010044 865 010047 867 010077 871 010100 872 010107 873 010125 874 010150 876 010152 879 010154 881 010202 887 010203 897 010212 899 010242 902 010261 903 010262 904 010264 905 010267 906 010270 909 010273 910 010305 911 010310 913 010340 917 010341 918 010347 919 010365 920 010410 922 010412 925 010414 927 010442 932 010443 966 010452 968 010502 971 010521 972 010522 973 010523 974 010525 977 010536 978 010541 981 010544 984 010555 985 010565 987 010603 989 010620 991 010635 992 010662 994 010663 997 010666 998 010714 1000 010715 1003 010717 1008 010766 1012 011000 1016 011004 1020 011037 1021 011045 1023 011065 1024 011072 1025 011073 1026 011074 1029 011105 1031 011113 1034 011141 1036 011146 1037 011154 1038 011156 1039 011157 1041 011160 1042 011163 1043 011212 1044 011214 1045 011215 1048 011230 1051 011243 1053 011247 1055 011257 1056 011264 1058 011265 1060 011266 1061 011267 1063 011270 1064 011274 1066 011300 1069 011310 1073 011400 1074 011401 1076 011406 1077 011414 1078 011416 1079 011431 1080 011435 1081 011436 1082 011442 1083 011444 1084 011457 1087 011463 1090 011464 1093 011522 1095 011536 1102 011537 1112 011546 1114 011576 1117 011615 1118 011616 1119 011620 1122 011623 1123 011635 1124 011640 1126 011666 1130 011667 1131 011671 1132 011674 1136 011701 1137 011711 1138 011727 1139 011745 1140 011753 1143 011766 1144 011770 1147 012000 1150 012002 1152 012030 1158 012031 1164 012040 1166 012070 1169 012107 1170 012121 1171 012123 1172 012151 1176 012152 1180 012225 1187 012226 1191 012235 1193 012254 1197 012255 1221 012264 1224 012267 1226 012317 1228 012336 1232 012342 1234 012345 1235 012352 1238 012353 1241 012364 1242 012365 1243 012367 1244 012370 1245 012376 1246 012400 1249 012416 1252 012422 1253 012423 1257 012432 1258 012445 1259 012472 1263 012473 1267 012540 1269 012554 1271 012604 1273 012606 1274 012622 1276 012623 1281 012630 1283 012631 1285 012634 1287 012641 1289 012645 1293 012646 1295 012652 1298 012664 1300 012761 1301 013015 1303 013051 1306 013052 1309 013056 1312 013063 1315 013074 1320 013075 1334 013104 1336 013134 1338 013153 1342 013157 1345 013162 1346 013163 1347 013164 1350 013166 1353 013177 1354 013207 1355 013225 1356 013237 1357 013242 1358 013243 1359 013261 1360 013304 1363 013306 1365 013307 1367 013334 1370 013335 1372 013337 1374 013354 1377 013420 1379 013443 1380 013450 1381 013451 1384 013452 1386 013473 1388 013500 1393 013501 1411 013510 1413 013540 1415 013557 1416 013571 1417 013573 1418 013621 1422 013622 1423 013630 1424 013631 1425 013633 1426 013634 1427 013636 1428 013640 1429 013641 1432 013642 1433 013645 1434 013653 1437 013654 1441 013724 1444 013731 1445 013734 1446 013736 1447 013737 1448 013740 1451 013743 1455 013774 1457 014023 1459 014027 1461 014030 1466 014031 1474 014040 1476 014070 1478 014107 1479 014121 1480 014123 1481 014151 1485 014152 1486 014153 1487 014155 1488 014160 1490 014163 1493 014211 1495 014220 749 014221 756 014223 757 014231 759 014232 762 014235 1500 014236 1507 014252 1508 014254 1510 014261 1511 014275 1515 014332 1516 014341 1519 014344 1520 014354 1522 014372 1523 014373 1525 014412 1526 014420 1528 014421 1530 014453 1532 014466 1534 014506 1535 014510 1536 014511 1539 014515 1541 014530 1544 014536 1545 014546 1547 014553 1549 014554 1556 014555 1562 014556 1564 014564 1565 014577 1567 014630 1569 014642 1571 014656 1574 014664 1575 014674 1577 014676 1583 014677 1591 014700 1593 014706 1594 014715 1596 014730 1597 014737 1599 014741 1601 014756 1607 014757 1613 014760 1614 014761 1615 015002 1617 015005 1618 015011 1620 015033 1622 015061 1624 015067 1626 015106 1627 015110 1628 015111 1631 015115 1633 015127 1636 015135 1637 015143 1638 015150 1640 015151 1646 015152 1662 015154 1682 015155 1683 015160 1684 015163 1685 015165 1687 015166 1688 015167 1689 015173 1692 015231 1694 015251 1695 015254 1697 015260 1699 015265 1701 015266 1705 015271 1706 015300 1709 015337 1711 015357 1712 015362 1714 015366 1716 015373 1720 015374 1721 015377 1722 015400 1723 015402 1725 015404 1726 015410 1727 015424 1731 015431 1733 015437 1734 015445 1735 015450 1737 015451 1738 015454 1739 015460 1740 015462 1743 015472 1744 015473 1745 015500 1746 015512 1748 015520 1749 015524 1750 015526 1751 015530 1752 015534 1754 015535 1755 015543 1756 015546 1757 015550 1760 015551 1761 015552 1762 015554 1763 015560 1764 015604 1767 015621 1769 015624 1770 015647 1771 015651 1772 015652 1774 015653 1775 015655 1776 015657 1777 015660 1778 015665 1780 015666 1783 015674 1785 015677 1787 015700 1788 015706 1789 015716 1791 015730 1792 015731 1795 015732 1797 015734 1798 015735 1799 015740 1800 015766 1801 015773 1805 015774 1806 016011 1807 016014 1809 016015 1810 016020 1811 016026 1812 016034 1815 016035 1816 016043 1819 016050 1821 016066 1822 016070 1824 016071 1828 016075 1832 016076 1838 016130 1839 016145 1840 016154 1841 016170 1842 016174 1843 016176 1844 016204 1845 016213 1846 016216 1848 016222 1849 016235 1852 016243 1854 016244 1856 016245 1858 016254 1860 016262 1862 016263 1864 016264 1865 016270 1866 016302 1868 016311 1870 016321 1871 016356 1872 016364 1875 016365 1877 016371 1878 016374 1879 016401 1881 016402 1882 016405 1883 016406 1884 016421 1885 016431 1886 016433 1887 016441 1888 016443 1890 016462 1893 016470 1896 016474 1898 016507 1901 016515 1902 016517 1906 016572 1908 016611 1910 016613 1913 016621 1916 016622 1918 016623 1919 016625 1920 016633 1921 016653 1923 016654 1925 016674 1927 016705 1929 016717 1932 016725 1936 016726 1942 016734 1944 016751 1946 016756 1947 017002 1948 017006 1949 017014 1952 017016 1954 017030 1957 017036 1962 017037 1971 017103 1972 017110 1975 017111 1979 017121 1980 017126 1981 017132 1983 017133 1985 017134 1989 017135 2002 017137 2004 017144 2005 017147 2006 017151 2007 017154 2009 017155 2010 017160 2011 017161 2012 017170 2016 017225 2018 017245 2019 017250 2021 017254 2023 017261 2025 017262 2028 017266 2030 017307 2034 017315 2035 017321 2036 017330 2037 017336 2039 017337 2043 017340 2046 017346 2048 017406 2050 017411 2051 017414 2052 017427 2055 017434 2056 017447 2061 017450 2065 017500 2066 017506 2070 017507 2073 017515 2075 017534 2076 017537 2079 017600 2081 017605 2082 017613 2086 017614 2090 017615 2097 017617 2098 017625 2100 017627 2102 017652 2105 017717 2109 017720 1 7 017741 2123 017771 2125 020014 2127 020017 2128 020021 2129 020023 2130 020026 2131 020031 2133 020033 2135 020073 2141 020117 2153 020125 2155 020126 2157 020151 2159 020214 2165 020222 2170 020230 2171 020236 2172 020247 2173 020265 2176 020273 2180 020274 2189 020302 2190 020312 2191 020323 2192 020341 2196 020347 2200 020377 2201 020407 2202 020416 2206 020421 2208 020426 2214 020427 2220 020430 2221 020442 2222 020445 2223 020447 2225 020450 2227 020452 2228 020460 2229 020463 2231 020465 2233 020466 2234 020472 2235 020507 2236 020514 2238 020515 2239 020523 2240 020542 2241 020547 2243 020550 2244 020552 2245 020557 2246 020600 2247 020602 2248 020607 2250 020610 2251 020614 2252 020633 2253 020640 2256 020641 2259 020670 2262 020671 2265 020726 2266 020736 2268 020740 2270 021003 2272 021026 2275 021034 2277 021037 2279 021056 2282 021124 2284 021125 2286 021152 2288 021210 2292 021211 2294 021225 2296 021265 2302 021266 2311 021270 2314 021312 2315 021332 2316 021344 2319 021360 2321 021361 2323 021407 2324 021413 2325 021416 2326 021424 2328 021461 2329 021507 2331 021515 2334 021516 2336 021554 2338 021610 2339 021615 2342 021616 2344 021622 2348 021623 2354 021624 2356 021631 2358 021657 2360 021663 2363 021714 2365 021737 2367 021741 2368 021744 2370 021776 2371 022003 2375 022004 2378 022005 2381 022011 2387 022012 2394 022020 2395 022022 2397 022057 2399 022114 2403 022115 2412 022131 2418 022132 2419 022137 2420 022141 2422 022142 2423 022145 2424 022150 2425 022153 2427 022171 2429 022204 2430 022243 2433 022244 2435 022246 2436 022252 2437 022255 2438 022257 2441 022260 2443 022266 2446 022272 2449 022276 2450 022277 2451 022315 2453 022334 2454 022377 2456 022400 2458 022402 2460 022403 2461 022406 2462 022414 2463 022420 2464 022421 2469 022433 2472 022446 2473 022455 2475 022507 2476 022512 2477 022522 2478 022523 2481 022531 2483 022540 2484 022541 2486 022546 2489 022627 2492 022630 2494 022635 2495 022637 2496 022675 2497 022700 2498 022701 2500 022706 2503 022764 2507 022765 2511 022766 2517 022767 2518 023004 2520 023007 2521 023017 2522 023035 2524 023036 2525 023043 2526 023047 2529 023050 2531 023062 2534 023070 2536 023072 2537 023074 2538 023075 2540 023114 2541 023121 2542 023125 2545 023126 2547 023140 2552 023146 2558 023147 2562 023150 2563 023157 2564 023175 2565 023207 2566 023211 2567 023213 2568 023214 2570 023215 2571 023225 2572 023227 2573 023231 2574 023232 2576 023233 2579 023245 2582 023254 2585 023272 2586 023276 2587 023300 2588 023302 2589 023303 2591 023304 2592 023310 2593 023315 2594 023317 2595 023321 2596 023322 2598 023323 2599 023327 2600 023331 2601 023334 2602 023354 2603 023361 2604 023362 2606 023401 2608 023410 2609 023414 2612 023442 2614 023443 2615 023444 2616 023446 2617 023447 2620 023451 2622 023461 2623 023463 2624 023464 2626 023465 2627 023471 2628 023473 2629 023476 2630 023516 2631 023523 2632 023524 2634 023543 2636 023552 2637 023556 2640 023604 2643 023605 2644 023606 2647 023607 2649 023617 2650 023621 2651 023622 2653 023623 2654 023633 2655 023636 2656 023656 2657 023701 2658 023703 2661 023730 2663 023731 2664 023732 2665 023734 2667 023735 2668 023736 2670 023737 2672 023740 2673 023750 2674 023753 2675 023773 2676 024016 2677 024020 2680 024045 2682 024046 2683 024047 2684 024055 2686 024110 2688 024111 2689 024113 2690 024114 2692 024115 2693 024116 2695 024117 2697 024120 2698 024130 2699 024133 2700 024153 2701 024176 2702 024200 2705 024225 2707 024226 2708 024227 2710 024230 2711 024231 2713 024232 2715 024233 2716 024237 2717 024242 2718 024262 2719 024305 2720 024307 2723 024334 2725 024335 2726 024336 2728 024337 2729 024340 2731 024341 2733 024342 2734 024352 2735 024355 2736 024375 2737 024376 2739 024413 2741 024426 2742 024436 2743 024440 2744 024442 2746 024443 2749 024471 2754 024472 2755 024477 2756 024500 2758 024501 2759 024511 2760 024514 2761 024534 2762 024541 2764 024542 2765 024574 2768 024622 2772 024623 2774 024624 2775 024625 2777 024626 2780 024627 2782 024664 2784 024665 2786 024667 2788 024670 2790 024675 2796 024676 2806 024677 2807 024704 2809 024712 2811 024732 2814 024740 2816 024743 2819 024752 2822 024761 2825 024766 2828 024774 2831 025000 2834 025004 2837 025010 2838 025012 2839 025013 2840 025023 2842 025027 2845 025030 2847 025032 2850 025064 2852 025076 2854 025121 2856 025122 2857 025124 2858 025141 2859 025164 2861 025165 2862 025167 2863 025204 2866 025227 2869 025233 2873 025267 2875 025276 2877 025305 2882 025323 2885 025331 2888 025332 2889 025334 2891 025336 2893 025354 2898 025362 2899 025365 2901 025367 2903 025371 2907 025377 2911 025407 2915 025410 2947 025412 2949 025417 2950 025420 2952 025421 2955 025446 2957 025450 2958 025453 2959 025454 2961 025460 2962 025464 2963 025465 2964 025470 2969 025557 2970 025563 2971 025564 2973 025623 2976 025624 2980 025704 2981 025712 2982 025715 2983 025720 2985 025721 2986 025724 2989 025727 2991 025757 2992 025761 2993 025764 2994 025765 2995 025772 2997 026031 2999 026035 3002 026036 3003 026043 3004 026047 3007 026050 3008 026055 3009 026062 3010 026064 3014 026065 3016 026115 3018 026117 3019 026120 3022 026121 3024 026133 3026 026135 3028 026141 3029 026145 3031 026165 3032 026210 3034 026211 3035 026214 3037 026234 3038 026262 3040 026263 3042 026321 3046 026347 3049 026354 3050 026357 3051 026360 3053 026363 3055 026364 3056 026370 3057 026372 3058 026375 3061 026376 3065 026377 3070 026401 3075 026404 3078 026421 3079 026425 3080 026430 3081 026433 3083 026436 3087 026602 3091 026603 3102 026605 3104 026612 3106 026616 3109 026665 3110 026671 3112 026723 3114 026743 3116 026763 3119 027016 3124 027052 3126 027053 3128 027112 3130 027114 3133 027120 3135 027127 3138 027172 3139 027176 3141 027230 3143 027250 3145 027270 3148 027323 3151 027356 3154 027411 3157 027441 3160 027474 3162 027475 3164 027535 3166 027537 3169 027543 3171 027546 3173 027570 3174 027600 3175 027604 3176 027607 3177 027611 3178 027612 3180 027614 3183 027723 3185 027725 3189 030037 3192 030043 3195 030045 3197 030050 3198 030072 3199 030077 3202 030100 3205 030102 3207 030105 3209 030107 3215 030205 3219 030273 3220 030275 3222 030326 3223 030334 3224 030336 3226 030420 3228 030421 3229 030423 3231 030434 3232 030437 3236 030544 3240 030555 3241 030606 3243 030607 3245 030623 3248 030677 3249 030711 3251 030712 3253 030715 3256 030721 3259 030723 3263 030732 3264 030755 3266 030762 3268 031005 3270 031075 3272 031101 3275 031104 3282 031106 3294 031127 3295 031161 3298 031167 3299 031177 3300 031230 3307 031234 3325 031242 3326 031250 3327 031255 3328 031256 3329 031265 3331 031323 3332 031353 3333 031362 3337 031412 3338 031420 3340 031421 3343 031422 3345 031435 3349 031463 3351 031505 3352 031511 3353 031516 3357 031517 3360 031537 3363 031545 3364 031553 3365 031555 3369 031577 3372 031627 3374 031650 3375 031653 3377 031707 3379 031731 3383 031735 ----------------------------------------------------------- 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