COMPILATION LISTING OF SEGMENT gcos_mme_inos_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 09/09/83 1151.7 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 gcos_mme_inos_: proc (mcpp, increment); 7 8 /* 9* * This procedure processes the I/O MME, GEINOS. The GEINOS calling sequence(s) are: 10* * Also contains code to process the GEENDC MME. 11* * 12* * MME GEINOS 13* * OPERATION WORD 14* * IDENTIFICATION WORD 15* * RETURN WORD 16* * 17* * or..... 18* * 19* * MME GEINOS 20* * OPERATION WORD 1 21* * IDENTIFICATION WORD 1 22* * OPERATION WORD 2 23* * IDENTIFICATION WORD 2 24* * RETURN WORD 25* * 26* * where: 27* * 28* * OPERATION WORD FORMAT = 29* * 30* * BITS USE 31* * 0-5 Device Command [cc] (See values below) 32* * 6-17 Zeros 33* * 18-22 IOC Command [ii] 34* * 23 Zero 35* * 24-29 Control 36* * 30-35 Count [nn] 37* * 38* * Operation word (GMAP oct implementation): 39* * 8 16 40* * oct cc0000ii00nn 41* * 42* * IDENTIFICATION WORD FORMAT = 43* * 44* * BITS USE 45* * 00-17 File Control Block Pointer 46* * 18-35 Dcw List Pointer 47* * 48* * RETURN WORD FORMAT = 49* * 50* * BITS USE 51* * 0-17 Status Return Pointer 52* * 18-35 Courtesy Call Address 53* * 54* * DCW FORMAT 55* * 56* * BITS USE 57* * 0-17 Data Address 58* * 18-20 Zero 59* * 21 Character tally flag. 60* * 22-23 Action Code (See values below) 61* * 24-35 Count (value of zero indicates count of 4096) 62* * 63* * DCW ACTION CODES 64* * 65* * CODE MEANING 66* * 00 (IOTD) Transfer and Disconnect (this is last DCW in list) 67* * 01 (IOTP) Transfer and Continue (with next DCW in list) 68* * 10 (TDCW) Skip to New DCW List (whose address is in Data Address) 69* * 11 (IONTP) Skip Data Transfer (skip words and continue with next DCW in list) 70* * 71* * OPERATION WORD DEVICE COMMANDS [cc] 72* * 73* * CODE MEANING 74* * 75* * 00 Request Status 76* * 77* * 03 Read Typewriter 78* * 04 Read Tape Decimal 79* * 05 Read Tape Binary 80* * 81* * 13 Write (then Read) Typewriter 82* * 14 Write Tape Decimal 83* * (and Write Filemark Decimal, when IOC command = "00100"b) 84* * 15 Write Tape Binary 85* * (and Write Filemark, when IOC command = "00100"b) 86* * 87* * 25 Read 88* * 89* * 30 Write Printer Edited 90* * 31 Write 91* * 92* * 34 Seek 93* * 94* * 40 Reset Status 95* * 96* * 41 Set 6250 Density 97* * 42 Set 800 Density 98* * 43 Set 556 Density 99* * 44 Forward Space Record 100* * 45 Forward Space to Filemark 101* * 46 Backspace Record 102* * 47 Backspace to Filemark 103* * 104* * 54 Erase 105* * 55 Write EOF 106* * 107* * 60 Set High Density 108* * 61 Set Low Density 109* * 64 Set 200 Density 110* * 65 Set 1600 Density 111* * 112* * 70 Rewind 113* * 72 Rewind and Unload 114* * 115* * 116**/ 117 118 /* 119* Author: DICK SNYDER OCTOBER 7, 1970 120* Change: T. CASEY, OCTOBER 1973, DECEMBER 1973, AUGUST 1974 121* Change: D. KAYDEN, MARCH 1974, APRIL 1974, JULY 1974, DECEMBER 1974, MARCH 1975 122* Change: R.H. MORRISON FEB 2, 1976 123* Change: M. R. Jordan, September 1976 124* Change: A. N. Kepner, March 1978 to allow courtesy call i/o within cc routines 125* Change: Dave Ward 05/20/81 multirecord read/write disk, various bugs. 126* Change: Dave Ward 09/02/81 Removed use of cmd_word variable. 127* Change: Dave Ward 09/02/81 provided tape density 6250. 128* Change: Dave Ward 09/16/81 removed use of init (except for constant). 129* Change: Scott C. Akers 12/23/81 Fix bugs which arise when dealing with 130* discontiguous DCWs and stuff. 131* 132* Change: Ron Barstad 01/27/83 Rewrite tape status checking. The 133* old version was checking tally residues 134* and IOM Central statuses, mistaking 135* them for handler status. 136* 137* Change: Ron Barstad 83-07-01 Fix bug in writting multi-records to a non-randon file 138* Change: Ron Barstad 83-08-03 Fix courtesy call queue to work like GCOS 139**/ 140 141 dcl increment fixed bin (24)parm; /* number of words MME processor 142* must skip over */ 143 dcl mcpp ptr parm /* pointer to machine conditions. */; 144 mcp = mcpp; 145 increment = 3; /* init parameter skip number */ 146 gseg = gcos_ext_stat_$gcos_slave_area_seg; /* pointer to slave program */ 147 storlimit = gcos_ext_stat_$storage_limit; /* slave core boundary */ 148 trace_or_stopsw = dbs_mme_inos_trace | dbs_mme_inos_stop; 149 150 scup = addr (mc.scu); /* get ptr to scu data */ 151 i = instruction_counter + 2; /* get offset of first id word */ 152 idptr = addrel (gseg, i); /* build pointer to id word */ 153 154 if id_word.filep >= storlimit then /* file control block ptr */ 155 call gcos_mme_bort_$system ( 156 gcos_et_$invalid_file_ptr 157 , "File code pointer in GEINOS sequence is outside slave limits." 158 ); 159 160 workp = addrel (gseg, id_word.filep); /* get pointer to fcb */ 161 substr (fc, 1, 1) = xlate (fixed (substr (file_code_word.fcode, 1, 6))); /* translate file code */ 162 substr (fc, 2, 1) = xlate (fixed (substr (file_code_word.fcode, 7, 6))); /* to ascii */ 163 164 if fc = " " /* a blank file code is illegal */ 165 then call gcos_mme_bort_$system (gcos_et_$fc_not_defined, 166 "Blank file code is illegal."); 167 168 call init_routine; /* Initialize variables. */ 169 170 /* Now we see if we have a legal file code. The variable "j" gets set. */ 171 172 if fc = "*t" | fc = "t/" | fc = "/t" /* See if it's the operator's console. */ 173 then fc = "t*"; 174 175 if ^match_fc () /* If we didn't find a match, 176* we bail out. */ 177 178 then call gcos_mme_bort_$system (gcos_et_$fc_not_defined, 179 """^a""", fc); 180 181 if fct.sysout (j) then /* abort if sysout file */ 182 call gcos_mme_bort_$system ( 183 gcos_et_$fc_not_defined 184 , "File code ""^a"" is assigned to SYSOUT." 185 , fc 186 ); 187 188 fibptr = fct.fibptr (j); /* copy pointer to fib */ 189 190 call process_request; /* Go do the dirty work. */ 191 192 com_proc (01): ; 193 194 /* disk or drum seek */ 195 seeksw = "1"b; /* Indicate seek has been performed. */ 196 if fib.type = random_file then do; /* (no seek necessary for sequential file) */ 197 if dcw_offset >= storlimit then /* dcw addr OOB? */ 198 call gcos_mme_bort_$system ( 199 gcos_et_$invalid_dcw_ptr 200 , "DCW is outside slave limits." 201 ); 202 203 dcwptr = addrel (gseg, dcw_offset); /* get address of dcw */ 204 if dcw.data_addr >= storlimit /* data address OOB? */ 205 | dcw.count ^= 1 then /* count not 1 ? */ 206 call gcos_mme_bort_$system ( 207 gcos_et_$bad_seek_dcw 208 , "DCW address field is outside slave limits or DCW word count is not 1." 209 ); 210 211 i = addrel (gseg, dcw.data_addr) -> seek_address; /* grab seek address */ 212 fib.current = i*64; /* multiply by block size */ 213 if trace_or_stopsw then call ioa_ ("seek ^w", i); 214 end; 215 216 bump: ; 217 218 increment = increment + 2; /* prepare for following command */ 219 idptr = addrel (idptr, 2); /* get ptr to new id word */ 220 call process_request; /* Do the next command. */ 221 222 com_proc (02): ; 223 224 /* read disk continuous */ 225 226 if fib.read = "0"b then do; /* Reads are not allowed on this file. */ 227 if fib.null then do; /* If this a null file */ 228 substr (slave_status, 3, 4) = "1111"b; /* return eof status. */ 229 goto return_stat; 230 end; 231 call gcos_mme_bort_$system ( 232 gcos_et_$impermissible_perm_read 233 , "No read permission on file ""^a""." 234 , fc 235 ); 236 end; 237 238 if fib.order = write_file then do; /* If last i/o request was a write, then */ 239 fib.order = read_file; /* we must bring ios_'s seek pointers together */ 240 goto seek; 241 end; 242 243 if fib.type = random_file then do; /* Seek only if file is random. */ 244 seek: ; 245 if seeksw = "0"b then /* read or write must be preceded by a seek */ 246 call gcos_mme_bort_$system ( 247 gcos_et_$bad_io_cmnd_file 248 , "Disk ^[read^;write^] without a seek on file ""^a""." 249 , fib.order = read_file 250 , fc 251 ); 252 call do_seek; 253 end; 254 if fib.type ^= random_file then /* Linked file. */ 255 call check_multirecord_request (mr); 256 goto loop; 257 258 com_proc (03): ; 259 260 /* write disk continuous */ 261 262 if fib.write = "0"b then do; /* write not allowed ? */ 263 if fib.null then goto return_stat; /* is this a null file ? */ 264 call gcos_mme_bort_$system ( 265 gcos_et_$impermissible_perm_write 266 , "No write access to file ""^a""." 267 , fc 268 ); 269 end; 270 271 if fib.order = read_file then do; /* if last i/o request was a read, then */ 272 fib.order = write_file; /* we must bring ios_'s seek pointers together */ 273 goto seek; 274 end; 275 if fib.type = random_file then goto seek; 276 call check_multirecord_request (mr); 277 278 /* transfer to loop. */ 279 280 /* Read and write processing. */ 281 282 loop: ; 283 284 /* Call a subroutine which examines the dcw list and returns the 285* number of contiguous words to transmit (count), the address to 286* transmit from/to (where), and an indicator saying whether 287* there are more dcws to be processed (continue). 288**/ 289 call get_dcw; 290 291 if fib.type = linked_file then do; /* Linked file on disk. */ 292 if fib.order = read_file then /* sequential file read */ 293 if fib.current >= fib.last then do; /* check for end of valid data */ 294 substr (slave_status, 3, 4) = "1111"b; /* set eof status */ 295 wc_residue = count; 296 da_residue = where; 297 goto return_stat; 298 end; 299 300 if mr = "0"b then /* Not a multirecord request. */ 301 if (count + total_count) > 320 then do; /* About to exceed 1 block. */ 302 wc_residue = count + total_count - 320; 303 continue = "0"b; 304 count = max (0, 320 - total_count); /* Adjust count to finish to 1 block. */ 305 end; 306 end; 307 308 fib.current = fib.current + count; /* Calculate next position in the file. */ 309 310 if fib.current > fib.size then goto disk_eof; /* will i/o go over eof ? */ 311 312 /* If get_dcw returns a where value of -1, this means that a skip 313* DCW (IONTP) has been encountered. In this case, the proper 314* pointer will be advanced by the value in count, an the next 315* DCW is obtained. 316**/ 317 318 if where = -1 then do; /* => Skip DCW (IONTP). */ 319 if fib.type = linked_file then 320 if fib.order = write_file then do; /* Fill block with zeroes. */ 321 if count < 1 then nelemt = 0; 322 else 323 call ios_$write ( 324 fib.stream 325 , addr (z320) 326 , 0 /* offset to 1st word of z320. */ 327 , count /* Number words to write. */ 328 , nelemt /* (output) number of words written. */ 329 , status 330 ); 331 goto complete; 332 end; 333 if count > 0 then 334 call do_seek; 335 end; 336 else do; /* Data movement DCW (IOTP or IOTD). */ 337 338 issue: ; 339 340 if fib.order = write_file then 341 call ios_$write ( 342 fib.stream 343 , gseg 344 , where 345 , count 346 , nelemt 347 , status 348 ); 349 else 350 call ios_$read ( 351 fib.stream 352 , gseg 353 , where 354 , count 355 , nelemt 356 , status 357 ); 358 359 complete: ; 360 361 total_count = total_count + nelemt; /* Update count total. */ 362 if fib.tape then goto tape_stat; 363 if code ^= 0 then do; 364 fail_loop: ; 365 call gcos_mme_bort_$system ( 366 code 367 , "Fatal ^[read^;write^] error on ^[random^;linked^] file ""^a""." 368 , fib.order = read_file 369 , fib.type = random_file 370 , fc 371 ); 372 end; 373 if fib.order = write_file then fib.last = max (fib.last, fib.current); /* update last pointer */ 374 da_residue = where + count; 375 end; 376 if continue then goto loop; 377 378 /* Complete the i/o operation. */ 379 if fib.type = linked_file then /* Final positioning. */ 380 if mr = "0"b then /* Not multirecord request. */ 381 if total_count < 320 then do; 382 fib.current = fib.current + (320 - total_count); 383 if fib.order = write_file then do; /* Fill block with zeroes. */ 384 call ios_$write ( 385 fib.stream 386 , addr (z320) 387 , 0 /* 1st word of z320. */ 388 , 320-total_count /* Number words to write. */ 389 , nelemt /* (output) number of words written. */ 390 , status 391 ); 392 if code ^= 0 then goto fail_loop; 393 if fib.order = write_file then fib.last = max (fib.last, fib.current); /* update last pointer */ 394 end; 395 else /* => linked file read. Position to block. */ 396 call do_seek; 397 end; 398 goto return_stat; 399 400 com_proc (04): ; 401 402 /* rewind disk/drum */ 403 404 if fib.print then goto return_stat; /* temporary fix until sysout is working */ 405 if fib.null then goto return_stat; /* is this a null file ? */ 406 407 fib.current = 0; /* reset position */ 408 409 goto disk_posit; 410 411 com_proc (05): ; 412 413 /* backspace disk/drum */ 414 415 bksp_sw = "1"b; /* remember backspace */ 416 417 418 bksp_share: ; 419 420 if fib.type = random_file then /* abort if random */ 421 call gcos_mme_bort_$system ( 422 gcos_et_$bad_io_cmnd_file 423 , "Attempt to backspace/forward space random file ""^a""." 424 , fc 425 ); 426 if fib.null then goto return_stat; /* is this a null file ? */ 427 428 j = op_word.count; 429 if j = 0 then j = 64; /* zero count means 64 */ 430 j = 320*j; 431 if bksp_sw then j = -j; 432 433 fib.current = fib.current + j; 434 if fib.current < 0 then fib.current = 0; /* allow for backspace too far */ 435 if fib.current > fib.size then do; /* check for end of file */ 436 437 438 disk_eof: ; 439 440 if fib.type = random_file then /* end of file on a random file */ 441 call gcos_mme_bort_$system ( 442 gcos_et_$access_beyond_file 443 , "Positioning to ^i on random file ""^a"" exceeds size ^i." 444 , fib.current 445 , fc 446 , fib.size 447 ); 448 substr (slave_status, 3, 4) = "1111"b; /* Is this the proper status ? */ 449 450 rec_ct_residue = divide (fib.current - fib.size, 320, 17, 0); 451 substr (slave_status, 31, 6) = substr (unspec (rec_ct_residue), 31, 6); 452 453 fib.current = fib.size; 454 455 end; 456 457 458 disk_posit: ; 459 460 call do_seek; 461 462 goto return_stat; /* process status */ 463 464 com_proc (06): ; 465 466 /* forward space disc/drum */ 467 468 bksp_sw = "0"b; /* remember forward space */ 469 470 goto bksp_share; /* now go share backspace code */ 471 472 com_proc (07): ; 473 474 /* reset status for disk/drum */ 475 476 goto return_stat; 477 478 com_proc (08): ; 479 480 /* request status for disk/drum */ 481 482 goto return_stat; 483 484 com_proc (09): ; /* read tape binary */ 485 486 error_retry = "0"b; 487 total_read = 0; /* Haven't read anything first time through. */ 488 fib.order = read_file; /* indicate read to be done */ 489 if fib.mode ^= "00"b 490 then do; 491 fib.mode = "00"b; 492 order = "binary"; 493 call ios_$order (fib.stream, order, null, status); 494 end; 495 496 more_dcws = "1"b; 497 do while (more_dcws); 498 call next_dcw_ptr (output_ptr, transfer_count, more_dcws); 499 call ios_$read (fib.stream, output_ptr, 0, transfer_count, nelemt, status); 500 501 total_read = total_read + nelemt; 502 da_residue = dcw.data_addr + nelemt; 503 wc_residue = transfer_count - nelemt; 504 505 end; 506 goto tape_status; 507 508 com_proc (10): ; /* write tape binary */ 509 510 fib.order = write_file; /* indicate write to be done */ 511 512 if fib.mode = "00"b then goto mode_set; /* mode already binary? */ 513 fib.mode = "00"b; /* set mode to binary */ 514 order = "binary"; /* set up to change mode */ 515 516 mode_order: ; 517 call ios_$order (fib.stream, order, null, status); /* change tape mode */ 518 519 mode_set: ; 520 call get_dcw; /* get dcw */ 521 error_retry = "0"b; /* not doing error recovery */ 522 if where >= 0 then 523 if continue = "0"b then goto issue; /* avoid overhead of extra buffering if possible */ 524 525 sc_ga = "1"b; /* remember for possible error recovery */ 526 if fib.buffer = null then 527 fib.buffer = addr (tapebuffer); 528 529 if fib.order = read_file then do; 530 531 sc_read: ; 532 call ios_$read (fib.stream, fib.buffer, 0, 1632, nelemt, status); 533 call adjust_buffer (fib.buffer); 534 535 call scatter_input (fib.buffer); /* send any data to slave, even if tape error */ 536 end; 537 else do; /* Write tape. */ 538 posit = 0; /* init fib.buffer position */ 539 540 ga_loop: ; 541 if where >= 0 /* skip dcw ? */ 542 then do; 543 ibuffptr = addrel (fib.buffer, posit); /* pointer to intermediate fib.buffer */ 544 sbuffptr = addrel (gseg, where); /* pointer to slave fib.buffer */ 545 internal_buffer = slave_buffer; /* move data */ 546 posit = posit + count; /* adjust intermediate fib.buffer position */ 547 end; 548 if continue /* more to do ? */ 549 then do; 550 call get_dcw; 551 goto ga_loop; 552 end; 553 554 da_residue = where + count; /* data address residue */ 555 wc_residue = 0; /* word count residue */ 556 557 call ios_$write (fib.stream, fib.buffer, 0, posit, nelemt, status); /* write gathered output */ 558 end; 559 goto tape_status; /* done - now process status */ 560 561 562 com_proc (11): ; 563 564 /* read tape nine */ 565 566 fib.order = read_file; /* indicate read to be done */ 567 568 569 asa9_common: ; 570 571 if fib.mode = "10"b then goto mode_set; /* already in asa9 mode? */ 572 573 fib.mode = "10"b; /* set mode to decimal */ 574 order = "nine"; /* prepare to make order call */ 575 576 goto mode_order; 577 578 com_proc (12): ; 579 580 /* write tape nine */ 581 582 fib.order = write_file; /* indicate write to be done */ 583 584 goto asa9_common; 585 586 com_proc (13): ; 587 588 /* rewind */ 589 590 order = "rewind"; 591 goto order_call; 592 593 com_proc (14): ; 594 595 /* write eof */ 596 597 order = "eof"; 598 goto order_call; 599 600 com_proc (15): ; 601 602 /* forward space file */ 603 604 order = "forward_file"; 605 goto order_call; 606 607 com_proc (16): ; 608 609 /* backspace file */ 610 611 order = "backspace_file"; 612 goto order_call; 613 614 com_proc (17): ; 615 616 /* forward space record */ 617 618 order = "forward_record"; 619 goto order_loop; 620 621 com_proc (18): ; 622 623 /* backspace record */ 624 625 order = "back"; 626 627 628 order_loop: ; 629 630 i = op_word.count; /* pick up skip count */ 631 if i = 0 then i = 64; /* count of 0 means 64 */ 632 633 do j = 1 to i; /* loop to skip */ 634 call ios_$order (fib.stream, order, null, status); /* issue a skip order */ 635 if code ^= 0 then do; /* stop if any problems */ 636 rec_ct_residue = i-j; /* compute count of no of skips left */ 637 goto tape_status; 638 end; 639 end; 640 641 goto tape_status; /* process status */ 642 643 com_proc (19): ; 644 645 /* write file mark binary */ 646 647 goto com_proc (14); 648 649 com_proc (20): ; 650 651 /* write file mark decimal */ 652 653 goto com_proc (14); 654 655 com_proc (21): ; 656 657 /* erase */ 658 659 order = "erase"; 660 goto order_call; 661 662 com_proc (22): ; 663 664 /* rewind and unload */ 665 666 order = "unload"; 667 goto order_call; 668 669 com_proc (23): ; 670 671 /* set high density */ 672 673 order = "high"; 674 density_history = "01"b ; 675 goto tape_high_low; 676 677 com_proc (24): ; 678 679 /* set low density */ 680 681 order = "low"; 682 density_history = "00"b ; 683 684 685 tape_high_low: ; 686 687 if fib.density = "0000"b then goto set_density; /* means "as is" */ 688 if fib.density = "1111"b then do; /* use system default densities */ 689 if order = "high" then order = default_high; 690 else order = default_low; 691 goto set_density; 692 end; 693 694 if fib.density = "0010"b then goto com_proc (26); 695 if fib.density = "0100"b then goto com_proc (27); 696 if fib.density = "1001"b then goto com_proc (28); 697 if fib.density = "1100"b then goto com_proc (41); 698 699 com_proc (25): ; 700 701 /* set 200 density */ 702 703 order = "d200"; 704 density_history = "10"b ; 705 goto set_density; 706 707 com_proc (26): ; 708 709 /* set 556 density */ 710 711 order = "d556"; 712 density_history = "00"b ; 713 goto set_density; 714 715 com_proc (27): ; 716 717 /* set 800 density */ 718 719 order = "d800"; 720 density_history = "01"b ; 721 goto set_density; 722 723 com_proc (28): ; 724 725 /* set 1600 density */ 726 727 order = "d1600"; 728 density_history = "11"b ; 729 730 set_density: ; 731 732 call ios_$order (fib.stream, order, null, status); 733 if code = 0 then fib.dens_hist = density_history; /* change history bits only if order was successful */ 734 goto tape_status; 735 736 com_proc (41): ; 737 738 /* set 6250 density */ 739 740 order = "d6250"; 741 density_history = "00"b ; 742 goto set_density; 743 744 com_proc (29): ; 745 746 /* reset status */ 747 748 order = "reset_status"; 749 override = 1; 750 751 752 order_call: ; 753 754 call ios_$order (fib.stream, order, null, status); 755 756 goto tape_status; 757 758 com_proc (30): ; 759 760 /* request status */ 761 762 call ios_$order (fib.stream, "request_status", addr (slave_status), status); 763 override = 1; 764 765 goto tape_status; 766 767 com_proc (31): ; 768 769 /* read tape bcd */ 770 771 fib.order = read_file; /* indicate read to be done */ 772 773 774 bcd_common: ; 775 776 if fib.mode = "01"b then goto mode_set; /* already in bcd mode? */ 777 778 fib.mode = "01"b; /* set mode to bcd */ 779 order = "bcd"; /* prepare to make order call */ 780 781 goto mode_order; 782 783 com_proc (32): ; 784 785 /* write tape bcd */ 786 787 fib.order = write_file; /* indicate write to be done */ 788 789 goto bcd_common; 790 791 com_proc (33): ; 792 793 /* write printer edited */ 794 795 n = 1; 796 797 798 write_prt: ; 799 800 do i = 1 to n; 801 802 803 get_prt_dcw: ; 804 805 call get_dcw; 806 if where < 0 then goto get_prt_dcw; /* skip dcw ? */ 807 if count > 27 then do; 808 if count = 4096 then goto print_skip; 809 count = 27; 810 end; 811 j = count*4; /* compute length of char */ 812 /* string overlay */ 813 call gcos_write_$bcd_ptr (fibptr, addrel (gseg, where) -> record, 814 "11111100"b); /* put on file */ 815 816 817 print_skip: ; 818 819 if continue then goto get_prt_dcw; 820 821 end; 822 823 goto return_stat; /* return good status */ 824 825 com_proc (34): ; 826 827 /* write printer edited continuous */ 828 829 n = op_word.count; /* get record count */ 830 if n = 0 then n = 64; 831 goto write_prt; 832 833 com_proc (35): ; 834 835 /* reset status */ 836 837 goto return_stat; 838 839 com_proc (36): ; 840 841 /* request status */ 842 843 goto return_stat; 844 845 com_proc (37): ; 846 847 /* write console */ 848 849 ascii_index = 0; /* init line index for possible multi-dcw list */ 850 851 852 type_loop: ; /* come here for all dcws after the first */ 853 854 call get_dcw; /* analyze dcw */ 855 856 if where = -1 then goto type_loop; /* if this dcw said skip data, do it */ 857 858 workp = addrel (gseg, where); /* get pointer to string to write */ 859 860 do i = 1 to count*6; 861 862 if bcd_string (i) = "77"b3 then do; /* escape */ 863 i = i+1; 864 if bcd_string (i) = "77"b3 then do; /* escape */ 865 i = i+1; 866 if bcd_string (i) = "77"b3 then char = "!"; 867 else 868 if bcd_string (i) = "17"b3 then char = "?"; 869 else 870 if bcd_string (i) = "20"b3 then do; 871 substr (ascii_string, ascii_index, 3) = "/b"; 872 ascii_index = ascii_index + 3; 873 goto skip_fill; 874 end; 875 else do; 876 substr (slave_status, 3, 10) = "0011010000"b; /* incorrect format */ 877 goto type_it; /* send the good part */ 878 end; 879 goto end_loop; 880 end; 881 882 j = fixed (bcd_string (i)); /* get carriage control char */ 883 if j < 32 then unspec (char) = "012"b3; /* put newline in string */ 884 else unspec (char) = "011"b3; /* put tab in string */ 885 goto end_loop; 886 end; 887 888 if bcd_string (i) = "17"b3 then goto skip_fill; /* if not fill char */ 889 char = xlate (fixed (bcd_string (i))); /* put ascii equivalent in string */ 890 891 892 end_loop: ; 893 894 ascii_index = ascii_index+1; /* increment ascii output string index */ 895 substr (ascii_string, ascii_index, 1) = char; /* stuff char into string */ 896 897 898 skip_fill: ; 899 900 if ascii_index > 129 then goto type_it; /* check for too much output */ 901 902 end; 903 904 if continue then goto type_loop; /* if more dcws, go process them */ 905 906 907 type_it: ; 908 909 if ascii_index > 0 then /* type line and test for write-then-read */ 910 call ios_$write_ptr (addr (ascii_string), 0, ascii_index); /* print output */ 911 912 if op_word.count = 2 then goto bump; /* test for write then read */ 913 goto return_stat; /* go return status */ 914 915 com_proc (38): ; 916 917 /* read console */ 918 919 call get_dcw; /* analyze dcw */ 920 921 call ios_$read_ptr (addr (ascii_string), 132, i); /* read a line from tty */ 922 i = i - 1; /* strip off NL */ 923 if i > 0 then /* check for null response */ 924 call gcos_cv_ascii_gebcd_ (addr (ascii_string), i, addr (mybuf), i); /* convert to bcd */ 925 /* don't attempt to convert null string */ 926 nelemt = divide (i+5, 6, 17, 0); /* compute word and character residues */ 927 cc_residue = mod (i, 6); 928 call scatter_input (addr (mybuf)); 929 goto return_stat; 930 931 com_proc (39): ; 932 933 /* reset status */ 934 935 goto return_stat; 936 937 com_proc (40): ; 938 939 /* request status */ 940 941 goto return_stat; 942 943 tape_stat: ; 944 945 if fib.order = read_file then call adjust_buffer (addrel (gseg, where)); /* adjust fib.buffer on input */ 946 947 wc_residue = count - nelemt; 948 da_residue = where + nelemt; 949 950 951 tape_status: ; 952 953 954 955 if ^substr (unspec (status), 1, 1) /* Are we expected to interpret 956* /* a Multics error code? */ 957 then do; 958 if code = 0 959 then go to return_stat; /* everything ok */ 960 else call gcos_mme_bort_$system (code, "fc=""^a""", fc); 961 end; 962 963 substr (slave_status, 1, 12) = "10"b 964 ||substr (unspec (status), 27, 10); /* copy major/minor status */ 965 substr (slave_status, 31, 6) = substr (unspec (rec_ct_residue), 31, 6); /* copy any residue from skip op */ 966 967 if trace_or_stopsw then call ioa_ ("status:^-^w", slave_status); 968 969 major_status = substr (unspec (status), 27, 4); /* Get major and minor status */ 970 minor_status = substr (unspec (status), 31, 6); 971 972 if major_status = "0000"b /* Device Ready */ 973 | major_status = "0100"b /* EOF */ 974 then goto return_stat; 975 976 if major_status = "1001"b /* Device busy */ 977 & minor_status = "000000"b /* Command Accepted */ 978 then goto return_stat; 979 980 981 if ^error_retry then /* if not already attempting error recovery, */ 982 fib.error_retry = fib.error_retry + 1; /* then count tape errors */ 983 984 call make_stat_ptr; /* we need pointer to status words */ 985 if override = 0 then 986 if substr (sw1, 1, 33) = (33)"1"b then /* error recovery override requested */ 987 override = - (addr (sw1) -> fb35); /* remember type */ 988 989 if override = 1 /* normal status override */ 990 | override = 5 /* override all except mpc statuses */ 991 then go to return_tape_stat; 992 993 if major_status = "0001"b /* Device Busy */ 994 | major_status = "0010"b /* Device Attention */ 995 then goto epabort; 996 997 if major_status = "0101"b /* Command Reject */ 998 then do; 999 if (minor_status & "001000"b) = "001000"b /* Tape on Load Point */ 1000 then goto return_tape_stat; 1001 else goto epabort; /* Other cmd rejects are illegal */ 1002 end; 1003 1004 if major_status ^= "0011"b 1005 then go to epabort; /* If not Data Alert, abort */ 1006 1007 if (minor_status & "000011"b) = "000011"b /* Bit During Erase */ 1008 then goto epabort; 1009 1010 if override = 3 1011 then goto return_tape_stat; /* override case 2 */ 1012 1013 if (minor_status & "000010"b) = "000010"b /* Blank Tape on Read */ 1014 | (minor_status & "100000"b) = "100000"b /* End of Tape */ 1015 1016 then goto return_tape_stat; 1017 1018 if (minor_status & "000001"b) = "000001"b /* Transfer Timing Alert */ 1019 | (minor_status & "000100"b) = "000100"b /* Transmission Parity Alert */ 1020 1021 then goto epabort; 1022 1023 /* We must have a parity error of some type */ 1024 1025 1026 if override = 2 then go to return_tape_stat; /* override parity errors */ 1027 1028 if ^error_retry then retry_count = 11; 1029 error_retry = "1"b; /* set switch to indicate we are processing error */ 1030 retry_count = retry_count-1; /* decrement retry attempt count */ 1031 if retry_count = 0 then go to epabort; /* abort if we still have */ 1032 /* parity error after 10 retries */ 1033 1034 slave_status = "400000000000"b3; /* reinitialize status for retry */ 1035 1036 if override ^= 4 then /* check for bypass noise check */ 1037 if fib.order = read_file then 1038 if nelemt < 4 then 1039 if nelemt > 0 then /* noise record */ 1040 if sc_ga then goto sc_read; 1041 else goto issue; 1042 1043 call ios_$order (fib.stream, "back", null, status); /* backspace tape */ 1044 1045 if fib.order = write_file then 1046 if retry_count ^= 10 then /* on a write, retry same spot once */ 1047 call ios_$order (fib.stream, "erase", null, status); /* then erase bad spot on tape */ 1048 1049 if sc_ga = "0"b then goto issue; 1050 else 1051 if fib.order = write_file 1052 then do; /* write gathered output */ 1053 call ios_$write (fib.stream, fib.buffer, 0, posit, nelemt, status); 1054 goto tape_status; /* done - now process status */ 1055 end; 1056 1057 else goto sc_read; 1058 1059 1060 epabort: ; 1061 1062 call gcos_mme_bort_$system ( 1063 gcos_et_$irrecoverable_io_err 1064 , "Fatal tape I/O error on file ""^a"". Status = ^w." 1065 , fc 1066 , slave_status 1067 ); 1068 1069 return_stat: ; 1070 1071 call make_stat_ptr; 1072 1073 1074 return_tape_stat: ; 1075 1076 sw1 = slave_status; /* move status into slave */ 1077 sw2 = "0"b; 1078 1079 substr (sw2, 1, 18) = substr (unspec (da_residue), 19, 18); /* and data address residues */ 1080 if cc_residue ^= 0 then /* check for character residue */ 1081 substr (sw2, 19, 3) = substr (unspec (cc_residue), 34, 3); /* we have some */ 1082 substr (sw2, 22, 1) = (fib.order = read_file); /* Last order was a read. */ 1083 substr (sw2, 23, 2) = type_dcw; /* Type of last DCW. */ 1084 substr (sw2, 25, 12) = substr (unspec (wc_residue), 25, 12); /* return word count */ 1085 if trace_or_stopsw then call ioa_ ("status ^w ^w", sw1, sw2); 1086 1087 fib.iocount = fib.iocount + 1; /* count I/O requests completed */ 1088 1089 if return_word.courtesy_call = 0 then return; /* done if no courtesy call */ 1090 1091 if gcos_ext_stat_$save_data.cc then do; /* Already in courtesy call */ 1092 1093 /* Check courtesy call queue for overflow */ 1094 new_next_avail = 1095 mod (courtesy_call.next_avail, hbound (courtesy_call.queue, 1))+1; 1096 if courtesy_call.next_out = new_next_avail then 1097 call gcos_mme_bort_$system ( 1098 gcos_et_$bad_mme_in_cc 1099 , "Maximum of ^i simultaneous outstanding courtesy calls has been exceeded." 1100 , hbound (courtesy_call.queue, 1)-1 1101 ); 1102 1103 /* Add cc address to queue */ 1104 courtesy_call.queue (courtesy_call.next_avail) = 1105 return_word.courtesy_call; 1106 courtesy_call.next_avail = new_next_avail; 1107 end; 1108 else do; /* Not in courtesy call yet. */ 1109 gcos_ext_stat_$save_data.cc = "1"b; /* indicate that courtesy call in progress */ 1110 1111 1112 /* Save machine conditions and increment value for return to the caller of */ 1113 /* MME GEINOS when the MME GEENDC is executed. Put courtesy call address */ 1114 /* in increment to cause control to go to courtesy call routine. */ 1115 1116 gcos_ext_stat_$increment_hold = increment; /* save increment */ 1117 courtesy_call.hold = courtesy_call_conditions.save_space; /* save MME GEINOS conditions */ 1118 i = return_word.courtesy_call; /* get courtesy call address */ 1119 j = instruction_counter; /* get loc of MME GEINOS */ 1120 increment = i-j-1; /* compute increment value to cause control to go to cc rtn */ 1121 end; 1122 1123 return; /* go */ 1124 1125 mme_endc: entry (mcpp, increment); 1126 1127 /* MME GEENDC. Processing consists of restoring 1128* The machine conditions that existed at the time of the MME GEINOS 1129**/ 1130 1131 if gcos_ext_stat_$save_data.cc = "0"b then 1132 call gcos_mme_bort_$system ( 1133 gcos_et_$geendc_not_in_cc 1134 , "A MME GEENDC has been executed outside of a courtesy call." 1135 ); 1136 1137 mcp = mcpp; 1138 1139 if courtesy_call.next_out = courtesy_call.next_avail then do; /* cc queue empty */ 1140 gcos_ext_stat_$save_data.cc = "0"b; /* unset courtesy call in progress flag */ 1141 1142 increment = gcos_ext_stat_$increment_hold; /* set old increment */ 1143 1144 /* Restoration of slave program registers at time of courtesy call */ 1145 mc_save_ptr = addr (courtesy_call.hold); 1146 mcp -> mc_save_data.pr_regs = mc_save_data.pr_regs; 1147 mcp -> mc_save_data.s_regs = mc_save_data.s_regs; 1148 mcp -> mc_save_data.ici_regs = mc_save_data.ici_regs; 1149 mcp -> mc_save_data.pl_regs = mc_save_data.pl_regs; 1150 end; 1151 else do; /* cc routine still waiting. */ 1152 1153 /* remove cc address from queue */ 1154 scup = addr (mc.scu); /* get ptr to scu data */ 1155 increment = /* Set increment to return to courtesy code return. */ 1156 courtesy_call.queue (courtesy_call.next_out) 1157 - instruction_counter 1158 -1 1159 ; 1160 courtesy_call.next_out = 1161 mod (courtesy_call.next_out, hbound (courtesy_call.queue, 1))+1; 1162 1163 end; 1164 1165 return; 1166 1167 inos_trace_filecode: entry (arg_string); 1168 1169 /* Set file code values to trace. */ 1170 dcl arg_string char(*)parm; 1171 1172 do k = 1 by 1; 1173 if next_arg (k, argp, arglen) then return; 1174 dbs_filecode = "1"b; 1175 if (arg = "-pr") | (arg = "-print") then do; /* Display which files being traced. */ 1176 if trace_index < 1 then call ioa_ ("No files being traced."); 1177 else 1178 do i = 1 to trace_index; 1179 call ioa_ ("^3i. ^a", i, trace_array (i)); 1180 end; 1181 end; 1182 else do; 1183 if trace_index >= hbound (trace_array, 1) then 1184 call ioa_ ("ONLY ^i ALLOWED, ^a not entered.", hbound (trace_array, 1), arg); 1185 else do; 1186 trace_index = trace_index + 1; /* set table size */ 1187 trace_array (trace_index) = /* Record file code (lower case) to trace. */ 1188 translate ( 1189 arg 1190 , "abcdefghijklmnopqrstuvwxyz" 1191 , "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 1192 ); 1193 end; 1194 end; 1195 end; 1196 return; 1197 1198 adjust_buffer: proc (bp); 1199 1200 /* for a fib.buffer just read from tape, 1201* determine if Multics has given us 1202* one word too much 1203**/ 1204 dcl bp ptr parm; 1205 1206 if nelemt >= 4 then 1207 if bcw.blk_size = (nelemt - 2) then 1208 if addrel (bp, nelemt - 1) -> word = "0"b then 1209 nelemt = nelemt - 1; 1210 return; 1211 1212 dcl word aligned bit(36) based; 1213 1214 dcl 1 bcw aligned based (bp), 1215 2 bsn fixed bin (18)unsigned unal, 1216 2 blk_size fixed bin (18)unsigned unal; 1217 end adjust_buffer; 1218 1219 check_multirecord_request: proc (m); 1220 1221 /* Set "m" to "1"b if the MME GEINOS operation word 1222* specifies a multirecord request, and verify that the sum of the 1223* DCW list count of words to move and/or skip is consistent with 1224* the operation word block count. 1225* Set "m" to "0"b if the operation is not multirecord. 1226**/ 1227 dcl m bit(1)parm; 1228 if op_word.ioc_com ^= multirecord_com then do; 1229 m = "0"b; 1230 return; 1231 end; 1232 1233 t = 0; /* Total of DCW's words. */ 1234 d = dcw_offset; 1235 get_ptr: ; 1236 1237 if d >= storlimit then /* dcw ptr legal ? */ 1238 call gcos_mme_bort_$system ( 1239 gcos_et_$invalid_dcw_ptr 1240 , "DCW (at ^6.3b oct) is outside slave limits (^6.3b)." 1241 , addr (d) -> r18 1242 , addr (storlimit) -> r18 1243 ); 1244 1245 dcwptr = addrel (gseg, d); /* get ptr to dcw list */ 1246 1247 if dcw.action = TDCW then do; /* Transfer DCW. */ 1248 d = dcw.data_addr; /* get new address */ 1249 goto get_ptr; /* continue */ 1250 end; 1251 1252 if dcw.count = 0 then t = t+4096; 1253 else t = t+dcw.count; 1254 d = d + 1; /* bump to next dcw */ 1255 if dcw.action ^= IOTD then goto get_ptr; /* iontp or iotp - check next dcw */ 1256 1257 nb = op_word.count; 1258 if nb = 0 then nb = 64; /* (gcos convention). */ 1259 if t ^= (320*nb) then 1260 call gcos_mme_bort_$system ( 1261 gcos_et_$bad_multirec 1262 , "Multirecord ^[read^;write^] on file ""^a""." 1263 ||"^/Requesting ^i blocks (^i words) but ^i specified in" 1264 ||" MME GEINOS command (at memory ^6.3b)." 1265 , fib.order = read_file 1266 , fc 1267 , nb 1268 , count 1269 , op_word.count 1270 , scu.ilc 1271 ); 1272 1273 m = "1"b; 1274 return; 1275 1276 dcl d fixed bin (24); 1277 dcl nb fixed bin (24); 1278 dcl t fixed bin (24); 1279 end check_multirecord_request; 1280 1281 debug_proc: proc (); 1282 1283 /* Display filecode debugging. */ 1284 if trace_index = 0 then goto trace; 1285 1286 do i = 1 to trace_index; 1287 if trace_array (i) = fc then goto trace; 1288 end; 1289 return; 1290 1291 trace: ; 1292 if dbs_mme_inos_trace then do; 1293 call ioa_ ( 1294 "^a order ^w ^a (at ^6.3b)" 1295 , fc 1296 , op_word 1297 , type_op (op_word.dev_com) 1298 , rel (opptr) 1299 ); 1300 end; 1301 1302 if dbs_mme_inos_stop then do; 1303 call ioa_ ("CALLING db:"); 1304 call db; 1305 end; 1306 return; 1307 1308 end debug_proc; 1309 1310 do_seek: proc; /* position file at fib.current */ 1311 1312 if fib.current > fib.last then do; 1313 call ios_$seek (fib.stream, "last", "first", fib.current, status); 1314 if code ^= 0 then 1315 call gcos_mme_bort_$system ( 1316 code 1317 , "I/O error seek extending file ""^a"" to position ^i." 1318 , fc 1319 , fib.current 1320 ); 1321 end; 1322 1323 if fib.order = write_file then seek_pointer = "write"; /* seek the write pointer */ 1324 else seek_pointer = "read"; /* seek the read pointer */ 1325 1326 call ios_$seek (fib.stream, seek_pointer, "first", fib.current, status); /* do seek */ 1327 if code ^= 0 then 1328 call gcos_mme_bort_$system ( 1329 code 1330 , "I/O error seeking to ^i on file ""^a""." 1331 , fib.current 1332 , fc 1333 ); 1334 1335 return; 1336 end do_seek; 1337 1338 get_cmd_tbl_entry: proc; 1339 if fib.tape /* tape? */ 1340 then do; 1341 fib.command_count = index.printer - index.tape; /* get command table length */ 1342 fib.command_index = index.tape; /* get command table address */ 1343 end; 1344 1345 else if fib.print /* printer? */ 1346 then do; 1347 fib.command_count = index.typewriter - index.printer; /* get command table length */ 1348 fib.command_index = index.printer; /* get command table address */ 1349 end; 1350 1351 else if fib.console /* typewriter? */ 1352 then do; 1353 fib.command_count = index.next - index.typewriter; /* get command table length */ 1354 fib.command_index = index.typewriter; /* get command table address */ 1355 end; 1356 1357 /* If none of the above, the device type is disk (or punch simulated as a disk). */ 1358 else do; 1359 fib.command_count = index.tape - index.disk; /* get command table length */ 1360 fib.command_index = index.disk; /* get command table address */ 1361 end; 1362 1363 return; 1364 1365 end get_cmd_tbl_entry; 1366 1367 get_dcw: proc; 1368 1369 /* Return "count" with total number of contiguous words specified 1370* by DCW's, "where" to the memory location, and "continue" to 1371* "1"b if there are more DCW's to be processed. The format of 1372* the DCW, and the meanings of the action codes, are described 1373* in the comments at the beginning of the external procedure, 1374* gcos_mme_inos_. 1375**/ 1376 count = 0; 1377 successive_tdcws = 0; 1378 1379 get_ptr: ; 1380 if dcw_offset >= storlimit then /* dcw ptr legal ? */ 1381 call gcos_mme_bort_$system ( 1382 gcos_et_$invalid_dcw_ptr 1383 , "DCW (at ^6.3b oct) is outside slave limits (^6.3b)." 1384 , addr (dcw_offset) -> r18 1385 , addr (storlimit) -> r18 1386 ); 1387 1388 dcwptr = addrel (gseg, dcw_offset); /* get ptr to dcw list */ 1389 if trace_or_stopsw then 1390 call ioa_ ( 1391 "dcw (^[IOTD^;IOTP^;TDCW^;IONTP^]) ^w" 1392 , fixed (dcw.action, 2)+1 1393 , dcw 1394 ); 1395 1396 if dcw.action = TDCW then do; /* Transfer DCW. */ 1397 successive_tdcws = successive_tdcws+1; 1398 if successive_tdcws>1 then 1399 call gcos_mme_bort_$system ( /* 2 successive TDCW's. */ 1400 gcos_et_$two_tdcws 1401 , "File ""^a""" 1402 , fc 1403 ); 1404 dcw_offset = dcw.data_addr; /* get new address */ 1405 goto get_ptr; /* continue */ 1406 end; 1407 successive_tdcws = 0; /* Reset count. */ 1408 1409 if dcw.action = IONTP then do; /* Skip and continue. */ 1410 continue = "1"b; /* indicate more to do */ 1411 if count ^= 0 then return; /* Exit perform previous DCW's, return to "get_dcw" for skip. */ 1412 if dcw.count = 0 then count = 4096; /* grab skip count */ 1413 else count = dcw.count; /* (count of 0 = 4096) */ 1414 type_dcw = IONTP; 1415 dcw_offset = dcw_offset + 1; /* bump over dcw */ 1416 where = -1; /* indicate medium skip to caller */ 1417 return; /* Exit to process skip. */ 1418 end; 1419 1420 /* => IOTD or IOTP form of DCW. */ 1421 if dcw.count = 0 then holdcount = 4096; /* count of 0 = 4096 */ 1422 else holdcount = dcw.count; 1423 1424 if count = 0 then /* first dcw processed this call ? */ 1425 where = dcw.data_addr; /* yes...get transfer start location */ 1426 else 1427 if (where + count) ^= dcw.data_addr then do; /* new dcw contiguous ? */ 1428 continue = "1"b; /* indicate more dcws to process */ 1429 return; /* exit */ 1430 end; 1431 count = count + holdcount; /* bump total transfer count */ 1432 dcw_offset = dcw_offset + 1; /* bump to next dcw */ 1433 type_dcw = IOTP; 1434 if dcw.action = IOTP then goto get_ptr; /* iotp - check next dcw */ 1435 type_dcw = IOTD; 1436 continue = "0"b; /* iotd dcw */ 1437 return; 1438 1439 dcl holdcount fixed bin (24); 1440 dcl successive_tdcws fixed bin (24); 1441 end get_dcw; 1442 1443 init_routine: proc; 1444 1445 seeksw, 1446 sc_ga, 1447 mr, 1448 type_dcw = "0"b; 1449 1450 unspec (status) = "0"b; 1451 1452 slave_status = "400000000000"b3; 1453 1454 cc_residue, 1455 da_residue, 1456 nelemt, 1457 override, 1458 total_count, 1459 wc_residue = 0; 1460 1461 argp, 1462 dcwptr, 1463 ibuffptr, 1464 mc_save_ptr, 1465 opptr, 1466 sbuffptr, 1467 sptr, 1468 swptr = null (); 1469 i = 0; 1470 1471 return; 1472 1473 end init_routine; 1474 1475 make_stat_ptr: proc; /* obtain pointer to status 1476* words and check return_word 1477* address fields */ 1478 if return_word.status_return >= storlimit then /* legal status return */ 1479 call gcos_mme_bort_$system ( 1480 gcos_et_$bad_status_ret_ptr 1481 , "Status return address in I/O sequence is outside slave limits." 1482 ); 1483 1484 if return_word.courtesy_call >= storlimit then /* legal courtesy call */ 1485 call gcos_mme_bort_$system ( 1486 gcos_et_$bad_cc_ptr 1487 , "Courtesy call address in I/O sequence is outside slave limits." 1488 ); 1489 1490 if return_word.status_return = 0 /* program doesn't want status */ 1491 then do; 1492 swptr = addr (scratch_status); /* so fake a return area */ 1493 scratch_status = "0"b; 1494 end; 1495 else swptr = addrel (gseg, return_word.status_return); /* get address of status words */ 1496 return; 1497 1498 end make_stat_ptr; 1499 1500 match_fc: proc () returns (bit (1)); /* Find a file code in the FC table. */ 1501 1502 do j = 1 to hbound (save_data.fibs, 1); /* Search file code table for match */ 1503 if fct.filecode (j) = fc /* Set MATCH flag if match. */ 1504 then return ("1"b); 1505 end; 1506 1507 return ("0"b); 1508 1509 end match_fc; 1510 1511 next_dcw_ptr: proc (data_ptr, how_many, continuation); 1512 1513 /* 1514* 1515* Check the DCW list and return the buffer pointer, transfer count, 1516* and a flag indicating whether this was the last DCW in the list. 1517* 1518* If the DCW is a transfer DCW (TDCW), then we go to the next list and 1519* start looking there, returning only when we find an I/O DCW. 1520* 1521* We also check the buffer pointer for legality. If it is out of 1522* range, we don't return to the caller, but instead bail out through 1523* the MME GEBORT escape-hatch. Ditto for 2 successive TDCWs. 1524* 1525**/ 1526 1527 dcl data_ptr pointer parm; 1528 dcl how_many fixed bin (21) parm; 1529 dcl continuation bit (1) parm; 1530 1531 successive_tdcws = 0; 1532 1533 if dcw_offset >= storlimit 1534 then call gcos_mme_bort_$system (gcos_et_$invalid_dcw_ptr, 1535 "DCW (at ^6.3b oct) is outside slave limits (^6.3b).", 1536 addr (dcw_offset) -> r18, 1537 addr (storlimit) -> r18); 1538 1539 dcwptr = addrel (gseg, dcw_offset); 1540 if trace_or_stopsw 1541 then call ioa_ ("dcw (^[IOTD^;IOTP^;TDCW^;IONTP^]) ^w", 1542 fixed (dcw.action, 2) + 1, 1543 dcw); 1544 1545 if dcw.action = TDCW 1546 then do; 1547 dcw_offset = dcw.data_addr; 1548 dcwptr = addrel (gseg, dcw_offset); 1549 if dcw.action = TDCW 1550 then call gcos_mme_bort_$system (gcos_et_$two_tdcws, 1551 "While accessing file code ""^a""", 1552 fc); 1553 end; 1554 1555 if dcw.data_addr = 0 /* Gotta provide an address SOMEHOW! */ 1556 | dcw.action = IONTP 1557 then data_ptr = addr (tapebuffer); /* If nothing else, round-file it. */ 1558 else data_ptr = addrel (gseg, data_addr); 1559 1560 if dcw.count = 0 1561 then how_many = 4096; /* Can't just do nuthin'. */ 1562 else how_many = dcw.count; 1563 1564 if how_many > gcos_ext_stat_$tape_buffer_size 1565 then call gcos_mme_bort_$system (gcos_et_$request_too_big, 1566 "gcos_mme_inos_", 1567 "^/Request was ^i, buffer size is ^i words (decimal).", 1568 how_many, 1569 gcos_ext_stat_$tape_buffer_size); 1570 1571 continuation = (dcw.action ^= IOTD); /* Gotta tell him there's more. */ 1572 1573 dcw_offset = dcw_offset + 1; /* Bump over this one. */ 1574 1575 return; 1576 1577 end next_dcw_ptr; 1578 1579 process_request: proc; /* Process the GEINOS command. */ 1580 1581 opptr = addrel (idptr, -1); /* build pointer to operation word */ 1582 sptr = addrel (idptr, 1); /* build pointer to return word */ 1583 dcw_offset = id_word.dcwp; /* get dcw list pointer */ 1584 if trace_or_stopsw then call debug_proc (); 1585 1586 if fib.command_index = 0 /* Get pointer to proper command table entry. */ 1587 then call get_cmd_tbl_entry; 1588 1589 /* Look up command in the command table specified in fib.command. 1590* Table length is specified by fib.command_count. */ 1591 1592 do i = fib.command_index to fib.command_index + fib.command_count; 1593 if substr (io (i).command, 1, 6) = op_word.dev_com /* are device and */ 1594 & substr (io (i).command, 19, 5) = op_word.ioc_com /* IOC command valid? */ 1595 then goto com_proc (io (i).process); /* go to processing rtn */ 1596 end; /* no...continue */ 1597 1598 call gcos_mme_bort_$system (gcos_et_$bad_io_cmnd_file, 1599 "This MME GEINOS command is not supported:" 1600 ||"^/file code=""^a"", command=^w (^a), memory offset=^6.3b", 1601 fc, 1602 unspec (op_word), 1603 type_op (op_word.dev_com), 1604 scu.ilc); 1605 1606 end process_request; 1607 1608 scatter_input: proc (bp); 1609 1610 /* move data from fib.buffer pointed to by bp 1611* to (possibly) multiple buffers in 1612* slave program, according to dcw list 1613**/ 1614 dcl bp ptr parm; 1615 1616 posit, wc_residue = 0; 1617 sc_loop: ; 1618 if nelemt < count then do; 1619 wc_residue = wc_residue + count - nelemt; 1620 if nelemt = 0 then goto sc_res; 1621 count = nelemt; 1622 end; 1623 if where = -1 then goto sc_skip; /* no-transfer and proceed */ 1624 ibuffptr = addrel (bp, posit); /* move from our fib.buffer */ 1625 sbuffptr = addrel (gseg, where); /* into slave fib.buffer */ 1626 slave_buffer = internal_buffer; 1627 sc_skip: ; 1628 nelemt = nelemt - count; 1629 posit = posit + count; 1630 da_residue = where + count; 1631 sc_res: ; 1632 if continue = "0"b then return; 1633 call get_dcw; 1634 goto sc_loop; 1635 1636 end scatter_input; 1637 1638 type_op: proc (op)returns (char (*)); 1639 1640 /* Return string specifying type of mme inos operation word. */ 1641 dcl op bit(6)unal parm; 1642 do i = 1 to hbound (device_cmd, 1); 1643 if op = device_cmd (i) then return (rtrim (name_cmd (i))); 1644 end; 1645 return ("UNKNOWN DEVICE COMMAND"); 1646 1647 dcl i fixed bin (24); 1648 dcl 1 operation_word_values (27)static int options(constant) 1649 ,2 device_cmd bit(6)init( 1650 "00"b3 /* Request Status */ 1651 , "03"b3 /* Read Typewriter */ 1652 , "04"b3 /* Read Tape Decimal */ 1653 , "05"b3 /* Read Tape Binary */ 1654 , "13"b3 /* Write (then Read) Typewriter */ 1655 , "14"b3 /* Write Tape Decimal */ 1656 , "15"b3 /* Write Tape Binary */ 1657 , "25"b3 /* Read */ 1658 , "30"b3 /* Write Printer Edited */ 1659 , "31"b3 /* Write */ 1660 , "34"b3 /* Seek */ 1661 , "40"b3 /* Reset Status */ 1662 , "41"b3 /* Set 6250 Density */ 1663 , "42"b3 /* Set 800 Density */ 1664 , "43"b3 /* Set 556 Density */ 1665 , "44"b3 /* Forward Space Record */ 1666 , "45"b3 /* Forward Space to Filemark */ 1667 , "46"b3 /* Backspace Record */ 1668 , "47"b3 /* Backspace to Filemark */ 1669 , "54"b3 /* Erase */ 1670 , "55"b3 /* Write EOF */ 1671 , "60"b3 /* Set High Density */ 1672 , "61"b3 /* Set Low Density */ 1673 , "64"b3 /* Set 200 Density */ 1674 , "65"b3 /* Set 1600 Density */ 1675 , "70"b3 /* Rewind */ 1676 , "72"b3 /* Rewind and Unload */ 1677 ) 1678 ,2 name_cmd char(28)init( 1679 /* 00"b3*/ "Request Status" 1680 , /* 03"b3*/ "Read Typewriter" 1681 , /* 04"b3*/ "Read Tape Decimal" 1682 , /* 05"b3*/ "Read Tape Binary" 1683 , /* 13"b3*/ "Write (then Read) Typewriter" 1684 , /* 14"b3*/ "Write Tape Decimal" 1685 , /* 15"b3*/ "Write Tape Binary" 1686 , /* 25"b3*/ "Read" 1687 , /* 30"b3*/ "Write Printer Edited" 1688 , /* 31"b3*/ "Write" 1689 , /* 34"b3*/ "Seek" 1690 , /* 40"b3*/ "Reset Status" 1691 , /* 41"b3*/ "Set 6250 Density" 1692 , /* 42"b3*/ "Set 800 Density" 1693 , /* 43"b3*/ "Set 556 Density" 1694 , /* 44"b3*/ "Forward Space Record" 1695 , /* 45"b3*/ "Forward Space to Filemark" 1696 , /* 46"b3*/ "Backspace Record" 1697 , /* 47"b3*/ "Backspace to Filemark" 1698 , /* 54"b3*/ "Erase" 1699 , /* 55"b3*/ "Write EOF" 1700 , /* 60"b3*/ "Set High Density" 1701 , /* 61"b3*/ "Set Low Density" 1702 , /* 64"b3*/ "Set 200 Density" 1703 , /* 65"b3*/ "Set 1600 Density" 1704 , /* 70"b3*/ "Rewind" 1705 , /* 72"b3*/ "Rewind and Unload" 1706 ); 1707 end type_op; 1708 1 1 /* BEGIN INCLUDE FILE gcos_next_arg.incl.pl1 (Wardd Multics) 06/09/81 2041.7 mst Tue */ 1 2 next_arg: proc (i, p, l)returns (bit (1)); 1 3 1 4 /* Set pointer "p" to the next argument in "arg_string" 1 5* and "l" to length of the argument, return "0"b. 1 6* Return "1"b if no more arguments. 1 7**/ 1 8 dcl i fixed bin(24)parm; 1 9 dcl l fixed bin(24)parm; 1 10 dcl p ptr parm; 1 11 if i = 1 then do; /* First argument. */ 1 12 rp = addr (arg_string); 1 13 rl = length (arg_string); 1 14 end; 1 15 if rl<1 then return ("1"b); /* No more arguments. */ 1 16 k = index (rs, ","); 1 17 p = rp; 1 18 if k = 0 then do; /* Final argument. */ 1 19 l = rl; 1 20 rl = 0; 1 21 rp = null (); 1 22 return ("0"b); 1 23 end; 1 24 1 25 /* More arguments remaining. */ 1 26 l = k-1; 1 27 rp = addr (rs2 (k+1)); 1 28 rl = rl - k; 1 29 return ("0"b); 1 30 1 31 dcl addr builtin; 1 32 dcl index builtin; 1 33 dcl k fixed bin(24); 1 34 dcl length builtin; 1 35 dcl rl fixed bin(24)static int; 1 36 dcl rp ptr static int; 1 37 dcl rs char(rl)unal based(rp); 1 38 dcl rs2 (k+1)char(1)unal based(rp); 1 39 end next_arg; 1 40 1 41 /* END INCLUDE FILE gcos_next_arg.incl.pl1 */ 1709 1710 1711 /* Variables for gcos_mme_inos_: */ 1712 /* IDENTIFIER ATTRIBUTES */ 1713 dcl addr builtin; 1714 dcl addrel builtin; 1715 dcl arg char(arglen) based (argp); 1716 dcl arglen fixed bin (24); 1717 dcl argp ptr; 1718 dcl ascii_index fixed bin (21); 1719 dcl ascii_string char(132); 1720 dcl bcd_string (count*6) bit(6) unal based (workp); 1721 dcl bksp_sw bit(1); 1722 dcl cc_residue fixed bin (24); 1723 dcl char char aligned; 1724 dcl continue bit(1) /* parameter from get_dcw */; 1725 dcl count fixed bin (21); 1726 dcl da_residue fixed bin (24); 1727 dcl db ext entry; 1728 dcl dcwptr ptr; 1729 dcl dcw_offset fixed bin (24) /* slave offset of current dcw */; 1730 dcl default_high char(5) int static options (constant) init ("d1600") /* system default high density */; 1731 dcl default_low char(4) int static options (constant) init ("d556") /* system default low density */; 1732 dcl density_history bit(2) aligned; 1733 dcl divide builtin; 1734 dcl error_retry bit(1) aligned /* 1 = processing parity error */; 1735 dcl fb35 fixed bin (35) based; 1736 dcl fc char(2) /* file code from file control block */; 1737 dcl fixed builtin; 1738 dcl gcos_cv_ascii_gebcd_ ext entry (ptr, fixed bin (21), ptr, fixed bin (21)); 1739 dcl gcos_et_$access_beyond_file fixed bin (35) ext; 1740 dcl gcos_et_$bad_cc_ptr fixed bin (35) ext; 1741 dcl gcos_et_$bad_io_cmnd_file fixed bin (35) ext; 1742 dcl gcos_et_$bad_mme_in_cc fixed bin (35) ext; 1743 dcl gcos_et_$bad_multirec fixed bin (35) ext static; 1744 dcl gcos_et_$bad_seek_dcw fixed bin (35) ext; 1745 dcl gcos_et_$bad_status_ret_ptr fixed bin (35) ext; 1746 dcl gcos_et_$fc_not_defined fixed bin (35) ext; 1747 dcl gcos_et_$geendc_not_in_cc fixed bin (35) ext; 1748 dcl gcos_et_$impermissible_perm_read fixed bin (35) ext; 1749 dcl gcos_et_$impermissible_perm_write fixed bin (35) ext; 1750 dcl gcos_et_$invalid_dcw_ptr fixed bin (35) ext; 1751 dcl gcos_et_$invalid_file_ptr fixed bin (35) ext; 1752 dcl gcos_et_$irrecoverable_io_err fixed bin (35) ext; 1753 dcl gcos_et_$need_multirec fixed bin (35) ext static; 1754 dcl gcos_et_$request_too_big fixed bin (35) ext static; 1755 dcl gcos_et_$two_tdcws fixed bin (35) ext static; 1756 dcl gcos_mme_bort_$system ext entry options (variable); 1757 dcl gcos_write_$bcd_ptr ext entry (ptr, char(*), bit(8)); 1758 dcl gseg ptr; 1759 dcl hbound builtin; 1760 dcl i fixed bin (21); 1761 dcl ibuffptr ptr; 1762 dcl idptr ptr; 1763 dcl instruction_counter fixed bin (18)unsigned unal based(addr(scu.ilc)); 1764 dcl internal_buffer (count) fixed bin (35) based (ibuffptr); 1765 dcl ioa_ ext entry options (variable); 1766 dcl j fixed bin (24); 1767 dcl k fixed bin (24); 1768 dcl major_status bit (4) aligned; 1769 dcl max builtin; 1770 dcl mc_save_ptr ptr; 1771 dcl minor_status bit (6) aligned; 1772 dcl mod builtin; 1773 dcl more_dcws bit (1); 1774 dcl mr bit(1) /* "1"b => multirecord request. */; 1775 dcl multirecord_com bit(5)static int options(constant)init("00011"b); 1776 dcl mybuf (160) bit(6) unal; 1777 dcl n fixed bin (24); 1778 dcl nelemt fixed bin (21); 1779 dcl new_next_avail fixed bin (24); 1780 dcl null builtin; 1781 dcl opptr ptr; 1782 dcl order char(20) /* holds order type */; 1783 dcl output_ptr pointer; 1784 dcl override fixed bin (24); 1785 dcl posit fixed bin (21); 1786 dcl record char(j) based /* overlay for bcd record */; 1787 dcl rec_ct_residue fixed bin (24)/* holds no of unskipped records */; 1788 dcl rel builtin; 1789 dcl retry_count fixed bin (24)/* number of attempts left in which */; 1790 dcl sbuffptr ptr; 1791 dcl scratch_status bit(72) aligned /* temp */; 1792 dcl sc_ga bit(1); 1793 dcl seeksw bit(1) /* sw controlling disk or drum seeks */; 1794 dcl seek_address fixed bin (24)based /* user seek address for disk or drum */; 1795 dcl seek_pointer char(5) /* holds name of pointer to seek */; 1796 dcl slave_buffer (count) fixed bin (35) based (sbuffptr); 1797 dcl slave_status bit(36) aligned; 1798 dcl sptr ptr; 1799 dcl storlimit fixed bin (19) /* slave core boundary */; 1800 dcl substr builtin; 1801 dcl successive_tdcws fixed bin; 1802 dcl swptr ptr; 1803 dcl tapebuffer (4096) bit(36) aligned; 1804 dcl total_count fixed bin (24); 1805 dcl total_read fixed bin (36); 1806 dcl trace_array (20) char(4) int static; 1807 dcl trace_index fixed bin (24) static int init(0); 1808 dcl trace_or_stopsw bit(1) static int init ("0"b); 1809 dcl transfer_count fixed bin (21); 1810 dcl translate builtin; 1811 dcl type_dcw bit(2); 1812 dcl unspec builtin; 1813 dcl wc_residue fixed bin (24); 1814 dcl where fixed bin (21); 1815 dcl workp ptr; 1816 dcl z320 (320)bit(36)static int options(constant)init((320)(36)"0"b); 1817 dcl 1 courtesy_call_conditions like save_machine_conditions based (mcp); 1818 1819 dcl ( 1820 IOTD init("00"b) 1821 , IOTP init("01"b) 1822 , TDCW init("10"b) 1823 , IONTP init("11"b) 1824 ) bit(2)static internal options(constant); 1825 1826 dcl 1 w aligned based 1827 , 2 l18 bit(18)unal 1828 , 2 r18 bit(18)unal 1829 ; 1830 1831 dcl 1 op_word aligned based (opptr), /* model of operation word */ 1832 2 dev_com bit(6) unal, /* device command */ 1833 2 zero1 bit(12) unal, /* zeros */ 1834 2 ioc_com bit(5) unal, /* ioc command */ 1835 2 zero2 bit(1) unal, /* zero */ 1836 2 control bit(6) unal, /* control */ 1837 2 count fixed bin (6)unsigned unal /* count */; 1838 1839 dcl 1 id_word aligned based (idptr), /* model of identification word */ 1840 2 filep fixed bin (18)unsigned unal, /* file control block pointer */ 1841 2 dcwp fixed bin (18)unsigned unal /* dcw list pointer */; 1842 1843 dcl 1 file_code_word aligned based (workp), /* model of file code word */ 1844 2 fill bit(24) unal, 1845 2 fcode bit(12) unal /* file code in bcd */; 1846 1847 dcl 1 return_word aligned based (sptr), /* model of status return word */ 1848 2 status_return fixed bin (18)unsigned unal, /* pointer to return words */ 1849 2 courtesy_call fixed bin (18)unsigned unal /* pointer to courtesy call rtn */; 1850 1851 dcl 1 stat_words aligned based (swptr), /* model of status words */ 1852 2 sw1 bit(36) aligned, /* word 1 */ 1853 2 sw2 bit(36) aligned /* word 2 */; 1854 1855 dcl 1 dcw aligned based (dcwptr), /* dcw model */ 1856 2 data_addr fixed bin (18)unsigned unal, /* data address */ 1857 2 zero bit(3) unal, /* fill */ 1858 2 chr_tally bit(1) unal, /* character tally indicator. */ 1859 2 action bit(2) unal, /* action */ 1860 2 count fixed bin (12)unsigned unal /* word count for transfer */; 1861 1862 dcl 1 mc_save_data based (mc_save_ptr), 1863 (2 pr_regs (16), 1864 2 s_regs (8), 1865 2 scu_0_3 (4), 1866 2 ici_regs, 1867 2 scu_5_7 (3), 1868 2 software_data (8), 1869 2 pl_regs (8)) fixed bin (35); 1870 1871 /* I/O Simulation Tables */ 1872 1873 1874 /* Command Tables: */ 1875 /* */ 1876 /* The command tables contain the possible legal commands for each device */ 1877 /* type. Each command table entry contains the command and the command */ 1878 /* processor address. */ 1879 1880 1881 /* Table of indices into io_commands list to 1882* separate MME GEINOS command word sublists 1883* for various devices. 1884**/ 1885 dcl 1 index static int options(constant), 1886 2 ( 1887 disk init(01), 1888 tape init(11), 1889 printer init(36), 1890 typewriter init(40), 1891 next init(44) 1892 ) fixed bin (24); 1893 1894 dcl 1 io (43) internal static options (constant), 1895 2 command bit (36) init ( 1896 1897 /* Disk commands: */ 1898 /* 1 */ "340000000002"b3 /* 34 - seek disk address */ 1899 , /* 2 */ "250000002400"b3 /* 25 - read disk continuous */ 1900 , /* 3 */ "250000060000"b3 /* 25 - multirecord disk read. */ 1901 , /* 4 */ "310000002400"b3 /* 31 - write disk continuous */ 1902 , /* 5 */ "310000060000"b3 /* 31 - multirecord disk write. */ 1903 , /* 6 */ "700000020001"b3 /* 70 - rewind */ 1904 , /* 7 */ "460000020001"b3 /* 46 - backspace record(s) */ 1905 , /* 8 */ "440000020001"b3 /* 44 - forward space record(s) */ 1906 , /* 9 */ "400000020001"b3 /* 40 - reset status */ 1907 , /* 10 */ "000000020001"b3 /* 00 - request status */ 1908 1909 /* Tape commands: */ 1910 , /* 11 */ "050000000000"b3 /* 05 - read tape binary */ 1911 , /* 12 */ "150000000000"b3 /* 15 - write tape binary */ 1912 , /* 13 */ "030000000000"b3 /* 03 - read tape nine */ 1913 , /* 14 */ "130000000000"b3 /* 13 - write tape nine */ 1914 , /* 15 */ "700000020001"b3 /* 70 - rewind */ 1915 , /* 16 */ "550000020001"b3 /* 55 - write eof */ 1916 , /* 17 */ "450000020001"b3 /* 45 - forward space to file mark */ 1917 , /* 18 */ "470000020001"b3 /* 47 - backspace to file mark */ 1918 , /* 19 */ "440000020001"b3 /* 44 - forward space one record */ 1919 , /* 20 */ "460000020001"b3 /* 46 - backspace one record */ 1920 , /* 21 */ "150000100000"b3 /* 15 - write file mark */ 1921 , /* 22 */ "140000100000"b3 /* 14 - write file mark decimal */ 1922 , /* 23 */ "540000020001"b3 /* 54 - erase */ 1923 , /* 24 */ "720000020001"b3 /* 72 - rewind and unload */ 1924 , /* 25 */ "600000020001"b3 /* 60 - set high density */ 1925 , /* 26 */ "610000020001"b3 /* 61 - set low density */ 1926 , /* 27 */ "640000020001"b3 /* 64 - set 200 density */ 1927 , /* 28 */ "430000020001"b3 /* 43 - set 556 density */ 1928 , /* 29 */ "420000020001"b3 /* 42 - set 800 density */ 1929 , /* 30 */ "650000020001"b3 /* 65 - set 1600 density */ 1930 , /* 31 */ "410000020001"b3 /* 41 - set 6520 density */ 1931 , /* 32 */ "400000020001"b3 /* 40 - reset status */ 1932 , /* 33 */ "000000020001"b3 /* 00 - request status */ 1933 , /* 34 */ "040000000000"b3 /* 04 - read tape bcd */ 1934 , /* 35 */ "140000000000"b3 /* 14 - write tape bcd */ 1935 1936 /* Printer commands: */ 1937 , /* 36 */ "300000000000"b3 /* 30 - write printer edited */ 1938 , /* 37 */ "300000060001"b3 /* 30 - write printer edited continuous */ 1939 , /* 38 */ "400000020001"b3 /* 40 - reset status */ 1940 , /* 39 */ "000000020001"b3 /* 00 - request status */ 1941 1942 /* Typewriter commands: */ 1943 , /* 40 */ "130000000000"b3 /* 13 - write or write then read */ 1944 , /* 41 */ "030000000000"b3 /* 03 - read */ 1945 , /* 42 */ "400000020001"b3 /* 40 - reset status */ 1946 , /* 43 */ "000000020001"b3 /* 00 - request status */ 1947 ), 1948 1949 /* Corresponding indices to labeled array location 1950* to processing routine. 1951**/ 1952 2 process fixed bin (24)init ( 1953 1954 /* Disk commands: */ 1955 1 /* 34 - seek disk address */ 1956 , 2 /* 25 - read disk continuous */ 1957 , 2 /* 25 - multirecord disk read */ 1958 , 3 /* 31 - write disk continuous */ 1959 , 3 /* 31 - multirecord disk write. */ 1960 , 4 /* 70 - rewind */ 1961 , 5 /* 46 - backspace record(s) */ 1962 , 6 /* 44 - forward space record(s) */ 1963 , 7 /* 40 - reset status */ 1964 , 8 /* 00 - request status */ 1965 1966 /* Tape commands: */ 1967 , 9 /* 05 - read tape binary */ 1968 , 10 /* 15 - write tape binary */ 1969 , 11 /* 03 - read tape nine */ 1970 , 12 /* 13 - write tape nine */ 1971 , 13 /* 70 - rewind */ 1972 , 14 /* 55 - write eof */ 1973 , 15 /* 45 - forward space to file mark */ 1974 , 16 /* 47 - backspace to file mark */ 1975 , 17 /* 44 - forward space one record */ 1976 , 18 /* 46 - backspace one record */ 1977 , 19 /* 15 - write file mark */ 1978 , 20 /* 14 - write file mark decimal */ 1979 , 21 /* 54 - erase */ 1980 , 22 /* 72 - rewind and unload */ 1981 , 23 /* 60 - set high density */ 1982 , 24 /* 61 - set low density */ 1983 , 25 /* 64 - set 200 density */ 1984 , 26 /* 43 - set 556 density */ 1985 , 27 /* 42 - set 800 density */ 1986 , 28 /* 65 - set 1600 density */ 1987 , 41 /* 41 - set 6520 density */ 1988 , 29 /* 40 - reset status */ 1989 , 30 /* 00 - request status */ 1990 , 31 /* 04 - read tape bcd */ 1991 , 32 /* 14 - write tape bcd */ 1992 1993 /* Printer commands: */ 1994 , 33 /* 30 - write printer edited */ 1995 , 34 /* 30 - write printer edited continuous */ 1996 , 35 /* 40 - reset status */ 1997 , 36 /* 00 - request status */ 1998 1999 /* Typewriter commands: */ 2000 , 37 /* 13 - write or write then read */ 2001 , 38 /* 03 - read */ 2002 , 39 /* 40 - reset status */ 2003 , 40 /* 00 - request status */ 2004 ); 2005 2 1 /* BEGIN INCLUDE FILE gcos_dcl_ios_.incl.pl1 (Wardd Multics) 06/16/81 1040.9 mst Tue */ 2 2 2 3 dcl ios_$attach entry ( 2 4 char(*) 2 5 , char(*) 2 6 , char(*) 2 7 , char(*) 2 8 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 9 ); 2 10 2 11 dcl ios_$detach entry ( 2 12 char(*) 2 13 , char(*) 2 14 , char(*) 2 15 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 16 ); 2 17 2 18 dcl ios_$order entry ( 2 19 char(*) 2 20 , char(*) 2 21 , ptr 2 22 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 23 ); 2 24 2 25 dcl ios_$read entry ( 2 26 char(*) 2 27 , ptr 2 28 , fixed bin(21) 2 29 , fixed bin(21) 2 30 , fixed bin(21) 2 31 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 32 ); 2 33 2 34 dcl ios_$read_ptr entry ( 2 35 ptr 2 36 , fixed bin(21) 2 37 , fixed bin(21) 2 38 ); 2 39 dcl ios_$setsize entry ( 2 40 char(*) 2 41 , fixed bin(21) 2 42 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 43 ); 2 44 2 45 dcl ios_$seek entry ( 2 46 char(*) 2 47 , char(*) 2 48 , char(*) 2 49 , fixed bin(21) 2 50 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 51 ); 2 52 2 53 dcl ios_$tell entry ( 2 54 char(*) 2 55 , char(*) 2 56 , char(*) 2 57 , fixed bin(21) 2 58 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 59 ); 2 60 2 61 dcl ios_$write entry ( 2 62 char(*) 2 63 , ptr 2 64 , fixed bin(21) 2 65 , fixed bin(21) 2 66 , fixed bin(21) 2 67 , 1, 2 fixed bin(35) aligned, 2 bit(36) aligned 2 68 ); 2 69 2 70 dcl ios_$write_ptr entry ( 2 71 ptr 2 72 , fixed bin(21) 2 73 , fixed bin(21) 2 74 ); 2 75 2 76 dcl 1 status /* Return status code. */ 2 77 , 2 code fixed bin(35)aligned 2 78 , 2 word2 bit(36)aligned 2 79 ; 2 80 2 81 /* END INCLUDE FILE gcos_dcl_ios_.incl.pl1 */ 2006 2007 3 1 /* BEGIN INCLUDE FILE gcos_xlate_bcd_ascii_.incl.pl1 5/19/76/ RHM */ 3 2 3 3 /* Change: Dave Ward 05/20/81 options constant. 3 4**/ 3 5 3 6 dcl xlate (0: 63) char(1) int static options(constant) init( /* bcd to ascii xlation table */ 3 7 3 8 "0","1","2","3","4","5","6","7","8","9","[","#","@",":",">","?", 3 9 3 10 " ","a","b","c","d","e","f","g","h","i","&",".","]","(","<","\", 3 11 3 12 "^","j","k","l","m","n","o","p","q","r","-","$","*",")",";","'", 3 13 3 14 "+","/","s","t","u","v","w","x","y","z","_",",","%","=","""","!" ); 3 15 3 16 /* END INCLUDE FILE gcos_xlate_bcd_ascii_.incl.pl1 */ 2008 2009 4 1 /* BEGIN INCLUDE FILE gcos_ext_stat_.incl.pl1 */ 4 2 /* 4 3* Changes to gcos_ext_stat_ must be made here AND gcos_ext_stat_.cds 4 4**/ 4 5 /* July 77 (MRJ) Mike Jordan. */ 4 6 /* Change: Mel Wilson Oct 1979 for gtss compatibility (Bell Canada). */ 4 7 /* Change: A. N. Kepner, March, 1978 to allow courtesy call i/o within cc routines. */ 4 8 /* Change: Dave Ward 06/01/81 Reorganized to eliminate alm object (using cds). Use of like structures. */ 4 9 /* Change: Scott C. Akers 01/26/82 Add tape_buffer_size for GEINOS processing. */ 4 10 /* Change: Ron Barstad 83-08-02 Added activity_card_num for execution report */ 4 11 /* Increased size of statistics for 4js3 MMEs */ 4 12 4 13 dcl gcos_ext_stat_$abort_reason char(128) varying /* abort reason from gcos pgm */ ext; 4 14 dcl gcos_ext_stat_$abort_return label /* abort return point */ ext; 4 15 dcl gcos_ext_stat_$activity_card_num pic "9999" ext; /* card number defining current activity */ 4 16 dcl gcos_ext_stat_$activity_name char(8) /* name of activity to be run */ ext; 4 17 dcl gcos_ext_stat_$activity_start_time fixed bin(71) /* TOD start of activity */ ext; 4 18 dcl gcos_ext_stat_$card_num pic "9999" /* ordinal number of card in input stream */ ext; 4 19 dcl gcos_ext_stat_$dbs (36)bit(1) /* Debugging switch. */ ext; 4 20 dcl gcos_ext_stat_$default_nondollar char(2) /* filecode where nondollar cards go by default */ ext; 4 21 dcl gcos_ext_stat_$dir_rings (3) fixed bin(3) /* ring brackets for created catalogs */ ext; 4 22 dcl gcos_ext_stat_$dpno char(100) varying /* arguments for call to dpunch */ ext; 4 23 dcl gcos_ext_stat_$dpo char(100) varying /* arguments for call to dprint */ ext; 4 24 dcl gcos_ext_stat_$endfc char(2) /* endfc value for endcopy processing */ ext; 4 25 dcl gcos_ext_stat_$er ptr /* fib pointer for *er */ ext; 4 26 dcl gcos_ext_stat_$etc_filecode char(2) /* filecode where $ ETC cards should be written */ ext; 4 27 dcl gcos_ext_stat_$gcos_slave_area_seg ptr /* pointer to gcos slave area segment */ ext; 4 28 dcl gcos_ext_stat_$gf fixed bin(24)/* sw used by getfield rtn */ ext; 4 29 dcl gcos_ext_stat_$incode fixed bin(24) /* switches to control incode processing */ ext; 4 30 dcl gcos_ext_stat_$increment_hold fixed bin(24) /* Holds increment for courtesy call returns. */ ext; 4 31 dcl gcos_ext_stat_$initial_cpu_time fixed bin(71) /* vcu time at activity start */ ext; 4 32 dcl gcos_ext_stat_$input_segment_path char(168) varying /* pathname of input segment */ ext; 4 33 dcl gcos_ext_stat_$jcl_warnings fixed bin(24) /* number warnings issued processing control cards */ ext; 4 34 dcl gcos_ext_stat_$job_cpu_time fixed bin(71) /* cpu usage at job start */ ext; 4 35 dcl gcos_ext_stat_$job_id char(18) varying /* unique job id for file naming */ ext; 4 36 dcl gcos_ext_stat_$job_real_time fixed bin(71) /* job start time in microseconds */ ext; 4 37 dcl gcos_ext_stat_$last_mme fixed bin(24)/* number of last mme executed */ ext; 4 38 dcl gcos_ext_stat_$ldrss fixed bin(24) /* loader shared stg. */ ext; 4 39 dcl gcos_ext_stat_$max_activities fixed bin(24)/* max activities in a job */ ext; 4 40 dcl gcos_ext_stat_$max_mem fixed bin(19) /* maximum memory available to an activity */ ext; 4 41 dcl gcos_ext_stat_$mme_rtrn label /* where to return at activity end */ ext; 4 42 dcl gcos_ext_stat_$nondollar char(2) /* non-dollar card file code */ ext; 4 43 dcl gcos_ext_stat_$nongcos char(2) /* filecode where nongcos dollar cards go */ ext; 4 44 dcl gcos_ext_stat_$normal_return label /* nonlocal goto for normal termination */ ext; 4 45 dcl gcos_ext_stat_$patchfile_ptr ptr /* pointer to patchfile */ ext; 4 46 dcl gcos_ext_stat_$pathname_prefix char(168)var ext; 4 47 dcl gcos_ext_stat_$pch ptr /* pointer to fib for syspunch collector file */ ext; 4 48 dcl gcos_ext_stat_$pdir char(168) varying /* pathname of process directory */ ext; 4 49 dcl gcos_ext_stat_$prt ptr /* pointer to fib for sysprint collector file */ ext; 4 50 dcl gcos_ext_stat_$rs ptr /* pointer to fib for geload r* collector file */ ext; 4 51 dcl gcos_ext_stat_$saveseg_ptr ptr /* pointer to save segment used by save/restart */ ext; 4 52 dcl gcos_ext_stat_$save_dir char(168) varying /* pathname of temp save directory */ ext; 4 53 dcl gcos_ext_stat_$seg_rings (3) fixed bin(3) /* ring brackets for created files */ ext; 4 54 dcl gcos_ext_stat_$sig_ptr ptr /* saved pointer to signal_ */ ext; 4 55 dcl gcos_ext_stat_$skip_umc bit(1) ext; 4 56 dcl gcos_ext_stat_$snumb bit (30) aligned /* snumb of the current job */ ext; 4 57 dcl gcos_ext_stat_$sought_label char(8) /* Label from GOTO, IF, or WHEN card */ ext; 4 58 dcl gcos_ext_stat_$statistics (3*44) fixed bin(24) /* mme usage statistics- 3 per mme */ ext; 4 59 dcl gcos_ext_stat_$stop_code fixed bin(24) /* debugging, print results and stop. */ ext; 4 60 dcl gcos_ext_stat_$storage_limit fixed bin(19) /* activity storage limit */ ext; 4 61 dcl gcos_ext_stat_$sysout_limit fixed bin(35) /* sysout line limit */ ext; 4 62 dcl gcos_ext_stat_$sysout_lines fixed bin(35) /* sysout lines used */ ext; 4 63 dcl gcos_ext_stat_$system_free_pointer ptr /* pointer to area for allocating in ext; set by gcos */ ext; 4 64 dcl gcos_ext_stat_$tape_buffer_size fixed bin(35) external static; /* tape buffer size for GEINOS. */ 4 65 dcl gcos_ext_stat_$temp_dir char(168) varying /* pathname of directory to hold temp files */ ext; 4 66 dcl gcos_ext_stat_$temp_seg_ptr ptr ext; 4 67 dcl gcos_ext_stat_$termination_code bit (18) /* termination code from gcos_mme_bort_ */ ext; 4 68 dcl gcos_ext_stat_$time_limit fixed bin(71) /* activity time limit */ ext; 4 69 dcl gcos_ext_stat_$userid char(12) /* the USERID */ ext; 4 70 dcl gcos_ext_stat_$validation_level fixed bin(3) /* current ring of execution */ ext; 4 71 4 72 /* Courtesy Call Queue 4 73* A queue for courtesy call addresses which must be saved during 4 74* execution of courtesy call routines. A courtesy call address is 4 75* saved each time a MME GEROUT or MME GEINOS, which specifies a 4 76* courtesy call, is executed within a courtesy call routine. Each 4 77* time a MME GEENDC is executed a courtesy call address will be 4 78* removed from this FIFO queue and the corresponding courtesy call 4 79* routine executed until the queue is empty. The FIFO "queue" is 4 80* implemented in a circular fashion. "next_avail" points to the 4 81* next empty location in the queue. "next_out" points to the 4 82* entry in the queue which has been in the queue longest. When 4 83* entering or removing entries from the queue the appropriate index 4 84* is incremented modulo the length of the queue. By convention the 4 85* queue is empty when "next_avail" equals "next_out". A 4 86* second convention is that the queue is considered to overflow 4 87* during an attempt to add an entry to the queue which would force 4 88* "next_avail" to "catch up" with "next_out". This means that 4 89* the last empty position in the queue will never be used. 4 90**/ 4 91 4 92 dcl 1 gcos_ext_stat_$courtesy_call_control aligned ext 4 93 , 3 courtesy_call 4 94 , 4 hold like save_machine_conditions /* Mach. conds. restored on courtesy call returns. */ 4 95 , 4 next_avail fixed bin(24) /* next available empty location in cc_queue. */ 4 96 , 4 next_out fixed bin(24) /* next entry to remove from cc_queue. */ 4 97 , 4 queue (6) fixed bin(24) 4 98 ; 4 99 5 1 /* BEGIN INCLUDE FILE gcos_save_mc.incl.pl1 (Wardd Multics) 09/12/81 0905.9 mst Sat */ 5 2 5 3 /* Structure to isolate the definition of the size of the 5 4*space needed to store he machine conditions structure (mc). 5 5**/ 5 6 dcl 1 save_machine_conditions based 5 7 , 3 save_space bit(1728) 5 8 ; 5 9 5 10 /* END INCLUDE FILE gcos_save_mc.incl.pl1 */ 4 100 4 101 4 102 dcl 1 gcos_ext_stat_$fct aligned ext, 4 103 3 fct (40) like fct_entry; 6 1 /* BEGIN INCLUDE FILE gcos_fct_entry.incl.pl1 (Wardd Multics) 05/30/81 1758.6 mst Sat */ 6 2 6 3 dcl 1 fct_entry aligned based, 6 4 2 filecode char(2) aligned, /* file code (or blank) */ 6 5 /* flags */ 6 6 2 sysout bit(1) unaligned, /* 1=file is sysout or dac */ 6 7 2 dac bit(1) unaligned, /* 1=file is dac,0=file is sysout */ 6 8 2 pad bit(34) unaligned, /* unused */ 6 9 2 fibptr ptr aligned /* ptr to fib for this file */ 6 10 ; 6 11 6 12 /* END INCLUDE FILE gcos_fct_entry.incl.pl1 */ 4 104 4 105 4 106 dcl 1 gcos_ext_stat_$save_data aligned ext, 4 107 3 save_data like save_data_entry; 7 1 /* BEGIN INCLUDE FILE gcos_save_data_entry.incl.pl1 (Wardd Multics) 07/01/81 1339.9 mst Wed */ 7 2 /* Change: Dave Ward 07/01/81 include gcos_flags_. */ 7 3 /* Change: Dave Ward 09/10/81 fib changed to fibs & likened to fib. */ 7 4 7 5 dcl 1 save_data_entry aligned based 7 6 ,3 flgs like flags /* system wide flgs */ 7 7 ,3 actid char(8) /* activity no. and accnt i.d. */ 7 8 ,3 short_actid bit(36) aligned /* short form of activity id */ 7 9 ,3 ident char(60) /* holds ident info from snumb card */ 7 10 ,3 psw bit(36) aligned /* program switch word */ 7 11 ,3 last_execute_act_no fixed bin(24)/* activity number of last $ EXECUTE card in job */ 7 12 ,3 activity_no fixed bin(24)/* activity number */ 7 13 ,3 job_time_limit fixed bin(71) /* job time limit */ 7 14 ,3 job_sysout_limit fixed bin(24)/* job sysout line limit */ 7 15 ,3 sysout_queue (10) char(32) /* sysout queue */ 7 16 ,3 sysout_queue_media (10) fixed bin(24)/* medium (print,punch) of each file on queue */ 7 17 ,3 sqindex fixed bin(24)/* curr offset in sysout queue */ 7 18 ,3 pathname_prefix char(168)varying /* prefix for gcos cfdescs */ 7 19 ,3 skip_umc aligned bit(1) /* flag to tell if we should skip umc names */ 7 20 ,3 job_deck pointer /* pointer to seg holding canonicalized job deck */ 7 21 ,3 jd_size fixed bin(24)/* size in words of job deck */ 7 22 ,3 jd_position fixed bin(24) /* position of current block of job deck */ 7 23 ,3 jd_rem_block_len fixed bin(24)/* words remaining in current block of job deck */ 7 24 ,3 syot_dir char(168)varying /* pathname of directory to hold sysout files */ 7 25 ,3 fibs (40) like fib 7 26 ,3 param (32) char(57)varying /* parameters */ 7 27 ; 7 28 8 1 /* BEGIN INCLUDE FILE gcos_flags.incl.pl1 (Wardd Multics) 07/01/81 1344.7 mst Wed */ 8 2 /* Change: Mel Wilson 03/01/79 to add gtssflag & identflag */ 8 3 /* Change: Dave Ward 07/01/81 revised, mad apart of gcos_ext_stat_. */ 8 4 8 5 8 6 /* Declaration of Simulator Wide Flags */ 8 7 8 8 dcl 1 flags aligned based, 8 9 2 ( 8 10 pad1, /* no longer used */ 8 11 copy, /* 1=copy option on|0=off */ 8 12 snumb, /* 1=snumb card read|0=not */ 8 13 ident, /* 1=ident card read|0=not */ 8 14 activ, /* 1=activity being defined|0=not */ 8 15 cc, /* 1=courtesy call active|0=not */ 8 16 pad2, /* no longer used */ 8 17 cksum, /* 1=don't check checksums|0=do */ 8 18 pad3, /* no longer used */ 8 19 wrapup, /* 1=processing wrapup after abort */ 8 20 8 21 /* FOLLOWING ADDED AFTER MARCH 73 */ 8 22 8 23 nosave, /* 1=disable save/restart function,0=not */ 8 24 pad4, /* no longer used */ 8 25 gcos, /* 1=job deck segment in gcos file format */ 8 26 raw, /* 1=sysout punch files to be converted to raw bit strings */ 8 27 list, /* 1=sysout print files to be converted to ascii */ 8 28 brief, /* 1=print nothing but fatal error messages on terminal */ 8 29 debug, /* 1=give option to call debug before aborting */ 8 30 no_canonicalize, /* 1=do NOT canonicalize job deck */ 8 31 8 32 /* 18 bits into first word */ 8 33 8 34 pad5, /* no longer used */ 8 35 dpunch, /* 1=dpunch sysout punch files;0=don't */ 8 36 dprint, /* 1=dprint sysout print files,0=don't */ 8 37 userid, /* 1=userid card read,0=not */ 8 38 userlib, /* 1= -userlib ctl arg given, see gcos_gein_ */ 8 39 dstar, /* 1=current activity card written on d* */ 8 40 write_etc, /* 1 tells get_cc_field to write $ ETC cards on etc_filecode */ 8 41 prev_act_abort, /* turned on by abort and off by $ BREAK */ 8 42 this_act_abort, /* turned on by abort to select abort disp codes */ 8 43 abort_subact, /* 1=processing abort subactivity */ 8 44 dump, /* 1=dump option given on activity card */ 8 45 nondollar, /* 1=reading nondollar card deck in gein */ 8 46 endjob, /* 1=cc_endjob already called once in this job */ 8 47 abort_card, /* 1=the terminator for this activity was a $ ABORT card */ 8 48 truncate, /* 1=truncate option given:truncate long ascii input lines */ 8 49 continue, /* 1=continue option given:continue after nonfatal errors */ 8 50 rout, /* 1=gcos_mme_rout_ was called in this activity */ 8 51 seeking, /* 1=gein is looking for a label and/or terminator */ 8 52 8 53 /* end of first word */ 8 54 8 55 seeking_terminator, /* 1=gein is looking for a terminator */ 8 56 lower_case, /* 1=lower case print conversion wanted */ 8 57 no_bar, /* 1=do not run slave program in BAR mode */ 8 58 long, /* 1=print some lines from execution reort on terminal */ 8 59 endfc, /* 1=process endfc option on endcopy card */ 8 60 gtssflag, /* 1=update gtss_user_state_ during execution */ 8 61 identflag, /* 1= use $ident banner info for print & punch */ 8 62 spawnflag, /* 1= entry due to tss spawn */ 8 63 taskflag /* 1= entry due to tss drl task */ 8 64 ) bit(1) unal, 8 65 2 pad6 bit(27)unal 8 66 ; 8 67 8 68 /* END INCLUDE FILE gcos_flags.incl.pl1 */ 7 29 7 30 7 31 /* END INCLUDE FILE gcos_save_data_entry.incl.pl1 */ 4 108 4 109 9 1 /* BEGIN INCLUDE FILE gcos_file_info_block_.incl.pl1 DAK - APRIL 74 */ 9 2 9 3 /* Declaration of File Information Block (fib) 9 4* 9 5* Change: Mel Wilson 11/01/79 for gtss compatibility 9 6* Change: Dave Ward 05/20/81 *_file constants. 9 7* Change: Dave Ward 05/29/81 separated fct structures. 9 8* Change: Dave Ward 09/02/81 provision for tape density 6250, dens_hist 2 bits (not 3). 9 9**/ 9 10 dcl 1 fib aligned based (fibptr) /* fib structure */ 9 11 9 12 , 2 buffer ptr aligned /* pointer to current buffer (gcos_write_) */ 9 13 , 2 buffer_indx fixed bin /* Index to buffer in use. */ 9 14 , 2 stream char(8)unal /* stream name for attaching this file */ 9 15 , 2 pathnm char(168)unal /* pathname (for disk, print or punch files) */ 9 16 , 2 unique_file_id bit(36) /* multics unique segment id for file */ 9 17 , 2 indicators /* five words of flags */ 9 18 9 19 , 3 indicators_word_1 9 20 , 4 used bit(1) unal /* 1=fib used, 0=fib used */ 9 21 , 4 attached bit(1) unal /* 1=stream is attached */ 9 22 , 4 type bit(1) unal /* 1=random, 0=linked */ 9 23 , 4 perm bit(1) unal /* 1=permanent file, 0=not */ 9 24 , 4 print bit(1) unal /* 1=file type is printer */ 9 25 , 4 punch bit(1) unal /* 1=file type is punch */ 9 26 , 4 reader bit(1) unal /* 1=file type is card reader */ 9 27 , 4 tape bit(1) unal /* 1=file type is tape */ 9 28 , 4 console bit(1) unal /* 1=file type is console typewriter */ 9 29 , 4 read bit(1) unal /* 1=read access permitted */ 9 30 , 4 write bit(1) unal /* 1=write access permitted */ 9 31 , 4 null bit(1) unal /* 1=file is null */ 9 32 , 4 purge bit(1) unal /* 1=purge file at time on release */ 9 33 , 4 gein bit(1) unal /* 1 = this file contains data cards from the job deck */ 9 34 , 4 disp bit(2) unal /* disposition code: 9 35* 00 = dismount 9 36* 01 = release 9 37* 10 = save 9 38* 11 = continue */ 9 39 , 4 adisp bit(2) unal /* abort disp - same codes as disp */ 9 40 , 4 order bit(1) unal /* 1 = write, 0 = read or other */ 9 41 , 4 mode bit(2) unal /* tape i/o mode 9 42* 00 = binary 9 43* 01 = decimal 9 44* 10 = nine */ 9 45 , 4 tracks bit(2) unal /* tape request code: 9 46* 00 = installation default 9 47* 01 = 7 track 9 48* 10 = 9 track */ 9 49 , 4 density bit(4) unal /* tape density from $ TAPE card 9 50* 0000 = site standard high 9 51* 0001 = 200 bpi 9 52* 0010 = 556 bpi 9 53* 0100 = 800 bpi 9 54* 1001 = 1600 bpi 9 55* 1100 = 6250 bpi 9 56* 1111 = handler capable of any appropriate denisty */ 9 57 , 4 dens_hist bit(2) unal /* density history for MME GEFADD */ 9 58 , 4 forced_acl_flag bit(1) unal /* 1 => acl forced for gtss file (2.4) */ 9 59 , 4 fill bit(6) unal /* reserved for future use */ 9 60 , 3 indicators_word_2 9 61 , 4 plud bit(18) unal /* primary log unit designator */ 9 62 /* bcd channel and channel number */ 9 63 9 64 , 4 slud bit(18) unal /* secondary log. unit designator */ 9 65 /* bcd channel and channel number */ 9 66 , 3 indicators_word_3 9 67 , 4 serial_no bit(30) unal /* tape serial number */ 9 68 , 4 pad bit( 6) unal /* unused */ 9 69 , 3 indicators_word_4 9 70 , 4 tape_name bit(72) unal /* tape name */ 9 71 9 72 , 2 current fixed bin(21) /* current file position */ 9 73 , 2 last fixed bin(21) /* eof for sequential disk files */ 9 74 , 2 size fixed bin(24) /* offset of end of file in words */ 9 75 , 2 init_size fixed bin(24) /* file size at start of activity */ 9 76 , 2 init_posit fixed bin(24) /* file position at start of activity */ 9 77 , 2 iocount fixed bin(35) /* total no. of i/o operations */ 9 78 , 2 rec_len fixed bin(24) /* length of current record (gcos_write_) */ 9 79 , 2 command_count fixed bin(17) unal /* size of command table for device (gcos_mme_inos_) */ 9 80 , 2 command_index fixed bin(17) unal /* pointer to command table entry (gcos_mme_inos_) */ 9 81 , 2 error_retry fixed bin(17) unal /* error retry counter */ 9 82 , 2 seq_no fixed bin(17) unal /* tape reel sequence no */ 9 83 ; 9 84 dcl fibptr ptr /* pointer to current fib in gcos_ext_stat_ */; 9 85 9 86 /* File usage classification constants: */ 9 87 dcl linked_file bit(1)static int options(constant)init("0"b); 9 88 dcl random_file bit(1)static int options(constant)init("1"b); 9 89 dcl read_file bit(1)static int options(constant)init("0"b); 9 90 dcl write_file bit(1)static int options(constant)init("1"b); 9 91 9 92 /* END INCLUDE FILE gcos_file_info_block_.incl.pl1 */ 4 110 4 111 4 112 dcl 1 gcos_ext_stat_$mc like mc /* machine condition from abort or fault */ ext; 10 1 /* */ 10 2 /* BEGIN INCLUDE FILE mc.incl.pl1 Created Dec 72 for 6180 - WSS. */ 10 3 /* Modified 06/07/76 by Greenberg for mc.resignal */ 10 4 /* Modified 07/07/76 by Morris for fault register data */ 10 5 /* Modified 08/28/80 by J. A. Bush for the DPS8/70M CVPU */ 10 6 /* Modified '82 to make values constant */ 10 7 10 8 /* words 0-15 pointer registers */ 10 9 10 10 dcl mcp ptr; 10 11 10 12 dcl 1 mc based (mcp) aligned, 10 13 2 prs (0:7) ptr, /* POINTER REGISTERS */ 10 14 (2 regs, /* registers */ 10 15 3 x (0:7) bit (18), /* index registers */ 10 16 3 a bit (36), /* accumulator */ 10 17 3 q bit (36), /* q-register */ 10 18 3 e bit (8), /* exponent */ 10 19 3 pad1 bit (28), 10 20 3 t bit (27), /* timer register */ 10 21 3 pad2 bit (6), 10 22 3 ralr bit (3), /* ring alarm register */ 10 23 10 24 2 scu (0:7) bit (36), 10 25 10 26 2 mask bit (72), /* mem controller mask at time of fault */ 10 27 2 ips_temp bit (36), /* Temporary storage for IPS info */ 10 28 2 errcode fixed bin (35), /* fault handler's error code */ 10 29 2 fim_temp, 10 30 3 unique_index bit (18) unal, /* unique index for restarting faults */ 10 31 3 resignal bit (1) unal, /* recompute signal name with fcode below */ 10 32 3 fcode bit (17) unal, /* fault code used as index to FIM table and SCT */ 10 33 2 fault_reg bit (36), /* fault register */ 10 34 2 pad2 bit (1), 10 35 2 cpu_type fixed bin (2) unsigned, /* L68 = 0, DPS8/70M = 1 */ 10 36 2 ext_fault_reg bit (15), /* extended fault reg for DPS8/70M CPU */ 10 37 2 fault_time bit (54), /* time of fault */ 10 38 10 39 2 eis_info (0:7) bit (36)) unaligned; 10 40 10 41 10 42 dcl (apx fixed bin init (0), 10 43 abx fixed bin init (1), 10 44 bpx fixed bin init (2), 10 45 bbx fixed bin init (3), 10 46 lpx fixed bin init (4), 10 47 lbx fixed bin init (5), 10 48 spx fixed bin init (6), 10 49 sbx fixed bin init (7)) internal static options (constant); 10 50 10 51 10 52 10 53 10 54 dcl scup ptr; 10 55 10 56 dcl 1 scu based (scup) aligned, /* SCU DATA */ 10 57 10 58 10 59 /* WORD (0) */ 10 60 10 61 (2 ppr, /* PROCEDURE POINTER REGISTER */ 10 62 3 prr bit (3), /* procedure ring register */ 10 63 3 psr bit (15), /* procedure segment register */ 10 64 3 p bit (1), /* procedure privileged bit */ 10 65 10 66 2 apu, /* APPENDING UNIT STATUS */ 10 67 3 xsf bit (1), /* ext seg flag - IT modification */ 10 68 3 sdwm bit (1), /* match in SDW Ass. Mem. */ 10 69 3 sd_on bit (1), /* SDW Ass. Mem. ON */ 10 70 3 ptwm bit (1), /* match in PTW Ass. Mem. */ 10 71 3 pt_on bit (1), /* PTW Ass. Mem. ON */ 10 72 3 pi_ap bit (1), /* Instr Fetch or Append cycle */ 10 73 3 dsptw bit (1), /* Fetch of DSPTW */ 10 74 3 sdwnp bit (1), /* Fetch of SDW non paged */ 10 75 3 sdwp bit (1), /* Fetch of SDW paged */ 10 76 3 ptw bit (1), /* Fetch of PTW */ 10 77 3 ptw2 bit (1), /* Fetch of pre-paged PTW */ 10 78 3 fap bit (1), /* Fetch of final address paged */ 10 79 3 fanp bit (1), /* Fetch of final address non-paged */ 10 80 3 fabs bit (1), /* Fetch of final address absolute */ 10 81 10 82 2 fault_cntr bit (3), /* number of retrys of EIS instructions */ 10 83 10 84 10 85 /* WORD (1) */ 10 86 10 87 2 fd, /* FAULT DATA */ 10 88 3 iro bit (1), /* illegal ring order */ 10 89 3 oeb bit (1), /* out of execute bracket */ 10 90 3 e_off bit (1), /* no execute */ 10 91 3 orb bit (1), /* out of read bracket */ 10 92 3 r_off bit (1), /* no read */ 10 93 3 owb bit (1), /* out of write bracket */ 10 94 3 w_off bit (1), /* no write */ 10 95 3 no_ga bit (1), /* not a gate */ 10 96 3 ocb bit (1), /* out of call bracket */ 10 97 3 ocall bit (1), /* outward call */ 10 98 3 boc bit (1), /* bad outward call */ 10 99 3 inret bit (1), /* inward return */ 10 100 3 crt bit (1), /* cross ring transfer */ 10 101 3 ralr bit (1), /* ring alarm register */ 10 102 3 am_er bit (1), /* associative memory fault */ 10 103 3 oosb bit (1), /* out of segment bounds */ 10 104 3 paru bit (1), /* processor parity upper */ 10 105 3 parl bit (1), /* processor parity lower */ 10 106 3 onc_1 bit (1), /* op not complete type 1 */ 10 107 3 onc_2 bit (1), /* op not complete type 2 */ 10 108 10 109 2 port_stat, /* PORT STATUS */ 10 110 3 ial bit (4), /* illegal action lines */ 10 111 3 iac bit (3), /* illegal action channel */ 10 112 3 con_chan bit (3), /* connect channel */ 10 113 10 114 2 fi_num bit (5), /* (fault/interrupt) number */ 10 115 2 fi_flag bit (1), /* 1 => fault, 0 => interrupt */ 10 116 10 117 10 118 /* WORD (2) */ 10 119 10 120 2 tpr, /* TEMPORARY POINTER REGISTER */ 10 121 3 trr bit (3), /* temporary ring register */ 10 122 3 tsr bit (15), /* temporary segment register */ 10 123 10 124 2 pad2 bit (9), 10 125 10 126 2 cpu_no bit (3), /* CPU number */ 10 127 10 128 2 delta bit (6), /* tally modification DELTA */ 10 129 10 130 10 131 /* WORD (3) */ 10 132 10 133 2 word3 bit (18), 10 134 10 135 2 tsr_stat, /* TSR STATUS for 1,2,&3 word instructions */ 10 136 3 tsna, /* Word 1 status */ 10 137 4 prn bit (3), /* Word 1 PR number */ 10 138 4 prv bit (1), /* Word 1 PR valid bit */ 10 139 3 tsnb, /* Word 2 status */ 10 140 4 prn bit (3), /* Word 2 PR number */ 10 141 4 prv bit (1), /* Word 2 PR valid bit */ 10 142 3 tsnc, /* Word 3 status */ 10 143 4 prn bit (3), /* Word 3 PR number */ 10 144 4 prv bit (1), /* Word 3 PR valid bit */ 10 145 10 146 2 tpr_tbr bit (6), /* TPR.TBR field */ 10 147 10 148 10 149 /* WORD (4) */ 10 150 10 151 2 ilc bit (18), /* INSTRUCTION COUNTER */ 10 152 10 153 2 ir, /* INDICATOR REGISTERS */ 10 154 3 zero bit (1), /* zero indicator */ 10 155 3 neg bit (1), /* negative indicator */ 10 156 3 carry bit (1), /* carryry indicator */ 10 157 3 ovfl bit (1), /* overflow indicator */ 10 158 3 eovf bit (1), /* eponent overflow */ 10 159 3 eufl bit (1), /* exponent underflow */ 10 160 3 oflm bit (1), /* overflow mask */ 10 161 3 tro bit (1), /* tally runout */ 10 162 3 par bit (1), /* parity error */ 10 163 3 parm bit (1), /* parity mask */ 10 164 3 bm bit (1), /* ^bar mode */ 10 165 3 tru bit (1), /* truncation mode */ 10 166 3 mif bit (1), /* multi-word instruction mode */ 10 167 3 abs bit (1), /* absolute mode */ 10 168 3 pad bit (4), 10 169 10 170 10 171 /* WORD (5) */ 10 172 10 173 2 ca bit (18), /* COMPUTED ADDRESS */ 10 174 10 175 2 cu, /* CONTROL UNIT STATUS */ 10 176 3 rf bit (1), /* on first cycle of repeat instr */ 10 177 3 rpt bit (1), /* repeat instruction */ 10 178 3 rd bit (1), /* repeat double instruction */ 10 179 3 rl bit (1), /* repeat link instruciton */ 10 180 3 pot bit (1), /* IT modification */ 10 181 3 pon bit (1), /* return type instruction */ 10 182 3 xde bit (1), /* XDE from Even location */ 10 183 3 xdo bit (1), /* XDE from Odd location */ 10 184 3 poa bit (1), /* operation preparation */ 10 185 3 rfi bit (1), /* tells CPU to refetch instruction */ 10 186 3 its bit (1), /* ITS modification */ 10 187 3 if bit (1), /* fault occured during instruction fetch */ 10 188 10 189 2 cpu_tag bit (6)) unaligned, /* computed tag field */ 10 190 10 191 10 192 /* WORDS (6,7) */ 10 193 10 194 2 even_inst bit (36), /* even instruction of faulting pair */ 10 195 10 196 2 odd_inst bit (36); /* odd instruction of faulting pair */ 10 197 10 198 10 199 10 200 10 201 10 202 10 203 /* ALTERNATE SCU DECLARATION */ 10 204 10 205 10 206 dcl 1 scux based (scup) aligned, 10 207 10 208 (2 pad0 bit (36), 10 209 10 210 2 fd, /* GROUP II FAULT DATA */ 10 211 3 isn bit (1), /* illegal segment number */ 10 212 3 ioc bit (1), /* illegal op code */ 10 213 3 ia_am bit (1), /* illegal address - modifier */ 10 214 3 isp bit (1), /* illegal slave procedure */ 10 215 3 ipr bit (1), /* illegal procedure */ 10 216 3 nea bit (1), /* non existent address */ 10 217 3 oobb bit (1), /* out of bounds */ 10 218 3 pad bit (29), 10 219 10 220 2 pad2 bit (36), 10 221 10 222 2 pad3a bit (18), 10 223 10 224 2 tsr_stat (0:2), /* TSR STATUS as an ARRAY */ 10 225 3 prn bit (3), /* PR number */ 10 226 3 prv bit (1), /* PR valid bit */ 10 227 10 228 2 pad3b bit (6)) unaligned, 10 229 10 230 2 pad45 (0:1) bit (36), 10 231 10 232 2 instr (0:1) bit (36); /* Instruction ARRAY */ 10 233 10 234 10 235 10 236 /* END INCLUDE FILE mc.incl.pl1 */ 4 113 4 114 4 115 dcl 1 gcos_ext_stat_$gcos_gtss ext 4 116 , 3 gcos_gtss_ext 4 117 , 4 u_state_ptr ptr 4 118 , 4 snumb_index fixed bin(24) 4 119 , 4 home_path char(168) 4 120 ; 4 121 4 122 /* END INCLUDE FILE gcos_ext_stat_.incl.pl1 */ 2010 2011 11 1 /* BEGIN INCLUDE FILE gcos_dbs_names.incl.pl1 (Wardd Multics) 06/08/81 1626.9 mst Mon */ 11 2 11 3 dcl dbs_names (11)char(14)var static int options(constant)init( 11 4 /* 1 */ "attach_file" 11 5 , /* 2 */ "dollar" 11 6 , /* 3 */ "filecode" 11 7 , /* 4 */ "mme_call" 11 8 , /* 5 */ "mme_inos_trace" 11 9 , /* 6 */ "trace_mme" 11 10 , /* 7 */ "nondollar" 11 11 , /* 8 */ "open_file" 11 12 , /* 9 */ "msf_test" 11 13 , /* 10 */ "stop_mme" 11 14 , /* 11 */ "mme_inos_stop" 11 15 ); 11 16 11 17 dcl ( 11 18 dbs_attach_file defined(gcos_ext_stat_$dbs(1)) 11 19 ,dbs_dollar defined(gcos_ext_stat_$dbs(2)) 11 20 ,dbs_filecode defined(gcos_ext_stat_$dbs(3)) 11 21 ,dbs_mme_call defined(gcos_ext_stat_$dbs(4)) 11 22 ,dbs_mme_inos_trace defined(gcos_ext_stat_$dbs(5)) 11 23 ,dbs_trace_mme defined(gcos_ext_stat_$dbs(6)) 11 24 ,dbs_nondollar defined(gcos_ext_stat_$dbs(7)) 11 25 ,dbs_open_file defined(gcos_ext_stat_$dbs(8)) 11 26 ,dbs_msf_test defined(gcos_ext_stat_$dbs(9)) 11 27 ,dbs_stop_mme defined(gcos_ext_stat_$dbs(10)) 11 28 ,dbs_mme_inos_stop defined(gcos_ext_stat_$dbs(11)) 11 29 ) bit(1); 11 30 11 31 /* END INCLUDE FILE gcos_dbs_names.incl.pl1 */ 2012 2013 end gcos_mme_inos_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/09/83 1007.6 gcos_mme_inos_.pl1 >spec>on>09/07/83-gcos>gcos_mme_inos_.pl1 1709 1 03/27/82 0424.8 gcos_next_arg.incl.pl1 >ldd>include>gcos_next_arg.incl.pl1 2006 2 03/27/82 0424.8 gcos_dcl_ios_.incl.pl1 >ldd>include>gcos_dcl_ios_.incl.pl1 2008 3 03/27/82 0424.8 gcos_xlate_bcd_ascii_.incl.pl1 >ldd>include>gcos_xlate_bcd_ascii_.incl.pl1 2010 4 09/08/83 1229.3 gcos_ext_stat_.incl.pl1 >spec>on>09/07/83-gcos>gcos_ext_stat_.incl.pl1 4-100 5 03/27/82 0424.8 gcos_save_mc.incl.pl1 >ldd>include>gcos_save_mc.incl.pl1 4-104 6 03/27/82 0424.8 gcos_fct_entry.incl.pl1 >ldd>include>gcos_fct_entry.incl.pl1 4-108 7 03/27/82 0424.8 gcos_save_data_entry.incl.pl1 >ldd>include>gcos_save_data_entry.incl.pl1 7-29 8 09/08/83 1230.3 gcos_flags.incl.pl1 >spec>on>09/07/83-gcos>gcos_flags.incl.pl1 4-110 9 03/27/82 0424.8 gcos_file_info_block_.incl.pl1 >ldd>include>gcos_file_info_block_.incl.pl1 4-113 10 08/17/83 1135.7 mc.incl.pl1 >ldd>include>mc.incl.pl1 2012 11 03/27/82 0424.8 gcos_dbs_names.incl.pl1 >ldd>include>gcos_dbs_names.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. IONTP constant bit(2) initial unaligned dcl 1819 ref 1409 1414 1555 IOTD constant bit(2) initial unaligned dcl 1819 ref 1255 1435 1571 IOTP constant bit(2) initial unaligned dcl 1819 ref 1433 1434 TDCW constant bit(2) initial unaligned dcl 1819 ref 1247 1396 1545 1549 action 0(22) based bit(2) level 2 packed unaligned dcl 1855 set ref 1247 1255 1389 1396 1409 1434 1540 1545 1549 1555 1571 addr builtin function dcl 1-31 in procedure "next_arg" ref 1-12 1-27 addr builtin function dcl 1713 in procedure "gcos_mme_inos_" ref 150 151 322 322 384 384 526 762 762 909 909 921 921 923 923 923 923 928 928 985 1119 1145 1154 1155 1237 1237 1380 1380 1492 1533 1533 1555 addrel builtin function dcl 1714 ref 152 160 203 211 219 543 544 813 858 945 945 1206 1245 1388 1495 1539 1548 1558 1581 1582 1624 1625 arg based char unaligned dcl 1715 set ref 1175 1175 1183* 1187 arg_string parameter char unaligned dcl 1170 set ref 1167 1-12 1-13 arglen 000100 automatic fixed bin(24,0) dcl 1716 set ref 1173* 1175 1175 1183 1183 1187 argp 000102 automatic pointer dcl 1717 set ref 1173* 1175 1175 1183 1187 1461* ascii_index 000104 automatic fixed bin(21,0) dcl 1718 set ref 849* 871 872* 872 894* 894 895 900 909 909* ascii_string 000105 automatic char(132) unaligned dcl 1719 set ref 871* 895* 909 909 921 921 923 923 bcd_string based bit(6) array unaligned dcl 1720 ref 862 864 866 867 869 882 888 889 bcw based structure level 1 dcl 1214 bksp_sw 000146 automatic bit(1) unaligned dcl 1721 set ref 415* 431 468* blk_size 0(18) based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1214 ref 1206 bp parameter pointer dcl 1614 in procedure "scatter_input" ref 1608 1624 bp parameter pointer dcl 1204 in procedure "adjust_buffer" ref 1198 1206 1206 buffer based pointer level 2 dcl 9-10 set ref 526 526* 532* 533* 535* 543 557* 1053* cc 0(05) 000146 external static bit(1) level 4 packed unaligned dcl 4-106 set ref 1091 1109* 1131 1140* cc_residue 000147 automatic fixed bin(24,0) dcl 1722 set ref 927* 1080 1080 1454* char 000150 automatic char(1) dcl 1723 set ref 866* 867* 883* 884* 889* 895 code 010312 automatic fixed bin(35,0) level 2 dcl 2-76 set ref 363 365* 392 635 733 958 960* 1314 1314* 1327 1327* command 000056 constant bit(36) initial array level 2 packed unaligned dcl 1894 ref 1593 1593 command_count 74 based fixed bin(17,0) level 2 packed unaligned dcl 9-10 set ref 1341* 1347* 1353* 1359* 1592 command_index 74(18) based fixed bin(17,0) level 2 packed unaligned dcl 9-10 set ref 1342* 1348* 1354* 1360* 1586 1592 1592 console 60(08) based bit(1) level 4 packed unaligned dcl 9-10 ref 1351 continuation parameter bit(1) unaligned dcl 1529 set ref 1511 1571* continue 000151 automatic bit(1) unaligned dcl 1724 set ref 303* 376 522 548 819 904 1410* 1428* 1436* 1632 count 000152 automatic fixed bin(21,0) dcl 1725 in procedure "gcos_mme_inos_" set ref 295 300 302 304* 308 321 322* 333 340* 349* 374 545 546 554 807 808 809* 811 860 947 1259* 1376* 1411 1412* 1413* 1424 1426 1431* 1431 1618 1619 1621* 1626 1628 1629 1630 count 0(24) based fixed bin(12,0) level 2 in structure "dcw" packed unsigned unaligned dcl 1855 in procedure "gcos_mme_inos_" set ref 204 1252 1253 1412 1413 1421 1422 1560 1562 count 0(30) based fixed bin(6,0) level 2 in structure "op_word" packed unsigned unaligned dcl 1831 in procedure "gcos_mme_inos_" set ref 428 630 829 912 1257 1259* courtesy_call 000142 external static structure level 2 in structure "gcos_ext_stat_$courtesy_call_control" dcl 4-92 in procedure "gcos_mme_inos_" courtesy_call 0(18) based fixed bin(18,0) level 2 in structure "return_word" packed unsigned unaligned dcl 1847 in procedure "gcos_mme_inos_" ref 1089 1104 1118 1484 courtesy_call_conditions based structure level 1 packed unaligned dcl 1817 current 65 based fixed bin(21,0) level 2 dcl 9-10 set ref 212* 292 308* 308 310 373 382* 382 393 407* 433* 433 434 434* 435 440* 450 453* 1312 1313* 1314* 1326* 1327* d 010342 automatic fixed bin(24,0) dcl 1276 set ref 1234* 1237 1237 1245 1248* 1254* 1254 da_residue 000153 automatic fixed bin(24,0) dcl 1726 set ref 296* 374* 502* 554* 948* 1079 1454* 1630* data_addr based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1855 set ref 204 211 502 1248 1404 1424 1426 1547 1555 1558 data_ptr parameter pointer dcl 1527 set ref 1511 1555* 1558* db 000042 constant entry external dcl 1727 ref 1304 dbs_filecode defined bit(1) unaligned dcl 11-17 set ref 1174* dbs_mme_inos_stop defined bit(1) unaligned dcl 11-17 ref 148 1302 dbs_mme_inos_trace defined bit(1) unaligned dcl 11-17 ref 148 1292 dcw based structure level 1 dcl 1855 set ref 1389* 1540* dcw_offset 000156 automatic fixed bin(24,0) dcl 1729 set ref 197 203 1234 1380 1380 1388 1404* 1415* 1415 1432* 1432 1533 1533 1539 1547* 1548 1573* 1573 1583* dcwp 0(18) based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1839 ref 1583 dcwptr 000154 automatic pointer dcl 1728 set ref 203* 204 204 211 502 1245* 1247 1248 1252 1253 1255 1388* 1389 1389 1396 1404 1409 1412 1413 1421 1422 1424 1426 1434 1461* 1539* 1540 1540 1545 1547 1548* 1549 1555 1555 1558 1560 1562 1571 default_high 000530 constant char(5) initial unaligned dcl 1730 ref 689 default_low 000573 constant char(4) initial unaligned dcl 1731 ref 690 dens_hist 60(27) based bit(2) level 4 packed unaligned dcl 9-10 set ref 733* density 60(23) based bit(4) level 4 packed unaligned dcl 9-10 ref 687 688 694 695 696 697 density_history 000157 automatic bit(2) dcl 1732 set ref 674* 682* 704* 712* 720* 728* 733 741* dev_com based bit(6) level 2 packed unaligned dcl 1831 set ref 1293* 1593 1598* device_cmd 000204 constant bit(6) initial array level 2 packed unaligned dcl 1648 ref 1642 1643 disk 000051 constant fixed bin(24,0) initial level 2 dcl 1885 ref 1359 1360 divide builtin function dcl 1733 ref 450 926 error_retry 75 based fixed bin(17,0) level 2 in structure "fib" packed unaligned dcl 9-10 in procedure "gcos_mme_inos_" set ref 981* 981 error_retry 000160 automatic bit(1) dcl 1734 in procedure "gcos_mme_inos_" set ref 486* 521* 981 1028 1029* fb35 based fixed bin(35,0) dcl 1735 ref 985 fc 000161 automatic char(2) unaligned dcl 1736 set ref 161* 162* 164 172 172 172 172* 175* 181* 231* 245* 264* 365* 420* 440* 960* 1062* 1259* 1287 1293* 1314* 1327* 1398* 1503 1549* 1598* fcode 0(24) based bit(12) level 2 packed unaligned dcl 1843 ref 161 162 fct 000144 external static structure array level 2 dcl 4-102 fct_entry based structure level 1 dcl 6-3 fib based structure level 1 dcl 9-10 fibptr 2 000144 external static pointer array level 3 in structure "gcos_ext_stat_$fct" dcl 4-102 in procedure "gcos_mme_inos_" ref 188 fibptr 010314 automatic pointer dcl 9-84 in procedure "gcos_mme_inos_" set ref 188* 196 212 226 227 238 239 243 245 254 262 263 271 272 275 291 292 292 292 308 308 310 310 319 319 322 340 340 349 362 365 365 373 373 373 373 379 382 382 383 384 393 393 393 393 404 405 407 420 426 433 433 434 434 435 435 440 440 440 450 450 453 453 488 489 491 493 499 510 512 513 517 526 526 529 532 532 533 535 543 557 557 566 571 573 582 634 687 688 694 695 696 697 732 733 754 762 771 776 778 787 813* 945 981 981 1036 1043 1045 1045 1050 1053 1053 1082 1087 1087 1259 1312 1312 1313 1313 1314 1323 1326 1326 1327 1339 1341 1342 1345 1347 1348 1351 1353 1354 1359 1360 1586 1592 1592 1592 fibs 322 000146 external static structure array level 3 dcl 4-106 ref 1502 file_code_word based structure level 1 dcl 1843 filecode 000144 external static char(2) array level 3 dcl 4-102 ref 1503 filep based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1839 ref 154 160 fixed builtin function dcl 1737 ref 161 162 882 889 1389 1540 flags based structure level 1 dcl 8-8 flgs 000146 external static structure level 3 dcl 4-106 gcos_cv_ascii_gebcd_ 000044 constant entry external dcl 1738 ref 923 gcos_et_$access_beyond_file 000046 external static fixed bin(35,0) dcl 1739 set ref 440* gcos_et_$bad_cc_ptr 000050 external static fixed bin(35,0) dcl 1740 set ref 1484* gcos_et_$bad_io_cmnd_file 000052 external static fixed bin(35,0) dcl 1741 set ref 245* 420* 1598* gcos_et_$bad_mme_in_cc 000054 external static fixed bin(35,0) dcl 1742 set ref 1096* gcos_et_$bad_multirec 000056 external static fixed bin(35,0) dcl 1743 set ref 1259* gcos_et_$bad_seek_dcw 000060 external static fixed bin(35,0) dcl 1744 set ref 204* gcos_et_$bad_status_ret_ptr 000062 external static fixed bin(35,0) dcl 1745 set ref 1478* gcos_et_$fc_not_defined 000064 external static fixed bin(35,0) dcl 1746 set ref 164* 175* 181* gcos_et_$geendc_not_in_cc 000066 external static fixed bin(35,0) dcl 1747 set ref 1131* gcos_et_$impermissible_perm_read 000070 external static fixed bin(35,0) dcl 1748 set ref 231* gcos_et_$impermissible_perm_write 000072 external static fixed bin(35,0) dcl 1749 set ref 264* gcos_et_$invalid_dcw_ptr 000074 external static fixed bin(35,0) dcl 1750 set ref 197* 1237* 1380* 1533* gcos_et_$invalid_file_ptr 000076 external static fixed bin(35,0) dcl 1751 set ref 154* gcos_et_$irrecoverable_io_err 000100 external static fixed bin(35,0) dcl 1752 set ref 1062* gcos_et_$request_too_big 000102 external static fixed bin(35,0) dcl 1754 set ref 1564* gcos_et_$two_tdcws 000104 external static fixed bin(35,0) dcl 1755 set ref 1398* 1549* gcos_ext_stat_$courtesy_call_control 000142 external static structure level 1 dcl 4-92 gcos_ext_stat_$dbs 000130 external static bit(1) array unaligned dcl 4-19 set ref 148 148 148 148 1174* 1174 1292 1292 1302 1302 gcos_ext_stat_$fct 000144 external static structure level 1 dcl 4-102 gcos_ext_stat_$gcos_slave_area_seg 000132 external static pointer dcl 4-27 ref 146 gcos_ext_stat_$increment_hold 000134 external static fixed bin(24,0) dcl 4-30 set ref 1116* 1142 gcos_ext_stat_$save_data 000146 external static structure level 1 dcl 4-106 gcos_ext_stat_$storage_limit 000136 external static fixed bin(19,0) dcl 4-60 ref 147 gcos_ext_stat_$tape_buffer_size 000140 external static fixed bin(35,0) dcl 4-64 set ref 1564 1564* gcos_mme_bort_$system 000106 constant entry external dcl 1756 ref 154 164 175 181 197 204 231 245 264 365 420 440 960 1062 1096 1131 1237 1259 1314 1327 1380 1398 1478 1484 1533 1549 1564 1598 gcos_write_$bcd_ptr 000110 constant entry external dcl 1757 ref 813 gseg 000162 automatic pointer dcl 1758 set ref 146* 152 160 203 211 340* 349* 544 813 858 945 945 1245 1388 1495 1539 1548 1558 1625 hbound builtin function dcl 1759 ref 1094 1096 1160 1183 1183 1183 1502 1642 hold 000142 external static structure level 3 dcl 4-92 set ref 1117* 1145 holdcount 010400 automatic fixed bin(24,0) dcl 1439 set ref 1421* 1422* 1431 how_many parameter fixed bin(21,0) dcl 1528 set ref 1511 1560* 1562* 1564 1564* i 000164 automatic fixed bin(21,0) dcl 1760 in procedure "gcos_mme_inos_" set ref 151* 152 211* 212 213* 630* 631 631* 633 636 800* 860* 862 863* 863 864 865* 865 866 867 869 882 888 889* 921* 922* 922 923 923* 923* 926 927 1118* 1120 1177* 1179* 1179* 1286* 1287* 1469* 1592* 1593 1593 1593* i parameter fixed bin(24,0) dcl 1-8 in procedure "next_arg" ref 1-2 1-11 i 000100 automatic fixed bin(24,0) dcl 1647 in procedure "type_op" set ref 1642* 1643 1643* ibuffptr 000166 automatic pointer dcl 1761 set ref 543* 545 1461* 1624* 1626 ici_regs 34 based fixed bin(35,0) level 2 dcl 1862 set ref 1148* 1148 id_word based structure level 1 dcl 1839 idptr 000170 automatic pointer dcl 1762 set ref 152* 154 160 219* 219 1581 1582 1583 ilc 4 based bit(18) level 2 packed unaligned dcl 10-56 set ref 151 1119 1155 1259* 1598* increment parameter fixed bin(24,0) dcl 141 set ref 6 145* 218* 218 1116 1120* 1125 1142* 1155* index builtin function dcl 1-32 in procedure "next_arg" ref 1-16 index 000051 constant structure level 1 unaligned dcl 1885 in procedure "gcos_mme_inos_" indicators 60 based structure level 2 dcl 9-10 indicators_word_1 60 based structure level 3 dcl 9-10 instruction_counter based fixed bin(18,0) unsigned unaligned dcl 1763 ref 151 1119 1155 internal_buffer based fixed bin(35,0) array dcl 1764 set ref 545* 1626 io 000056 constant structure array level 1 unaligned dcl 1894 ioa_ 000112 constant entry external dcl 1765 ref 213 967 1085 1176 1179 1183 1293 1303 1389 1540 ioc_com 0(18) based bit(5) level 2 packed unaligned dcl 1831 set ref 1228 1593 iocount 72 based fixed bin(35,0) level 2 dcl 9-10 set ref 1087* 1087 ios_$order 000114 constant entry external dcl 2-18 ref 493 517 634 732 754 762 1043 1045 ios_$read 000116 constant entry external dcl 2-25 ref 349 499 532 ios_$read_ptr 000120 constant entry external dcl 2-34 ref 921 ios_$seek 000122 constant entry external dcl 2-45 ref 1313 1326 ios_$write 000124 constant entry external dcl 2-61 ref 322 340 384 557 1053 ios_$write_ptr 000126 constant entry external dcl 2-70 ref 909 j 000172 automatic fixed bin(24,0) dcl 1766 set ref 181 188 428* 429 429* 430* 430 431* 431 433 633* 636* 811* 813 813 882* 883 1119* 1120 1502* 1503* k 010456 automatic fixed bin(24,0) dcl 1-33 in procedure "next_arg" set ref 1-16* 1-18 1-26 1-27 1-28 k 000173 automatic fixed bin(24,0) dcl 1767 in procedure "gcos_mme_inos_" set ref 1172* 1173* l parameter fixed bin(24,0) dcl 1-9 set ref 1-2 1-19* 1-26* last 66 based fixed bin(21,0) level 2 dcl 9-10 set ref 292 373* 373 393* 393 1312 length builtin function dcl 1-34 ref 1-13 linked_file constant bit(1) initial unaligned dcl 9-87 ref 291 319 379 m parameter bit(1) unaligned dcl 1227 set ref 1219 1229* 1273* major_status 000174 automatic bit(4) dcl 1768 set ref 969* 972 972 976 993 993 997 1004 max builtin function dcl 1769 ref 304 373 393 mc based structure level 1 dcl 10-12 mc_save_data based structure level 1 unaligned dcl 1862 mc_save_ptr 000176 automatic pointer dcl 1770 set ref 1145* 1146 1147 1148 1149 1461* mcp 010316 automatic pointer dcl 10-10 set ref 144* 150 1117 1137* 1146 1147 1148 1149 1154 mcpp parameter pointer dcl 143 ref 6 144 1125 1137 minor_status 000200 automatic bit(6) dcl 1771 set ref 970* 976 999 1007 1013 1013 1018 1018 mod builtin function dcl 1772 ref 927 1094 1160 mode 60(19) based bit(2) level 4 packed unaligned dcl 9-10 set ref 489 491* 512 513* 571 573* 776 778* more_dcws 000201 automatic bit(1) unaligned dcl 1773 set ref 496* 497 498* mr 000202 automatic bit(1) unaligned dcl 1774 set ref 254* 276* 300 379 1445* multirecord_com constant bit(5) initial unaligned dcl 1775 ref 1228 mybuf 000203 automatic bit(6) array unaligned dcl 1776 set ref 923 923 928 928 n 000236 automatic fixed bin(24,0) dcl 1777 set ref 795* 800 829* 830 830* name_cmd 0(09) 000204 constant char(28) initial array level 2 packed unaligned dcl 1648 ref 1643 nb 010343 automatic fixed bin(24,0) dcl 1277 set ref 1257* 1258 1258* 1259 1259* nelemt 000237 automatic fixed bin(21,0) dcl 1778 set ref 321* 322* 340* 349* 361 384* 499* 501 502 503 532* 557* 926* 947 948 1036 1036 1053* 1206 1206 1206 1206* 1206 1454* 1618 1619 1620 1621 1628* 1628 new_next_avail 000240 automatic fixed bin(24,0) dcl 1779 set ref 1094* 1096 1106 next 4 000051 constant fixed bin(24,0) initial level 2 dcl 1885 ref 1353 next_avail 60 000142 external static fixed bin(24,0) level 3 dcl 4-92 set ref 1094 1104 1106* 1139 next_out 61 000142 external static fixed bin(24,0) level 3 dcl 4-92 set ref 1096 1139 1155 1160* 1160 null builtin function dcl 1780 in procedure "gcos_mme_inos_" ref 493 493 517 517 526 634 634 732 732 754 754 1043 1043 1045 1045 1461 1-21 null 60(11) based bit(1) level 4 in structure "fib" packed unaligned dcl 9-10 in procedure "gcos_mme_inos_" ref 227 263 405 426 op parameter bit(6) unaligned dcl 1641 ref 1638 1643 op_word based structure level 1 dcl 1831 set ref 1293* 1598 1598 operation_word_values 000204 constant structure array level 1 packed unaligned dcl 1648 opptr 000242 automatic pointer dcl 1781 set ref 428 630 829 912 1228 1257 1259 1293 1293 1293 1293 1461* 1581* 1593 1593 1598 1598 1598 order 000244 automatic char(20) unaligned dcl 1782 in procedure "gcos_mme_inos_" set ref 492* 493* 514* 517* 574* 590* 597* 604* 611* 618* 625* 634* 659* 666* 673* 681* 689 689* 690* 703* 711* 719* 727* 732* 740* 748* 754* 779* order 60(18) based bit(1) level 4 in structure "fib" packed unaligned dcl 9-10 in procedure "gcos_mme_inos_" set ref 238 239* 245 271 272* 292 319 340 365 373 383 393 488* 510* 529 566* 582* 771* 787* 945 1036 1045 1050 1082 1259 1323 output_ptr 000252 automatic pointer dcl 1783 set ref 498* 499* override 000254 automatic fixed bin(24,0) dcl 1784 set ref 749* 763* 985 985* 989 989 1010 1026 1036 1454* p parameter pointer dcl 1-10 set ref 1-2 1-17* pl_regs 50 based fixed bin(35,0) array level 2 dcl 1862 set ref 1149* 1149 posit 000255 automatic fixed bin(21,0) dcl 1785 set ref 538* 543 546* 546 557* 1053* 1616* 1624 1629* 1629 pr_regs based fixed bin(35,0) array level 2 dcl 1862 set ref 1146* 1146 print 60(04) based bit(1) level 4 packed unaligned dcl 9-10 ref 404 1345 printer 2 000051 constant fixed bin(24,0) initial level 2 dcl 1885 ref 1341 1347 1348 process 1 000056 constant fixed bin(24,0) initial array level 2 dcl 1894 ref 1593 queue 62 000142 external static fixed bin(24,0) array level 3 dcl 4-92 set ref 1094 1096 1104* 1155 1160 r18 0(18) based bit(18) level 2 packed unaligned dcl 1826 set ref 1237* 1237* 1380* 1380* 1533* 1533* random_file constant bit(1) initial unaligned dcl 9-88 ref 196 243 254 275 365 420 440 read 60(09) based bit(1) level 4 packed unaligned dcl 9-10 ref 226 read_file constant bit(1) initial unaligned dcl 9-89 ref 239 245 271 292 365 488 529 566 771 945 1036 1082 1259 rec_ct_residue 000256 automatic fixed bin(24,0) dcl 1787 set ref 450* 451 636* 965 record based char unaligned dcl 1786 set ref 813* rel builtin function dcl 1788 ref 1293 1293 retry_count 000257 automatic fixed bin(24,0) dcl 1789 set ref 1028* 1030* 1030 1031 1045 return_word based structure level 1 dcl 1847 rl 000036 internal static fixed bin(24,0) dcl 1-35 set ref 1-13* 1-15 1-16 1-19 1-20* 1-28* 1-28 rp 000040 internal static pointer dcl 1-36 set ref 1-12* 1-16 1-17 1-21* 1-27* 1-27 rs based char unaligned dcl 1-37 ref 1-16 rs2 based char(1) array unaligned dcl 1-38 set ref 1-27 s_regs 20 based fixed bin(35,0) array level 2 dcl 1862 set ref 1147* 1147 save_data 000146 external static structure level 2 dcl 4-106 save_data_entry based structure level 1 dcl 7-5 save_machine_conditions based structure level 1 packed unaligned dcl 5-6 save_space based bit(1728) level 2 packed unaligned dcl 1817 ref 1117 sbuffptr 000260 automatic pointer dcl 1790 set ref 544* 545 1461* 1625* 1626 sc_ga 000264 automatic bit(1) unaligned dcl 1792 set ref 525* 1036 1049 1445* scratch_status 000262 automatic bit(72) dcl 1791 set ref 1492 1493* scu 30 based bit(36) array level 2 in structure "mc" packed unaligned dcl 10-12 in procedure "gcos_mme_inos_" set ref 150 1154 scu based structure level 1 dcl 10-56 in procedure "gcos_mme_inos_" scup 010320 automatic pointer dcl 10-54 set ref 150* 151 1119 1154* 1155 1259 1598 seek_address based fixed bin(24,0) dcl 1794 ref 211 seek_pointer 000266 automatic char(5) unaligned dcl 1795 set ref 1323* 1324* 1326* seeksw 000265 automatic bit(1) unaligned dcl 1793 set ref 195* 245 1445* size 67 based fixed bin(24,0) level 2 dcl 9-10 set ref 310 435 440* 450 453 slave_buffer based fixed bin(35,0) array dcl 1796 set ref 545 1626* slave_status 000270 automatic bit(36) dcl 1797 set ref 228* 294* 448* 451* 762 762 876* 963* 965* 967* 1034* 1062* 1076 1452* sptr 000272 automatic pointer dcl 1798 set ref 1089 1104 1118 1461* 1478 1484 1490 1495 1582* stat_words based structure level 1 dcl 1851 status 010312 automatic structure level 1 unaligned dcl 2-76 set ref 322* 340* 349* 384* 493* 499* 517* 532* 557* 634* 732* 754* 762* 955 963 969 970 1043* 1045* 1053* 1313* 1326* 1450* status_return based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1847 ref 1478 1490 1495 storlimit 000274 automatic fixed bin(19,0) dcl 1799 set ref 147* 154 197 204 1237 1237 1380 1380 1478 1484 1533 1533 stream 3 based char(8) level 2 packed unaligned dcl 9-10 set ref 322* 340* 349* 384* 493* 499* 517* 532* 557* 634* 732* 754* 762* 1043* 1045* 1053* 1313* 1326* substr builtin function dcl 1800 set ref 161* 161 162* 162 228* 294* 448* 451* 451 871* 876* 895* 955 963* 963 965* 965 969 970 985 1079* 1079 1080* 1080 1082* 1083* 1084* 1084 1593 1593 successive_tdcws 010401 automatic fixed bin(24,0) dcl 1440 in procedure "get_dcw" set ref 1377* 1397* 1397 1398 1407* successive_tdcws 000275 automatic fixed bin(17,0) dcl 1801 in procedure "gcos_mme_inos_" set ref 1531* sw1 based bit(36) level 2 dcl 1851 set ref 985 985 1076* 1085* sw2 1 based bit(36) level 2 dcl 1851 set ref 1077* 1079* 1080* 1082* 1083* 1084* 1085* swptr 000276 automatic pointer dcl 1802 set ref 985 985 1076 1077 1079 1080 1082 1083 1084 1085 1085 1461* 1492* 1495* sysout 1 000144 external static bit(1) array level 3 packed unaligned dcl 4-102 ref 181 t 010344 automatic fixed bin(24,0) dcl 1278 set ref 1233* 1252* 1252 1253* 1253 1259 tape 1 000051 constant fixed bin(24,0) initial level 2 in structure "index" dcl 1885 in procedure "gcos_mme_inos_" ref 1341 1342 1359 tape 60(07) based bit(1) level 4 in structure "fib" packed unaligned dcl 9-10 in procedure "gcos_mme_inos_" ref 362 1339 tapebuffer 000300 automatic bit(36) array dcl 1803 set ref 526 1555 total_count 010300 automatic fixed bin(24,0) dcl 1804 set ref 300 302 304 361* 361 379 382 384 1454* total_read 010302 automatic fixed bin(36,0) dcl 1805 set ref 487* 501* 501 trace_array 000010 internal static char(4) array unaligned dcl 1806 set ref 1179* 1183 1183 1183 1187* 1287 trace_index 000034 internal static fixed bin(24,0) initial dcl 1807 set ref 1176 1177 1183 1186* 1186 1187 1284 1286 trace_or_stopsw 000035 internal static bit(1) initial unaligned dcl 1808 set ref 148* 213 967 1085 1389 1540 1584 transfer_count 010304 automatic fixed bin(21,0) dcl 1809 set ref 498* 499* 503 translate builtin function dcl 1810 ref 1187 type 60(02) based bit(1) level 4 packed unaligned dcl 9-10 ref 196 243 254 275 291 319 365 379 420 440 type_dcw 010305 automatic bit(2) unaligned dcl 1811 set ref 1083 1414* 1433* 1435* 1445* typewriter 3 000051 constant fixed bin(24,0) initial level 2 dcl 1885 ref 1347 1353 1354 unspec builtin function dcl 1812 set ref 451 883* 884* 955 963 965 969 970 1079 1080 1084 1450* 1598 1598 w based structure level 1 dcl 1826 wc_residue 010306 automatic fixed bin(24,0) dcl 1813 set ref 295* 302* 503* 555* 947* 1084 1454* 1616* 1619* 1619 where 010307 automatic fixed bin(21,0) dcl 1814 set ref 296 318 340* 349* 374 522 541 544 554 806 813 856 858 945 945 948 1416* 1424* 1426 1623 1625 1630 word based bit(36) dcl 1212 ref 1206 workp 010310 automatic pointer dcl 1815 set ref 160* 161 162 858* 862 864 866 867 869 882 888 889 write 60(10) based bit(1) level 4 packed unaligned dcl 9-10 ref 262 write_file constant bit(1) initial unaligned dcl 9-90 ref 238 272 319 340 373 383 393 510 582 787 1045 1050 1323 xlate 000510 constant char(1) initial array unaligned dcl 3-6 ref 161 162 889 z320 010362 constant bit(36) initial array unaligned dcl 1816 set ref 322 322 384 384 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. abx internal static fixed bin(17,0) initial dcl 10-42 apx internal static fixed bin(17,0) initial dcl 10-42 bbx internal static fixed bin(17,0) initial dcl 10-42 bpx internal static fixed bin(17,0) initial dcl 10-42 dbs_attach_file defined bit(1) unaligned dcl 11-17 dbs_dollar defined bit(1) unaligned dcl 11-17 dbs_mme_call defined bit(1) unaligned dcl 11-17 dbs_msf_test defined bit(1) unaligned dcl 11-17 dbs_names internal static varying char(14) initial array dcl 11-3 dbs_nondollar defined bit(1) unaligned dcl 11-17 dbs_open_file defined bit(1) unaligned dcl 11-17 dbs_stop_mme defined bit(1) unaligned dcl 11-17 dbs_trace_mme defined bit(1) unaligned dcl 11-17 gcos_et_$need_multirec external static fixed bin(35,0) dcl 1753 gcos_ext_stat_$abort_reason external static varying char(128) dcl 4-13 gcos_ext_stat_$abort_return external static label variable dcl 4-14 gcos_ext_stat_$activity_card_num external static picture(4) unaligned dcl 4-15 gcos_ext_stat_$activity_name external static char(8) unaligned dcl 4-16 gcos_ext_stat_$activity_start_time external static fixed bin(71,0) dcl 4-17 gcos_ext_stat_$card_num external static picture(4) unaligned dcl 4-18 gcos_ext_stat_$default_nondollar external static char(2) unaligned dcl 4-20 gcos_ext_stat_$dir_rings external static fixed bin(3,0) array dcl 4-21 gcos_ext_stat_$dpno external static varying char(100) dcl 4-22 gcos_ext_stat_$dpo external static varying char(100) dcl 4-23 gcos_ext_stat_$endfc external static char(2) unaligned dcl 4-24 gcos_ext_stat_$er external static pointer dcl 4-25 gcos_ext_stat_$etc_filecode external static char(2) unaligned dcl 4-26 gcos_ext_stat_$gcos_gtss external static structure level 1 unaligned dcl 4-115 gcos_ext_stat_$gf external static fixed bin(24,0) dcl 4-28 gcos_ext_stat_$incode external static fixed bin(24,0) dcl 4-29 gcos_ext_stat_$initial_cpu_time external static fixed bin(71,0) dcl 4-31 gcos_ext_stat_$input_segment_path external static varying char(168) dcl 4-32 gcos_ext_stat_$jcl_warnings external static fixed bin(24,0) dcl 4-33 gcos_ext_stat_$job_cpu_time external static fixed bin(71,0) dcl 4-34 gcos_ext_stat_$job_id external static varying char(18) dcl 4-35 gcos_ext_stat_$job_real_time external static fixed bin(71,0) dcl 4-36 gcos_ext_stat_$last_mme external static fixed bin(24,0) dcl 4-37 gcos_ext_stat_$ldrss external static fixed bin(24,0) dcl 4-38 gcos_ext_stat_$max_activities external static fixed bin(24,0) dcl 4-39 gcos_ext_stat_$max_mem external static fixed bin(19,0) dcl 4-40 gcos_ext_stat_$mc external static structure level 1 unaligned dcl 4-112 gcos_ext_stat_$mme_rtrn external static label variable dcl 4-41 gcos_ext_stat_$nondollar external static char(2) unaligned dcl 4-42 gcos_ext_stat_$nongcos external static char(2) unaligned dcl 4-43 gcos_ext_stat_$normal_return external static label variable dcl 4-44 gcos_ext_stat_$patchfile_ptr external static pointer dcl 4-45 gcos_ext_stat_$pathname_prefix external static varying char(168) dcl 4-46 gcos_ext_stat_$pch external static pointer dcl 4-47 gcos_ext_stat_$pdir external static varying char(168) dcl 4-48 gcos_ext_stat_$prt external static pointer dcl 4-49 gcos_ext_stat_$rs external static pointer dcl 4-50 gcos_ext_stat_$save_dir external static varying char(168) dcl 4-52 gcos_ext_stat_$saveseg_ptr external static pointer dcl 4-51 gcos_ext_stat_$seg_rings external static fixed bin(3,0) array dcl 4-53 gcos_ext_stat_$sig_ptr external static pointer dcl 4-54 gcos_ext_stat_$skip_umc external static bit(1) unaligned dcl 4-55 gcos_ext_stat_$snumb external static bit(30) dcl 4-56 gcos_ext_stat_$sought_label external static char(8) unaligned dcl 4-57 gcos_ext_stat_$statistics external static fixed bin(24,0) array dcl 4-58 gcos_ext_stat_$stop_code external static fixed bin(24,0) dcl 4-59 gcos_ext_stat_$sysout_limit external static fixed bin(35,0) dcl 4-61 gcos_ext_stat_$sysout_lines external static fixed bin(35,0) dcl 4-62 gcos_ext_stat_$system_free_pointer external static pointer dcl 4-63 gcos_ext_stat_$temp_dir external static varying char(168) dcl 4-65 gcos_ext_stat_$temp_seg_ptr external static pointer dcl 4-66 gcos_ext_stat_$termination_code external static bit(18) unaligned dcl 4-67 gcos_ext_stat_$time_limit external static fixed bin(71,0) dcl 4-68 gcos_ext_stat_$userid external static char(12) unaligned dcl 4-69 gcos_ext_stat_$validation_level external static fixed bin(3,0) dcl 4-70 ios_$attach 000000 constant entry external dcl 2-3 ios_$detach 000000 constant entry external dcl 2-11 ios_$setsize 000000 constant entry external dcl 2-39 ios_$tell 000000 constant entry external dcl 2-53 lbx internal static fixed bin(17,0) initial dcl 10-42 lpx internal static fixed bin(17,0) initial dcl 10-42 sbx internal static fixed bin(17,0) initial dcl 10-42 scux based structure level 1 dcl 10-206 spx internal static fixed bin(17,0) initial dcl 10-42 NAMES DECLARED BY EXPLICIT CONTEXT. adjust_buffer 005760 constant entry internal dcl 1198 ref 533 945 asa9_common 003545 constant label dcl 569 ref 584 bcd_common 004203 constant label dcl 774 ref 789 bksp_share 003001 constant label dcl 418 ref 470 bump 002116 constant label dcl 216 ref 912 check_multirecord_request 006005 constant entry internal dcl 1219 ref 254 276 com_proc 000000 constant label array(41) dcl 192 ref 647 653 694 695 696 697 1593 complete 002561 constant label dcl 359 ref 331 debug_proc 006215 constant entry internal dcl 1281 ref 1584 disk_eof 003064 constant label dcl 438 set ref 310 disk_posit 003141 constant label dcl 458 ref 409 do_seek 006350 constant entry internal dcl 1310 ref 252 333 395 460 end_loop 004457 constant label dcl 892 ref 879 885 epabort 005225 constant label dcl 1060 set ref 993 1001 1004 1007 1018 1031 fail_loop 002572 constant label dcl 364 set ref 392 ga_loop 003450 constant label dcl 540 ref 551 gcos_mme_inos_ 001537 constant entry external dcl 6 get_cmd_tbl_entry 006550 constant entry internal dcl 1338 ref 1586 get_dcw 006613 constant entry internal dcl 1367 ref 289 520 550 805 854 919 1633 get_prt_dcw 004243 constant label dcl 803 ref 806 819 get_ptr 006024 constant label dcl 1235 in procedure "check_multirecord_request" ref 1249 1255 get_ptr 006616 constant label dcl 1379 in procedure "get_dcw" ref 1405 1434 init_routine 007046 constant entry internal dcl 1443 ref 168 inos_trace_filecode 005570 constant entry external dcl 1167 issue 002463 constant label dcl 338 ref 522 1041 1049 loop 002327 constant label dcl 282 ref 256 376 make_stat_ptr 007101 constant entry internal dcl 1475 ref 984 1071 match_fc 007167 constant entry internal dcl 1500 ref 175 mme_endc 005462 constant entry external dcl 1125 mode_order 003316 constant label dcl 516 ref 576 781 mode_set 003347 constant label dcl 519 ref 512 571 776 next_arg 010015 constant entry internal dcl 1-2 ref 1173 next_dcw_ptr 007225 constant entry internal dcl 1511 ref 498 order_call 004103 constant label dcl 752 ref 591 598 605 612 660 667 order_loop 003626 constant label dcl 628 ref 619 print_skip 004311 constant label dcl 817 ref 808 process_request 007501 constant entry internal dcl 1579 ref 190 220 return_stat 005256 constant label dcl 1069 ref 229 263 297 398 404 405 426 462 476 482 823 837 843 913 929 935 941 958 972 976 return_tape_stat 005260 constant label dcl 1074 ref 989 999 1010 1013 1026 sc_loop 007661 constant label dcl 1617 ref 1634 sc_read 003372 constant label dcl 531 ref 1036 1050 sc_res 007726 constant label dcl 1631 ref 1620 sc_skip 007716 constant label dcl 1627 ref 1623 scatter_input 007655 constant entry internal dcl 1608 ref 535 928 seek 002203 constant label dcl 244 set ref 240 273 275 set_density 004025 constant label dcl 730 ref 687 691 705 713 721 742 skip_fill 004465 constant label dcl 898 ref 873 888 tape_high_low 003736 constant label dcl 685 set ref 675 tape_stat 004612 constant label dcl 943 ref 362 tape_status 004632 constant label dcl 951 ref 506 559 637 641 734 756 765 1054 trace 006242 constant label dcl 1291 ref 1284 1287 type_it 004475 constant label dcl 907 ref 877 900 type_loop 004335 constant label dcl 852 ref 856 904 type_op 007735 constant entry internal dcl 1638 ref 1293 1598 write_prt 004232 constant label dcl 798 ref 831 NAME DECLARED BY CONTEXT OR IMPLICATION. rtrim builtin function ref 1643 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 11530 11700 11065 11540 Length 12454 11065 150 540 443 32 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gcos_mme_inos_ 4896 external procedure is an external procedure. adjust_buffer internal procedure shares stack frame of external procedure gcos_mme_inos_. check_multirecord_request internal procedure shares stack frame of external procedure gcos_mme_inos_. debug_proc internal procedure shares stack frame of external procedure gcos_mme_inos_. do_seek internal procedure shares stack frame of external procedure gcos_mme_inos_. get_cmd_tbl_entry internal procedure shares stack frame of external procedure gcos_mme_inos_. get_dcw internal procedure shares stack frame of external procedure gcos_mme_inos_. init_routine internal procedure shares stack frame of external procedure gcos_mme_inos_. make_stat_ptr internal procedure shares stack frame of external procedure gcos_mme_inos_. match_fc internal procedure shares stack frame of external procedure gcos_mme_inos_. next_dcw_ptr internal procedure shares stack frame of external procedure gcos_mme_inos_. process_request internal procedure shares stack frame of external procedure gcos_mme_inos_. scatter_input internal procedure shares stack frame of external procedure gcos_mme_inos_. type_op 67 internal procedure uses returns(char(*)) or returns(bit(*)). next_arg internal procedure shares stack frame of external procedure gcos_mme_inos_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 trace_array gcos_mme_inos_ 000034 trace_index gcos_mme_inos_ 000035 trace_or_stopsw gcos_mme_inos_ 000036 rl next_arg 000040 rp next_arg STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gcos_mme_inos_ 000100 arglen gcos_mme_inos_ 000102 argp gcos_mme_inos_ 000104 ascii_index gcos_mme_inos_ 000105 ascii_string gcos_mme_inos_ 000146 bksp_sw gcos_mme_inos_ 000147 cc_residue gcos_mme_inos_ 000150 char gcos_mme_inos_ 000151 continue gcos_mme_inos_ 000152 count gcos_mme_inos_ 000153 da_residue gcos_mme_inos_ 000154 dcwptr gcos_mme_inos_ 000156 dcw_offset gcos_mme_inos_ 000157 density_history gcos_mme_inos_ 000160 error_retry gcos_mme_inos_ 000161 fc gcos_mme_inos_ 000162 gseg gcos_mme_inos_ 000164 i gcos_mme_inos_ 000166 ibuffptr gcos_mme_inos_ 000170 idptr gcos_mme_inos_ 000172 j gcos_mme_inos_ 000173 k gcos_mme_inos_ 000174 major_status gcos_mme_inos_ 000176 mc_save_ptr gcos_mme_inos_ 000200 minor_status gcos_mme_inos_ 000201 more_dcws gcos_mme_inos_ 000202 mr gcos_mme_inos_ 000203 mybuf gcos_mme_inos_ 000236 n gcos_mme_inos_ 000237 nelemt gcos_mme_inos_ 000240 new_next_avail gcos_mme_inos_ 000242 opptr gcos_mme_inos_ 000244 order gcos_mme_inos_ 000252 output_ptr gcos_mme_inos_ 000254 override gcos_mme_inos_ 000255 posit gcos_mme_inos_ 000256 rec_ct_residue gcos_mme_inos_ 000257 retry_count gcos_mme_inos_ 000260 sbuffptr gcos_mme_inos_ 000262 scratch_status gcos_mme_inos_ 000264 sc_ga gcos_mme_inos_ 000265 seeksw gcos_mme_inos_ 000266 seek_pointer gcos_mme_inos_ 000270 slave_status gcos_mme_inos_ 000272 sptr gcos_mme_inos_ 000274 storlimit gcos_mme_inos_ 000275 successive_tdcws gcos_mme_inos_ 000276 swptr gcos_mme_inos_ 000300 tapebuffer gcos_mme_inos_ 010300 total_count gcos_mme_inos_ 010302 total_read gcos_mme_inos_ 010304 transfer_count gcos_mme_inos_ 010305 type_dcw gcos_mme_inos_ 010306 wc_residue gcos_mme_inos_ 010307 where gcos_mme_inos_ 010310 workp gcos_mme_inos_ 010312 status gcos_mme_inos_ 010314 fibptr gcos_mme_inos_ 010316 mcp gcos_mme_inos_ 010320 scup gcos_mme_inos_ 010342 d check_multirecord_request 010343 nb check_multirecord_request 010344 t check_multirecord_request 010400 holdcount get_dcw 010401 successive_tdcws get_dcw 010456 k next_arg type_op 000100 i type_op THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_cs call_ext_out_desc call_ext_out call_int_this_desc return mod_fx1 shorten_stack ext_entry ext_entry_desc int_entry_desc return_chars_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. db gcos_cv_ascii_gebcd_ gcos_mme_bort_$system gcos_write_$bcd_ptr ioa_ ios_$order ios_$read ios_$read_ptr ios_$seek ios_$write ios_$write_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. gcos_et_$access_beyond_file gcos_et_$bad_cc_ptr gcos_et_$bad_io_cmnd_file gcos_et_$bad_mme_in_cc gcos_et_$bad_multirec gcos_et_$bad_seek_dcw gcos_et_$bad_status_ret_ptr gcos_et_$fc_not_defined gcos_et_$geendc_not_in_cc gcos_et_$impermissible_perm_read gcos_et_$impermissible_perm_write gcos_et_$invalid_dcw_ptr gcos_et_$invalid_file_ptr gcos_et_$irrecoverable_io_err gcos_et_$request_too_big gcos_et_$two_tdcws gcos_ext_stat_$courtesy_call_control gcos_ext_stat_$dbs gcos_ext_stat_$fct gcos_ext_stat_$gcos_slave_area_seg gcos_ext_stat_$increment_hold gcos_ext_stat_$save_data gcos_ext_stat_$storage_limit gcos_ext_stat_$tape_buffer_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 001533 144 001544 145 001550 146 001552 147 001555 148 001557 150 001570 151 001572 152 001576 154 001601 160 001624 161 001631 162 001637 164 001644 168 001670 172 001671 175 001703 181 001733 188 001766 190 001773 192 001774 195 001775 196 001777 197 002005 203 002030 204 002034 211 002064 212 002072 213 002075 216 002116 218 002117 219 002122 220 002125 222 002126 226 002127 227 002133 228 002136 229 002140 231 002141 238 002165 239 002173 240 002175 243 002176 244 002203 245 002204 252 002243 254 002244 256 002254 258 002255 262 002256 263 002262 264 002265 271 002311 272 002315 273 002317 275 002320 276 002325 282 002327 289 002330 291 002331 292 002337 294 002345 295 002347 296 002351 297 002353 300 002354 302 002363 303 002365 304 002366 308 002374 310 002376 318 002401 319 002404 321 002413 322 002420 331 002456 333 002457 335 002462 338 002463 340 002464 349 002526 359 002561 361 002562 362 002564 363 002570 364 002572 365 002573 373 002641 374 002654 376 002657 379 002661 382 002673 383 002676 384 002703 392 002744 393 002746 394 002761 395 002762 398 002763 400 002764 404 002765 405 002771 407 002774 409 002775 411 002776 415 002777 418 003001 420 003002 426 003034 428 003040 429 003043 430 003046 431 003050 433 003054 434 003056 435 003061 438 003064 440 003065 448 003126 450 003130 451 003135 453 003137 458 003141 460 003142 462 003143 464 003144 468 003145 470 003146 472 003147 476 003150 478 003151 482 003152 484 003153 486 003154 487 003155 488 003157 489 003162 491 003165 492 003167 493 003172 496 003221 497 003223 498 003227 499 003231 501 003266 502 003271 503 003275 505 003300 506 003301 508 003302 510 003303 512 003306 513 003311 514 003313 516 003316 517 003317 519 003347 520 003350 521 003351 522 003352 525 003356 526 003360 529 003366 531 003372 532 003373 533 003432 535 003440 536 003446 538 003447 540 003450 541 003451 543 003453 544 003460 545 003464 546 003471 548 003473 550 003475 551 003476 554 003477 555 003502 557 003503 559 003540 562 003541 566 003542 569 003545 571 003546 573 003554 574 003560 576 003563 578 003564 582 003565 584 003570 586 003571 590 003572 591 003575 593 003576 597 003577 598 003602 600 003603 604 003604 605 003607 607 003610 611 003611 612 003614 614 003615 618 003616 619 003621 621 003622 625 003623 628 003626 630 003627 631 003632 633 003635 634 003643 635 003673 636 003675 637 003700 639 003701 641 003703 643 003704 647 003705 649 003706 653 003707 655 003710 659 003711 660 003714 662 003715 666 003716 667 003721 669 003722 673 003723 674 003726 675 003730 677 003731 681 003732 682 003735 685 003736 687 003737 688 003744 689 003747 690 003757 691 003762 694 003763 695 003765 696 003767 697 003771 699 003773 703 003774 704 003777 705 004001 707 004002 711 004003 712 004006 713 004007 715 004010 719 004011 720 004014 721 004016 723 004017 727 004020 728 004023 730 004025 732 004026 733 004056 734 004066 736 004067 740 004070 741 004073 742 004074 744 004075 748 004076 749 004101 752 004103 754 004104 756 004134 758 004135 762 004136 763 004174 765 004176 767 004177 771 004200 774 004203 776 004204 778 004212 779 004216 781 004221 783 004222 787 004223 789 004226 791 004227 795 004230 798 004232 800 004233 803 004243 805 004244 806 004245 807 004247 808 004252 809 004254 811 004256 813 004260 817 004311 819 004312 821 004314 823 004316 825 004317 829 004320 830 004323 831 004326 833 004327 837 004330 839 004331 843 004332 845 004333 849 004334 852 004335 854 004336 856 004337 858 004342 860 004345 862 004355 863 004365 864 004366 865 004376 866 004377 867 004412 869 004417 871 004421 872 004425 873 004427 876 004430 877 004434 879 004435 882 004436 883 004440 884 004445 885 004447 888 004450 889 004452 892 004457 894 004460 895 004461 898 004465 900 004466 902 004471 904 004473 907 004475 909 004476 912 004516 913 004522 915 004523 919 004524 921 004525 922 004544 923 004546 926 004571 927 004575 928 004601 929 004605 931 004606 935 004607 937 004610 941 004611 943 004612 945 004613 947 004624 948 004627 951 004632 955 004633 958 004636 960 004640 963 004663 965 004670 967 004672 969 004716 970 004722 972 004725 976 004731 981 004735 984 004745 985 004746 989 004756 993 004763 997 004770 999 004772 1001 004776 1004 004777 1007 005001 1010 005005 1013 005007 1018 005017 1026 005027 1028 005031 1029 005035 1030 005037 1031 005041 1034 005043 1036 005045 1041 005063 1043 005064 1045 005116 1049 005160 1050 005162 1053 005170 1054 005224 1060 005225 1062 005226 1069 005256 1071 005257 1074 005260 1076 005261 1077 005263 1079 005265 1080 005270 1082 005277 1083 005307 1084 005314 1085 005316 1087 005344 1089 005351 1091 005354 1094 005361 1096 005367 1104 005417 1106 005425 1107 005427 1109 005430 1116 005432 1117 005435 1118 005445 1119 005447 1120 005453 1123 005457 1125 005460 1131 005467 1137 005512 1139 005516 1140 005523 1142 005525 1145 005527 1146 005531 1147 005534 1148 005537 1149 005541 1150 005544 1154 005545 1155 005547 1160 005557 1165 005564 1167 005565 1172 005603 1173 005606 1174 005613 1175 005616 1176 005630 1177 005647 1179 005655 1180 005701 1181 005703 1183 005704 1186 005740 1187 005741 1193 005754 1195 005755 1196 005757 1198 005760 1206 005762 1210 006004 1219 006005 1228 006007 1229 006014 1230 006020 1233 006021 1234 006022 1235 006024 1237 006025 1245 006062 1247 006066 1248 006074 1249 006077 1252 006100 1253 006107 1254 006110 1255 006111 1257 006113 1258 006116 1259 006121 1273 006207 1274 006214 1281 006215 1284 006216 1286 006221 1287 006227 1288 006237 1289 006241 1291 006242 1292 006243 1293 006246 1300 006320 1302 006321 1303 006325 1304 006342 1306 006347 1310 006350 1312 006351 1313 006355 1314 006412 1323 006445 1324 006456 1326 006461 1327 006514 1335 006547 1338 006550 1339 006551 1341 006555 1342 006560 1343 006562 1345 006563 1347 006566 1348 006571 1349 006573 1351 006574 1353 006577 1354 006602 1355 006604 1359 006605 1360 006610 1363 006612 1367 006613 1376 006614 1377 006615 1379 006616 1380 006617 1388 006654 1389 006660 1396 006713 1397 006721 1398 006722 1404 006752 1405 006755 1407 006756 1409 006757 1410 006761 1411 006763 1412 006766 1413 006775 1414 006776 1415 007000 1416 007001 1417 007003 1421 007004 1422 007013 1424 007014 1426 007022 1428 007031 1429 007033 1431 007034 1432 007036 1433 007037 1434 007041 1435 007043 1436 007044 1437 007045 1443 007046 1445 007047 1450 007054 1452 007056 1454 007060 1461 007066 1469 007077 1471 007100 1475 007101 1478 007102 1484 007126 1490 007152 1492 007156 1493 007160 1494 007162 1495 007163 1496 007166 1500 007167 1502 007171 1503 007177 1505 007215 1507 007217 1511 007225 1531 007227 1533 007230 1539 007265 1540 007271 1545 007324 1547 007331 1548 007334 1549 007337 1555 007370 1558 007405 1560 007412 1562 007421 1564 007422 1571 007466 1573 007477 1575 007500 1579 007501 1581 007502 1582 007505 1583 007510 1584 007513 1586 007517 1592 007525 1593 007545 1596 007572 1598 007574 1606 007653 1608 007655 1616 007657 1617 007661 1618 007662 1619 007665 1620 007671 1621 007673 1623 007674 1624 007677 1625 007705 1626 007711 1627 007716 1628 007717 1629 007721 1630 007723 1631 007726 1632 007727 1633 007732 1634 007733 1638 007734 1642 007742 1643 007747 1644 010003 1645 010005 1 2 010015 1 11 010017 1 12 010022 1 13 010026 1 15 010034 1 16 010046 1 17 010060 1 18 010062 1 19 010063 1 20 010065 1 21 010066 1 22 010070 1 26 010075 1 27 010077 1 28 010103 1 29 010105 ----------------------------------------------------------- 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