software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape6 / MCPIP.PA
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/MCPIP.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/MCPIP.PA
new file mode 100644 (file)
index 0000000..283216c
--- /dev/null
@@ -0,0 +1,2344 @@
+/7     OS/8 MCPIP                              MAGTAPE AND CASSETTE PIP
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f
+/      S.R.
+
+/      REVISED FEB. 11, 1974
+/      SECOND REVISION: 7-AUG-75
+
+
+/1.    INSTALLED PATCH SEQ #1 , SEPT. 1974 DSN
+/      (NOW TRANSFERS LAST 2 BYTES CORRECTLY IN IMAGE MODE)
+/2.    BUMPED VERSION NUMBER TO V5
+/3.    FIXED /L BUG IF DEVICE NOT MAGTAPE OR CASSETTE
+
+       KCLR=6700       /CLEAR ALL
+                       /CLEAR STATUS A AND B REGISTERS.
+       KSDR=6701       /SKIP ON DATA FLAG
+       KSEN=6702       /SKIP ON ERROR
+       KSBF=6703       /SKIP ON READY FLAG
+       KLSA=6704       /LOAD STATUS A FROM AC 4-11
+                       /CLEAR AC, THEN
+                       /LOAD 8 BIT COMPLEMENT OF STATUS A
+                       /BACK INTO AC
+       KSAF=6705       /SKIP ON ANY FLAG OR ERROR
+       KGOA=6706       /ASSERT THE CONTENTS OF STATUS A,
+                       /TRANSFER DATA IF READ OR WRITE
+       KRSB=6707       /READ STATUS B INTO AC 4-11
+
+
+       FIXMRI CALL=4400
+       FIXMRI EXIT=5400
+       FIXMRI INCR=2000
+
+/CORE ALLOCATION
+
+/00000-01777   COMMAND DECODER
+/02000-02377   OUTPUT HANDLER
+/02400-02777   INPUT HANDLER
+/03000-03777   CASSETTE OUTPUT BUFFER
+/04000-04777   CASSETTE INPUT BUFFER
+/05000-05577   STAND ALONE CASSETTE HANDLER
+/05600-07577   LOOKUP, ENTER, CLOSE
+/07600-07777   OS/8
+
+/10000-11777   USR
+/12000-14577   PIPC
+/14600-17577   OS/8 INPUT/OUTPUT BUFFER
+/17600-17777   OS/8
+\f/USR HAS THE FOLLOWING FREE LOCATIONS:
+/0-6
+/10-17 (BUT GET DESTROYED)
+/20-37
+
+       TEMP=20
+       TEMP1=21
+       TEMP2=22
+       TEMP3=23
+
+/      STARTING ADDRESS = 12000
+/      JOB STATUS WORD = 6003
+
+       INHAND=2400
+       OUTHAND=2000
+       COBUF=3000
+       CIBUF=4000
+
+       PIPVERSION=6
+       PATCHLEV=77&"A
+       SPCODE=6
+       CLCODE=0
+       REWCOD=1
+       FICODE=3
+       EOCODE=5
+       RECCOD=2
+\f/V3 CHANGES:
+
+/1.    SHRUNK 0S/8 BUFFER TO 3000 WORDS
+/2.    ADDED VERSION NUMBER (/V)
+/3.    MADE INDEPENDENT OF MAGIC LOCATIONS IN CASSETTE HANDLER
+/4.    ADDED MAGTAPE SUPPORT OF CASSETTE FILE STRUCTURE
+/5.    ALTMODE MEANS RETURN TO KBM
+/6.    ^C DOESN'T CLOSE CASSETTES UNLESS WE ALREADY WROTE ON IT
+/7.    FIXED BUG THAT CSA2 THRU CSA7 DIDN'T WORK
+/8.    CR ALONE TO CD GIVES NO ERROR MESSAGE
+/9.    ADDED ^O AND ^C SUPPORT TO MESSAGE PRINTOUT
+/10.   GIVE ERRORS ON ILLEGAL * OR ? IN NAME
+/11.   USES TTY: AS DEFAULT OUTPUT DEVICE ON /L
+
+/PROPOSED:
+/8.    ALLOW *.* FOR CASSETTE INPUT
+/9.    SUPPORT OF UNLABELED MAGTAPE STANDARD
+/10.   /7 OR /9 SPECIFIES CHANNEL
+
+/FIXES SINCE FIELD TEST :
+
+/1.    ^C ALWAYS BRINGS YOU BACK TO KBM
+/2.    FIXED BUG RE CHECK FOR FILE FULL
+/3.    MADE COMPATIBLE WITH NEW TM8E HANDLER
+/4.    TIME-OUT ON CASSETTE READ
+/5.    BE NICE-GUY IF OS/8 LOOKUP FAILURE
+\f/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
+/AND READY.
+/THE NEW UNIT NUMBER (0-7) IS IN THE AC.
+/THE UNIT  NUMBER IS IN BITS 8-11 OF THE AC.
+/RETURN 1 IS MADE IF THE UNIT IS NOT READY.
+/CINUSE IS SET TO 1.
+/THE HANDLER MUST NOT ALREADY BE IN USE.
+/THE DATA FIELD IS INTERROGATED
+/AND A RETURN CIF CDF IS BUILT
+/AND STORED IN LOCATION RETCIF
+
+\f      *5000
+
+FIXDVC,        0
+       DCA DVC
+       RDF
+       TAD (CIF CDF
+       CDF 0
+       DCA TMP
+       TAD I FIXDVC
+       DCA ERRET
+       ISZ FIXDVC
+       TAD TMP
+       DCA I ERRET
+       TAD DVC
+       SNA
+       JMP CHECKR
+       RAR             /MOVE UNIT TO LINK; DEVICE TO AC
+       AND (3          /MASK OFF DEVICE CODE
+       DCA DVC         /SAVE DEVICE CODE
+       SZL
+       TAD (100
+       DCA I (ABUNIT   /SET UNIT IN BIT 5
+       TAD DVC
+       CLL RTL
+       RAL             /UGLY
+       DCA DVC         /MOVE TO BITS 6-8
+       TAD (IOTBL
+       DCA IOTPTR
+IOTLOOP,TAD I IOTPTR
+       SNA             /END OF TABLE?
+       JMP CHECKR      /YES
+       DCA TMP
+       TAD I TMP
+       AND (7707       /MASK OUT OLD DVC
+       TAD DVC         /INSERT NEW ONE
+       DCA I TMP       /REPLACE
+       ISZ IOTPTR      /POINT TO NEXT ONE
+       JMP IOTLOOP
+
+TMP,   0
+DVC,   0               /DEVICE CODE
+IOTPTR,        0
+\fCHECKR,       JMS I (CLEAR
+       TAD (200
+       JMS I (LOADA    /SELECT DRIVE
+       JMS I (CHECKB
+       AND (7735       /IGNORE EOT/BOT FLAG
+                       /AND WLO
+       TAD (-1
+       SZA CLA
+       JMP I ERRET     /NOT READY
+       ISZ I (CINUSE
+       JMP I FIXDVC
+
+ERRET, 0               /ERROR RETURN LOCATION
+\fFIDDLE,       0
+       CIF 10
+       JMS I (FID2     /NEED ROOM
+       TAD (CIBUF+11
+       DCA 10
+       TAD FAST
+       SZA CLA
+       JMP DIREOL
+       TAD (40
+       DCA I 10
+       TAD I (CIBUF+20
+       DCA I 10
+       TAD I (CIBUF+20
+       AND (177
+       SZA
+       TAD (-40
+       SZA CLA
+       TAD ("/-40
+       TAD (40
+       DCA SLSH
+       TAD I (CIBUF+21
+       DCA I 10
+       TAD SLSH
+       DCA I 10
+       INCR 10
+       INCR 10
+       TAD SLSH
+       DCA I 10
+       TAD I (CIBUF+22
+       DCA I 10
+       TAD I (CIBUF+23
+       DCA I 10
+DIREOL,        TAD (15
+       DCA I 10
+       TAD (12
+       DCA I 10
+       TAD (32
+       DCA I 10
+FIDLV, EXIT FIDDLE
+
+/0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 17 20 21 22 23 24 25
+/F I L E N A M E S                  D  D  M  M  Y  Y
+/F I L E N A . M E S       M  M  /  D  D  /  Y  Y CR LF ^Z
+
+FAST,  0               /0 MEANS F NOT SPECIFIED
+\fSLSH, "/
+
+IOTBL, IOT0
+       IOT1
+       IOT4
+       IOT5
+       IOT6
+       IOT6C
+       IOT7
+       0
+       PAGE
+\fUTIL, 0
+       DCA TEMPU
+       DCA REWSW       /ZERO REWIND SWITCH
+       TAD I UTIL
+       TAD (-10
+       SNA
+       ISZ REWSW
+       ISZ UTIL
+       TAD (210
+       DCA TEMPFN
+       TAD TEMPU
+       JMS I (FIXDVC   /FIX DEVICE CODE
+       UTEND           /UNIT NOT READY
+       TAD (UT
+       DCA CRET        /SET RETURN ADDRESS
+       STA
+       DCA I (RW       /NOTE FACT THAT OP AINT READ
+       TAD TEMPFN
+       JMS I (LOADA
+       JMS GO          /INITIATE UTIL
+       JMP CRET+1
+       ISZ UTIL
+UTEND, HLT
+       JMP I UTIL
+UT,    JMS CHECKB      /LOOK AT STATUS B
+       AND (50         /CHECK FOR CL, EMPTY, OR WLO
+                       /GIVE NO ERROR ON WLO ************
+                       /BAD FOR WRGAP
+       SNA
+       JMP OK          /NO ERRORS
+       TAD (-40
+       SZA CLA
+       JMP NOTOK       /ERROR NOT CL
+       TAD REWSW
+       SNA CLA         /CL OK IF DID REWIND
+NOTOK, STA
+OK,    JMS CLEAR
+       TAD CINUSE
+       SMA CLA
+       JMP UTEND-1
+       TAD BSTATE      /ERROR
+       JMP UTEND
+
+TEMPU, 0
+TEMPFN,        0
+REWSW, 0               /1 MEANS OPERATION IS REWIND
+\fCHECKB,       0
+IOT7,  KRSB            /READ STATUS B INTO AC 4-11
+       DCA BSTATE      /SAVE STATUS B
+       TAD BSTATE
+       JMP I CHECKB
+
+CLEAR, 0
+       DCA CINUSE      /LEAVE STATUS CONDITION IN AC; -1 MEANS  ERROR
+IOT0,  KCLR            /CLEAR STATUS A AND B
+       JMP I CLEAR
+
+GO,    0
+IOT6,  KGOA            /ASSERT CONTENTS OF STATUS A
+       CLA
+       JMP I GO
+
+CHK,   0
+       JMS I (CHECKB
+       AND (374
+IOT1,  KSDR
+       SKP             /DATA FLAG NOT UP -
+       JMP I CHK
+       TAD (-20
+       SNA CLA         /IS IT END OF FILE?
+       JMP I (ERRR     /YES, ERROR - BUT DON'T RETRY
+       TAD BSTATE
+       JMP I CHK
+
+CINUSE,        0               /1 MEANS HANDLER IN USE
+BSTATE,        0               /STATUS OF REGISTER B ON ERROR
+\fDTEM, 0
+
+DOPTION,JMS I (CONVRT
+       7601
+       DCA DTEM
+       TAD I (OUNIT
+       JMS I (LOOKUP
+       JMP I (XER4
+       JMP MBNF        /NOT FOUND
+       INCR DTEM
+       JMS I (DELET
+       JMP I (XER77    /OUTPUT ERROR
+MBNF,  TAD DTEM
+       SNA CLA         /ANYTHING DELETED?
+       JMP I (XER24    /NO
+       JMS UTIL
+       REWIND
+       CLA
+       CIF CDF 10      /YES
+       JMP I (DECODE
+\fCRET, 0
+       CDF 0
+       TAD (-200       /COUNT OF HOW LONG TO WAIT
+       DCA I (OUTER
+IOL,   JMS I (CTRLC
+       JMS I (TIMEOUT
+IOT5,  KSAF
+       JMP IOL
+       EXIT CRET
+       PAGE
+\fHANDLER,0
+       DCA TUN
+       TAD I HANDLER   /GET FUNCTION CONTROL WORD
+       AND L70         /ISOLATE FIELD OF BUFFER
+       TAD LCDF
+       DCA WCDF
+       TAD I HANDLER   /RETRIEVE FUNCTION CONTROL WORD
+       RAL             /READ/WRITE BIT TO LINK
+       CLA RAL
+       DCA RW          /RW=1 IF WRITE
+       ISZ HANDLER     /POINT TO BUFFER ADDRESS
+       TAD I HANDLER   /GET BUFFER ADDRESS
+       DCA BUFFER      /SAVE IT
+       ISZ HANDLER     /POINT TO ERROR RETURN
+       TAD TUN
+       JMS I (FIXDVC
+       LV              /NOT READY
+       TAD WCDF
+       DCA BFIELD
+       TAD WCDF
+       DCA BFLD
+       STA CLL RTL     /TAD (-3
+       DCA ERKNT
+       JMS     SETUP   /SET UP READ OR WRITE
+       JMP I (CRET+1
+       ISZ HANDLER     /POINT TO GOOD RETURN
+LV,    HLT
+       JMP I HANDLER
+RW,    0               /1 IF WRITE (-1 IF UTIL)
+ERKNT, -3
+\fSETUP,        0
+       TAD RW
+       TAD (WRITEX
+       DCA I (CRET     /SET RETURN ADDRESS
+       TAD BUFFER
+       DCA BPTR
+       TAD BSIZE
+       CMA             /WANT TO READ ONE MORE
+       TAD RW
+       DCA BKNT
+       TAD RW
+       DCA OUTSW
+       TAD RW
+       CLL RTL
+       RTL             /WRITE FN CODE=20
+       TAD (200        /SELECT AND INTERRUPT ENABLE
+       JMS I (LOADA
+WCDF,  HLT
+       TAD RW
+       SZA CLA
+       TAD I BPTR
+LCDF,  CDF 0
+       JMS I (GO
+       JMP I   SETUP
+
+\fREADX,        JMS I (CHK
+       AND L374
+       SZA
+       JMP ERRX
+IOT6C, KGOA            /GET CHAR JUST READ
+       DCA BYTE
+       ISZ BKNT
+       SKP
+       JMP RWCRC
+BMODE, TAD BYTE
+TUN,
+BFLD,  HLT
+       DCA I BPTR
+       ISZ BPTR
+L374,  374
+       JMP I (CRET+1   /CRET ALREADY SET UP
+
+BSIZE, 200
+OUTSW, 0               /1 MEANS WE BEGAN TO WRITE
+\fRWCRC,        TAD (260        /ENABLE, ENABLE INTER, READ CRC
+       JMS I (LOADA
+       JMS I (GO
+       JMS I (CRET
+       JMS I (CHK
+CRCMN, JMS I (GO
+       JMS I (CRET
+       JMS I (CHECKB
+       AND (7775       /IGNORE WLO
+       TAD (-1
+ERRX,  SNA CLA         /ERRORS?
+       JMP     ERRR+1  /NO - CLEAN BILL OF HEALTH
+       ISZ     ERKNT   /TRY 3 TIMES
+       JMP I   (ERRCOV /RETRY
+ERRR,  STA             /ERROR WHILE READING CRC
+       JMS I (CLEAR
+       TAD I (CINUSE
+       SMA CLA
+       JMP LV-1
+       TAD I (BSTATE
+       JMP LV
+\fWRITEX,       JMP READX
+       JMS I (CHK
+       SZA
+       JMP ERRX
+       ISZ BKNT
+       SKP
+       JMP WCRC
+BFIELD,        HLT
+       ISZ BPTR
+L70,   70
+       TAD I BPTR
+       JMS I (GO
+       JMP I (CRET+1
+
+
+WCRC,  TAD (260
+       JMS I (LOADA
+       JMP CRCMN
+BKNT,  0               /NUMBER OF CHARS EXPECTED
+BPTR,  0               /NEXT LOCATION IN BUFFER TO STORE INTO
+BYTE,  0               /TEMPORARILY HOLDS BYTE FOUND
+BUFFER,        0
+       PAGE
+\f/ LOOKUP, ETC.
+
+       F1=10
+       READ=0
+       WRITE=4000
+
+       REWIND=10
+       BACKFIL=30
+       WRGAP=40
+       BACKBLOCK=50
+       SKPFIL=70
+
+       HSIZE=40
+       OBUFFER=4600    /LOCATION OF OS/8 I/O BUFFER
+       BINBUF=OBUFFER
+       OBUFLEN=3000
+       HOBUFLEN=OBUFLEN%2
+       MAXBLK=OBUFLEN%400
+
+FILNUM,        0
+/      ENTER
+
+/      TAD UNIT
+/      JMS I (ENTER
+/      <ERROR RETURN>
+/      <NORMAL RETURN>
+
+/      ENTER FILENAME AS SPECIFIED IN SINCH
+/      USER MUST SET SINCH BUT ONLY FIRST 25 (OCTAL) LOCATIONS.
+
+ENTER, 0
+       JMS I (LOOKUP
+       JMP ERET        /ERROR WHILE READING
+       JMP NTF
+       JMS I (DELET
+       JMP ERET        /ERROR WHILE DELETING
+NTF,   JMS BACK
+       JMP ERET        /ERROR BACKING UP
+       JMS I QH1       /WRITE NEW HEADER
+       WRITE
+       SINCH
+       JMP ERET        /CASSETTE NOT READY
+       TAD I (RECSIZ
+       DCA I (BSIZE
+       INCR ENTER
+ERET,  EXIT ENTER
+
+RDOR,  0
+       AND (374        /CASSETTE ONLY
+       TAD (-200
+       SZA CLA         /WAS ERROR JUST CRC?
+       EXIT BACK       /NO
+       EXIT RDOR       /YES, OK CONTINUE
+\fBACK, 0
+BK4,   JMS I QU1
+BK2,   BACKFIL         /GO BACK TO FILE GAP
+       EXIT BACK
+BK3,   JMS I QU1
+       BACKBLOCK       /BACK TO LAST RECORD
+       JMP BKERR
+       TAD I (RECSIZ
+       DCA I (BSIZE
+       JMS I QH1       /READ LAST RECORD OF PREV FILE
+       READ+F1         /DON'T STORE IN BUFFER
+       BINBUF
+       JMS RDOR        /^*******
+                       /ERROR READING LAST BLOCK
+NEWGAP,        JMS I QU1
+       WRGAP           /WRITE A NEW GAP
+       EXIT BACK
+BK9,   TAD (HSIZE
+       DCA I (BSIZE
+       INCR BACK
+       EXIT BACK
+
+BKERR, AND (3775       /CASSETTES ONLY
+       TAD (-41
+       SZA CLA         /WAS ERROR CLEAR LEADER?
+       EXIT BACK
+       JMP NEWGAP
+
+BK1,   JMP BK9
+
+/FOR MAGTAPES:
+
+/BK2_BACKBLOCK
+/BK3_BK1
+\fCLOSE,        0
+       JMS I QU1
+       WRGAP
+       JMP CLRET       /ERROR WHILE WRITING GAP
+       TAD (HSIZE
+       DCA I (BSIZE
+       JMS I QH1
+       WRITE           /WRITE SENTINEL
+       ZER
+       JMP CLRET
+       JMS I QU1
+       REWIND
+       JMP CLRET
+       INCR CLOSE      /SKIP ERROR RETURN
+CLRET, EXIT CLOSE
+\fCRED, 0
+       TAD I (INRECSZ
+       DCA I (BSIZE
+       TAD I (IUNIT
+       JMS I QH1
+       READ
+       CIBUF
+       JMP INER
+       TAD (CIBUF
+       DCA I (CIPTR
+       TAD I (INRECSZ
+       CIA
+       DCA I (CIKNT
+/      CLA IAC
+/      DCA DATAFLG
+       EXIT CRED
+INER,  AND EOFBIT
+       SZA CLA         /REAL ERROR?
+       JMP I (XER4     /YES
+/      TAD DATAFLG
+/      SNA CLA         /READ ANY DATA?
+/      JMP INTO        /NO REWIND
+/      DCA DATAFLG     /YES, COULD CLOSE OUTPUT AND OPEN NEXT INPUT
+INTO,  CLA
+       TAD I (IUNIT
+       JMS I QU1
+       REWIND
+       CLA
+       TAD I (BIPTR
+       CIF CDF 10      /NO, MERELY END-OF-FILE
+       TAD (-OBUFFER+377
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA I (INTEN    /NUMBER OF BLOCKS GOT
+       JMP I (XFIN
+
+LOADA, 0
+       TAD ABUNIT
+IOT4,  KLSA
+       CLA
+       JMP I LOADA
+
+EOFBIT,        254             /CHANGED TO 3673 FOR MAGTAPE
+/DATAFLG,0             /1 MEANS READ DATA
+\fQU1,  UTIL
+QH1,   HANDLER
+ABUNIT,        0
+       PAGE
+\f
+/      LOOKUP
+
+/      TAD UNIT
+/      JMS I (LOOKUP
+/      I/O ERROR RETURN
+/      <NOT FOUND RETURN>
+/      <FOUND RETURN>
+/      ALWAYS LOOKS FOR THING SPECIFIED IN SINCH
+
+LOOKUP,        0
+       DCA P1
+       CDF 10
+       TAD I (7644
+       CDF 0
+       AND (10         /IS /U SPECIFIED?
+       SZA CLA
+       JMP GOODRT      /YES, DO NOTHING
+       TAD P1
+       JMS I QU2
+       REWIND
+       JMP ERRIT
+       TAD (HSIZE      /SET LENGTH OF RECORD HEADER
+       DCA I (BSIZE
+       DCA I (FILNUM
+FL1,   JMP FL2         /ZERO THIS LOCATION FOR MAGTAPES
+FLOOP, JMS I QU2
+       SKPFIL
+       JMP ERRIT
+FL2,   INCR I (FILNUM
+       JMS I QH2
+       READ
+       INCH
+       JMP ERRIT
+       TAD (INCH
+       DCA P1
+       TAD I P1
+       SNA CLA         /SENTINEL FILE?
+       JMP NFNDRET     /YES, NOT FOUND
+       TAD (SINCH      /NO, IS THIS THE ONE WANTED?
+       DCA P2
+       TAD (-10
+       DCA SCNT
+\fSLOOP,        TAD I P1
+       CIA
+       TAD I P2
+       AND (177        /ONLY LAST 7 BITS NEED MATCH
+       SZA CLA
+       JMP FLOOP       /FILE KEY NOT ONE DESIRED
+       INCR P1
+       INCR P2
+       ISZ SCNT
+       JMP SLOOP
+GOODRT,        INCR LOOKUP     /SKIP NOT FOUND RETURN
+NFNDRET,INCR LOOKUP    /SKIP ERROR RETURN
+ERRIT, CLA
+       TAD I (RECSIZ
+       DCA I (BSIZE    /BE NICE TO USER
+LRET,  EXIT LOOKUP     /BYE-BYE
+
+ERRT,  AND EOTBIT      /REAL ERROR?
+       SZA CLA
+       JMP ERRIT       /YES
+       JMP NFNDRET     /NO, MERELY END-OF CASSETTE
+
+/END OF CASSETTD IS SIGNALLED BY
+
+/A     SENTINEL FILE
+/B     DOUBLE FILE GAP
+/C     EOT
+
+EOTBIT,        314             /CHANGE TO 3663 FOR MAGTAPE
+\fP1,   0
+P2,    0
+SCNT,  0
+DELET, 0
+       JMS I (BACK
+       EXIT DELET
+       JMS I QH2       /WRITE EMPTY HEADER
+       WRITE+10
+       EMPTINCH
+       EXIT DELET      /ERROR WHILE DELETING
+       CLL STA RAL     /-2
+       TAD LOOKUP
+       DCA LOOKUP
+       JMP FLOOP       /JUMP INTO LOOKUP TO CONTINUE
+ZER,   0
+
+QH2,   HANDLER
+QU2,   UTIL
+FL3,   JMP FL2
+\fERRCOV,       JMS I (CLEAR
+       JMS I (CTRLC
+       TAD     (250
+       JMS I   (LOADA
+       JMS I   (GO     /BACKSPACE BLOCK
+       JMS I   (CRET   /WAIT
+       JMS I   (CHECKB
+       AND     (374    /KILL WRITE-LOCK BIT
+       SZA CLA
+       JMP I   (ERRR
+       JMS I   (SETUP  /RE-SET UP OPERATION
+       JMP I   (CRET+1 /GO AWAY
+\fTIMEOUT,0
+       ISZ INNER
+       JMP I TIMEOUT
+       ISZ OUTER
+       JMP I TIMEOUT
+       TAD I (RW       / I/O HAS TAKEN A LOT OF TIME
+       SZA CLA         /IS IT A READ OP?
+       JMP I TIMEOUT   /NO, RETURN
+       JMP I (ERRR     /YES, ERROR
+
+INNER, 0
+OUTER, -200
+       PAGE
+\f/SEND CONTENTS OF OS/8 BUFFER TO CASSETTE
+/VIA CASSETTE OUTPUT BUFFER
+
+CWRITE,        0
+       TAD (OBUFFER
+       DCA BUPTR       /PT TO BEGIN OF BUFFER
+       CDF 10
+       TAD I (INTEN    /GET NO. OF BLOCKS READ
+       SNA
+       JMP CWLV
+       CDF 0
+       CLL RTR
+       RTR
+       RAR             /CONVERT TO WORDS
+       IAC
+       AND (7776       /ROUND UP TO EVEN NO.
+       CLL RAR         /DIVIDE BY TWO
+       CIA             /USE AS COUNT OF DOUBLE-WORDS
+       DCA BUKNT       /2000 TWO-WORD ENTRIES
+CWLOOP,        CDF 10
+       TAD I BUPTR
+       JMS CWR         /SENT TO CASSETTE OUTPUT BUFFER
+       CDF 10
+       TAD I BUPTR
+       AND (7400
+       DCA TEMP1
+       INCR BUPTR      /PT TO 2ND HALF
+       TAD I BUPTR
+       JMS CWR
+       CDF 10
+       TAD I BUPTR
+       AND (7400
+       CLL RTR
+       RTR
+       TAD TEMP1
+       RTR
+       RTR
+       JMS CWR
+       INCR BUPTR      /PT TO NEXT DOUBLE-WORD
+       ISZ BUKNT       /AT END OF BUFFER?
+       JMP CWLOOP      /NO
+CWLV,  CIF CDF 10
+       EXIT CWRITE     /YES, RETURN
+BUPTR, 0               /PTS INTO OBUUFER
+BUKNT, 0
+\f/INSERT CHAR IN CASSETTE OUTPUT BUFFER
+/AND OUTPUT BUFFER IF BUFFER FULL
+
+CWR,   0
+       AND (377
+       CDF 0
+       DCA CWTMP
+       TAD LDRFLG
+       SZA CLA
+       JMS I (LDRTST
+       CDF 10
+       TAD I (7643
+       RTL             /PUT /B OPTION IN LINK
+       CDF 0
+       SNL CLA
+       JMP GOK
+       TAD CWTMP
+       TAD M200
+       SNA CLA
+       JMP I (PREFIN
+GOK,   TAD CWTMP2
+       JMS CWR2
+       TAD CWTMP1
+       DCA CWTMP2
+       TAD CWTMP
+       DCA CWTMP1
+CWREX, EXIT CWR
+
+CWR2,  0
+       SPA
+       JMP CWRIGN      /IGNORE -1
+       CDF 0
+       DCA I COPTR     /INSERT CHAR IN COBUF
+       INCR COPTR
+       ISZ COKNT       /COBUF FULL?
+       EXIT CWR2       /NO, SO RETURN
+       JMS CWRI
+M200,
+CWRIGN,        7600            /CLA
+       EXIT CWR2
+\fCWRI, 0
+       TAD COKNT
+       TAD RECSIZ
+       SNA CLA
+       EXIT CWRI       /DO NOTHING IF BUFFER EMPTY
+       TAD RECSIZ
+       DCA I (BSIZE
+       TAD I (OUNIT
+       JMS I QH3       /YES, WRITE OUT BUFFER
+       WRITE           /WRITE FROM FIELD 0
+PCOBUF,        COBUF           /LOCATION COBUF
+       JMP XER7        /OUTPUT ERROR
+       TAD PCOBUF
+       DCA COPTR       /BUFFER IS NOW EMPTY
+       TAD RECSIZ
+       CIA
+       DCA COKNT
+       EXIT CWRI
+
+RECSIZ,        0               /RECORD SIZE ON OUTPUT
+COPTR, COBUF           /PTS TO NEXT FREE LOCATION IN COBUF
+COKNT, -1000           /NUMBER OF EMPTY SLOTS LEFT IN COBUF
+
+XER7,  CIF CDF 10
+       AND (40
+       SZA CLA         /CLEAR LEADER?
+       JMP I (ER5      /YES, DEVICE FULL
+       JMP I (ER7      /OUTPUT ERROR
+XER4,  CIF CDF 10
+       JMP I (ER4
+XER8,  CIF CDF 10
+       JMP I (ER8
+
+LDRFLG,        0               /NON-ZERO IF IGNORING LEADER
+CWTMP1,        -1
+CWTMP2,        -1
+CWTMP, 0
+QH3,   HANDLER
+       PAGE
+\fPREFIN,       TAD (200
+       JMS I (CWR2     /WRITE OUT TRAILER
+       JMP CFIN2       /BUT NO CHECKSUM
+CFIN,  TAD I (CWTMP2   /V3C
+       JMS I (CWR2
+       TAD I (CWTMP1   /V3C
+       JMS I (CWR2
+CFIN2, JMS I (CWRI
+       TAD I (OUNIT
+XCLOSE,        JMS I (CLOSE
+       JMP I (XER8
+XLV,   CIF CDF 10
+       JMP I (DECODE
+\fCTRTEM,
+CREAD, 0
+       TAD (OBUFFER
+       DCA BIPTR
+       TAD (-OBUFLEN
+       DCA BIKNT
+ZRLUP, CDF 10
+       DCA I BIPTR     /ZERO BUFFER
+       CLA IAC
+       AND I (7643
+       SZA CLA
+       TAD (DCRE-CRE   /GOT L OPTION
+       TAD (CRE
+       CDF 0
+       DCA XCRE        /PT TO INPUT SUBR
+       INCR BIPTR
+       ISZ BIKNT
+       JMP ZRLUP
+       TAD (OBUFFER
+       DCA BIPTR
+       TAD (-HOBUFLEN
+       DCA BIKNT       /# OF DOUBLE-WORDS
+CRLOOP,        JMS I XCRE
+       CDF 10
+       DCA I BIPTR
+       JMS I XCRE
+       DCA TEMP2
+       JMS I XCRE
+       DCA TEMP3
+       CDF 10
+       TAD TEMP3
+       RTL
+       RTL
+       AND (7400
+       TAD I BIPTR
+       DCA I BIPTR
+       INCR BIPTR
+       TAD TEMP3
+       RTR
+       RTR
+       RAR
+       AND (7400
+       TAD TEMP2
+       DCA I BIPTR
+       INCR BIPTR
+       ISZ BIKNT
+       JMP CRLOOP      /REITERATE
+       CIF CDF 10
+       TAD (MAXBLK
+       DCA I (INTEN    /READ 10 BLOCKS
+       EXIT CREAD      /ALL DONE
+\fBIPTR,        0               /PTS INTO OBUFFER
+BIKNT, 0
+XCRE,  CRE
+
+CTRLC, 0
+       KSF
+       EXIT CTRLC
+       TAD (7600
+       KRS
+       TAD (-7603
+       SZA CLA
+       EXIT CTRLC
+       JMS I (CLEAR
+       TAD I (OUNIT
+       SPA CLA
+       JMP I (7600
+       TAD I (OUNIT
+       DCA CTRTEM
+       STA
+       DCA I (OUNIT
+       TAD CTRTEM
+       JMS I (CLOSE
+       JMP I (XER8
+       JMP I (7600
+\fLOPTION,TAD I (IUNIT
+       JMS I QU3
+       REWIND
+       JMP I (INER
+       CLA IAC
+       DCA I (CIBUF
+LM1,   JMP LM2         /ZERO FOR MAGTAPE
+       JMS I QU3
+       SKPFIL
+       JMP I (INER
+LM2,   CIF CDF 10
+       JMP I (CHLOOP
+LM3,   JMP LM2
+QU3,   UTIL
+       PAGE
+\fCIKNT,        -1              /ONE'S COMPLEMENT OF # OF BYTES LEFT IN CIBUF
+CIPTR, CIBUF           /PTS TO NEXT BYTE IN CIBUF TO BE READ
+
+CRE,   0
+       CDF 0
+       TAD FTFLG       /FIRST TIME THROUGH?
+       SZA CLA
+       JMP FT          /YES
+       TAD TLRFLG
+       SNA CLA
+       JMP EPI         /TRAILER
+       ISZ CIKNT
+       SKP
+       JMS I (CRED
+       TAD I CIPTR
+       JMS CHKSUM
+       JMS CHKTLR
+       TAD I CIPTR
+       INCR CIPTR
+/      AND (377
+       EXIT CRE
+
+
+/READ DIRECTORY
+DCRE,  0
+       CDF 0
+       ISZ CIKNT
+       SKP
+       JMS DCRED
+       TAD I CIPTR
+       TAD (-32
+       SNA
+       JMP DCRE+1      /ALLOW '32' TO SHORTEN BUFFER
+       TAD (32
+       SNA
+       TAD (232
+       INCR CIPTR
+       EXIT DCRE
+\fFT,   DCA FTFLG
+       TAD (200        /SEND LEADER
+       EXIT CRE
+
+CHKSUM,        0
+       DCA CHTEM
+       TAD CHTEM
+       AND (200
+       SNA CLA
+       TAD CHTEM
+       TAD CHECKSUM
+       DCA CHECKSUM
+       EXIT CHKSUM
+CHTEM, 0
+CHECKSUM,0
+FTFLG, 1               /1 IF FIRST TIME HERE
+CHKPTR,        CHKTBL
+TLRFLG,        0
+
+CHKTBL,        0               /CHECKSUM LEFT PART
+       0               /CHECKSUM RIGHT PART
+       200             /TRAILER
+       32              /CTRL/Z
+       -1              /TABLE END
+
+CHKTLR,        0
+       CDF 10
+       TAD I (7643
+       CDF 0
+       RTL             /B SWITCH TO LINK
+       SNL CLA
+       EXIT CHKTLR
+       TAD I CIPTR
+       TAD (-200
+       SZA CLA
+       EXIT CHKTLR
+       DCA TLRFLG
+       TAD (CHKTBL
+       DCA CHKPTR
+       TAD CHECKSUM
+       RTR
+       RTR
+       RTR
+       AND (77
+       DCA CHKTBL
+       TAD CHECKSUM
+       AND (77
+       DCA CHKTBL+1
+EPI,   TAD I CHKPTR
+       SPA
+       JMP I (INTO
+       INCR CHKPTR
+       EXIT CRE
+\fDCRED,        0
+       TAD (40
+       DCA I (BSIZE
+       TAD I PCIBUF
+       SNA CLA
+       JMP I (INTO
+       TAD I (IUNIT
+       JMS I QH4
+       READ
+PCIBUF,        CIBUF
+       JMP I (INER
+       TAD PCIBUF
+       DCA CIPTR
+       TAD I CIPTR
+       SZA CLA
+       TAD (-23
+       TAD (-2
+       DCA CIKNT
+       JMS I (FIDDLE
+       TAD I CIPTR
+       SNA CLA
+       EXIT DCRED
+       JMS I QU4
+       SKPFIL
+       JMP I (INER
+       EXIT DCRED
+
+QH4,   HANDLER
+QU4,   UTIL
+/THIS WAS VERY UNOPTIMAL ADDING IN MAGTAPE SUPPORT
+/AFTER THE PROGRAM WAS ALL DONE AND BURIED.
+/IT COULD HAVE BEEN DONE IN A MUCH BETTER METHOD
+/IF IT WAS DESIGNED IN BEFORE THE PROGRAM WAS WRITTEN.
+       PAGE
+\f/FIRST ARG: PTS TO OS/8 FILENAME IN FIELD 1
+
+CONVRT,        0
+       STA
+       TAD I CONVRT
+       DCA ONPTR
+       INCR CONVRT
+       TAD (SINCH
+       DCA CNPTR
+       TAD (-4
+       DCA CKNT
+CONLUP,        CDF 10
+       INCR ONPTR
+       TAD I ONPTR
+       CDF 0
+       RTR
+       RTR
+       RTR
+       JMS CNV
+       DCA I CNPTR
+       INCR CNPTR
+       CDF 10
+       TAD I ONPTR
+       CDF 0
+       JMS CNV
+       DCA I CNPTR
+       INCR CNPTR
+       ISZ CKNT
+       JMP CONLUP
+       TAD (40
+       DCA I CNPTR
+       CDF 10
+       TAD I (7643
+       CDF 0
+       RTL
+       SNL CLA
+       EXIT CONVRT     / NOT /B
+       CDF 10
+       TAD I (7643
+       RAL
+       CLA
+       TAD I ONPTR
+       CDF 0
+       SZA CLA
+       EXIT CONVRT     /EXTENSION SPECIFIED
+       SZL
+       EXIT CONVRT     /   /A
+       CLL STA RAL
+       TAD CNPTR
+       DCA CNPTR
+       TAD ("B         /SET EXTENSION TO .BIN
+       DCA I CNPTR
+       INCR CNPTR
+       TAD ("I
+       DCA I CNPTR
+       INCR CNPTR
+       TAD ("N
+       DCA I CNPTR
+       EXIT CONVRT
+\fCNV,  0
+       AND (77
+       SZA             /CHANGE 0 TO BLANK
+       TAD (40
+       AND (77
+       TAD (40
+       EXIT CNV
+
+ONPTR, 0
+CNPTR, 0
+CKNT,  0
+
+LOOK4ME,JMS CONVRT
+       7606
+       TAD IUNIT
+       JMS I (LOOKUP
+       JMP I (XER4
+       JMP XER24
+       TAD I (INCH+12  /GET H.O. INPUT RECORD SIZE
+       CLL RTR
+       RTR
+       RAR
+       TAD I (INCH+13
+       DCA INRECSZ
+       TAD INRECSZ
+       SNA
+       JMP XER40       /RECORD SIZE 0
+       CLL
+       TAD (-1001
+       SZL CLA
+       JMP XER10
+       CIF CDF 10
+       JMP I (CHLOOP
+
+XER24, CIF CDF 10
+       JMP I (ER24
+XER25, CIF CDF 10
+       JMP I (ER3
+\fOUNIT,        0
+IUNIT, 0
+/IN CASE OF CASSETTES, CONTAINS UNIT (AS CHAR)
+/IN CASE OF MAGTAPE, CONTAINS HANDLER ENTRY ADDRESS
+/OUNIT IS -1 DURING A ^C CLOSE
+/-1 MEANS DON'T CLOSE ON ERROR
+INRECSZ,200    /RECORD SIZE ON INPUT
+XER40, CIF CDF 10
+       JMP I (ER40
+XER10, CIF CDF 10
+       JMP I (ER10
+F1CTRLC,0
+       JMS I (CTRLC
+       CIF CDF 10
+       EXIT F1CTRLC
+       PAGE
+\fSINCH,        ZBLOCK 16
+       40;40;40;40;40;40
+       ZBLOCK 14
+INCH,  ZBLOCK 40
+
+LDRTST,        0
+       TAD I (CWTMP
+       TAD (-200
+       SNA CLA         /LEADER?
+       JMP I (CWREX    /YES, EXIT CWR
+       DCA I (LDRFLG   /NO
+       EXIT LDRTST
+\fENTERO,       TAD (COBUF
+       DCA I (COPTR
+       JMS I (CONVRT
+       7601
+       JMS I (MAKDAT
+       TAD I (RECSIZ
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA I (SINCH+12
+       TAD I (RECSIZ
+       AND (377
+       DCA I (SINCH+13
+       CDF 10
+       TAD I (FILTYP
+       CDF 0
+       DCA I (SINCH+11
+       DCA I (SINCH+14
+       DCA I (SINCH+15
+       CDF 10
+       TAD I (VRSNO
+       CDF 0
+       DCA I (SINCH+24
+       TAD I (OUNIT
+       JMS I (ENTER
+       JMP I (XER25
+       CIF CDF 10
+       DCA I (OSWITCH
+       JMP I (CONT1
+       PAGE
+\fZOPTION,TAD I (OUNIT
+       JMS I QU5
+       REWIND
+       JMP XER77       /OUTPUT ERROR
+       CDF 10
+       TAD I (7601
+       CDF 0
+       SNA CLA
+       JMP NOFILE
+       JMS I (CONVRT
+       7601
+       JMS I (LOOKUP
+       JMP I (XER4
+       JMP I (XER24
+       JMS I QU5
+       SKPFIL
+       JMP I (XER24
+       TAD (40
+       DCA I (BSIZE
+       JMS I QH5
+       READ
+       INCH
+       JMP XER77
+CLO3,  JMS I (BACK
+       JMP XER77
+       JMS I QH5
+       WRITE
+       ZER
+       JMP XER77
+NOFILE,        JMP I (XCLOSE
+\fMAKDAT,       0
+       CDF 10
+       TAD I (DATE
+       CDF 0
+       SNA
+       JMP SETOBL
+       DCA SKNT
+       TAD (SINCH+16
+       DCA SPTR
+       TAD SKNT
+       RTR
+       RAR
+       AND (37
+       JMS TWO         /INSERT DAY
+       TAD SKNT
+       RTL
+       RTL
+       RAL
+       AND (17
+       JMS TWO         /INSERT MONTH
+       TAD SKNT
+       AND (7
+       TAD (106
+       JMS TWO         /INSERT YEAR
+       EXIT MAKDAT
+
+SETOBL,        TAD (-6         /SET DATE TO BLANKS
+       DCA SKNT
+       TAD (SINCH+16
+       DCA SPTR
+SELOOP,        TAD (40
+       DCA I SPTR
+       INCR SPTR
+       ISZ SKNT
+       JMP SELOOP
+       EXIT MAKDAT
+
+SPTR,  0
+SKNT,  0
+TEM2,  0
+TENS,  0
+\fTWO,  0
+       DCA TEM2
+       TAD (60
+       DCA TENS
+       TAD TEM2
+TWOLUP,        TAD (-12
+       SPA
+       JMP NEG
+       INCR TENS
+       JMP TWOLUP
+NEG,   TAD (72
+       DCA TEM2
+       TAD TENS
+       DCA I SPTR
+       INCR SPTR
+       TAD TEM2
+       DCA I SPTR
+       INCR SPTR
+       EXIT TWO
+
+XER77, CIF CDF 10
+       JMP I (ER7      /OUTPUT ERROR
+
+QU5,   UTIL
+QH5,   HANDLER
+\fMHANDLER,0            /AC CONTAINS HANDLER ENTRY ADDRESS
+       CIF 10
+       JMP I (MHAN     /KLUDGEY LINK TO FIELD 1
+
+MUTIL, 0               /AC CONTAINS ETC.
+       CIF 10
+       JMP I (MUT
+       PAGE
+\f      FIELD 1
+
+       XR=10
+
+       *2000
+
+START, JMP DEC2        /NORMAL STARTING ADDRESS
+CHAIN, JMP NODEC       /CHAIN STARTING ADDRESS
+DECODE,        STL CLA RAR
+       AND I (7642
+       SZA CLA
+       JMP KBM         /RETURN TO KBM ON $
+/      WOULD BE NICE HERE TO TELL CD/BATCH NOT TO SPOOL
+DEC2,  CALL (200
+       5               /COMMAND DECODE
+       5200            /USING SPECIAL MODE
+NODEC, TAD (OUTHAND+1
+       DCA ENTR        /RESET PTR TO HANDLER LOCATION
+       STA
+       DCA I (OSWITCH
+       JMS I (CHKSW    /CHECK FOR SWITCH OPTIONS
+       CDF 0
+       DCA I (OUTSW
+       STA
+       DCA I (OUNIT
+       CDF 10
+       TAD I (7666
+       DCA I (DATE
+FET,   TAD I (7600     /GET DEVICE NUMBER OF OUTPUT FILE
+       SNA             /WAS ONE SPECIFIED?
+       JMP NOF         /NO - NO OUTPUT FILE
+       CALL (200
+       1               /FETCH HANDLER
+ENTR,  OUTHAND+1       /INTO PAGES 2400 AND 2600
+                       /REPLACED BY HANDLER STARTING ADDRESS
+       JMP I (ER6              /OUTPUT DEVICE DOESN'T EXIST
+       TAD I (7644
+       AND (1000
+       SZA CLA
+       JMP I (FOXOUT   /O SPECIFIED
+       STL CLA RTR
+       AND I (7645
+       TAD I (7601
+       SNA CLA
+       JMP NOCAS       /NO OUTPUT NAME
+       TAD (7600
+       JMS I (CHKNAM
+       JMP I (STARER   /*.*
+       TAD I (7600
+       JMS I (TCAS     /CASSETTE?
+       JMP I (FIXOUT   /YES
+       JMP I (FXMOUT   /MAGTAPE
+NOCAS, TAD (7601       /NO
+       DCA OBLK        /GET PTR TO OUTPUT FILE NAME
+       TAD ENTR
+       DCA I (OENTRY   /STORE AWAY OUTPUT HANDLER ENTRY PT
+       TAD (OWRITE
+       DCA PWRITE
+       TAD (FINIO
+       DCA I (XFINIO
+       TAD I (7643
+       RTL
+       SNL CLA
+       JMP NOB
+       TAD I (7604     /GET EXT
+       SZA CLA
+       JMP NOB
+       TAD (216        /SET TO .BN
+       DCA I (7604
+NOB,   TAD I (7600     /GET DEVICE NUMBER AGAIN
+       CALL (200
+       3               /OPEN OUTPUT FILE
+OBLK,  7601            /PTS TO OUTPUT FILE NAME
+                       /REPLACED BY STARTING BLOCK NUMBER
+LEN,   0               /REPLACED BY NEGATIVE OF LENGTH OF OUT AREA
+       JMP I (ER3      /FILE OPEN ERROR
+       DCA I (REALEN   /ZERO REAL LENGTH
+       TAD OBLK
+       DCA I (OBLOCK   /SET STARTING BLOCK NUMBER
+CONT1, JMS I (GETIN
+/      INITIALIZE INPUT STUFF
+CHLOOP,        CIF CDF 0
+       JMS I (F1CTRLC
+       CALL PREAD
+       CIF CDF 0
+       JMS I (F1CTRLC
+       CALL PWRITE
+       JMP CHLOOP
+\fPREAD,        OREAD
+PWRITE,        OWRITE
+NOF,   STL CLA RTR
+       AND I (7645
+       SNA CLA
+       JMP I (ER1
+       JMP I (FOXOUT   /Z IMPLIES O
+
+KBM,   CIF CDF 0
+       JMP I (7605
+       PAGE
+\fUDIG, 0
+
+GETSWDIG,0
+       DCA UDIG
+       TAD I (7645
+       AND (1774
+       SNA
+       EXIT GETSWDIG   /NO UNIT
+       INCR GETSWDIG
+       RTL
+       RAL
+LUDIG, SZL
+       JMP GOTUD
+       INCR UDIG
+       RAL
+       JMP LUDIG
+G7600,
+GOTUD, 7600
+       TAD UDIG
+       TAD (60
+       EXIT GETSWDIG
+\fFOXOUT,       JMS GETSWDIG
+       JMP I (ER1      /NO OUTPUT UNIT
+       JMP GOTOU
+FIXOUT,        TAD I (ENTR
+       JMS I (GETDVC
+GOTOU, CDF 0
+       DCA I (OUNIT
+       CDF 10
+       JMS I (SETCAS
+YAHAOU,        TAD I (7643
+       AND (400
+       SZA CLA
+       JMP DOPT
+       STL CLA RTR
+       AND I (7645
+       SZA CLA
+       JMP ZOPT
+       TAD I G7600
+       RTR
+       RTR
+       AND (377        /ISOLATE FILE TYPE
+       DCA FILTYP      /SAVE IT
+       JMS I (GETLEN
+       TAD (CW
+       DCA I (PWRITE
+       TAD (CFINIO
+       DCA I (XFINIO
+       TAD I (7643
+       RTL             /B TO LINK
+       SZL CLA
+       CLA IAC
+       CIF CDF 0
+       DCA I (LDRFLG
+       STA
+       DCA I (CWTMP1
+       STA
+       DCA I (CWTMP2
+       DCA I (CHECKSUM
+       JMP I (ENTERO
+/      RETURN TO CONT1
+
+FXMOUT,        TAD I (ENTR
+       CDF 0
+       DCA I (OUNIT
+       CDF 10
+       JMS I (SETMAG
+       TAD I (ENTR     /GET LOCATION OF MAGTAPE HANDLER
+       JMS SETDEN
+       JMP YAHAOU
+\fSETDEN,       0
+       AND G7600
+       DCA MTA
+       TAD I (7644
+       AND (10
+       SZA CLA         /IS /U SPECIFIED?
+       IAC             /YES, USE DENSITY 3
+       TAD (2          /NO, USE DENSITY 2
+       DCA DEN
+       CDF 0
+       TAD PARITY
+       CLL RAR         /LINK ON IF PARITY SPECIFIED
+       SZL
+       TAD PAR
+       SNL
+       TAD I MTA       /GET RELATIVE LOC 0
+       AND (400        /ISOLATE PARITY
+       TAD DEN         /FORCE CORE DUMP MODE
+       DCA I MTA       /STORE BACK DENSITY AND PARITY
+       CDF 10
+       JMP I SETDEN
+\fFILTYP,       0
+BINTYP,        0               /SET BINARY TYPE - DON'T TOUCH LINK
+       IAC
+       IAC
+       DCA FILTYP
+       EXIT BINTYP
+
+DOPT,  CIF CDF 0
+       JMP I (DOPTION
+
+ZOPT,  CIF CDF 0
+       JMP I (ZOPTION
+
+MTA,   0               /FIRST LOC OF MAGTAPE HANDLER
+PARITY,        0               /0 MENAS NOT SPECIFIED, 1 MEANS SPECIFIED PARITY
+PAR,   0               /0 OR 400 SPECIFYING PARITY
+DEN,   2               /DENSITY
+       PAGE
+\fFID2, 0
+       TAD I (CIBUF
+       AND (177                /DF=0
+       TAD (-52
+       SNA CLA
+       JMS EMPTY
+       TAD I (CIBUF+10
+       DCA I (CIBUF+11
+       TAD I (CIBUF+7
+       DCA I (CIBUF+10
+       TAD I (CIBUF+6
+       DCA I (CIBUF+7
+       TAD (".
+       DCA I (CIBUF+6
+       CIF 0
+       JMP I FID2
+
+EMPTY, 0
+       TAD I (FAST
+       SNA CLA
+       JMP I EMPTY
+       STA
+       DCA I (CIKNT
+       TAD (32
+       DCA I (CIBUF
+       CIF 0
+       JMP I (FIDLV
+\fGETLEN,       0
+       CLL STA RAR     /3777
+       AND I (7642     /GET H.O. OPTION
+       DCA VRSNO
+       TAD I (7646     /GET = OPTION (L.O. 12 BITS)
+       CLL
+       TAD (-1001
+       SZL CLA         /LESS THAN 1001?
+       JMP I (ER10     /NO, ERROR
+       TAD I (7646     /YES
+       SNA
+       TAD (200        /200 IS DEFAULT RECORD SIZE
+       CDF 0
+       DCA I (RECSIZ
+       TAD I (RECSIZ
+       CIA
+       DCA I (COKNT
+       CDF 10
+       EXIT GETLEN
+
+FINIO, JMS I (OWRITE
+       TAD I (7600     /GET OUTPUT DEVICE NUMBER
+       CALL (200
+       4               /CLOSE
+       7601            /PTR TO FILE NAME
+REALEN,        0               /LENGTH OF NEW OUTPUT FILE
+       JMP ER8         /CLOSE ERROR
+       JMP I (DECODE
+ER8,   JMS I (PRINT
+       TEXT    /?CLOSE ERROR/
+ER5,   JMS I (PRINT
+       TEXT    /?OUTPUT DEVICE FULL/
+\fER30, JMS I (PRINT
+       TEXT    /?OUT=IN/
+VRSNO, 0
+
+ER6,   JMS I (PRINT
+       TEXT    /?FETCH ERROR/
+ER24,  STA
+       DCA I (SPSWTCH  /RETURN FROM PRINT
+       JMS I (PRINT
+       TEXT    /?FILE NOT FOUND/
+       ISZ I (FUDSW    /FIXUP CASSETTE
+       JMP I (CLO
+       PAGE
+\fOREAD,        0
+       TAD (MAXBLK
+       DCA INTEN       /TRY TO READ 10 BLOCKS
+       TAD (MAXBLK^200+10
+       DCA READSZ
+       TAD I (7605
+       AND (17
+       TAD (7757
+       DCA TEMP        /GET DCB ADDR
+       TAD I TEMP      /GET DCB
+       AND (1000
+       SZA CLA
+       JMP ER4         /INPUT DEVICE IS WRITE-ONLY
+       TAD I TEMP
+       SMA CLA
+       JMP YES         /NOT FILE-STRUCTURED
+       TAD I (INLEN
+       TAD (MAXBLK
+       SMA SZA CLA     /CAN I READ IN 10 BLOCKS?
+       JMS SHORT       /NO
+YES,   CIF 0           /YES
+       JMS I IENTRY    /CALL INPUT HANDLER
+READSZ,        2010            /READ 20 PAGES INTO FIELD 1
+       OBUFFER         /LOCATION 4000
+IBLOCK,        0               /INPUT BLOCK NUMBER
+       JMP QER4        /INPUT ERROR
+       TAD IBLOCK
+       TAD INTEN
+       DCA IBLOCK      /UPDATE BLOCK NUMBER
+       TAD I (INLEN
+       TAD INTEN
+       DCA I (INLEN    /UPDATE LENGTH LEFT
+       TAD INTEN
+       TAD (-MAXBLK
+       SZA CLA
+       JMP XFIN
+       EXIT OREAD      /RETURN
+INTEN, 10              /NUMBER OF BLOCKS JUST READ
+XFINIO,        FINIO
+
+SHORT, 0
+       TAD I (INLEN    /HOW MANY BLOCKS LEFT?
+       CIA             /MAKE POSITIVE
+       DCA INTEN       /THAT'S AS MUCH AS WE CAN READ
+       TAD INTEN
+       SNA
+XFIN,  JMP I XFINIO    /NO MORE
+       CLL RTR
+       RTR
+       RTR             /CONVERT TO PAGES IN BITS 1-5
+       TAD (10         /ADD IN FIELD 1 BIT
+       DCA READSZ
+       EXIT SHORT      /RETURN
+\fIENTRY,       0               /PTS TO INPUT HANDLER ENTRY POINT
+QER4,  SMA CLA
+       JMP SFIN        /NON-FATAL END-OF FILE
+ER4,   JMS I (PRINT
+       TEXT    /?INPUT ERROR/
+ER26,  JMS I (PRINT
+       TEXT /?TOO MANY FILES/
+SFIN,  TAD (7600
+       DCA TPTR
+SLUP,  STA
+       TAD TPTR
+       DCA TPTR
+       TAD I TPTR
+       SNA CLA
+       JMP SLUP
+       TAD TPTR
+       TAD (-OBUFFER+1
+       SNA
+       JMP ALLZ
+       TAD (377        /CHANGED FROM PIPC'S 376
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA INTEN
+       JMP XFIN
+ALLZ,  CLA IAC
+       JMP .-3
+TPTR,  0
+\fER3,  JMS I (PRINT
+       TEXT    /?ENTER ERROR/
+       PAGE
+\fGETIN,        0               /OPEN INPUT FILE
+       DCA DATE
+       TAD I (7605     /ANY MORE FILES SPECIFIED?
+       SNA CLA
+       JMP NOIN        /NO
+       TAD I (7612
+       SZA CLA
+       JMP I (ER26     /2ND INPUT FILE IS BAD
+       TAD (7605
+       JMS I (CHKNAM
+       JMP I (STARER   /*.*
+       TAD (7606
+       DCA IN          /SET PTR TO FILE NAME
+       TAD (INHAND+1
+       DCA IN3
+       TAD I (7605     /GET DEVICE NUMBER
+       CALL (200
+       1               /FETCH NEW DEVICE HANDLER
+IN3,   INHAND+1        /INTO PAGES 3200 AND 3400
+                       /REPLACED BY ENTRY PT TO INPUT HANDLER
+       JMP I (ER6      /FETCH ERROR
+       TAD I (7643
+       AND (10
+       SZA CLA
+       JMP I (FOXIN    /I SPECIFIED
+       CLA IAC         /V3C
+       AND I (7643     /LOOK AT /L OPTION
+       TAD I (7606
+       SNA CLA
+       JMP NOCAS2
+/IF NO NAME IS GIVEN AND /L IS NOT SPECIFIED, THEN USE
+/MAGTAPE OR CASSETTE HANDLER AS IS, I.E. AS
+/A NON-FILE-STRUCTURED OS/8 DRIVER.
+       TAD I (7605
+       JMS I (TCAS     /CASSETTE?
+       JMP I (FIXIN    /YES
+       JMP I (FIXMIN   /MAGTAPE
+NOCAS2,        CLA IAC
+       AND I (7643
+       SZA CLA
+       JMP ER11        /V3C  /L SPECIFIED WHEN DEVICE WAS NOT MAGTAPE OR CASSETTE
+       TAD (OREAD
+       DCA I (PREAD
+       TAD IN3         /GET NEW HANDLER ENTRY PT
+       DCA I (IENTRY   /STORE AWAY
+       TAD I (7605     /GET DEVICE NUMBER AGAIN
+       CALL (200
+       2               /PERFORM A LOOKUP
+IN,    0               /PTR TO FILE NAME
+                       /REPLACED BY INPUT BLOCK NUMBER
+IN2,   0               /REPLACED BY NEGATIVE OF INPUT FILE LENGTH
+       JMP LKERR       /LOOKUP ERROR
+       TAD IN          /GET NEW INPUT BLOCK
+       DCA I (IBLOCK   /STORE AWAY
+       TAD IN2         /GET NEW INPUT FILE LENGTH
+       DCA INLEN
+       TAD I (1404     /GET # OF ADDITIONAL WORDS
+       SNA
+       JMP NONE
+       TAD 17
+       DCA POINTER
+       TAD I POINTER   /GET FILE CREATION DATE
+       SNA
+       JMP NONE
+SETDAT,        DCA DATE
+       EXIT GETIN
+NONE,  TAD I (7666     /USE TODAY'S DATE
+       JMP SETDAT
+LKERR, CLA
+       TAD I (7611
+       SZA CLA
+       JMP I (ER24     /FILE NOT FOUND
+       TAD I (7643     /TRY .BN
+       RTL
+       SNL CLA
+       JMP I (ER24     / NOT /B
+       TAD (216
+       DCA I (7611
+       JMP GETIN+1
+
+INLEN, 0
+DATE,  0               /OS8 DATE OF INPUT FILE
+POINTER,0
+
+NOIN,  CLA IAC
+       AND I (7643
+       SNA CLA
+       JMP I (ER21
+       JMP I (FOXIN    / /L SPECIFIED
+\fER11, JMS I (PRINT    /V3C
+       TEXT    /?L OPTION OUT OF CONTEXT/
+       PAGE
+\f/ENTER WITH INTEN BLOCKS TO WRITE
+OWRITE,        0
+       TAD I (INTEN    /HOW MUCH IS THERE TO WRITE?
+       SNA
+       EXIT OWRITE     /NOTHING
+       DCA OUTEN       /SAVE NUMBER OF BLOCKS TO WRITE
+       TAD I (7600
+       AND (17
+       TAD (7757
+       DCA TEMP
+       STL CLA RTR
+       AND I TEMP
+       SZA CLA
+       JMP I (ER7      /OUTPUT DEVICE IS READ-ONLY
+       TAD OUTEN
+       CLL RTR
+       RTR
+       RTR             /CONVERT TO PAGES
+       TAD (4010       /FIELD 1 (WRITE DIRECTLY FROM INPUT BUFFER)
+       DCA WRSIZ
+       TAD I (LEN
+       SNA CLA
+       JMP NFS         /NON-FILE STRUCTURED
+       TAD I (REALEN
+       TAD OUTEN
+       STL
+       TAD I (LEN
+       SNL SZA CLA
+       JMP I (ER5
+NFS,   CIF 0
+       JMS I OENTRY    /CALL OUTPUT HANDLER
+WRSIZ, 6010            /WRITE 20 PAGES FROM FIELD 1
+       OBUFFER         /LOCATION 4000
+OBLOCK,        0               /OUTPUT BLOCK NUMBER
+       JMP I (ER7      /OUTPUT ERROR
+       TAD OBLOCK
+       TAD OUTEN
+       DCA OBLOCK      /UPDATE OUTPUT BLOCK NUMBER
+       TAD I (REALEN
+       TAD OUTEN
+       DCA I (REALEN   /UPDATE LENGTH WROTE
+       EXIT OWRITE
+
+OENTRY,        0
+OUTEN, 0
+\fFOXIN,        JMS I (GETSWDIG
+       JMP I (ER21
+       JMP GOTIU
+FIXIN, TAD I (IN3      /GET INPUT HANDLER ADDRESS
+       JMS I (GETDVC
+GOTIU, CDF 0
+       DCA I (IUNIT
+       CDF 10
+       JMS I (SETCAS
+YAHAIN,        CDF 0
+       TAD I (OUNIT
+       CIA
+       TAD I (IUNIT
+       SNA CLA
+       JMP I (ER30
+       STA
+       DCA I (CIKNT
+       DCA I (CHECKSUM
+       CLA IAC
+       DCA I (TLRFLG
+       CDF 10
+       TAD (CR
+       DCA I (PREAD
+       TAD I (7643
+       RTL
+       CLA RAL
+       CDF 0
+       DCA I (FTFLG
+       CDF 10
+       JMS I (GETLEN
+       TAD I (7643
+       AND (100        / F OPTION?
+       CDF 0
+       DCA I (FAST
+       CDF 10
+       CLA IAC
+       AND I (7643
+       CIF CDF 0
+       SZA CLA
+       JMP I (LOPTION
+       JMP I (LOOK4ME
+/RETURN TO CHLOOP
+\fFIXMIN,       TAD I (IN3
+       CDF 0
+       DCA I (IUNIT
+       CDF 10
+       JMS I (SETMAG
+       TAD I (IN3
+       JMS I (SETDEN
+       JMP YAHAIN
+       PAGE
+\fPRINT,        0
+       CLA
+       CDF 10
+       DCA CTOFLG      /ALLOW ECHOING
+       JMS CRLF
+PRLUP, TAD I PRINT
+       RTR
+       RTR
+       RTR
+       JMS PRIN
+       TAD I PRINT
+       JMS PRIN
+       INCR PRINT
+       JMP PRLUP
+
+PRIN,  0
+       AND (77
+       SNA
+       JMP PRFIN
+       TAD (240
+       AND (77
+       TAD (240
+       DCA TM
+       KSF
+       JMP NOBOTH
+       TAD (200
+       KRS
+       TAD (-203
+       SNA
+       JMP KBM2
+       TAD (203-217
+       SZA CLA
+       JMP NOBOTH
+       TAD ("^
+       JMS TYPE
+       TAD ("O
+       JMS TYPE
+       JMS CRLF
+       ISZ CTOFLG
+NOBOTH,        TAD TM
+       JMS TYPE
+       EXIT PRIN
+PRFIN, JMS CRLF
+       DCA FUDSW
+       TAD I (SPSWTCH
+       SNA CLA
+       JMP CLO
+       DCA I (SPSWTCH  /SWITCH NON-ZERO MEANS RETURN
+       INCR PRINT      /POINT TO RETURN
+       JMP I PRINT
+\f/DO A CLOSE IF OUTPUT CASSETTE OPEN
+CLO,   CDF 0
+       TAD I (OUNIT
+       CDF 10
+       SPA CLA
+       JMP I (DECODE
+       TAD OSWITCH
+       SZA CLA
+       JMP I (DECODE
+       CDF 0
+       TAD I (OUTSW
+       CDF 10
+       SNA CLA         /DID WE WRITE ON OUTPUT CASSETTE?
+       JMP I (DECODE   /NO
+       CIF CDF 0
+       TAD I (OUNIT
+       DCA TEMP
+       STA
+       DCA I (OUNIT
+       TAD FUDSW
+       SZA CLA
+       JMP I (CLO3
+       TAD TEMP
+       JMP I (XCLOSE
+OSWITCH,-1             /0 MEANS OUTPUT CASSETTE OPEN
+
+KBM2,  CIF CDF 0
+       JMP I L7600     /RETURN TO OS/8
+
+FUDSW, 0               /1 MEANS GOT OS/8 LOOKUP FAILURE
+\fTYPE, 0
+       DCA TM
+       TAD CTOFLG
+       SZA CLA
+       EXIT TYPE       /NOT ECHOING
+       TAD TM
+       TLS
+       TSF
+       JMP .-1
+L7600, 7600
+       EXIT TYPE
+
+CRLF,  0
+       TAD (215
+       JMS TYPE
+       TAD (212
+       JMS TYPE
+       EXIT CRLF
+
+CTOFLG,        0               /1 MEANS DON'T ECHO
+TM,    0
+
+ER7,   JMS PRINT
+       TEXT    /?OUTPUT ERROR/
+
+CFINIO,        CIF CDF 0
+       JMS I (CWRITE
+       CIF CDF 0
+       JMP I (CFIN     /FINISH OUTPUT AND WRITE SENTINEL
+/RETURN TO DECODE
+       PAGE
+\fER10, JMS I (PRINT
+       TEXT    /?RECORD SIZE TOO BIG/
+/ENTRY POINT REL 1: UNIT 1
+/ENTRY POINT REL 7: UNIT 0
+
+GETDVC,        0
+       IAC
+       DCA TEMP
+       STL CLA RTL     /2
+       AND TEMP
+       RAR
+       DCA UNIT        /DETERMINE IF UNIT 0 OR 1
+       TAD TEMP
+       AND (7600
+       DCA TEMP
+       CDF 0
+LOOKIO,        ISZ TEMP
+       TAD I TEMP      /SEARCH HANDLER FOR ANY IOT
+       AND (7700
+       TAD (-6700
+       SZA CLA
+       JMP LOOKIO
+       TAD I TEMP      /GET CASSETETE IOT
+       CDF 10
+       AND (30         /V3 BUG FIX FROM V2
+       CLL RTR
+       TAD UNIT
+       TAD (60
+       EXIT GETDVC     /LEAVE IT IN AC
+
+UNIT,  0
+\fCHKNAM,       0               /DON'T ALLOW *'S OR ?'S
+       DCA XR          /IN OUTPUT OR INPUT NAME
+       TAD I XR
+       TAD (-5200
+       SNA
+       JMP STARNM      /ENTIRE NAME IS *
+       TAD (5200
+       JMS CHKSTR
+       TAD I XR
+       JMS CHKSTR
+       TAD I XR
+       JMS CHKSTR
+       TAD I XR
+       JMS CHKSTR
+       ISZ CHKNAM
+       JMP I CHKNAM    /NAME GOOD, RETURN 2
+
+CHKSTR,        0
+       DCA TEM
+       TAD TEM
+       CLL RTR
+       RTR
+       RTR
+       JMS CHC
+       TAD TEM
+       JMS CHC
+       JMP I CHKSTR
+\fCHC,  0
+       AND (77
+       TAD (-52
+       SNA
+       JMP STARER      /* IN NAME
+       TAD (52-77
+       SZA CLA
+       JMP I CHC       /OKAY
+STARER,        JMS I (PRINT
+       TEXT    /?ILLEGAL * OR ?/
+
+STARNM,        ISZ XR
+       ISZ XR
+       TAD I XR
+       TAD (-5200
+       SZA CLA
+       JMP STARER      /NOT *.*
+       JMP I CHKNAM    /TAKE SPECIAL RETURN ON *.*
+
+TEM,   0
+\fCHKSW,        0               /CHECK SWITCHES
+       TAD I (7644
+       AND (4          /CHECK FOR /V
+       SZA CLA
+       JMS I (VERSN    /PRINT MCPIP VERSION #
+       TAD I (7644
+       AND (400        /CHECK FOR /P
+                       /NOTE /P = 400 SAME AS ODD PARITY CODE
+       SZA
+       JMP ODDPAR
+       TAD I (7643
+       AND (200        /CHECK FOR /E
+       SZA CLA
+       JMP EVPAR
+GOTP,  NOP
+       JMP I CHKSW
+
+ODDPAR,                        /400 IN AC
+EVPAR, DCA I (PAR
+       CLA IAC
+       DCA I (PARITY
+       JMP GOTP
+       PAGE
+\fSPSWTCH,0             /NON-ZERO MEANS RETURN FROM PRINT
+
+/RET 1: CASSETTE
+/RET 2: MAGTAPE
+/RET 3: NEITHER
+
+TCAS,  0
+       AND (17         /ISOLATE
+       TAD (7757       /ADD IN BASE OF DCB TABLE
+       DCA TEMP        /TO GET DCB ADDRESS
+       TAD I TEMP      /GET DCB
+       AND (770        /ISOLATE UNIT TYPE
+       TAD (-270       /CASSETTE HANDLER TYPE IS 27
+       SNA
+       JMP ITSCAS
+       TAD (270-200
+       SZA CLA
+       INCR TCAS       /NOTHING SPECIAL
+       INCR TCAS       /MAGTAPE
+ITSCAS,        EXIT TCAS
+\fVERSN,        0
+       STA
+       DCA SPSWTCH     /RETURN FROM PRINT
+       JMS I (PRINT
+       TEXT    \OS/8 MCPIP V\
+       *.-1
+       PIPVERSION+60^100+PATCHLEV
+       0
+       JMP I VERSN
+
+ER1,   TAD I (7605
+       SNA CLA
+       JMP I (DECODE   /NO OUT AND NO IN
+       CLA IAC
+       AND I (7643     /WAS /L SPECIFIED?
+       SZA CLA
+       JMP SETTY       /YES
+       JMS I (PRINT
+       TEXT    /?NO OUTPUT FILE/
+ER40,  JMS I (PRINT
+       TEXT    /?CANNOT HANDLE VARIABLE-LENGTH RECORDS/
+\fSETTY,        TAD (3100
+       DCA Y
+       JMS I (200
+       12              /INQUIRE
+TT,    2424
+Y,     3100            /DEVICE TTY
+       0
+       JMP ER99
+       TAD Y           /GET DEVICE NO. OF TTY:
+       DCA I (7600
+       JMP I (FET
+
+ER99,  JMS I (PRINT
+       TEXT    /?TTY DOES NOT EXIST/
+ER21,  JMS I (PRINT
+       TEXT    /?NO INPUT FILE/
+\fCW,   0
+       CIF CDF 0
+       JMS I (CWRITE
+       EXIT CW
+
+CR,    0
+       CIF CDF 0
+       JMS I (CREAD
+       EXIT CR
+       PAGE
+\fSETCAS,       0
+       TAD (UTIL
+       JMS SETU
+       TAD (HANDLER
+       JMS SETH
+       CDF 0
+       TAD (BACKFIL
+       DCA I (BK2
+       TAD I (BK4
+       DCA I (BK3
+       TAD (254
+       DCA I (EOFBIT
+       TAD I (FL3
+       DCA I (FL1
+       TAD (314
+       DCA I (EOTBIT
+       TAD I (LM3
+       DCA I (LM1
+       CDF 10
+       JMP I SETCAS
+
+SETMAG,        0
+       TAD (MUTIL
+       JMS SETU
+       TAD (MHANDLER
+       JMS SETH
+       CDF 0
+       TAD (BACKBLOCK
+       DCA I (BK2
+       TAD I (BK1
+       DCA I (BK3
+       TAD (3673
+       DCA I (EOFBIT
+       DCA I (FL1
+       TAD (3663
+       DCA I (EOTBIT
+       DCA I (LM1
+       CDF 10
+       JMP I SETMAG
+\fSETU, 0
+       DCA SETH
+       CDF 0
+       TAD SETH
+       DCA I (QU1
+       TAD SETH
+       DCA I (QU2
+       TAD SETH
+       DCA I (QU3
+       TAD SETH
+       DCA I (QU4
+       TAD SETH
+       DCA I (QU5
+       CDF 10
+       JMP I SETU
+\fSETH, 0
+       DCA SETU
+       CDF 0
+       TAD SETU
+       DCA  I (QH1
+       TAD SETU
+       DCA I (QH2
+       TAD SETU
+       DCA I (QH3
+       TAD SETU
+       DCA I (QH4
+       TAD SETU
+       DCA I (QH5
+       CDF 10
+       JMP I SETH
+       PAGE
+\fMH,   0
+
+MHAN,  SZA
+       DCA MENTRY
+       TAD I (MHANDLER
+       DCA MH          /PICK UP ARGS VIA MH
+       TAD I MH        /GET FN WORD
+       TAD (SPCODE     /ADD SPECIAL CODE
+       DCA MARG1
+       ISZ MH
+       TAD I MH        /GET CORE LOC
+       DCA MARG2
+       ISZ MH          /PT TO ERROR RETURN
+       TAD I (BSIZE    /GET BLOCKSIZE
+       CIA
+       DCA MARG3       /STORE NEG
+       CDF 10
+       CIF 0
+       JMS I MENTRY    /CALL MAGTAPE HANDLER
+MARG1, HLT
+MARG2, HLT
+MARG3, HLT
+       SKP             /TAKE ERROR RETURN
+       ISZ MH          /NORMAL RETURN
+       CIF CDF 0
+       JMP I MH        /GO BACK TO FIELD 0
+
+MENTRY,        0
+\fMU,   0
+
+MUT,   SZA
+       DCA MENTRY      /DF=0
+       TAD I (MUTIL    /PICK UP ARGS
+       DCA MU          /VIA 'MU'
+       TAD I MU        /GET UTILITY FUNCTION
+       ISZ MU
+       CDF 10
+       TAD (-REWIND
+       SNA
+       JMP REWT
+       TAD (REWIND-BACKFIL
+       SNA
+       JMP BAKFT
+       TAD (BACKFIL-WRGAP
+       SNA
+       JMP WRGT
+       TAD (WRGAP-BACKBLOCK
+       SNA
+       JMP BAKBT
+       TAD (BACKBLOCK-SKPFIL
+       SZA CLA
+       HLT             /IMPOSSIBLE
+SKPFT, STL CLA RAR     /4000=WRITE
+BAKFT, TAD (WRITE+FICODE-REWCOD
+REWT,  TAD (REWCOD-EOCODE
+WRGT,  TAD (EOCODE-RECCOD-WRITE
+BAKBT, TAD (RECCOD+WRITE
+       DCA MRG1
+       CIF 0
+       JMS I MENTRY
+MRG1,  HLT
+MCA,   HLT             /IRRELEVANT
+MWC,   -1
+       SKP             /ERROR RETURN
+       ISZ MU
+       CIF CDF 0
+       JMP I MU        /RETURN
+\fEMPTINCH,52;105;115;120;124;131;40;40;40;14
+       0;0;0;0;40;40;40;40;40;40
+       ZBLOCK 14
+       PAGE
+\f      *2000
+       $