sw/os8/v3d/sources/system/dectapes/dectape6/MCPIP.PA

   1 /7      OS/8 MCPIP                              MAGTAPE AND CASSETTE PIP
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /COPYRIGHT  (C)  1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
  12 /
  13 /
  14 /
  15 /
  16 /
  17 /
  18 /
  19 /
  20 /
  21 /
  22 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  23 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  24 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  25 /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
  26 /
  27 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  28 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  29 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  30 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  31 /
  32 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  33 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  34 /DIGITAL.
  35 /
  36 /
  37 /
  38 /
  39 /
  40 /
  41 /
  42 /
  43 /
  44 /
  45 \f
  46 /       S.R.
  47
  48 /       REVISED FEB. 11, 1974
  49 /       SECOND REVISION: 7-AUG-75
  50
  51
  52 /1.     INSTALLED PATCH SEQ #1 , SEPT. 1974 DSN
  53 /       (NOW TRANSFERS LAST 2 BYTES CORRECTLY IN IMAGE MODE)
  54 /2.     BUMPED VERSION NUMBER TO V5
  55 /3.     FIXED /L BUG IF DEVICE NOT MAGTAPE OR CASSETTE
  56
  57         KCLR=6700       /CLEAR ALL
  58                         /CLEAR STATUS A AND B REGISTERS.
  59         KSDR=6701       /SKIP ON DATA FLAG
  60         KSEN=6702       /SKIP ON ERROR
  61         KSBF=6703       /SKIP ON READY FLAG
  62         KLSA=6704       /LOAD STATUS A FROM AC 4-11
  63                         /CLEAR AC, THEN
  64                         /LOAD 8 BIT COMPLEMENT OF STATUS A
  65                         /BACK INTO AC
  66         KSAF=6705       /SKIP ON ANY FLAG OR ERROR
  67         KGOA=6706       /ASSERT THE CONTENTS OF STATUS A,
  68                         /TRANSFER DATA IF READ OR WRITE
  69         KRSB=6707       /READ STATUS B INTO AC 4-11
  70
  71
  72         FIXMRI CALL=4400
  73         FIXMRI EXIT=5400
  74         FIXMRI INCR=2000
  75
  76 /CORE ALLOCATION
  77
  78 /00000-01777    COMMAND DECODER
  79 /02000-02377    OUTPUT HANDLER
  80 /02400-02777    INPUT HANDLER
  81 /03000-03777    CASSETTE OUTPUT BUFFER
  82 /04000-04777    CASSETTE INPUT BUFFER
  83 /05000-05577    STAND ALONE CASSETTE HANDLER
  84 /05600-07577    LOOKUP, ENTER, CLOSE
  85 /07600-07777    OS/8
  86
  87 /10000-11777    USR
  88 /12000-14577    PIPC
  89 /14600-17577    OS/8 INPUT/OUTPUT BUFFER
  90 /17600-17777    OS/8
  91 \f/USR HAS THE FOLLOWING FREE LOCATIONS:
  92 /0-6
  93 /10-17 (BUT GET DESTROYED)
  94 /20-37
  95
  96         TEMP=20
  97         TEMP1=21
  98         TEMP2=22
  99         TEMP3=23
 100
 101 /       STARTING ADDRESS = 12000
 102 /       JOB STATUS WORD = 6003
 103
 104         INHAND=2400
 105         OUTHAND=2000
 106         COBUF=3000
 107         CIBUF=4000
 108
 109         PIPVERSION=6
 110         PATCHLEV=77&"A
 111
 112         SPCODE=6
 113         CLCODE=0
 114         REWCOD=1
 115         FICODE=3
 116         EOCODE=5
 117         RECCOD=2
 118 \f/V3 CHANGES:
 119
 120 /1.     SHRUNK 0S/8 BUFFER TO 3000 WORDS
 121 /2.     ADDED VERSION NUMBER (/V)
 122 /3.     MADE INDEPENDENT OF MAGIC LOCATIONS IN CASSETTE HANDLER
 123 /4.     ADDED MAGTAPE SUPPORT OF CASSETTE FILE STRUCTURE
 124 /5.     ALTMODE MEANS RETURN TO KBM
 125 /6.     ^C DOESN'T CLOSE CASSETTES UNLESS WE ALREADY WROTE ON IT
 126 /7.     FIXED BUG THAT CSA2 THRU CSA7 DIDN'T WORK
 127 /8.     CR ALONE TO CD GIVES NO ERROR MESSAGE
 128 /9.     ADDED ^O AND ^C SUPPORT TO MESSAGE PRINTOUT
 129 /10.    GIVE ERRORS ON ILLEGAL * OR ? IN NAME
 130 /11.    USES TTY: AS DEFAULT OUTPUT DEVICE ON /L
 131
 132 /PROPOSED:
 133 /8.     ALLOW *.* FOR CASSETTE INPUT
 134 /9.     SUPPORT OF UNLABELED MAGTAPE STANDARD
 135 /10.    /7 OR /9 SPECIFIES CHANNEL
 136
 137 /FIXES SINCE FIELD TEST :
 138
 139 /1.     ^C ALWAYS BRINGS YOU BACK TO KBM
 140 /2.     FIXED BUG RE CHECK FOR FILE FULL
 141 /3.     MADE COMPATIBLE WITH NEW TM8E HANDLER
 142 /4.     TIME-OUT ON CASSETTE READ
 143 /5.     BE NICE-GUY IF OS/8 LOOKUP FAILURE
 144 \f/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
 145 /AND READY.
 146 /THE NEW UNIT NUMBER (0-7) IS IN THE AC.
 147 /THE UNIT  NUMBER IS IN BITS 8-11 OF THE AC.
 148 /RETURN 1 IS MADE IF THE UNIT IS NOT READY.
 149 /CINUSE IS SET TO 1.
 150 /THE HANDLER MUST NOT ALREADY BE IN USE.
 151 /THE DATA FIELD IS INTERROGATED
 152 /AND A RETURN CIF CDF IS BUILT
 153 /AND STORED IN LOCATION RETCIF
 154
 155 \f       *5000
 156
 157 FIXDVC, 0
 158         DCA DVC
 159         RDF
 160         TAD (CIF CDF
 161         CDF 0
 162         DCA TMP
 163         TAD I FIXDVC
 164         DCA ERRET
 165         ISZ FIXDVC
 166         TAD TMP
 167         DCA I ERRET
 168         TAD DVC
 169         SNA
 170         JMP CHECKR
 171         RAR             /MOVE UNIT TO LINK; DEVICE TO AC
 172         AND (3          /MASK OFF DEVICE CODE
 173         DCA DVC         /SAVE DEVICE CODE
 174         SZL
 175         TAD (100
 176         DCA I (ABUNIT   /SET UNIT IN BIT 5
 177         TAD DVC
 178         CLL RTL
 179         RAL             /UGLY
 180         DCA DVC         /MOVE TO BITS 6-8
 181         TAD (IOTBL
 182         DCA IOTPTR
 183 IOTLOOP,TAD I IOTPTR
 184         SNA             /END OF TABLE?
 185         JMP CHECKR      /YES
 186         DCA TMP
 187         TAD I TMP
 188         AND (7707       /MASK OUT OLD DVC
 189         TAD DVC         /INSERT NEW ONE
 190         DCA I TMP       /REPLACE
 191         ISZ IOTPTR      /POINT TO NEXT ONE
 192         JMP IOTLOOP
 193
 194 TMP,    0
 195 DVC,    0               /DEVICE CODE
 196 IOTPTR, 0
 197 \fCHECKR,        JMS I (CLEAR
 198         TAD (200
 199         JMS I (LOADA    /SELECT DRIVE
 200         JMS I (CHECKB
 201         AND (7735       /IGNORE EOT/BOT FLAG
 202                         /AND WLO
 203         TAD (-1
 204         SZA CLA
 205         JMP I ERRET     /NOT READY
 206         ISZ I (CINUSE
 207         JMP I FIXDVC
 208
 209 ERRET,  0               /ERROR RETURN LOCATION
 210 \fFIDDLE,        0
 211         CIF 10
 212         JMS I (FID2     /NEED ROOM
 213         TAD (CIBUF+11
 214         DCA 10
 215         TAD FAST
 216         SZA CLA
 217         JMP DIREOL
 218         TAD (40
 219         DCA I 10
 220         TAD I (CIBUF+20
 221         DCA I 10
 222         TAD I (CIBUF+20
 223         AND (177
 224         SZA
 225         TAD (-40
 226         SZA CLA
 227         TAD ("/-40
 228         TAD (40
 229         DCA SLSH
 230         TAD I (CIBUF+21
 231         DCA I 10
 232         TAD SLSH
 233         DCA I 10
 234         INCR 10
 235         INCR 10
 236         TAD SLSH
 237         DCA I 10
 238         TAD I (CIBUF+22
 239         DCA I 10
 240         TAD I (CIBUF+23
 241         DCA I 10
 242 DIREOL, TAD (15
 243         DCA I 10
 244         TAD (12
 245         DCA I 10
 246         TAD (32
 247         DCA I 10
 248 FIDLV,  EXIT FIDDLE
 249
 250 /0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 17 20 21 22 23 24 25
 251 /F I L E N A M E S                  D  D  M  M  Y  Y
 252 /F I L E N A . M E S       M  M  /  D  D  /  Y  Y CR LF ^Z
 253
 254 FAST,   0               /0 MEANS F NOT SPECIFIED
 255 \fSLSH,  "/
 256
 257 IOTBL,  IOT0
 258         IOT1
 259         IOT4
 260         IOT5
 261         IOT6
 262         IOT6C
 263         IOT7
 264         0
 265         PAGE
 266 \fUTIL,  0
 267         DCA TEMPU
 268         DCA REWSW       /ZERO REWIND SWITCH
 269         TAD I UTIL
 270         TAD (-10
 271         SNA
 272         ISZ REWSW
 273         ISZ UTIL
 274         TAD (210
 275         DCA TEMPFN
 276         TAD TEMPU
 277         JMS I (FIXDVC   /FIX DEVICE CODE
 278         UTEND           /UNIT NOT READY
 279         TAD (UT
 280         DCA CRET        /SET RETURN ADDRESS
 281         STA
 282         DCA I (RW       /NOTE FACT THAT OP AINT READ
 283         TAD TEMPFN
 284         JMS I (LOADA
 285         JMS GO          /INITIATE UTIL
 286         JMP CRET+1
 287         ISZ UTIL
 288 UTEND,  HLT
 289         JMP I UTIL
 290 UT,     JMS CHECKB      /LOOK AT STATUS B
 291         AND (50         /CHECK FOR CL, EMPTY, OR WLO
 292                         /GIVE NO ERROR ON WLO ************
 293                         /BAD FOR WRGAP
 294         SNA
 295         JMP OK          /NO ERRORS
 296         TAD (-40
 297         SZA CLA
 298         JMP NOTOK       /ERROR NOT CL
 299         TAD REWSW
 300         SNA CLA         /CL OK IF DID REWIND
 301 NOTOK,  STA
 302 OK,     JMS CLEAR
 303         TAD CINUSE
 304         SMA CLA
 305         JMP UTEND-1
 306         TAD BSTATE      /ERROR
 307         JMP UTEND
 308
 309 TEMPU,  0
 310 TEMPFN, 0
 311 REWSW,  0               /1 MEANS OPERATION IS REWIND
 312 \fCHECKB,        0
 313 IOT7,   KRSB            /READ STATUS B INTO AC 4-11
 314         DCA BSTATE      /SAVE STATUS B
 315         TAD BSTATE
 316         JMP I CHECKB
 317
 318 CLEAR,  0
 319         DCA CINUSE      /LEAVE STATUS CONDITION IN AC; -1 MEANS  ERROR
 320 IOT0,   KCLR            /CLEAR STATUS A AND B
 321         JMP I CLEAR
 322
 323 GO,     0
 324 IOT6,   KGOA            /ASSERT CONTENTS OF STATUS A
 325         CLA
 326         JMP I GO
 327
 328 CHK,    0
 329         JMS I (CHECKB
 330         AND (374
 331 IOT1,   KSDR
 332         SKP             /DATA FLAG NOT UP -
 333         JMP I CHK
 334         TAD (-20
 335         SNA CLA         /IS IT END OF FILE?
 336         JMP I (ERRR     /YES, ERROR - BUT DON'T RETRY
 337         TAD BSTATE
 338         JMP I CHK
 339
 340 CINUSE, 0               /1 MEANS HANDLER IN USE
 341 BSTATE, 0               /STATUS OF REGISTER B ON ERROR
 342 \fDTEM,  0
 343
 344 DOPTION,JMS I (CONVRT
 345         7601
 346         DCA DTEM
 347         TAD I (OUNIT
 348         JMS I (LOOKUP
 349         JMP I (XER4
 350         JMP MBNF        /NOT FOUND
 351         INCR DTEM
 352         JMS I (DELET
 353         JMP I (XER77    /OUTPUT ERROR
 354 MBNF,   TAD DTEM
 355         SNA CLA         /ANYTHING DELETED?
 356         JMP I (XER24    /NO
 357         JMS UTIL
 358         REWIND
 359         CLA
 360         CIF CDF 10      /YES
 361         JMP I (DECODE
 362 \fCRET,  0
 363         CDF 0
 364         TAD (-200       /COUNT OF HOW LONG TO WAIT
 365         DCA I (OUTER
 366 IOL,    JMS I (CTRLC
 367         JMS I (TIMEOUT
 368 IOT5,   KSAF
 369         JMP IOL
 370         EXIT CRET
 371         PAGE
 372 \fHANDLER,0
 373         DCA TUN
 374         TAD I HANDLER   /GET FUNCTION CONTROL WORD
 375         AND L70         /ISOLATE FIELD OF BUFFER
 376         TAD LCDF
 377         DCA WCDF
 378         TAD I HANDLER   /RETRIEVE FUNCTION CONTROL WORD
 379         RAL             /READ/WRITE BIT TO LINK
 380         CLA RAL
 381         DCA RW          /RW=1 IF WRITE
 382         ISZ HANDLER     /POINT TO BUFFER ADDRESS
 383         TAD I HANDLER   /GET BUFFER ADDRESS
 384         DCA BUFFER      /SAVE IT
 385         ISZ HANDLER     /POINT TO ERROR RETURN
 386         TAD TUN
 387         JMS I (FIXDVC
 388         LV              /NOT READY
 389         TAD WCDF
 390         DCA BFIELD
 391         TAD WCDF
 392         DCA BFLD
 393         STA CLL RTL     /TAD (-3
 394         DCA ERKNT
 395         JMS     SETUP   /SET UP READ OR WRITE
 396         JMP I (CRET+1
 397         ISZ HANDLER     /POINT TO GOOD RETURN
 398 LV,     HLT
 399         JMP I HANDLER
 400 RW,     0               /1 IF WRITE (-1 IF UTIL)
 401 ERKNT,  -3
 402 \fSETUP, 0
 403         TAD RW
 404         TAD (WRITEX
 405         DCA I (CRET     /SET RETURN ADDRESS
 406         TAD BUFFER
 407         DCA BPTR
 408         TAD BSIZE
 409         CMA             /WANT TO READ ONE MORE
 410         TAD RW
 411         DCA BKNT
 412         TAD RW
 413         DCA OUTSW
 414         TAD RW
 415         CLL RTL
 416         RTL             /WRITE FN CODE=20
 417         TAD (200        /SELECT AND INTERRUPT ENABLE
 418         JMS I (LOADA
 419 WCDF,   HLT
 420         TAD RW
 421         SZA CLA
 422         TAD I BPTR
 423 LCDF,   CDF 0
 424         JMS I (GO
 425         JMP I   SETUP
 426
 427 \fREADX, JMS I (CHK
 428         AND L374
 429         SZA
 430         JMP ERRX
 431 IOT6C,  KGOA            /GET CHAR JUST READ
 432         DCA BYTE
 433         ISZ BKNT
 434         SKP
 435         JMP RWCRC
 436 BMODE,  TAD BYTE
 437 TUN,
 438 BFLD,   HLT
 439         DCA I BPTR
 440         ISZ BPTR
 441 L374,   374
 442         JMP I (CRET+1   /CRET ALREADY SET UP
 443
 444 BSIZE,  200
 445 OUTSW,  0               /1 MEANS WE BEGAN TO WRITE
 446 \fRWCRC, TAD (260        /ENABLE, ENABLE INTER, READ CRC
 447         JMS I (LOADA
 448         JMS I (GO
 449         JMS I (CRET
 450         JMS I (CHK
 451 CRCMN,  JMS I (GO
 452         JMS I (CRET
 453         JMS I (CHECKB
 454         AND (7775       /IGNORE WLO
 455         TAD (-1
 456 ERRX,   SNA CLA         /ERRORS?
 457         JMP     ERRR+1  /NO - CLEAN BILL OF HEALTH
 458         ISZ     ERKNT   /TRY 3 TIMES
 459         JMP I   (ERRCOV /RETRY
 460 ERRR,   STA             /ERROR WHILE READING CRC
 461         JMS I (CLEAR
 462         TAD I (CINUSE
 463         SMA CLA
 464         JMP LV-1
 465         TAD I (BSTATE
 466         JMP LV
 467 \fWRITEX,        JMP READX
 468         JMS I (CHK
 469         SZA
 470         JMP ERRX
 471         ISZ BKNT
 472         SKP
 473         JMP WCRC
 474 BFIELD, HLT
 475         ISZ BPTR
 476 L70,    70
 477         TAD I BPTR
 478         JMS I (GO
 479         JMP I (CRET+1
 480
 481
 482 WCRC,   TAD (260
 483         JMS I (LOADA
 484         JMP CRCMN
 485 BKNT,   0               /NUMBER OF CHARS EXPECTED
 486 BPTR,   0               /NEXT LOCATION IN BUFFER TO STORE INTO
 487 BYTE,   0               /TEMPORARILY HOLDS BYTE FOUND
 488 BUFFER, 0
 489         PAGE
 490 \f/ LOOKUP, ETC.
 491
 492         F1=10
 493         READ=0
 494         WRITE=4000
 495
 496         REWIND=10
 497         BACKFIL=30
 498         WRGAP=40
 499         BACKBLOCK=50
 500         SKPFIL=70
 501
 502         HSIZE=40
 503         OBUFFER=4600    /LOCATION OF OS/8 I/O BUFFER
 504         BINBUF=OBUFFER
 505         OBUFLEN=3000
 506         HOBUFLEN=OBUFLEN%2
 507         MAXBLK=OBUFLEN%400
 508
 509 FILNUM, 0
 510 /       ENTER
 511
 512 /       TAD UNIT
 513 /       JMS I (ENTER
 514 /       <ERROR RETURN>
 515 /       <NORMAL RETURN>
 516
 517 /       ENTER FILENAME AS SPECIFIED IN SINCH
 518 /       USER MUST SET SINCH BUT ONLY FIRST 25 (OCTAL) LOCATIONS.
 519
 520 ENTER,  0
 521         JMS I (LOOKUP
 522         JMP ERET        /ERROR WHILE READING
 523         JMP NTF
 524         JMS I (DELET
 525         JMP ERET        /ERROR WHILE DELETING
 526 NTF,    JMS BACK
 527         JMP ERET        /ERROR BACKING UP
 528         JMS I QH1       /WRITE NEW HEADER
 529         WRITE
 530         SINCH
 531         JMP ERET        /CASSETTE NOT READY
 532         TAD I (RECSIZ
 533         DCA I (BSIZE
 534         INCR ENTER
 535 ERET,   EXIT ENTER
 536
 537 RDOR,   0
 538         AND (374        /CASSETTE ONLY
 539         TAD (-200
 540         SZA CLA         /WAS ERROR JUST CRC?
 541         EXIT BACK       /NO
 542         EXIT RDOR       /YES, OK CONTINUE
 543 \fBACK,  0
 544 BK4,    JMS I QU1
 545 BK2,    BACKFIL         /GO BACK TO FILE GAP
 546         EXIT BACK
 547 BK3,    JMS I QU1
 548         BACKBLOCK       /BACK TO LAST RECORD
 549         JMP BKERR
 550         TAD I (RECSIZ
 551         DCA I (BSIZE
 552         JMS I QH1       /READ LAST RECORD OF PREV FILE
 553         READ+F1         /DON'T STORE IN BUFFER
 554         BINBUF
 555         JMS RDOR        /^*******
 556                         /ERROR READING LAST BLOCK
 557 NEWGAP, JMS I QU1
 558         WRGAP           /WRITE A NEW GAP
 559         EXIT BACK
 560 BK9,    TAD (HSIZE
 561         DCA I (BSIZE
 562         INCR BACK
 563         EXIT BACK
 564
 565 BKERR,  AND (3775       /CASSETTES ONLY
 566         TAD (-41
 567         SZA CLA         /WAS ERROR CLEAR LEADER?
 568         EXIT BACK
 569         JMP NEWGAP
 570
 571 BK1,    JMP BK9
 572
 573 /FOR MAGTAPES:
 574
 575 /BK2_BACKBLOCK
 576 /BK3_BK1
 577 \fCLOSE, 0
 578         JMS I QU1
 579         WRGAP
 580         JMP CLRET       /ERROR WHILE WRITING GAP
 581         TAD (HSIZE
 582         DCA I (BSIZE
 583         JMS I QH1
 584         WRITE           /WRITE SENTINEL
 585         ZER
 586         JMP CLRET
 587         JMS I QU1
 588         REWIND
 589         JMP CLRET
 590         INCR CLOSE      /SKIP ERROR RETURN
 591 CLRET,  EXIT CLOSE
 592 \fCRED,  0
 593         TAD I (INRECSZ
 594         DCA I (BSIZE
 595         TAD I (IUNIT
 596         JMS I QH1
 597         READ
 598         CIBUF
 599         JMP INER
 600         TAD (CIBUF
 601         DCA I (CIPTR
 602         TAD I (INRECSZ
 603         CIA
 604         DCA I (CIKNT
 605 /       CLA IAC
 606 /       DCA DATAFLG
 607         EXIT CRED
 608 INER,   AND EOFBIT
 609         SZA CLA         /REAL ERROR?
 610         JMP I (XER4     /YES
 611 /       TAD DATAFLG
 612 /       SNA CLA         /READ ANY DATA?
 613 /       JMP INTO        /NO REWIND
 614 /       DCA DATAFLG     /YES, COULD CLOSE OUTPUT AND OPEN NEXT INPUT
 615 INTO,   CLA
 616         TAD I (IUNIT
 617         JMS I QU1
 618         REWIND
 619         CLA
 620         TAD I (BIPTR
 621         CIF CDF 10      /NO, MERELY END-OF-FILE
 622         TAD (-OBUFFER+377
 623         CLL RTL
 624         RTL
 625         RAL
 626         AND (17
 627         DCA I (INTEN    /NUMBER OF BLOCKS GOT
 628         JMP I (XFIN
 629
 630 LOADA,  0
 631         TAD ABUNIT
 632 IOT4,   KLSA
 633         CLA
 634         JMP I LOADA
 635
 636 EOFBIT, 254             /CHANGED TO 3673 FOR MAGTAPE
 637 /DATAFLG,0              /1 MEANS READ DATA
 638 \fQU1,   UTIL
 639 QH1,    HANDLER
 640 ABUNIT, 0
 641         PAGE
 642 \f
 643 /       LOOKUP
 644
 645 /       TAD UNIT
 646 /       JMS I (LOOKUP
 647 /       I/O ERROR RETURN
 648 /       <NOT FOUND RETURN>
 649 /       <FOUND RETURN>
 650 /       ALWAYS LOOKS FOR THING SPECIFIED IN SINCH
 651
 652 LOOKUP, 0
 653         DCA P1
 654         CDF 10
 655         TAD I (7644
 656         CDF 0
 657         AND (10         /IS /U SPECIFIED?
 658         SZA CLA
 659         JMP GOODRT      /YES, DO NOTHING
 660         TAD P1
 661         JMS I QU2
 662         REWIND
 663         JMP ERRIT
 664         TAD (HSIZE      /SET LENGTH OF RECORD HEADER
 665         DCA I (BSIZE
 666         DCA I (FILNUM
 667 FL1,    JMP FL2         /ZERO THIS LOCATION FOR MAGTAPES
 668 FLOOP,  JMS I QU2
 669         SKPFIL
 670         JMP ERRIT
 671 FL2,    INCR I (FILNUM
 672         JMS I QH2
 673         READ
 674         INCH
 675         JMP ERRIT
 676         TAD (INCH
 677         DCA P1
 678         TAD I P1
 679         SNA CLA         /SENTINEL FILE?
 680         JMP NFNDRET     /YES, NOT FOUND
 681         TAD (SINCH      /NO, IS THIS THE ONE WANTED?
 682         DCA P2
 683         TAD (-10
 684         DCA SCNT
 685 \fSLOOP, TAD I P1
 686         CIA
 687         TAD I P2
 688         AND (177        /ONLY LAST 7 BITS NEED MATCH
 689         SZA CLA
 690         JMP FLOOP       /FILE KEY NOT ONE DESIRED
 691         INCR P1
 692         INCR P2
 693         ISZ SCNT
 694         JMP SLOOP
 695 GOODRT, INCR LOOKUP     /SKIP NOT FOUND RETURN
 696 NFNDRET,INCR LOOKUP     /SKIP ERROR RETURN
 697 ERRIT,  CLA
 698         TAD I (RECSIZ
 699         DCA I (BSIZE    /BE NICE TO USER
 700 LRET,   EXIT LOOKUP     /BYE-BYE
 701
 702 ERRT,   AND EOTBIT      /REAL ERROR?
 703         SZA CLA
 704         JMP ERRIT       /YES
 705         JMP NFNDRET     /NO, MERELY END-OF CASSETTE
 706
 707 /END OF CASSETTD IS SIGNALLED BY
 708
 709 /A      SENTINEL FILE
 710 /B      DOUBLE FILE GAP
 711 /C      EOT
 712
 713 EOTBIT, 314             /CHANGE TO 3663 FOR MAGTAPE
 714 \fP1,    0
 715 P2,     0
 716 SCNT,   0
 717 DELET,  0
 718         JMS I (BACK
 719         EXIT DELET
 720         JMS I QH2       /WRITE EMPTY HEADER
 721         WRITE+10
 722         EMPTINCH
 723         EXIT DELET      /ERROR WHILE DELETING
 724         CLL STA RAL     /-2
 725         TAD LOOKUP
 726         DCA LOOKUP
 727         JMP FLOOP       /JUMP INTO LOOKUP TO CONTINUE
 728 ZER,    0
 729
 730 QH2,    HANDLER
 731 QU2,    UTIL
 732 FL3,    JMP FL2
 733 \fERRCOV,        JMS I (CLEAR
 734         JMS I (CTRLC
 735         TAD     (250
 736         JMS I   (LOADA
 737         JMS I   (GO     /BACKSPACE BLOCK
 738         JMS I   (CRET   /WAIT
 739         JMS I   (CHECKB
 740         AND     (374    /KILL WRITE-LOCK BIT
 741         SZA CLA
 742         JMP I   (ERRR
 743         JMS I   (SETUP  /RE-SET UP OPERATION
 744         JMP I   (CRET+1 /GO AWAY
 745 \fTIMEOUT,0
 746         ISZ INNER
 747         JMP I TIMEOUT
 748         ISZ OUTER
 749         JMP I TIMEOUT
 750         TAD I (RW       / I/O HAS TAKEN A LOT OF TIME
 751         SZA CLA         /IS IT A READ OP?
 752         JMP I TIMEOUT   /NO, RETURN
 753         JMP I (ERRR     /YES, ERROR
 754
 755 INNER,  0
 756 OUTER,  -200
 757         PAGE
 758 \f/SEND CONTENTS OF OS/8 BUFFER TO CASSETTE
 759 /VIA CASSETTE OUTPUT BUFFER
 760
 761 CWRITE, 0
 762         TAD (OBUFFER
 763         DCA BUPTR       /PT TO BEGIN OF BUFFER
 764         CDF 10
 765         TAD I (INTEN    /GET NO. OF BLOCKS READ
 766         SNA
 767         JMP CWLV
 768         CDF 0
 769         CLL RTR
 770         RTR
 771         RAR             /CONVERT TO WORDS
 772         IAC
 773         AND (7776       /ROUND UP TO EVEN NO.
 774         CLL RAR         /DIVIDE BY TWO
 775         CIA             /USE AS COUNT OF DOUBLE-WORDS
 776         DCA BUKNT       /2000 TWO-WORD ENTRIES
 777 CWLOOP, CDF 10
 778         TAD I BUPTR
 779         JMS CWR         /SENT TO CASSETTE OUTPUT BUFFER
 780         CDF 10
 781         TAD I BUPTR
 782         AND (7400
 783         DCA TEMP1
 784         INCR BUPTR      /PT TO 2ND HALF
 785         TAD I BUPTR
 786         JMS CWR
 787         CDF 10
 788         TAD I BUPTR
 789         AND (7400
 790         CLL RTR
 791         RTR
 792         TAD TEMP1
 793         RTR
 794         RTR
 795         JMS CWR
 796         INCR BUPTR      /PT TO NEXT DOUBLE-WORD
 797         ISZ BUKNT       /AT END OF BUFFER?
 798         JMP CWLOOP      /NO
 799 CWLV,   CIF CDF 10
 800         EXIT CWRITE     /YES, RETURN
 801 BUPTR,  0               /PTS INTO OBUUFER
 802 BUKNT,  0
 803 \f/INSERT CHAR IN CASSETTE OUTPUT BUFFER
 804 /AND OUTPUT BUFFER IF BUFFER FULL
 805
 806 CWR,    0
 807         AND (377
 808         CDF 0
 809         DCA CWTMP
 810         TAD LDRFLG
 811         SZA CLA
 812         JMS I (LDRTST
 813         CDF 10
 814         TAD I (7643
 815         RTL             /PUT /B OPTION IN LINK
 816         CDF 0
 817         SNL CLA
 818         JMP GOK
 819         TAD CWTMP
 820         TAD M200
 821         SNA CLA
 822         JMP I (PREFIN
 823 GOK,    TAD CWTMP2
 824         JMS CWR2
 825         TAD CWTMP1
 826         DCA CWTMP2
 827         TAD CWTMP
 828         DCA CWTMP1
 829 CWREX,  EXIT CWR
 830
 831 CWR2,   0
 832         SPA
 833         JMP CWRIGN      /IGNORE -1
 834         CDF 0
 835         DCA I COPTR     /INSERT CHAR IN COBUF
 836         INCR COPTR
 837         ISZ COKNT       /COBUF FULL?
 838         EXIT CWR2       /NO, SO RETURN
 839         JMS CWRI
 840 M200,
 841 CWRIGN, 7600            /CLA
 842         EXIT CWR2
 843 \fCWRI,  0
 844         TAD COKNT
 845         TAD RECSIZ
 846         SNA CLA
 847         EXIT CWRI       /DO NOTHING IF BUFFER EMPTY
 848         TAD RECSIZ
 849         DCA I (BSIZE
 850         TAD I (OUNIT
 851         JMS I QH3       /YES, WRITE OUT BUFFER
 852         WRITE           /WRITE FROM FIELD 0
 853 PCOBUF, COBUF           /LOCATION COBUF
 854         JMP XER7        /OUTPUT ERROR
 855         TAD PCOBUF
 856         DCA COPTR       /BUFFER IS NOW EMPTY
 857         TAD RECSIZ
 858         CIA
 859         DCA COKNT
 860         EXIT CWRI
 861
 862 RECSIZ, 0               /RECORD SIZE ON OUTPUT
 863 COPTR,  COBUF           /PTS TO NEXT FREE LOCATION IN COBUF
 864 COKNT,  -1000           /NUMBER OF EMPTY SLOTS LEFT IN COBUF
 865
 866 XER7,   CIF CDF 10
 867         AND (40
 868         SZA CLA         /CLEAR LEADER?
 869         JMP I (ER5      /YES, DEVICE FULL
 870         JMP I (ER7      /OUTPUT ERROR
 871 XER4,   CIF CDF 10
 872         JMP I (ER4
 873 XER8,   CIF CDF 10
 874         JMP I (ER8
 875
 876 LDRFLG, 0               /NON-ZERO IF IGNORING LEADER
 877 CWTMP1, -1
 878 CWTMP2, -1
 879 CWTMP,  0
 880 QH3,    HANDLER
 881         PAGE
 882 \fPREFIN,        TAD (200
 883         JMS I (CWR2     /WRITE OUT TRAILER
 884         JMP CFIN2       /BUT NO CHECKSUM
 885 CFIN,   TAD I (CWTMP2   /V3C
 886         JMS I (CWR2
 887         TAD I (CWTMP1   /V3C
 888         JMS I (CWR2
 889 CFIN2,  JMS I (CWRI
 890         TAD I (OUNIT
 891 XCLOSE, JMS I (CLOSE
 892         JMP I (XER8
 893 XLV,    CIF CDF 10
 894         JMP I (DECODE
 895 \fCTRTEM,
 896 CREAD,  0
 897         TAD (OBUFFER
 898         DCA BIPTR
 899         TAD (-OBUFLEN
 900         DCA BIKNT
 901 ZRLUP,  CDF 10
 902         DCA I BIPTR     /ZERO BUFFER
 903         CLA IAC
 904         AND I (7643
 905         SZA CLA
 906         TAD (DCRE-CRE   /GOT L OPTION
 907         TAD (CRE
 908         CDF 0
 909         DCA XCRE        /PT TO INPUT SUBR
 910         INCR BIPTR
 911         ISZ BIKNT
 912         JMP ZRLUP
 913         TAD (OBUFFER
 914         DCA BIPTR
 915         TAD (-HOBUFLEN
 916         DCA BIKNT       /# OF DOUBLE-WORDS
 917 CRLOOP, JMS I XCRE
 918         CDF 10
 919         DCA I BIPTR
 920         JMS I XCRE
 921         DCA TEMP2
 922         JMS I XCRE
 923         DCA TEMP3
 924         CDF 10
 925         TAD TEMP3
 926         RTL
 927         RTL
 928         AND (7400
 929         TAD I BIPTR
 930         DCA I BIPTR
 931         INCR BIPTR
 932         TAD TEMP3
 933         RTR
 934         RTR
 935         RAR
 936         AND (7400
 937         TAD TEMP2
 938         DCA I BIPTR
 939         INCR BIPTR
 940         ISZ BIKNT
 941         JMP CRLOOP      /REITERATE
 942         CIF CDF 10
 943         TAD (MAXBLK
 944         DCA I (INTEN    /READ 10 BLOCKS
 945         EXIT CREAD      /ALL DONE
 946 \fBIPTR, 0               /PTS INTO OBUFFER
 947 BIKNT,  0
 948 XCRE,   CRE
 949
 950 CTRLC,  0
 951         KSF
 952         EXIT CTRLC
 953         TAD (7600
 954         KRS
 955         TAD (-7603
 956         SZA CLA
 957         EXIT CTRLC
 958         JMS I (CLEAR
 959         TAD I (OUNIT
 960         SPA CLA
 961         JMP I (7600
 962         TAD I (OUNIT
 963         DCA CTRTEM
 964         STA
 965         DCA I (OUNIT
 966         TAD CTRTEM
 967         JMS I (CLOSE
 968         JMP I (XER8
 969         JMP I (7600
 970 \fLOPTION,TAD I (IUNIT
 971         JMS I QU3
 972         REWIND
 973         JMP I (INER
 974         CLA IAC
 975         DCA I (CIBUF
 976 LM1,    JMP LM2         /ZERO FOR MAGTAPE
 977         JMS I QU3
 978         SKPFIL
 979         JMP I (INER
 980 LM2,    CIF CDF 10
 981         JMP I (CHLOOP
 982 LM3,    JMP LM2
 983 QU3,    UTIL
 984         PAGE
 985 \fCIKNT, -1              /ONE'S COMPLEMENT OF # OF BYTES LEFT IN CIBUF
 986 CIPTR,  CIBUF           /PTS TO NEXT BYTE IN CIBUF TO BE READ
 987
 988 CRE,    0
 989         CDF 0
 990         TAD FTFLG       /FIRST TIME THROUGH?
 991         SZA CLA
 992         JMP FT          /YES
 993         TAD TLRFLG
 994         SNA CLA
 995         JMP EPI         /TRAILER
 996         ISZ CIKNT
 997         SKP
 998         JMS I (CRED
 999         TAD I CIPTR
1000         JMS CHKSUM
1001         JMS CHKTLR
1002         TAD I CIPTR
1003         INCR CIPTR
1004 /       AND (377
1005         EXIT CRE
1006
1007
1008 /READ DIRECTORY
1009 DCRE,   0
1010         CDF 0
1011         ISZ CIKNT
1012         SKP
1013         JMS DCRED
1014         TAD I CIPTR
1015         TAD (-32
1016         SNA
1017         JMP DCRE+1      /ALLOW '32' TO SHORTEN BUFFER
1018         TAD (32
1019         SNA
1020         TAD (232
1021         INCR CIPTR
1022         EXIT DCRE
1023 \fFT,    DCA FTFLG
1024         TAD (200        /SEND LEADER
1025         EXIT CRE
1026
1027 CHKSUM, 0
1028         DCA CHTEM
1029         TAD CHTEM
1030         AND (200
1031         SNA CLA
1032         TAD CHTEM
1033         TAD CHECKSUM
1034         DCA CHECKSUM
1035         EXIT CHKSUM
1036 CHTEM,  0
1037 CHECKSUM,0
1038 FTFLG,  1               /1 IF FIRST TIME HERE
1039 CHKPTR, CHKTBL
1040 TLRFLG, 0
1041
1042 CHKTBL, 0               /CHECKSUM LEFT PART
1043         0               /CHECKSUM RIGHT PART
1044         200             /TRAILER
1045         32              /CTRL/Z
1046         -1              /TABLE END
1047
1048 CHKTLR, 0
1049         CDF 10
1050         TAD I (7643
1051         CDF 0
1052         RTL             /B SWITCH TO LINK
1053         SNL CLA
1054         EXIT CHKTLR
1055         TAD I CIPTR
1056         TAD (-200
1057         SZA CLA
1058         EXIT CHKTLR
1059         DCA TLRFLG
1060         TAD (CHKTBL
1061         DCA CHKPTR
1062         TAD CHECKSUM
1063         RTR
1064         RTR
1065         RTR
1066         AND (77
1067         DCA CHKTBL
1068         TAD CHECKSUM
1069         AND (77
1070         DCA CHKTBL+1
1071 EPI,    TAD I CHKPTR
1072         SPA
1073         JMP I (INTO
1074         INCR CHKPTR
1075         EXIT CRE
1076 \fDCRED, 0
1077         TAD (40
1078         DCA I (BSIZE
1079         TAD I PCIBUF
1080         SNA CLA
1081         JMP I (INTO
1082         TAD I (IUNIT
1083         JMS I QH4
1084         READ
1085 PCIBUF, CIBUF
1086         JMP I (INER
1087         TAD PCIBUF
1088         DCA CIPTR
1089         TAD I CIPTR
1090         SZA CLA
1091         TAD (-23
1092         TAD (-2
1093         DCA CIKNT
1094         JMS I (FIDDLE
1095         TAD I CIPTR
1096         SNA CLA
1097         EXIT DCRED
1098         JMS I QU4
1099         SKPFIL
1100         JMP I (INER
1101         EXIT DCRED
1102
1103 QH4,    HANDLER
1104 QU4,    UTIL
1105 /THIS WAS VERY UNOPTIMAL ADDING IN MAGTAPE SUPPORT
1106 /AFTER THE PROGRAM WAS ALL DONE AND BURIED.
1107 /IT COULD HAVE BEEN DONE IN A MUCH BETTER METHOD
1108 /IF IT WAS DESIGNED IN BEFORE THE PROGRAM WAS WRITTEN.
1109         PAGE
1110 \f/FIRST ARG: PTS TO OS/8 FILENAME IN FIELD 1
1111
1112 CONVRT, 0
1113         STA
1114         TAD I CONVRT
1115         DCA ONPTR
1116         INCR CONVRT
1117         TAD (SINCH
1118         DCA CNPTR
1119         TAD (-4
1120         DCA CKNT
1121 CONLUP, CDF 10
1122         INCR ONPTR
1123         TAD I ONPTR
1124         CDF 0
1125         RTR
1126         RTR
1127         RTR
1128         JMS CNV
1129         DCA I CNPTR
1130         INCR CNPTR
1131         CDF 10
1132         TAD I ONPTR
1133         CDF 0
1134         JMS CNV
1135         DCA I CNPTR
1136         INCR CNPTR
1137         ISZ CKNT
1138         JMP CONLUP
1139         TAD (40
1140         DCA I CNPTR
1141         CDF 10
1142         TAD I (7643
1143         CDF 0
1144         RTL
1145         SNL CLA
1146         EXIT CONVRT     / NOT /B
1147         CDF 10
1148         TAD I (7643
1149         RAL
1150         CLA
1151         TAD I ONPTR
1152         CDF 0
1153         SZA CLA
1154         EXIT CONVRT     /EXTENSION SPECIFIED
1155         SZL
1156         EXIT CONVRT     /   /A
1157         CLL STA RAL
1158         TAD CNPTR
1159         DCA CNPTR
1160         TAD ("B         /SET EXTENSION TO .BIN
1161         DCA I CNPTR
1162         INCR CNPTR
1163         TAD ("I
1164         DCA I CNPTR
1165         INCR CNPTR
1166         TAD ("N
1167         DCA I CNPTR
1168         EXIT CONVRT
1169 \fCNV,   0
1170         AND (77
1171         SZA             /CHANGE 0 TO BLANK
1172         TAD (40
1173         AND (77
1174         TAD (40
1175         EXIT CNV
1176
1177 ONPTR,  0
1178 CNPTR,  0
1179 CKNT,   0
1180
1181 LOOK4ME,JMS CONVRT
1182         7606
1183         TAD IUNIT
1184         JMS I (LOOKUP
1185         JMP I (XER4
1186         JMP XER24
1187         TAD I (INCH+12  /GET H.O. INPUT RECORD SIZE
1188         CLL RTR
1189         RTR
1190         RAR
1191         TAD I (INCH+13
1192         DCA INRECSZ
1193         TAD INRECSZ
1194         SNA
1195         JMP XER40       /RECORD SIZE 0
1196         CLL
1197         TAD (-1001
1198         SZL CLA
1199         JMP XER10
1200         CIF CDF 10
1201         JMP I (CHLOOP
1202
1203 XER24,  CIF CDF 10
1204         JMP I (ER24
1205 XER25,  CIF CDF 10
1206         JMP I (ER3
1207 \fOUNIT, 0
1208 IUNIT,  0
1209 /IN CASE OF CASSETTES, CONTAINS UNIT (AS CHAR)
1210 /IN CASE OF MAGTAPE, CONTAINS HANDLER ENTRY ADDRESS
1211 /OUNIT IS -1 DURING A ^C CLOSE
1212 /-1 MEANS DON'T CLOSE ON ERROR
1213 INRECSZ,200     /RECORD SIZE ON INPUT
1214 XER40,  CIF CDF 10
1215         JMP I (ER40
1216 XER10,  CIF CDF 10
1217         JMP I (ER10
1218 F1CTRLC,0
1219         JMS I (CTRLC
1220         CIF CDF 10
1221         EXIT F1CTRLC
1222         PAGE
1223 \fSINCH, ZBLOCK 16
1224         40;40;40;40;40;40
1225         ZBLOCK 14
1226 INCH,   ZBLOCK 40
1227
1228 LDRTST, 0
1229         TAD I (CWTMP
1230         TAD (-200
1231         SNA CLA         /LEADER?
1232         JMP I (CWREX    /YES, EXIT CWR
1233         DCA I (LDRFLG   /NO
1234         EXIT LDRTST
1235 \fENTERO,        TAD (COBUF
1236         DCA I (COPTR
1237         JMS I (CONVRT
1238         7601
1239         JMS I (MAKDAT
1240         TAD I (RECSIZ
1241         CLL RTL
1242         RTL
1243         RAL
1244         AND (17
1245         DCA I (SINCH+12
1246         TAD I (RECSIZ
1247         AND (377
1248         DCA I (SINCH+13
1249         CDF 10
1250         TAD I (FILTYP
1251         CDF 0
1252         DCA I (SINCH+11
1253         DCA I (SINCH+14
1254         DCA I (SINCH+15
1255         CDF 10
1256         TAD I (VRSNO
1257         CDF 0
1258         DCA I (SINCH+24
1259         TAD I (OUNIT
1260         JMS I (ENTER
1261         JMP I (XER25
1262         CIF CDF 10
1263         DCA I (OSWITCH
1264         JMP I (CONT1
1265         PAGE
1266 \fZOPTION,TAD I (OUNIT
1267         JMS I QU5
1268         REWIND
1269         JMP XER77       /OUTPUT ERROR
1270         CDF 10
1271         TAD I (7601
1272         CDF 0
1273         SNA CLA
1274         JMP NOFILE
1275         JMS I (CONVRT
1276         7601
1277         JMS I (LOOKUP
1278         JMP I (XER4
1279         JMP I (XER24
1280         JMS I QU5
1281         SKPFIL
1282         JMP I (XER24
1283         TAD (40
1284         DCA I (BSIZE
1285         JMS I QH5
1286         READ
1287         INCH
1288         JMP XER77
1289 CLO3,   JMS I (BACK
1290         JMP XER77
1291         JMS I QH5
1292         WRITE
1293         ZER
1294         JMP XER77
1295 NOFILE, JMP I (XCLOSE
1296 \fMAKDAT,        0
1297         CDF 10
1298         TAD I (DATE
1299         CDF 0
1300         SNA
1301         JMP SETOBL
1302         DCA SKNT
1303         TAD (SINCH+16
1304         DCA SPTR
1305         TAD SKNT
1306         RTR
1307         RAR
1308         AND (37
1309         JMS TWO         /INSERT DAY
1310         TAD SKNT
1311         RTL
1312         RTL
1313         RAL
1314         AND (17
1315         JMS TWO         /INSERT MONTH
1316         TAD SKNT
1317         AND (7
1318         TAD (106
1319         JMS TWO         /INSERT YEAR
1320         EXIT MAKDAT
1321
1322 SETOBL, TAD (-6         /SET DATE TO BLANKS
1323         DCA SKNT
1324         TAD (SINCH+16
1325         DCA SPTR
1326 SELOOP, TAD (40
1327         DCA I SPTR
1328         INCR SPTR
1329         ISZ SKNT
1330         JMP SELOOP
1331         EXIT MAKDAT
1332
1333 SPTR,   0
1334 SKNT,   0
1335 TEM2,   0
1336 TENS,   0
1337 \fTWO,   0
1338         DCA TEM2
1339         TAD (60
1340         DCA TENS
1341         TAD TEM2
1342 TWOLUP, TAD (-12
1343         SPA
1344         JMP NEG
1345         INCR TENS
1346         JMP TWOLUP
1347 NEG,    TAD (72
1348         DCA TEM2
1349         TAD TENS
1350         DCA I SPTR
1351         INCR SPTR
1352         TAD TEM2
1353         DCA I SPTR
1354         INCR SPTR
1355         EXIT TWO
1356
1357 XER77,  CIF CDF 10
1358         JMP I (ER7      /OUTPUT ERROR
1359
1360 QU5,    UTIL
1361 QH5,    HANDLER
1362 \fMHANDLER,0             /AC CONTAINS HANDLER ENTRY ADDRESS
1363         CIF 10
1364         JMP I (MHAN     /KLUDGEY LINK TO FIELD 1
1365
1366 MUTIL,  0               /AC CONTAINS ETC.
1367         CIF 10
1368         JMP I (MUT
1369         PAGE
1370 \f       FIELD 1
1371
1372         XR=10
1373
1374         *2000
1375
1376 START,  JMP DEC2        /NORMAL STARTING ADDRESS
1377 CHAIN,  JMP NODEC       /CHAIN STARTING ADDRESS
1378 DECODE, STL CLA RAR
1379         AND I (7642
1380         SZA CLA
1381         JMP KBM         /RETURN TO KBM ON $
1382 /       WOULD BE NICE HERE TO TELL CD/BATCH NOT TO SPOOL
1383 DEC2,   CALL (200
1384         5               /COMMAND DECODE
1385         5200            /USING SPECIAL MODE
1386 NODEC,  TAD (OUTHAND+1
1387         DCA ENTR        /RESET PTR TO HANDLER LOCATION
1388         STA
1389         DCA I (OSWITCH
1390         JMS I (CHKSW    /CHECK FOR SWITCH OPTIONS
1391         CDF 0
1392         DCA I (OUTSW
1393         STA
1394         DCA I (OUNIT
1395         CDF 10
1396         TAD I (7666
1397         DCA I (DATE
1398 FET,    TAD I (7600     /GET DEVICE NUMBER OF OUTPUT FILE
1399         SNA             /WAS ONE SPECIFIED?
1400         JMP NOF         /NO - NO OUTPUT FILE
1401         CALL (200
1402         1               /FETCH HANDLER
1403 ENTR,   OUTHAND+1       /INTO PAGES 2400 AND 2600
1404                         /REPLACED BY HANDLER STARTING ADDRESS
1405         JMP I (ER6              /OUTPUT DEVICE DOESN'T EXIST
1406         TAD I (7644
1407         AND (1000
1408         SZA CLA
1409         JMP I (FOXOUT   /O SPECIFIED
1410         STL CLA RTR
1411         AND I (7645
1412         TAD I (7601
1413         SNA CLA
1414         JMP NOCAS       /NO OUTPUT NAME
1415         TAD (7600
1416         JMS I (CHKNAM
1417         JMP I (STARER   /*.*
1418         TAD I (7600
1419         JMS I (TCAS     /CASSETTE?
1420         JMP I (FIXOUT   /YES
1421         JMP I (FXMOUT   /MAGTAPE
1422 NOCAS,  TAD (7601       /NO
1423         DCA OBLK        /GET PTR TO OUTPUT FILE NAME
1424         TAD ENTR
1425         DCA I (OENTRY   /STORE AWAY OUTPUT HANDLER ENTRY PT
1426         TAD (OWRITE
1427         DCA PWRITE
1428         TAD (FINIO
1429         DCA I (XFINIO
1430         TAD I (7643
1431         RTL
1432         SNL CLA
1433         JMP NOB
1434         TAD I (7604     /GET EXT
1435         SZA CLA
1436         JMP NOB
1437         TAD (216        /SET TO .BN
1438         DCA I (7604
1439 NOB,    TAD I (7600     /GET DEVICE NUMBER AGAIN
1440         CALL (200
1441         3               /OPEN OUTPUT FILE
1442 OBLK,   7601            /PTS TO OUTPUT FILE NAME
1443                         /REPLACED BY STARTING BLOCK NUMBER
1444 LEN,    0               /REPLACED BY NEGATIVE OF LENGTH OF OUT AREA
1445         JMP I (ER3      /FILE OPEN ERROR
1446         DCA I (REALEN   /ZERO REAL LENGTH
1447         TAD OBLK
1448         DCA I (OBLOCK   /SET STARTING BLOCK NUMBER
1449 CONT1,  JMS I (GETIN
1450 /       INITIALIZE INPUT STUFF
1451 CHLOOP, CIF CDF 0
1452         JMS I (F1CTRLC
1453         CALL PREAD
1454         CIF CDF 0
1455         JMS I (F1CTRLC
1456         CALL PWRITE
1457         JMP CHLOOP
1458 \fPREAD, OREAD
1459 PWRITE, OWRITE
1460 NOF,    STL CLA RTR
1461         AND I (7645
1462         SNA CLA
1463         JMP I (ER1
1464         JMP I (FOXOUT   /Z IMPLIES O
1465
1466 KBM,    CIF CDF 0
1467         JMP I (7605
1468         PAGE
1469 \fUDIG,  0
1470
1471 GETSWDIG,0
1472         DCA UDIG
1473         TAD I (7645
1474         AND (1774
1475         SNA
1476         EXIT GETSWDIG   /NO UNIT
1477         INCR GETSWDIG
1478         RTL
1479         RAL
1480 LUDIG,  SZL
1481         JMP GOTUD
1482         INCR UDIG
1483         RAL
1484         JMP LUDIG
1485 G7600,
1486 GOTUD,  7600
1487         TAD UDIG
1488         TAD (60
1489         EXIT GETSWDIG
1490 \fFOXOUT,        JMS GETSWDIG
1491         JMP I (ER1      /NO OUTPUT UNIT
1492         JMP GOTOU
1493 FIXOUT, TAD I (ENTR
1494         JMS I (GETDVC
1495 GOTOU,  CDF 0
1496         DCA I (OUNIT
1497         CDF 10
1498         JMS I (SETCAS
1499 YAHAOU, TAD I (7643
1500         AND (400
1501         SZA CLA
1502         JMP DOPT
1503         STL CLA RTR
1504         AND I (7645
1505         SZA CLA
1506         JMP ZOPT
1507         TAD I G7600
1508         RTR
1509         RTR
1510         AND (377        /ISOLATE FILE TYPE
1511         DCA FILTYP      /SAVE IT
1512         JMS I (GETLEN
1513         TAD (CW
1514         DCA I (PWRITE
1515         TAD (CFINIO
1516         DCA I (XFINIO
1517         TAD I (7643
1518         RTL             /B TO LINK
1519         SZL CLA
1520         CLA IAC
1521         CIF CDF 0
1522         DCA I (LDRFLG
1523         STA
1524         DCA I (CWTMP1
1525         STA
1526         DCA I (CWTMP2
1527         DCA I (CHECKSUM
1528         JMP I (ENTERO
1529 /       RETURN TO CONT1
1530
1531 FXMOUT, TAD I (ENTR
1532         CDF 0
1533         DCA I (OUNIT
1534         CDF 10
1535         JMS I (SETMAG
1536         TAD I (ENTR     /GET LOCATION OF MAGTAPE HANDLER
1537         JMS SETDEN
1538         JMP YAHAOU
1539 \fSETDEN,        0
1540         AND G7600
1541         DCA MTA
1542         TAD I (7644
1543         AND (10
1544         SZA CLA         /IS /U SPECIFIED?
1545         IAC             /YES, USE DENSITY 3
1546         TAD (2          /NO, USE DENSITY 2
1547         DCA DEN
1548         CDF 0
1549         TAD PARITY
1550         CLL RAR         /LINK ON IF PARITY SPECIFIED
1551         SZL
1552         TAD PAR
1553         SNL
1554         TAD I MTA       /GET RELATIVE LOC 0
1555         AND (400        /ISOLATE PARITY
1556         TAD DEN         /FORCE CORE DUMP MODE
1557         DCA I MTA       /STORE BACK DENSITY AND PARITY
1558         CDF 10
1559         JMP I SETDEN
1560 \fFILTYP,        0
1561 BINTYP, 0               /SET BINARY TYPE - DON'T TOUCH LINK
1562         IAC
1563         IAC
1564         DCA FILTYP
1565         EXIT BINTYP
1566
1567 DOPT,   CIF CDF 0
1568         JMP I (DOPTION
1569
1570 ZOPT,   CIF CDF 0
1571         JMP I (ZOPTION
1572
1573 MTA,    0               /FIRST LOC OF MAGTAPE HANDLER
1574 PARITY, 0               /0 MENAS NOT SPECIFIED, 1 MEANS SPECIFIED PARITY
1575 PAR,    0               /0 OR 400 SPECIFYING PARITY
1576 DEN,    2               /DENSITY
1577         PAGE
1578 \fFID2,  0
1579         TAD I (CIBUF
1580         AND (177                /DF=0
1581         TAD (-52
1582         SNA CLA
1583         JMS EMPTY
1584         TAD I (CIBUF+10
1585         DCA I (CIBUF+11
1586         TAD I (CIBUF+7
1587         DCA I (CIBUF+10
1588         TAD I (CIBUF+6
1589         DCA I (CIBUF+7
1590         TAD (".
1591         DCA I (CIBUF+6
1592         CIF 0
1593         JMP I FID2
1594
1595 EMPTY,  0
1596         TAD I (FAST
1597         SNA CLA
1598         JMP I EMPTY
1599         STA
1600         DCA I (CIKNT
1601         TAD (32
1602         DCA I (CIBUF
1603         CIF 0
1604         JMP I (FIDLV
1605 \fGETLEN,        0
1606         CLL STA RAR     /3777
1607         AND I (7642     /GET H.O. OPTION
1608         DCA VRSNO
1609         TAD I (7646     /GET = OPTION (L.O. 12 BITS)
1610         CLL
1611         TAD (-1001
1612         SZL CLA         /LESS THAN 1001?
1613         JMP I (ER10     /NO, ERROR
1614         TAD I (7646     /YES
1615         SNA
1616         TAD (200        /200 IS DEFAULT RECORD SIZE
1617         CDF 0
1618         DCA I (RECSIZ
1619         TAD I (RECSIZ
1620         CIA
1621         DCA I (COKNT
1622         CDF 10
1623         EXIT GETLEN
1624
1625 FINIO,  JMS I (OWRITE
1626         TAD I (7600     /GET OUTPUT DEVICE NUMBER
1627         CALL (200
1628         4               /CLOSE
1629         7601            /PTR TO FILE NAME
1630 REALEN, 0               /LENGTH OF NEW OUTPUT FILE
1631         JMP ER8         /CLOSE ERROR
1632         JMP I (DECODE
1633 ER8,    JMS I (PRINT
1634         TEXT    /?CLOSE ERROR/
1635 ER5,    JMS I (PRINT
1636         TEXT    /?OUTPUT DEVICE FULL/
1637 \fER30,  JMS I (PRINT
1638         TEXT    /?OUT=IN/
1639 VRSNO,  0
1640
1641 ER6,    JMS I (PRINT
1642         TEXT    /?FETCH ERROR/
1643 ER24,   STA
1644         DCA I (SPSWTCH  /RETURN FROM PRINT
1645         JMS I (PRINT
1646         TEXT    /?FILE NOT FOUND/
1647         ISZ I (FUDSW    /FIXUP CASSETTE
1648         JMP I (CLO
1649         PAGE
1650 \fOREAD, 0
1651         TAD (MAXBLK
1652         DCA INTEN       /TRY TO READ 10 BLOCKS
1653         TAD (MAXBLK^200+10
1654         DCA READSZ
1655         TAD I (7605
1656         AND (17
1657         TAD (7757
1658         DCA TEMP        /GET DCB ADDR
1659         TAD I TEMP      /GET DCB
1660         AND (1000
1661         SZA CLA
1662         JMP ER4         /INPUT DEVICE IS WRITE-ONLY
1663         TAD I TEMP
1664         SMA CLA
1665         JMP YES         /NOT FILE-STRUCTURED
1666         TAD I (INLEN
1667         TAD (MAXBLK
1668         SMA SZA CLA     /CAN I READ IN 10 BLOCKS?
1669         JMS SHORT       /NO
1670 YES,    CIF 0           /YES
1671         JMS I IENTRY    /CALL INPUT HANDLER
1672 READSZ, 2010            /READ 20 PAGES INTO FIELD 1
1673         OBUFFER         /LOCATION 4000
1674 IBLOCK, 0               /INPUT BLOCK NUMBER
1675         JMP QER4        /INPUT ERROR
1676         TAD IBLOCK
1677         TAD INTEN
1678         DCA IBLOCK      /UPDATE BLOCK NUMBER
1679         TAD I (INLEN
1680         TAD INTEN
1681         DCA I (INLEN    /UPDATE LENGTH LEFT
1682         TAD INTEN
1683         TAD (-MAXBLK
1684         SZA CLA
1685         JMP XFIN
1686         EXIT OREAD      /RETURN
1687 INTEN,  10              /NUMBER OF BLOCKS JUST READ
1688 XFINIO, FINIO
1689
1690 SHORT,  0
1691         TAD I (INLEN    /HOW MANY BLOCKS LEFT?
1692         CIA             /MAKE POSITIVE
1693         DCA INTEN       /THAT'S AS MUCH AS WE CAN READ
1694         TAD INTEN
1695         SNA
1696 XFIN,   JMP I XFINIO    /NO MORE
1697         CLL RTR
1698         RTR
1699         RTR             /CONVERT TO PAGES IN BITS 1-5
1700         TAD (10         /ADD IN FIELD 1 BIT
1701         DCA READSZ
1702         EXIT SHORT      /RETURN
1703 \fIENTRY,        0               /PTS TO INPUT HANDLER ENTRY POINT
1704 QER4,   SMA CLA
1705         JMP SFIN        /NON-FATAL END-OF FILE
1706 ER4,    JMS I (PRINT
1707         TEXT    /?INPUT ERROR/
1708 ER26,   JMS I (PRINT
1709         TEXT /?TOO MANY FILES/
1710 SFIN,   TAD (7600
1711         DCA TPTR
1712 SLUP,   STA
1713         TAD TPTR
1714         DCA TPTR
1715         TAD I TPTR
1716         SNA CLA
1717         JMP SLUP
1718         TAD TPTR
1719         TAD (-OBUFFER+1
1720         SNA
1721         JMP ALLZ
1722         TAD (377        /CHANGED FROM PIPC'S 376
1723         CLL RTL
1724         RTL
1725         RAL
1726         AND (17
1727         DCA INTEN
1728         JMP XFIN
1729 ALLZ,   CLA IAC
1730         JMP .-3
1731 TPTR,   0
1732 \fER3,   JMS I (PRINT
1733         TEXT    /?ENTER ERROR/
1734         PAGE
1735 \fGETIN, 0               /OPEN INPUT FILE
1736         DCA DATE
1737         TAD I (7605     /ANY MORE FILES SPECIFIED?
1738         SNA CLA
1739         JMP NOIN        /NO
1740         TAD I (7612
1741         SZA CLA
1742         JMP I (ER26     /2ND INPUT FILE IS BAD
1743         TAD (7605
1744         JMS I (CHKNAM
1745         JMP I (STARER   /*.*
1746         TAD (7606
1747         DCA IN          /SET PTR TO FILE NAME
1748         TAD (INHAND+1
1749         DCA IN3
1750         TAD I (7605     /GET DEVICE NUMBER
1751         CALL (200
1752         1               /FETCH NEW DEVICE HANDLER
1753 IN3,    INHAND+1        /INTO PAGES 3200 AND 3400
1754                         /REPLACED BY ENTRY PT TO INPUT HANDLER
1755         JMP I (ER6      /FETCH ERROR
1756         TAD I (7643
1757         AND (10
1758         SZA CLA
1759         JMP I (FOXIN    /I SPECIFIED
1760         CLA IAC         /V3C
1761         AND I (7643     /LOOK AT /L OPTION
1762         TAD I (7606
1763         SNA CLA
1764         JMP NOCAS2
1765 /IF NO NAME IS GIVEN AND /L IS NOT SPECIFIED, THEN USE
1766 /MAGTAPE OR CASSETTE HANDLER AS IS, I.E. AS
1767 /A NON-FILE-STRUCTURED OS/8 DRIVER.
1768         TAD I (7605
1769         JMS I (TCAS     /CASSETTE?
1770         JMP I (FIXIN    /YES
1771         JMP I (FIXMIN   /MAGTAPE
1772 NOCAS2, CLA IAC
1773         AND I (7643
1774         SZA CLA
1775         JMP ER11        /V3C  /L SPECIFIED WHEN DEVICE WAS NOT MAGTAPE OR CASSETTE
1776         TAD (OREAD
1777         DCA I (PREAD
1778         TAD IN3         /GET NEW HANDLER ENTRY PT
1779         DCA I (IENTRY   /STORE AWAY
1780         TAD I (7605     /GET DEVICE NUMBER AGAIN
1781         CALL (200
1782         2               /PERFORM A LOOKUP
1783 IN,     0               /PTR TO FILE NAME
1784                         /REPLACED BY INPUT BLOCK NUMBER
1785 IN2,    0               /REPLACED BY NEGATIVE OF INPUT FILE LENGTH
1786         JMP LKERR       /LOOKUP ERROR
1787         TAD IN          /GET NEW INPUT BLOCK
1788         DCA I (IBLOCK   /STORE AWAY
1789         TAD IN2         /GET NEW INPUT FILE LENGTH
1790         DCA INLEN
1791         TAD I (1404     /GET # OF ADDITIONAL WORDS
1792         SNA
1793         JMP NONE
1794         TAD 17
1795         DCA POINTER
1796         TAD I POINTER   /GET FILE CREATION DATE
1797         SNA
1798         JMP NONE
1799 SETDAT, DCA DATE
1800         EXIT GETIN
1801 NONE,   TAD I (7666     /USE TODAY'S DATE
1802         JMP SETDAT
1803 LKERR,  CLA
1804         TAD I (7611
1805         SZA CLA
1806         JMP I (ER24     /FILE NOT FOUND
1807         TAD I (7643     /TRY .BN
1808         RTL
1809         SNL CLA
1810         JMP I (ER24     / NOT /B
1811         TAD (216
1812         DCA I (7611
1813         JMP GETIN+1
1814
1815 INLEN,  0
1816 DATE,   0               /OS8 DATE OF INPUT FILE
1817 POINTER,0
1818
1819 NOIN,   CLA IAC
1820         AND I (7643
1821         SNA CLA
1822         JMP I (ER21
1823         JMP I (FOXIN    / /L SPECIFIED
1824 \fER11,  JMS I (PRINT    /V3C
1825         TEXT    /?L OPTION OUT OF CONTEXT/
1826         PAGE
1827 \f/ENTER WITH INTEN BLOCKS TO WRITE
1828 OWRITE, 0
1829         TAD I (INTEN    /HOW MUCH IS THERE TO WRITE?
1830         SNA
1831         EXIT OWRITE     /NOTHING
1832         DCA OUTEN       /SAVE NUMBER OF BLOCKS TO WRITE
1833         TAD I (7600
1834         AND (17
1835         TAD (7757
1836         DCA TEMP
1837         STL CLA RTR
1838         AND I TEMP
1839         SZA CLA
1840         JMP I (ER7      /OUTPUT DEVICE IS READ-ONLY
1841         TAD OUTEN
1842         CLL RTR
1843         RTR
1844         RTR             /CONVERT TO PAGES
1845         TAD (4010       /FIELD 1 (WRITE DIRECTLY FROM INPUT BUFFER)
1846         DCA WRSIZ
1847         TAD I (LEN
1848         SNA CLA
1849         JMP NFS         /NON-FILE STRUCTURED
1850         TAD I (REALEN
1851         TAD OUTEN
1852         STL
1853         TAD I (LEN
1854         SNL SZA CLA
1855         JMP I (ER5
1856 NFS,    CIF 0
1857         JMS I OENTRY    /CALL OUTPUT HANDLER
1858 WRSIZ,  6010            /WRITE 20 PAGES FROM FIELD 1
1859         OBUFFER         /LOCATION 4000
1860 OBLOCK, 0               /OUTPUT BLOCK NUMBER
1861         JMP I (ER7      /OUTPUT ERROR
1862         TAD OBLOCK
1863         TAD OUTEN
1864         DCA OBLOCK      /UPDATE OUTPUT BLOCK NUMBER
1865         TAD I (REALEN
1866         TAD OUTEN
1867         DCA I (REALEN   /UPDATE LENGTH WROTE
1868         EXIT OWRITE
1869
1870 OENTRY, 0
1871 OUTEN,  0
1872 \fFOXIN, JMS I (GETSWDIG
1873         JMP I (ER21
1874         JMP GOTIU
1875 FIXIN,  TAD I (IN3      /GET INPUT HANDLER ADDRESS
1876         JMS I (GETDVC
1877 GOTIU,  CDF 0
1878         DCA I (IUNIT
1879         CDF 10
1880         JMS I (SETCAS
1881 YAHAIN, CDF 0
1882         TAD I (OUNIT
1883         CIA
1884         TAD I (IUNIT
1885         SNA CLA
1886         JMP I (ER30
1887         STA
1888         DCA I (CIKNT
1889         DCA I (CHECKSUM
1890         CLA IAC
1891         DCA I (TLRFLG
1892         CDF 10
1893         TAD (CR
1894         DCA I (PREAD
1895         TAD I (7643
1896         RTL
1897         CLA RAL
1898         CDF 0
1899         DCA I (FTFLG
1900         CDF 10
1901         JMS I (GETLEN
1902         TAD I (7643
1903         AND (100        / F OPTION?
1904         CDF 0
1905         DCA I (FAST
1906         CDF 10
1907         CLA IAC
1908         AND I (7643
1909         CIF CDF 0
1910         SZA CLA
1911         JMP I (LOPTION
1912         JMP I (LOOK4ME
1913 /RETURN TO CHLOOP
1914 \fFIXMIN,        TAD I (IN3
1915         CDF 0
1916         DCA I (IUNIT
1917         CDF 10
1918         JMS I (SETMAG
1919         TAD I (IN3
1920         JMS I (SETDEN
1921         JMP YAHAIN
1922         PAGE
1923 \fPRINT, 0
1924         CLA
1925         CDF 10
1926         DCA CTOFLG      /ALLOW ECHOING
1927         JMS CRLF
1928 PRLUP,  TAD I PRINT
1929         RTR
1930         RTR
1931         RTR
1932         JMS PRIN
1933         TAD I PRINT
1934         JMS PRIN
1935         INCR PRINT
1936         JMP PRLUP
1937
1938 PRIN,   0
1939         AND (77
1940         SNA
1941         JMP PRFIN
1942         TAD (240
1943         AND (77
1944         TAD (240
1945         DCA TM
1946         KSF
1947         JMP NOBOTH
1948         TAD (200
1949         KRS
1950         TAD (-203
1951         SNA
1952         JMP KBM2
1953         TAD (203-217
1954         SZA CLA
1955         JMP NOBOTH
1956         TAD ("^
1957         JMS TYPE
1958         TAD ("O
1959         JMS TYPE
1960         JMS CRLF
1961         ISZ CTOFLG
1962 NOBOTH, TAD TM
1963         JMS TYPE
1964         EXIT PRIN
1965 PRFIN,  JMS CRLF
1966         DCA FUDSW
1967         TAD I (SPSWTCH
1968         SNA CLA
1969         JMP CLO
1970         DCA I (SPSWTCH  /SWITCH NON-ZERO MEANS RETURN
1971         INCR PRINT      /POINT TO RETURN
1972         JMP I PRINT
1973 \f/DO A CLOSE IF OUTPUT CASSETTE OPEN
1974 CLO,    CDF 0
1975         TAD I (OUNIT
1976         CDF 10
1977         SPA CLA
1978         JMP I (DECODE
1979         TAD OSWITCH
1980         SZA CLA
1981         JMP I (DECODE
1982         CDF 0
1983         TAD I (OUTSW
1984         CDF 10
1985         SNA CLA         /DID WE WRITE ON OUTPUT CASSETTE?
1986         JMP I (DECODE   /NO
1987         CIF CDF 0
1988         TAD I (OUNIT
1989         DCA TEMP
1990         STA
1991         DCA I (OUNIT
1992         TAD FUDSW
1993         SZA CLA
1994         JMP I (CLO3
1995         TAD TEMP
1996         JMP I (XCLOSE
1997 OSWITCH,-1              /0 MEANS OUTPUT CASSETTE OPEN
1998
1999 KBM2,   CIF CDF 0
2000         JMP I L7600     /RETURN TO OS/8
2001
2002 FUDSW,  0               /1 MEANS GOT OS/8 LOOKUP FAILURE
2003 \fTYPE,  0
2004         DCA TM
2005         TAD CTOFLG
2006         SZA CLA
2007         EXIT TYPE       /NOT ECHOING
2008         TAD TM
2009         TLS
2010         TSF
2011         JMP .-1
2012 L7600,  7600
2013         EXIT TYPE
2014
2015 CRLF,   0
2016         TAD (215
2017         JMS TYPE
2018         TAD (212
2019         JMS TYPE
2020         EXIT CRLF
2021
2022 CTOFLG, 0               /1 MEANS DON'T ECHO
2023 TM,     0
2024
2025 ER7,    JMS PRINT
2026         TEXT    /?OUTPUT ERROR/
2027
2028 CFINIO, CIF CDF 0
2029         JMS I (CWRITE
2030         CIF CDF 0
2031         JMP I (CFIN     /FINISH OUTPUT AND WRITE SENTINEL
2032 /RETURN TO DECODE
2033         PAGE
2034 \fER10,  JMS I (PRINT
2035         TEXT    /?RECORD SIZE TOO BIG/
2036 /ENTRY POINT REL 1: UNIT 1
2037 /ENTRY POINT REL 7: UNIT 0
2038
2039 GETDVC, 0
2040         IAC
2041         DCA TEMP
2042         STL CLA RTL     /2
2043         AND TEMP
2044         RAR
2045         DCA UNIT        /DETERMINE IF UNIT 0 OR 1
2046         TAD TEMP
2047         AND (7600
2048         DCA TEMP
2049         CDF 0
2050 LOOKIO, ISZ TEMP
2051         TAD I TEMP      /SEARCH HANDLER FOR ANY IOT
2052         AND (7700
2053         TAD (-6700
2054         SZA CLA
2055         JMP LOOKIO
2056         TAD I TEMP      /GET CASSETETE IOT
2057         CDF 10
2058         AND (30         /V3 BUG FIX FROM V2
2059         CLL RTR
2060         TAD UNIT
2061         TAD (60
2062         EXIT GETDVC     /LEAVE IT IN AC
2063
2064 UNIT,   0
2065 \fCHKNAM,        0               /DON'T ALLOW *'S OR ?'S
2066         DCA XR          /IN OUTPUT OR INPUT NAME
2067         TAD I XR
2068         TAD (-5200
2069         SNA
2070         JMP STARNM      /ENTIRE NAME IS *
2071         TAD (5200
2072         JMS CHKSTR
2073         TAD I XR
2074         JMS CHKSTR
2075         TAD I XR
2076         JMS CHKSTR
2077         TAD I XR
2078         JMS CHKSTR
2079         ISZ CHKNAM
2080         JMP I CHKNAM    /NAME GOOD, RETURN 2
2081
2082 CHKSTR, 0
2083         DCA TEM
2084         TAD TEM
2085         CLL RTR
2086         RTR
2087         RTR
2088         JMS CHC
2089         TAD TEM
2090         JMS CHC
2091         JMP I CHKSTR
2092 \fCHC,   0
2093         AND (77
2094         TAD (-52
2095         SNA
2096         JMP STARER      /* IN NAME
2097         TAD (52-77
2098         SZA CLA
2099         JMP I CHC       /OKAY
2100 STARER, JMS I (PRINT
2101         TEXT    /?ILLEGAL * OR ?/
2102
2103 STARNM, ISZ XR
2104         ISZ XR
2105         TAD I XR
2106         TAD (-5200
2107         SZA CLA
2108         JMP STARER      /NOT *.*
2109         JMP I CHKNAM    /TAKE SPECIAL RETURN ON *.*
2110
2111 TEM,    0
2112 \fCHKSW, 0               /CHECK SWITCHES
2113         TAD I (7644
2114         AND (4          /CHECK FOR /V
2115         SZA CLA
2116         JMS I (VERSN    /PRINT MCPIP VERSION #
2117         TAD I (7644
2118         AND (400        /CHECK FOR /P
2119                         /NOTE /P = 400 SAME AS ODD PARITY CODE
2120         SZA
2121         JMP ODDPAR
2122         TAD I (7643
2123         AND (200        /CHECK FOR /E
2124         SZA CLA
2125         JMP EVPAR
2126 GOTP,   NOP
2127         JMP I CHKSW
2128
2129 ODDPAR,                 /400 IN AC
2130 EVPAR,  DCA I (PAR
2131         CLA IAC
2132         DCA I (PARITY
2133         JMP GOTP
2134         PAGE
2135 \fSPSWTCH,0              /NON-ZERO MEANS RETURN FROM PRINT
2136
2137 /RET 1: CASSETTE
2138 /RET 2: MAGTAPE
2139 /RET 3: NEITHER
2140
2141 TCAS,   0
2142         AND (17         /ISOLATE
2143         TAD (7757       /ADD IN BASE OF DCB TABLE
2144         DCA TEMP        /TO GET DCB ADDRESS
2145         TAD I TEMP      /GET DCB
2146         AND (770        /ISOLATE UNIT TYPE
2147         TAD (-270       /CASSETTE HANDLER TYPE IS 27
2148         SNA
2149         JMP ITSCAS
2150         TAD (270-200
2151         SZA CLA
2152         INCR TCAS       /NOTHING SPECIAL
2153         INCR TCAS       /MAGTAPE
2154 ITSCAS, EXIT TCAS
2155 \fVERSN, 0
2156         STA
2157         DCA SPSWTCH     /RETURN FROM PRINT
2158         JMS I (PRINT
2159         TEXT    \OS/8 MCPIP V\
2160         *.-1
2161         PIPVERSION+60^100+PATCHLEV
2162         0
2163         JMP I VERSN
2164
2165 ER1,    TAD I (7605
2166         SNA CLA
2167         JMP I (DECODE   /NO OUT AND NO IN
2168         CLA IAC
2169         AND I (7643     /WAS /L SPECIFIED?
2170         SZA CLA
2171         JMP SETTY       /YES
2172         JMS I (PRINT
2173         TEXT    /?NO OUTPUT FILE/
2174 ER40,   JMS I (PRINT
2175         TEXT    /?CANNOT HANDLE VARIABLE-LENGTH RECORDS/
2176 \fSETTY, TAD (3100
2177         DCA Y
2178         JMS I (200
2179         12              /INQUIRE
2180 TT,     2424
2181 Y,      3100            /DEVICE TTY
2182         0
2183         JMP ER99
2184         TAD Y           /GET DEVICE NO. OF TTY:
2185         DCA I (7600
2186         JMP I (FET
2187
2188 ER99,   JMS I (PRINT
2189         TEXT    /?TTY DOES NOT EXIST/
2190 ER21,   JMS I (PRINT
2191         TEXT    /?NO INPUT FILE/
2192 \fCW,    0
2193         CIF CDF 0
2194         JMS I (CWRITE
2195         EXIT CW
2196
2197 CR,     0
2198         CIF CDF 0
2199         JMS I (CREAD
2200         EXIT CR
2201         PAGE
2202 \fSETCAS,        0
2203         TAD (UTIL
2204         JMS SETU
2205         TAD (HANDLER
2206         JMS SETH
2207         CDF 0
2208         TAD (BACKFIL
2209         DCA I (BK2
2210         TAD I (BK4
2211         DCA I (BK3
2212         TAD (254
2213         DCA I (EOFBIT
2214         TAD I (FL3
2215         DCA I (FL1
2216         TAD (314
2217         DCA I (EOTBIT
2218         TAD I (LM3
2219         DCA I (LM1
2220         CDF 10
2221         JMP I SETCAS
2222
2223 SETMAG, 0
2224         TAD (MUTIL
2225         JMS SETU
2226         TAD (MHANDLER
2227         JMS SETH
2228         CDF 0
2229         TAD (BACKBLOCK
2230         DCA I (BK2
2231         TAD I (BK1
2232         DCA I (BK3
2233         TAD (3673
2234         DCA I (EOFBIT
2235         DCA I (FL1
2236         TAD (3663
2237         DCA I (EOTBIT
2238         DCA I (LM1
2239         CDF 10
2240         JMP I SETMAG
2241 \fSETU,  0
2242         DCA SETH
2243         CDF 0
2244         TAD SETH
2245         DCA I (QU1
2246         TAD SETH
2247         DCA I (QU2
2248         TAD SETH
2249         DCA I (QU3
2250         TAD SETH
2251         DCA I (QU4
2252         TAD SETH
2253         DCA I (QU5
2254         CDF 10
2255         JMP I SETU
2256 \fSETH,  0
2257         DCA SETU
2258         CDF 0
2259         TAD SETU
2260         DCA  I (QH1
2261         TAD SETU
2262         DCA I (QH2
2263         TAD SETU
2264         DCA I (QH3
2265         TAD SETU
2266         DCA I (QH4
2267         TAD SETU
2268         DCA I (QH5
2269         CDF 10
2270         JMP I SETH
2271         PAGE
2272 \fMH,    0
2273
2274 MHAN,   SZA
2275         DCA MENTRY
2276         TAD I (MHANDLER
2277         DCA MH          /PICK UP ARGS VIA MH
2278         TAD I MH        /GET FN WORD
2279         TAD (SPCODE     /ADD SPECIAL CODE
2280         DCA MARG1
2281         ISZ MH
2282         TAD I MH        /GET CORE LOC
2283         DCA MARG2
2284         ISZ MH          /PT TO ERROR RETURN
2285         TAD I (BSIZE    /GET BLOCKSIZE
2286         CIA
2287         DCA MARG3       /STORE NEG
2288         CDF 10
2289         CIF 0
2290         JMS I MENTRY    /CALL MAGTAPE HANDLER
2291 MARG1,  HLT
2292 MARG2,  HLT
2293 MARG3,  HLT
2294         SKP             /TAKE ERROR RETURN
2295         ISZ MH          /NORMAL RETURN
2296         CIF CDF 0
2297         JMP I MH        /GO BACK TO FIELD 0
2298
2299 MENTRY, 0
2300 \fMU,    0
2301
2302 MUT,    SZA
2303         DCA MENTRY      /DF=0
2304         TAD I (MUTIL    /PICK UP ARGS
2305         DCA MU          /VIA 'MU'
2306         TAD I MU        /GET UTILITY FUNCTION
2307         ISZ MU
2308         CDF 10
2309         TAD (-REWIND
2310         SNA
2311         JMP REWT
2312         TAD (REWIND-BACKFIL
2313         SNA
2314         JMP BAKFT
2315         TAD (BACKFIL-WRGAP
2316         SNA
2317         JMP WRGT
2318         TAD (WRGAP-BACKBLOCK
2319         SNA
2320         JMP BAKBT
2321         TAD (BACKBLOCK-SKPFIL
2322         SZA CLA
2323         HLT             /IMPOSSIBLE
2324 SKPFT,  STL CLA RAR     /4000=WRITE
2325 BAKFT,  TAD (WRITE+FICODE-REWCOD
2326 REWT,   TAD (REWCOD-EOCODE
2327 WRGT,   TAD (EOCODE-RECCOD-WRITE
2328 BAKBT,  TAD (RECCOD+WRITE
2329         DCA MRG1
2330         CIF 0
2331         JMS I MENTRY
2332 MRG1,   HLT
2333 MCA,    HLT             /IRRELEVANT
2334 MWC,    -1
2335         SKP             /ERROR RETURN
2336         ISZ MU
2337         CIF CDF 0
2338         JMP I MU        /RETURN
2339 \fEMPTINCH,52;105;115;120;124;131;40;40;40;14
2340         0;0;0;0;40;40;40;40;40;40
2341         ZBLOCK 14
2342         PAGE
2343 \f       *2000
2344         $