software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape7 / PIP10.PA
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/PIP10.PA b/sw/os8/v3d/sources/system/dectapes/dectape7/PIP10.PA
new file mode 100644 (file)
index 0000000..a85dc26
--- /dev/null
@@ -0,0 +1,3615 @@
+/2 OS8 PIP10 - PDP-10 CONVERSION PROGRAM V3A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1974,1975 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      DTRB=6772
+       DTLB=6774
+       DTXA=6764
+       DTCA=6762
+       DTRA=6761
+       DTSF=6771
+
+
+/WRITTEN BY MARK BRAMHALL 1970
+/MODIFIED FOR TD8E BY R. LARY 1973
+/DATE 75 PATCH ADDED BY S.R. AFTER 1/5/75
+/
+/PIP10 IS A PIP FOR OS8 THAT HANDLES PDP-10 DECTAPES
+/
+/COMMAND DECODER RULES:
+/
+/*OUTPUT_INPUT,INPUT,...
+/
+/OUTPUT IS:
+/      DEV:FILE.EXT[NN]
+/      DEFAULT DEVICE IS DSK:
+/      [NN] IGNORED IF PDP-10 OUTPUT
+/      IF /L OR /F DEFAULT OUTPUT IS TTY:
+/
+/INPUT IS:
+/      DEV:FILE.EXT
+/      DEFAULT DEVICE IS DSK:
+/      FOLLOWING DEFAULT DEVICES ARE THE PRECEEDING DEVICE
+/      UP TO NINE (9) INPUT FILES
+/
+/OPTIONS ARE:
+/      /L IS LIST DIRECTORY (ONLY VALID IF PDP-10 INPUT)
+/      /F IS SHORT FORM DIRECTORY (ONLY PDP-10 INPUT)
+/      /Z IS ZERO DIRECTORY BEFORE TRANSFER (ONLY IF PDP-10 OUTPUT)
+/      /D IS DELETE OLD OUTPUT FILE BEFORE TRANSFER
+/      /B IS BINARY MODE TRANSFER (I.E. 8 BITS PER 36 BITS)
+/      /I IS IMAGE MODE TRANSFER (I.E. 3 12 BITS PER 36 BITS)
+/      /P IS PRESERVE LINE NUMBERS (DEFAULT IS TO DELETE THEM)
+
+
+/      MAINTENACE RELEASE FIXES:
+
+/1.    DATE 75 STUFF
+/2.    TD8E RELIABILITY IMPROVEMENTS
+/3.    ANSI DATE OUTPUT FORMAT
+/4.    INCORPORATED PATCH BY DAVID HEMBLEN [UNITED AIRCRAFT
+/      RESEARCH LABORATORIES] TO ALLOW WRITING PDP-6
+/      DECTAPES ON A TD8E.
+\f/COMMAND DECODER SETS UP:
+/
+/AT "MOUTPU" THE LIST--
+/      LLL LLL LLD DDD         OR              UUU 100 000 000
+/      NAME (TRIMMED)                          NAME (EXCESS 40)
+/      NAME                                    NAME
+/      NAME                                    NAME
+/      EXTENSION                               EXTENSION
+/      0                                       EXTENSION
+/
+/      OS8 FILE                OR              PDP-10 FILE
+/
+/WHERE L IS LENGTH (8 BITS), D IS DEVICE (4 BITS), U IS UNIT (3 BITS)
+/
+/AT "MINPUT" THE LIST--
+/      LLL LLL LLD DDD         OR              UUU 100 000 000
+/      START BLOCK                             ANY BLOCK
+/
+/      OS8 FILE                OR              PDP-10 FILE
+/
+/THE LIST ENDS WITH A ZERO (0) WORD
+/
+/AT "MPARAM" THE BLOCK--
+/      ABC DEF GHI JKL
+/      MNO PQR STU VWX
+/      YZ0 123 456 789
+/
+/WHICH ARE THE OPTION CHARACTERS
+/
+/THE = CONSTRUCTION IS NOT IMPLEMENTED
+\f/DEFINITIONS
+
+VERSION=       3       /VERSION NUMBER
+SUBVER=        01              /PATCH LEVEL
+                       /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+
+DIRECT=7000            /PDP-10 DIRECTORY BUFFER (FIELD 1)
+IBUF10=3000            /PDP-10 INPUT BUFFER (FIELD 1)
+INBUF=3000             /OS8 INPUT BUFFER (FIELD 1)
+OBUF10=5000            /PDP-10 OUTPUT BUFFER (FIELD 1)
+OUBUF=5000             /OS8 OUTPUT BUFFER (FIELD 1)
+
+OUDEVH=7200            /OUTPUT DEVICE (FIELD 0)
+INDEVH=6600            /INPUT DEVICE (FIELD 0)
+
+INCTL=1010             /INPUT CONTROL
+OUCTL=5010             /OUTPUT CONTROL
+INRECS=4               /INPUT RECORDS
+
+MDATE=7666             /MONITOR'S DATE (FIELD 1)
+
+MINPUT=7617            /INPUT LIST (FIELD 1)
+MOUTPU=7600            /OUTPUT LIST (FIELD 1)
+MPARAM=7643            /PARAMETER LIST (FIELD 1)
+JSBITS=7746            /0S8 JOB STATUS BITS
+
+DCB=7760               /DEVICE CONTROL BLOCK (FIELD 1)
+PTP=20                 /DCB VALUE OF THE PAPER TAPE PUNCH
+\f/PAGE ZERO AND POINTERS
+
+*10
+
+INDEX0,        0               /AUTO-INDEX REGISTERS
+INDEX1,        0
+INDEX2,        0
+INDEX3,        0
+INDEX4,        0
+INDEX5,        0
+INDEX6,        0
+IXR,   0               /INPUT LIST INDEX REGISTER
+
+*20
+
+UNIT10,        0               /CURRENT PDP-10 UNIT (U400)
+
+POINT, 0               /GENERAL POINTER
+
+CNTR,  0               /GENERAL COUNTER
+
+TEMP1, 0               /TEMPORARIES
+TEMP2, 0
+TEMP3, 0
+TEMP4, 0
+TEMP5, 0
+TEMP6, 0
+
+CHARNI,        0               /CHARACTER INPUT NUMBER
+CHARNO,        0               /CHARACTER OUTPUT NUMBER
+
+OUNIT, 0               /OUTPUT UNIT
+IUNIT, 0               /INPUT UNIT
+
+IBLOCK,        0               /INPUT BLOCK
+OBLOCK,        0               /OUTPUT BLOCK
+
+INPUT, 0               /INPUT ROUTINE POINTER
+OUTPUT,        0               /OUTPUT ROUTINE POINTER
+
+IPOINT,        0               /INPUT POINTER
+OPOINT,        0               /OUTPUT POINTER
+
+SAVELN,        0               /OPTION /P SWITCH
+
+MODE,  0               /OPTION /I AND /B SWITCH
+
+WORDS, 0               /WORDS LEFT COUNTER
+
+DATE,  0               /TODAY'S DATE
+
+FREEP, 0               /POINT TO FREE SPOT
+
+PRINT0,        0               /PRINT ROUTINE TEMPORARIES
+PRINT1,        0
+PRINT2,        0
+PRINT3,        0
+PRINTC,        0               /240 FOR LEADING SPACES
+
+RBFLAG,        0               /RUBOUT FLAG
+
+CDDEVF,        0               /DEFAULT DEVICE NAME
+       0
+
+CDNAME,        0               /FILE NAME
+       0
+       0
+CDEXT, 0               /FILE EXTENSION
+       0
+       0               /FILLER WORD
+
+PERSW, 0               /PERIOD SWITCH
+
+DEVSW, 0               /DEVICE SWITCH
+
+CDDEV, 0               /DEVICE
+       0
+
+INSEG, 0               /PDP-10 UNIT WITH DIRECTORY IN CORE
+
+PDP10D,        ZBLOCK 10       /LIST OF KNOWN PDP-10 UNITS
+
+CDCNT, 0               /INPUT LIST COUNTER
+
+CDI04, 0               /POINTER SAVE
+
+XDSK,  TEXT /DSK/      /DEFAULT DEVICE DSK:
+
+OCHARY,        0               /TEMPORARY
+DVTYPE,        0               /DEVICE TYPE HOLDER
+TDUNIT,        0               /0 OR 4000
+TAPFUN,        0               /DECTAPE FUNCTION
+DATE75,        0               /1 MEANS HAD H.O. BIT ON
+XDATE, 0               /POINTS TO EXTRA DATE BIT
+HIDATE,        0               /HIGH-ORDER BIT OF TODAY'S DATE
+
+/      KLUDGE FOR DATE-75 BUG:
+/      ONLY CONSIDER 1 MORE BIT OF PRECISION
+/      INSTEAD OF ALL 3 EXTRA BITS
+/      SINCE OS/8 DATE WILL RUN OUT BEFORE
+/      THAT FAILS
+       PAGE
+\f      JMP I (PIP10    /NORMAL ENTRY
+       JMS     ERROR   /PIP10 CANNOT BE CHAINED TO
+       ERMES0-1
+
+/ERROR ROUTINES
+
+IOERR, JMS ERROR       /I/O ERROR
+       ERMES1-1
+
+NOROOM,        JMS ERROR       /NO ROOM IN TAPE OR DIRECTORY
+       ERMES2-1
+
+NOOFIL,        JMS ERROR       /NO SUCH DEVICE
+       ERMES3-1
+
+FNOTFD,        JMS     ERROR           /FILE NOT FOUND
+       ERMES9-1
+NOT10F,        JMS ERROR       /NOT A PDP-10 FILE
+       ERMES4-1
+
+ERDELF,        JMS ERROR       /ERROR DELETING A FILE
+       ERMES5-1
+
+NOTPSF,        JMS ERROR       /NOT A OS8 FILE
+       ERMES6-1
+
+NOOOFL,        JMS ERROR       /ERROR OPENING THE OUTPUT FILE
+       ERMES7-1
+
+SYNTAX,        JMS ERROR       /SYNTAX ERROR
+       ERMES8-1
+
+ERROR, 0               /ERROR ROUTINE
+       CLA
+       CDF
+       TAD I ERROR
+       DCA INDEX0      /POINT TO MESSAG-1
+       TAD (ERROR3
+       DCA OUTPUT      /SET TTY: OUTPUT
+       JMS ERROR4      /PRINT THE STRING
+       JMP I (PIPCD    /AND BACK TO NORMAL
+
+ERROR4,        0               /PRINT THE STRING POINTED BY INDEX0
+       TAD I INDEX0
+       DCA TEMP1       /SAVE WORD
+       TAD TEMP1
+       RTR
+       RTR
+       RTR
+       JMS ERROR2      /BREAK IT DOWN
+       TAD TEMP1
+       JMS ERROR2
+       JMP ERROR4+1    /LOOP
+
+ERROR2,        0
+       AND [77         /USE 6 BITS
+       SNA
+       JMP I ERROR4    /END
+       DCA TEMP2
+       TAD TEMP2
+       AND (40
+       SNA CLA
+       TAD (100
+       TAD [200        /MAKE A CHAR
+       TAD TEMP2
+       TAD (-337       /_ IS SPECIAL
+       SNA
+       TAD (215-337
+       TAD (337
+       JMS ERROR7      /PUT IT
+       JMP I ERROR2
+
+ERROR7,        0
+       DCA TEMP2
+       TAD TEMP2
+       JMS I OUTPUT
+       TAD TEMP2
+       TAD (-215
+       SZA CLA
+       JMP I ERROR7
+       TAD (212
+       JMP ERROR7+1
+
+ERROR3,        0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I ERROR3
+\f/PRINT ROUTINE
+
+PRINT, 0
+       DCA PRINT0
+PRINT7,        DCA PRINTC      /SET SWITCH
+       TAD (PRINTL
+       DCA PRINT1
+       CLL CLA CMA RTL
+       DCA PRINT3
+PRINT4,        DCA PRINT2
+       JMP .+3
+
+       DCA PRINT0
+       ISZ PRINT2
+       TAD PRINT0
+       TAD I PRINT1
+       SMA
+       JMP .-5
+       CLA
+       ISZ PRINT1
+       TAD PRINT2
+       SZA
+       JMP PRINT5      /IT IS NON-ZERO
+       TAD PRINTC
+       SZA
+       JMS I OUTPUT    /PRINT LEADING SPACE IF DESIRED
+       JMP PRINT6
+
+PRINT5,        TAD ("0
+       JMS I OUTPUT
+       CLL CLA CML RAR
+PRINT6,        ISZ PRINT3
+       JMP PRINT4
+       TAD PRINT0
+       TAD ("0
+       JMS I OUTPUT
+       JMP I PRINT
+       PAGE
+\f/PDP-10 DECTAPE SERVICE ROUTINE
+/
+/CALL:
+/      JMS READT       /READ PDP-10 DECTAPE
+/      BUFFER          /BUFFER ADDRESS - FIELD 1
+/      BLOCK           /BLOCK NUMBER
+/
+/      JMS WRITET      /WRITE PDP-10 DECTAPE
+/      BUFFER          /BUFFER ADDRESS - FIELD 1
+/      BLOCK           /BLOCK NUMBER
+/
+/THE UNIT IS IN "UNIT10"
+
+TCON2, 2               /MUST BE AT BEGINNING OF PAGE!
+
+WRITET,        0               /WRITE PDP-10 DECTAPE
+       CDF             /BE SURE OF FIELD 0
+       TAD     WRITET
+       STL
+       JMS I   (TDIOCK /CHECK FOR TD IO
+       TAD I WRITET    /GET BUFFER ADDRESS
+       DCA TBUF        /AND SAVE IT
+       JMS RWTEST      /TEST DIRECTION
+WRITE2,        JMS I (FLIP     /REVERSE - FLIP BUFFER NOW
+       TAD (50
+WRITE1,        DCA TAPFUN      /SET FUNCTION (30=READ, 50=WRITE)
+       DTLB            /SEARCH INTO FIELD 0
+       TAD (TBLK
+       DCA I TCA       /TAPE BLOCK INTO "TBLK"
+TERR,  RTL             /ERROR BIT IS 0 INITIALLY
+       RAL             /SHIFT END ZONE BIT INTO LINK
+       CML CLA         /CLEAR REST OF THE JUNK
+       TAD [200        /'GO' BIT
+TSTART,        SNL             /SKIP IF NO REVERSE DIRECTION
+       TAD [400        /'REVERSE' BIT
+       DTXA            /START DRIVE GOING
+TLOOP, JMS I   (DTWAIT
+
+TOUT,  SPA             /ERROR?
+       JMP TERR        /YES - CHECK IT
+       DTRA            /CHECK DIRECTION
+       RTL
+       RTL             /DIRECTION BIT INTO LINK
+TMOD1, SZL CLA         /'SNL CLA' IF REVERSE MODE
+TMOD4, TAD TCON2       /'CLL CLA CMA RAL' IF REVERSE MODE
+       TAD TBLK        /GET BLOCK FOUND
+       CMA
+       TAD I WRITET    /GET BLOCK DESIRED
+       CMA
+       SZA CLA         /SKIP IF FOUND THE BLOCK
+       JMP TSTART      /NOT FOUND - GO AGAIN
+TMOD2, SZL CLA         /'SNL CLA' IF REVERSE MODE
+       JMP TSTART+1    /FOUND BUT WRONG DIRECTION - REVERSE IT
+       CLA CMA
+       TAD TBUF        /GET BUFFER ADDRESS-1
+       DCA I TCA       /SET ADDRESS
+       TAD (10
+       DTLB            /SET FIELD 1 BUFFER
+       TAD TAPFUN
+       DTXA            /SET READ OR WRITE
+       TAD TM600
+       DCA I TWC       /SET WORD COUNT OF 600 OCTAL WORDS
+       DTSF            /FLAG?
+       JMP .-1         /NO - WAIT
+       DTRB            /CHECK FOR ERRORS
+       SPA CLA
+       JMP I (IOERR    /ERROR!!
+       TAD [200
+       DTXA            /STOP THE DRIVE
+TMOD3, JMS I (FLIP     /POSSIBLE FLIP AFTER READ
+       ISZ WRITET
+       JMP I WRITET    /EXIT
+
+TCA,   7755            /DECTAPE CURRENT ADDRESS
+TWC,   7754            /DECTAPE WORD COUNT
+TBLK,  0               /SET TO BLOCK FOUND IN SEARCH
+TBUF,  0               /HOLDS BUFFER ADDRESS
+
+/READ ENTRY POINT
+
+READT, 0               /PDP-10 DECTAPE READ
+       CDF             /INSURE FIELD 0
+       TAD     READT
+       CLL
+       JMS I   (TDIOCK /CHECK FOR TD IO
+       TAD I READT     /GET BUFFER ADDRESS
+       DCA TBUF        /AND SAVE IT
+       TAD READT
+       DCA WRITET      /MOVE RETURN ADDRESS
+       JMS RWTEST      /CHECK DIRECTION
+       NOP             /NO INITIAL FLIP IF REVERSE
+       TAD (30         /READ FUNCTION
+       JMP WRITE1      /GO DO REST OF THE ROUTINE
+\fRWTEST,       0               /CHECK DIRECTION TO READ/WRITE AND SEARCH
+       ISZ WRITET
+       JMS I   (GOLDBK /GET OLD BLOCK NUMBER (NEGATIVE)
+       TAD I WRITET    /GET DESIRED BLOCK
+       DCA TBLK        /SAVE FOR FUTURE USE
+       SZL CLA
+       TAD (10         /FORWARD - SZL CLA
+       TAD TMOD6       /REVERSE - SNL CLA
+       DCA TMOD1       /SET UP FOR DIRECTION
+       TAD TMOD1
+       DCA TMOD2
+       SNL CLA
+       TAD WRITE2      /REVERSE - FLIP BUFFER AFTER
+       DCA TMOD3       /FORWARD - NO BUFFER FLIP
+TMOD6, SNL CLA
+       TAD (7344-1200  /REVERSE - CLL CLA CMA RAL
+       TAD TMOD5       /FORWARD - TAD TCON2
+       DCA TMOD4       /X0002 OR 17776
+       SZL CLA
+       ISZ RWTEST      /FORWARD - 2ND EXIT
+       IAC
+       SNL
+       CIA             /REVERSE DIRECTION
+       TAD I WRITET
+       SPA
+TM600, CLA             /NO LOWER THAN 0
+       DCA I TAPFUN    /SET NEW LAST SERVICED BLOCK
+       TAD TBLK        /REMEMBER SAVING THIS?
+       CLL
+       SMA SZA         /<0 AND 0 SKIP AND HAVE LINK=0
+       CLL CML CIA     />0 BECOMES <0 AND HAS LINK=1
+TMOD5, TAD TCON2
+       CLA RTR         /LINK HAS SEARCH DIRECTION
+       RTR
+       TAD (10         /ADD 'SEARCH' BIT
+       DTCA DTXA       /LOAD SEARCH AND DIRECTION
+       TAD UNIT10      /GET UNIT
+       DTXA            /ADD UNIT (ALSO FLIPS DIRECTION)
+       JMP I RWTEST    /EXIT
+       PAGE
+\f/"OLDTBL" IS LIST OF LAST SERVICED BLOCKS
+
+OLDTBL,        0;0;0;0;0;0;0;0
+/FLIP THE BUFFER ROUTINE
+
+FLIP,  0               /FLIP A 600 WORD BUFFER (FIELD 1)
+       TAD I (TBUF     /BUFFER START
+       DCA FLIP1       /SET START
+       TAD (577
+       TAD I (TBUF
+       DCA FLIP2       /SET END (END=START+577)
+       TAD (-300
+       DCA FLIP3       /SET COUNT (600/2=300)
+       CDF 10          /BUFFER IS IN FIELD 1
+FLIP6, TAD I FLIP1     /GET START
+       JMS FLIP4       /FLIP IT
+       DCA FLIP5       /SAVE TEMPORARILY
+       TAD I FLIP2     /GET END
+       JMS FLIP4       /FLIP IT
+       DCA I FLIP1     /PUT END INTO START
+       TAD FLIP5
+       DCA I FLIP2     /PUT START INTO END
+       ISZ FLIP1       /BUMP POINTERS
+       CLA CMA
+       TAD FLIP2
+       DCA FLIP2
+       ISZ FLIP3       /DONE?
+       JMP FLIP6       /NO - LOOP
+       CDF             /BACK TO FIELD 0
+       JMP I FLIP      /EXIT
+
+FLIP1, 0               /START POINTER
+FLIP2, 0               /END POINTER
+FLIP3, 0               /COUNTER
+FLIP5, 0               /TEMPORARY
+FLIP7, 0               /FLIPPING TEMPORARIES
+FLIP8, 0               /"        "
+
+FLIP4, 0               /FLIP A CELL
+       DCA FLIP7       /SAVE IT
+       TAD FLIP7
+       RTL
+       RTL
+       AND (7          /GET ...1
+       DCA FLIP8       /ACCUMULATE RESULT
+       TAD FLIP7
+       RTR
+       RAR
+       AND (70         /GET ..2.
+       TAD FLIP8
+       DCA FLIP8       /BUILD RESULT
+       TAD FLIP7
+       AND (70
+       CLL RTL
+       RAL             /GET .3..
+       TAD FLIP8
+       DCA FLIP8       /BUILD RESULT
+       TAD FLIP7
+       AND (7
+       CLL RTR
+       RTR             /GET 4...
+       TAD FLIP8
+       CMA             /GET NOT 4321
+       JMP I FLIP4     /EXIT
+\f/TD8E I/O ROUTINE - CALLS STANDARD ROUTINE
+
+TDIOCK,        0
+       DCA     TDRET   /SAVE RETURN ADDR
+       RAR
+       DCA     TDFUN   /SAVE READ/WRITE
+       JMS I   (GET10D /GET TYPE OF DECTAPE
+       TAD     (-2
+       SZA CLA
+       JMP I   TDIOCK  /TC08 - CONTINUE
+       TAD I   TDRET
+       DCA     TDBUF   /SAVE BUF ADDR
+       ISZ     TDRET
+       JMS     GOLDBK  /GET OLD BLOCK #
+       TAD I   TDRET
+       CLA RAL         /GET DIRECTION
+       TAD     (110    /ONE BLOCK, FIELD 1
+       TAD     TDFUN
+       DCA     TDFUN   /SAVE FINAL FUNCTION WORD
+       JMS I   (TDUSET /SET UP HANDLER
+       TAD     TDUNIT
+       SPA CLA
+       TAD     (DTA1-DTA0
+       TAD     (DTA0
+       DCA     TDIOCK  /SET UP HANDLER ENTRY PTR
+       TAD I   TDRET
+       DCA I   TAPFUN
+       TAD I   TAPFUN
+       DCA     TDBLK
+       JMS I   TDIOCK
+TDFUN, 0
+TDBUF, 0
+TDBLK, 0
+       JMP I   (IOERR
+       ISZ     TDRET
+       JMP I   TDRET
+TDRET, 0
+
+GOLDBK,        0
+       TAD UNIT10      /GET THE UNIT WE NEED
+       CLL RTL
+       RTL             /SHIFT INTO BITS 9-11
+       TAD (OLDTBL
+       DCA TAPFUN      /POINT TO THIS UNIT'S POSITION
+       TAD I TAPFUN    /GET LAST SERVICED BLOCK
+       CLL CIA
+       JMP I   GOLDBK
+       PAGE
+\f/GET A LINE ROUTINE
+
+GLINE, 0               /GET A LINE
+       TAD ["*
+       JMS I [ERROR3   /ANNOUNCE US WITH A *
+       DCA RBFLAG      /RESET RUBOUT FLAG
+       TAD [LINBUF-1
+       DCA IXR         /POINT TO THE BUFFER
+CHLOOP,        KSF
+       JMP CHLOOP      /WAIT FOR TTY:
+       TAD [200
+       KRS             /READ TTY:
+       DCA TEMP1
+       KCC
+       TAD [SPADR-1
+       DCA INDEX0      /SET LIST SEARCH
+       TAD I INDEX0
+       SNA
+       JMP .+6         /END OF LIST
+       TAD TEMP1
+       SNA CLA
+       JMP I INDEX0    /FOUND SO JUMP
+       ISZ INDEX0
+       JMP .-7         /LOOP
+
+       JMS PRNT        /PRINT IT
+CINSRT,        TAD TEMP1
+       DCA I IXR       /STORE THE CHARACTER
+       TAD IXR
+       TAD (-LINBUF-100
+       SZA CLA
+       JMP CHLOOP      /GET ANOTHER CHARACTER
+       JMS CRCR
+       JMP I (SYNTAX   /ERROR
+
+CARRET,        JMS CRCR
+CLFINI,        DCA I IXR       /SET END
+       DCA I IXR
+       JMP I GLINE     /EXIT
+
+SPADR, -225;JMP CTRLU
+       -215;JMP CARRET
+       -377;JMP RUBOUT
+       -375;JMP ALTMOD
+       -376;JMP ALTMOD
+       -233;JMP ALTMOD
+       -200;JMP CHLOOP
+       -217;JMP CHLOOP
+       -337;JMP BAKARR
+       -212;JMP LFEED
+       -203;JMP CTRLC
+       0
+
+BAKARR,        JMS PRNT        /"_"
+       TAD ["<
+       JMP CINSRT+1    /USE "<" INSTEAD
+
+CTRLC,
+CTRLU, TAD ["^
+       JMS I [ERROR3   /CONTROL CHARACTERS
+       TAD TEMP1
+       TAD [100
+CLRLIN,        JMS I [ERROR3
+       JMS CRCR
+       TAD I INDEX0
+       SZA CLA
+       JMP GLINE+1     /NOT "^C"
+       TSF
+       JMP .-1
+       JMP I (7605     /TO MONITOR
+
+CRCR,  0
+       TAD [215
+       DCA TEMP1
+       JMS PRNT
+       TAD [212
+       JMS I [ERROR3   /PRINT CR-LF
+       JMP I CRCR
+
+ALTMOD,        TAD ["$
+       DCA TEMP1       /ALTMODE IS "$"
+       JMS PRNT
+       JMP CLFINI      /ENDS THE LINE
+
+RUBOUT,        TAD IXR
+       TAD (1-LINBUF
+       SNA CLA
+       JMP RBSPCL      /SPECIAL TREATMENT
+       TAD ("\
+       ISZ RBFLAG
+       JMS I [ERROR3   /PRINT \
+       CLA CMA
+       DCA RBFLAG      /SET FLAG
+       TAD IXR
+       DCA TEMP2
+       TAD I TEMP2
+       JMS I [ERROR3   /PRINT RUBED CHAR
+LBCKUP,        CLA CMA
+       TAD IXR
+       JMP CHLOOP-1    /GO GET ANOTHER
+
+RBSPCL,        ISZ RBFLAG
+       JMP CLRLIN+1    /NOT INTO RUBOUTS
+       TAD ("\
+       JMP CLRLIN
+
+PRNT,  0
+       ISZ RBFLAG
+       JMP .+3
+       TAD ("\
+       JMS I [ERROR3   /END OF RUBOUTS
+       DCA RBFLAG
+       TAD TEMP1
+       JMS I [ERROR3   /PRINT CHAR
+       JMP I PRNT
+
+LFEED, JMS CRCR
+       DCA I IXR       /SET END
+       TAD [LINBUF-1
+       DCA IXR
+       TAD ["*
+       JMS I [ERROR3
+       TAD I IXR       /PRINT THE LINE
+       SNA
+       JMP LBCKUP
+       JMP .-4
+       PAGE
+\f/FIND A SLOT ROUTINE
+/SLOT NUMBERS BETWEEN 0 AND 1101
+/RETURN WITH A 5 BIT NUMBER (1 TO 26 OCTAL)
+/
+/CALL:
+/      JMS FINDSL      /FIND A SLOT
+/      SLOT#           /SLOT NUMBER
+/      (AC)            /VALUE OF SLOT RETURNED
+/
+/SLOT NUMBER OF 0 RETURNS 7777
+
+FINDSL,        0               /FIND A SLOT
+       CLA CMA
+       TAD I FINDSL    /GET SLOT NUMBER-1
+       ISZ FINDSL
+       SPA             /WAS IT 0?
+       JMP FINDSA      /YES
+       JMS DIV7        /NO - DIVIDE BY 7
+       TAD (JMP I FINDS0+7
+       DCA DIV1        /USE REMAINDER FOR JUMPING
+       CDF 10          /BUFFER IS IN FIELD 1
+DIV1,  HLT             /TEMPORARY AND JUMP CELL
+
+FINDSA,        CLA CMA
+       JMP I FINDSL    /EXIT WITH 7777 FOR SLOT NUMBER 0
+
+FINDS0,        FINDS1          /JUMP TABLE
+       FINDS2
+       FINDS3
+       FINDS4
+       FINDS5
+       FINDS6
+       FINDS7
+
+/DIVIDE BY 7 ROUTINE
+
+DIV7,  0               /DIVIDE BY 7
+       DCA DIV1        /SAVE IT
+       TAD (DIRECT
+       DCA POINT       /POINT TO DIRECTORY
+       TAD DIV1
+DIV3,  TAD (-7         /SUBTRACT 7'S
+       SPA
+       JMP I DIV7      /EXIT WITH REMAINDER
+       ISZ POINT       /BUMP POINTER BY 3
+       ISZ POINT
+       ISZ POINT
+       JMP DIV3        /AND LOOP
+
+/FIND SLOT ROUTINE #1
+/USE WORD 1 BITS 0-4
+
+FINDS1,        TAD I POINT     /GET CELL
+       RTL
+       RTL
+       RTL             /GET FIRST 5 BITS
+FINDS8,        AND [37         /ONLY 5 BITS
+       CDF             /BACK TO FIELD 0
+       JMP I FINDSL    /AND EXIT WITH VALUE IN AC
+
+/FIND SLOT ROUTINE #2
+/USE WORD 1 BITS 5-9
+
+FINDS2,        TAD I POINT
+       RTR             /USE BITS 5-9
+       JMP FINDS8
+
+/FIND SLOT ROUTINE #3
+/USE WORD 1 BITS 10-11 AND WORD 2 BITS 0-2
+
+FINDS3,        TAD I POINT
+       AND [3          /USE BITS 10-11 OF 1ST WORD
+       CLL RTL
+       RAL             /SHIFT TO BITS 7-8
+       DCA DIV1        /SAVE IT
+       ISZ POINT       /NEXT WORD
+       TAD I POINT
+       CLL RTL
+FINDS9,        RTL             /GET INTO BITS 8-11
+       AND [17         /GET ONLY BITS 8-11
+       TAD DIV1        /ADD OTHER BITS
+       JMP FINDS8
+
+/FIND SLOT ROUTINE #4
+/USE WORD 2 BITS 3-7
+
+FINDS4,        ISZ POINT       /USE 2ND WORD
+       TAD I POINT
+       RTR             /USE BITS 3-7
+       JMP FINDS2+1
+
+/FIND SLOT ROUTINE #5
+/USE WORD 2 BITS 8-11 AND WORD 3 BIT 0
+
+FINDS5,        ISZ POINT       /USE 2ND WORD
+       TAD I POINT
+       AND [17
+       CLL RAL         /GET BITS 7-10
+       DCA DIV1        /AND SAVE THEM
+       ISZ POINT       /NEXT WORD
+       CLL CLA CML RAR
+       AND I POINT     /GET BIT 0
+       JMP FINDS9
+
+/FIND SLOT ROUTINE #6
+/USE WORD 2 BITS 1-5
+
+FINDS6,        ISZ POINT
+       ISZ POINT       /USE 3RD WORD
+       TAD I POINT
+       RAL
+       JMP FINDS1+1
+
+/FIND SLOT ROUTINE #7
+/USE WORD 3 BITS 6-10
+
+FINDS7,        ISZ POINT
+       ISZ POINT       /USE 3RD WORD
+       TAD I POINT
+       RAR             /GET RID OF LAST BIT
+       JMP FINDS8
+\f/DELETE A PDP-10 ENTRY
+/
+/CALL:
+/      (AC)            /POINT TO NAME-1 (FIELD 1)
+/      JMS DELETE      /DELETE A PDP-10 ENTRY
+/      -NO-            /NOT FOUND
+/      -OK-            /ENTRY DELETED
+
+DELETE,        0               /DELETE A PDP-10 ENTRY
+       JMS I   (FIND   /TRY TO FIND IT FIRST
+       JMP I DELETE    /NOT FOUND
+       ISZ DELETE      /FOUND - 2ND EXIT
+       DCA DELET1      /SAVE SLOT NUMBER
+       CLA IAC
+       DCA DELET2      /START AT SLOT 1
+       TAD (-1101
+       DCA DELET3      /DO 1101 SLOTS
+       JMS FINDSL      /FIND A SLOT
+DELET2,        0               /SLOT NUMBER
+       CIA
+       TAD DELET1      /IS IT ONE OF OURS?
+       SZA CLA
+       JMP DELET4      /NO
+       TAD DELET2      /YES
+       DCA .+2         /SET SLOT NUMBER AGAIN
+       JMS I (FILLSL   /FILL WITH A 0
+       0
+       0               /FILL WITH A 0
+DELET4,        ISZ DELET2      /NEXT SLOT
+       ISZ DELET3      /MORE?
+       JMP DELET2-1    /YES - LOOP
+       CDF 10          /DIRECTORY IS IN FIELD 1
+       DCA I INDEX0    /REMEMBER "FIND" SETTING THIS UP?
+       DCA I INDEX0    /REMOVE THE FILE NAME
+       DCA I INDEX0
+       TAD INDEX0
+       TAD [77
+       DCA INDEX0      /POINT TO EXTENSION
+       DCA I INDEX0
+       DCA I INDEX0    /REMOVE EXTENSION
+       DCA I INDEX0
+       CDF
+       JMP I DELETE    /EXIT
+
+DELET1,        0               /HOLDS FOUND SLOT NUMBER
+DELET3,        0               /COUNTER
+       PAGE
+\f/FILL A SLOT ROUTINE
+/
+/CALL:
+/      JMS FILLSL      /FILL A SLOT
+/      SLOT#           /SLOT NUMBER
+/      VALUE           /VALUE TO FILL SLOT WITH
+/
+/SLOT NUMBER 0 IS ILLEGAL!
+
+FILLSL,        0               /FILL A SLOT ROUTINE
+       CLA CMA
+       TAD I FILLSL    /GET SLOT NUMBER-1
+       ISZ FILLSL
+       JMS I (DIV7     /DIVIDE BY 7
+       TAD (JMP I FILLS0+7
+       DCA FILLS9      /USE REMAINDER FOR JUMPING
+       TAD I FILLSL    /GET VALUE
+       ISZ FILLSL
+       AND [37         /5 BIT VALUE ONLY
+       CDF 10          /DIRECTORY IS IN FIELD 1
+FILLS9,        HLT             /TEMPORARY AND JUMP CELL
+
+/JUMP TABLE
+
+FILLS0,        FILLS1
+       FILLS2
+       FILLS3
+       FILLS4
+       FILLS5
+       FILLS6
+       FILLS7
+
+FILLSA,        0               /TEMPORARY
+
+/FILL SLOT ROUTINE #1
+/BITS 0-4 OF WORD 1
+
+FILLS1,        CLL RTR
+       RTR             /VALUE INTO BITS 0-4
+       RTR
+       DCA FILLS9      /SAVE VALUE
+       TAD I POINT
+       AND [177        /AND OFF BITS 0-4
+FILLS8,        TAD FILLS9      /ADD IN VALUE
+       DCA I POINT     /SET NEW WORD
+       CDF             /BACK TO FIELD 0
+       JMP I FILLSL    /EXIT
+
+/FILL SLOT ROUTINE #2
+/BITS 5-9 OF WORD 1
+
+FILLS2,        CLL RTL         /VALUE INTO BITS 5-9
+       DCA FILLS9      /SAVE VALUE
+       TAD I POINT
+       AND (7603       /AND OFF BITS 5-9
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #3
+/BITS 10-11 OF WORD 1 AND BITS 0-2 OF WORD 2
+
+FILLS3,        DCA FILLS9      /SAVE VALUE
+       TAD FILLS9
+       CLL RAR
+       CLL RAR         /GET BITS 10-11
+       CLL RAR
+       DCA FILLSA      /SAVE
+       TAD I POINT
+       AND (7774       /AND OFF BITS 10-11
+       TAD FILLSA      /ADD IN BITS 10-11
+       DCA I POINT     /SET NEW WORD
+       ISZ POINT       /GOTO WORD 2
+       TAD FILLS9
+       AND [7          /GET BITS 0-2
+       CLL RTR
+       RTR             /SHIFT THEM
+       DCA FILLS9      /SAVE VALUE
+       TAD I POINT
+       AND (777        /AND OFF BITS 0-2
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #4
+/BITS 3-7 OF WORD 2
+
+FILLS4,        CLL RTL
+       RTL             /SHIFT INTO POSITION
+       DCA FILLS9      /AND SAVE
+       ISZ POINT       /USE WORD 2
+       TAD I POINT
+       AND (7017       /AND OFF BITS 3-7
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #5
+/BITS 8-11 OF WORD 2 AND BIT 0 OF WORD 3
+
+FILLS5,        DCA FILLS9
+       TAD FILLS9      /GET VALUE
+       CLL RAR         /GET BITS 8-11
+       DCA FILLSA      /AND SAVE
+       ISZ POINT       /USE WORD 2 FIRST
+       TAD I POINT
+       AND [7760       /AND OFF BITS 8-11
+       TAD FILLSA      /ADD IN THOSE BITS
+       DCA I POINT     /SET NEW WORD 2
+       ISZ POINT       /NOW WORD 3
+       CLA IAC
+       AND FILLS9      /GET BIT 0
+       CLL RTR         /AND SHIFT INTO POSITION
+       DCA FILLS9      /AND SAVE IT
+       CLL CLA CMA RAR
+       AND I POINT     /AND OFF BIT 0
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #6
+/BITS 1-5 OF WORD 3
+
+FILLS6,        CLL RTL
+       RTL             /SHIFT INTO POSITION
+       RTL
+       DCA FILLS9      /AND SAVE
+       ISZ POINT
+       ISZ POINT       /USE WORD 3
+       TAD I POINT
+       AND (4077       /AND OFF BITS 1-5
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #7
+/BITS 6-10 OF WORD 3
+/BIT 11 OF WORD 3 A 0
+
+FILLS7,        CLL RAL         /SHIFT INTO POSITION
+       DCA FILLS9      /AND SAVE
+       ISZ POINT
+       ISZ POINT       /USE WORD 3
+       TAD I POINT
+       AND [7700       /AND OFF BITS 6-11
+       JMP FILLS8
+\fFIX75,        0               /DF 10
+       CDF             /SET H.O. DATE WORD OF FILE
+       TAD I (SLOTNO   /ENTRY NO. OF FILE
+       CLL RAL         /*3
+       TAD I (SLOTNO   /SINCE 1 -10 WORD= 3 -8 WORDS
+       TAD (DIRECT-1   /POINT TO HIGH ORDER BIT OF DATE
+       DCA FIXPTR      /V3C
+       CDF 10
+       STA CLL RAL     /OTHER STUFF IS VERY IMPORTANT
+       AND I FIXPTR    /SO KEEP IT
+       TAD HIDATE      /OR IN THIS BIT
+       DCA I FIXPTR    /AND WRITE IT BACK
+       JMP I FIX75
+
+FIXPTR,        0               /POINTS TO WORD CONTAINING H.O. DATE
+       PAGE
+\f/GET NEXT SLOT ROUTINE
+/GOES BY 5'S EITHER FORWARD OR BACKWARD
+/
+/CALL:
+/      (AC)            /CURRENT BLOCK NUMBER
+/      JMS NEXTSL      /GET NEXT SLOT
+/      (AC)            /NEXT BLOCK NUMBER
+/
+/GOES TO "NOROOM" IF DIRECTORY FULL
+
+NEXTSL,        0               /GET NEXT SLOT
+       TAD NEXTDI      /ADD IN DIRECTION FACTOR
+       SPA
+       JMP NEXTS2      /<0 MEANS REVERSE DIRECTION
+       TAD [-1102
+       SMA
+       JMP NEXTS2      />1101 MEANS REVERSE DIRECTION
+       TAD (1102
+       DCA NEXTS1      /SET NEW BLOCK NUMBER
+       JMS I (FINDSL   /IS THIS SLOT FREE?
+NEXTS1,        0               /BLOCK NUMBER
+       SZA CLA
+       JMP NEXTS3      /NO - NOT FREE
+       TAD NEXTS1      /FREE
+       DCA NEXTS7+1    /SET BLOCK AGAIN
+NEXTS7,        JMS I (FILLSL   /FILL THIS SLOT THEN
+       0               /SLOT TO FILL
+SLOTNO,        0               /VALUE TO FILL WITH
+       TAD NEXTDI
+       SMA CLA         /MAKE SURE DIRECTION IS -4 OR 4
+       TAD (10
+       TAD (-4
+       DCA NEXTDI
+       TAD NEXTS7+1    /GET NEW BLOCK
+       JMP I NEXTSL    /EXIT
+
+NEXTS2,        CLA             /REVERSE DIRECTION
+       TAD NEXTDI
+       SMA CLA         /SET 0 OR 1101
+       TAD (1101
+       DCA NEXTS1      /INTO BLOCK NUMBER
+       TAD NEXTDI
+       CIA             /REVERSE DIRECTION
+       JMP NEXTS3+1    /GO PRETEND WE FOUND A FULL SLOT
+
+NEXTS3,        TAD NEXTDI
+       SMA CLA         /MAKE DIRECTION -1 OR 1
+       CLL CLA CMA RAL
+       CMA
+       DCA NEXTDI      /DIRECTION IS -1 OR 1
+       TAD [-1102
+       DCA NEXTS4      /CHECK 1102 BLOCKS
+       TAD NEXTS1
+       DCA NEXTS5      /SET START BLOCK
+       JMS I (FINDSL   /CHECK A SLOT
+NEXTS5,        0               /SLOT TO CHECK
+       SNA CLA
+       JMP NEXTS6      /FOUND A FREE SLOT
+       ISZ     NEXTS4  /TRY MORE?
+       SKP             /YES
+       JMP I   (NOROOM /NO - OUT OF ROOM
+       TAD NEXTS5
+       TAD NEXTDI      /ADD DIRECTION TO SLOT
+       SPA
+       JMP NEXTS2      /<0 IS TOO FAR
+       TAD [-1102
+       SMA
+       JMP NEXTS2      />1101 IS TOO FAR
+       TAD (1102
+       DCA NEXTS5      /SET NEW BLOCK
+       JMP     NEXTS5-1        /KEEP GOING
+
+NEXTS6,        TAD NEXTS5      /GET FREE BLOCK
+       JMP NEXTS7-1    /AND SET IT
+
+NEXTS4,        0               /COUNTER
+
+NEXTDI,        0               /DIRECTION (5, -5, 1, -1)
+
+/MORE PDP-10 OUTPUT
+
+/OUTPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
+
+OCHAR3,        TAD OCHARY
+       CLL RTR
+       RTR
+       AND [7
+       TAD I OPOINT
+       DCA I OPOINT
+       ISZ OPOINT
+       TAD OCHARY
+       AND [17
+       CLL RTR
+       RTR
+       RAR
+       JMP I (OCHARD
+\fMONTBL,       "J;"A;"N
+       "F;"E;"B
+       "M;"A;"R
+       "A;"P;"R
+       "M;"A;"Y
+       "J;"U;"N
+       "J;"U;"L
+       "A;"U;"G
+       "S;"E;"P
+       "O;"C;"T
+       "N;"O;"V
+       "D;"E;"C
+       PAGE
+\f/PDP-10 CHARACTER OUTPUT ROUTINE
+/
+/CALL:
+/      (AC)            /CHARACTER
+/      JMS OCHR10      /OUTPUT TO PDP-10
+/      -RETURN-        /O.K. RETURN
+
+OCHR10,        0               /OUTPUT TO PDP-10
+       DCA OCHARY      /SAVE CHAR
+       TAD MODE        /IMAGE MODE?
+       SZA
+       JMP OC10A1      /YES /I OR /B
+       TAD OCHARY      /NO - USE 7 BITS
+       AND [177
+OC10A2,        DCA OCHARY
+OC10A3,        TAD CHARNO      /GET CHAR NUMBER
+       TAD (JMP I OCHARX
+       DCA OCHARZ      /USE TO SET UP JUMP
+       CDF 10          /BUFFER IS IN FIELD 1
+OCHARZ,        0               /JUMP TO THE ROUTINE
+
+OC10A1,        SMA CLA         /BINARY?
+       JMP OC10A3      /NO
+       TAD OCHARY      /YES
+       AND [377
+       JMP OC10A2
+
+OCHARX,        OCHAR0
+       OCHAR1
+       OCHAR2
+       OCHAR3
+       OCHAR4
+
+/OUTPUT CHARACTER #0 - BITS 0-6 WORD 1
+
+OCHAR0,        TAD I [OBUF10+2
+       AND [177        /GET COUNT
+       TAD (-177
+       SZA CLA
+       JMP OCHARA      /STILL ROOM IN BUFFER
+       CDF             /NO ROOM IN BUFFER
+       TAD OBLOCK
+       JMS I (NEXTSL   /GET THE NEXT BLOCK NUMBER
+       DCA OCHARZ      /AND SAVE IT
+       CDF 10          /BACK TO FIELD 1
+       TAD OCHARZ
+       AND [7700
+       CLL RTR
+       RTR
+       RTR             /GET LINK POINTER
+       DCA I [OBUF10
+       TAD OCHARZ
+       AND [77
+       CLL RTL
+       RTL
+       RTL
+       TAD I [OBUF10+1
+       DCA I [OBUF10+1 /AND SET POINTER
+       TAD OUNIT
+       DCA UNIT10      /SET OUR UNIT
+       TAD OBLOCK
+       DCA .+3         /AND OUR BLOCK
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       OBUF10
+       0               /BLOCK NUMBER IS SET
+       CDF 10          /BACK TO FIELD 1
+       DCA I [OBUF10
+       TAD I [OBUF10+1
+       AND [77
+       DCA I [OBUF10+1 /CLEAR POINTER
+       TAD OCHARZ
+       DCA OBLOCK      /SET NEW BLOCK
+       TAD I [OBUF10+2
+       AND [7400
+       DCA I [OBUF10+2 /ZERO COUNT
+       TAD (OBUF10+3
+       DCA OPOINT      /RESET POINTER
+OCHARA,        ISZ I [OBUF10+2 /BUMP COUNT
+       TAD MODE        /IMAGE MODE?
+       SNA
+       JMP OCHARB      /NO
+       SMA CLA         /BINARY?
+       JMP OC10A4      /NO
+       DCA I OPOINT    /YES
+       ISZ OPOINT
+       DCA I OPOINT
+       ISZ OPOINT
+       TAD OCHARY
+       DCA I OPOINT    /SET 8 BITS
+       ISZ OPOINT
+OCHARC,        CDF             /BACK TO FIELD 0
+       JMP I OCHR10    /EXIT
+
+OC10A5,        ISZ OPOINT
+OC10A4,        TAD OCHARY
+       JMP OCHARD
+
+OCHARB,        TAD OCHARY
+       CLL RTL
+       RTL
+       RAL             /USE BITS 0-6
+OCHARD,        DCA I OPOINT    /SET IT
+       ISZ CHARNO      /BUMP CHARACTER NUMBER
+       JMP OCHARC
+
+/OUTPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
+
+OCHAR1,        TAD MODE
+       SZA CLA
+       JMP OC10A5
+       TAD OCHARY
+       CLL RAR         /GET BITS 7-11
+       CLL RAR
+       TAD I OPOINT
+       DCA I OPOINT    /SET WORD 1
+       ISZ OPOINT      /NOW WORD 2
+       TAD OCHARY
+       AND [3
+       CLL RTR
+       RAR             /GET BITS 0-1
+       JMP OCHARD
+
+/OUTPUT CHARACTER #2 - BITS 2-8 WORD 2
+
+OCHAR2,        TAD MODE
+       SZA CLA
+       JMP OC10A6
+       TAD OCHARY
+       CLL RTL
+       RAL             /GET BITS 2-8
+       TAD I OPOINT
+       JMP OCHARD
+
+/OUTPUT CHARACTER #4 - BITS 4-10 WORD 3
+/BIT 11 WORD 3 IS 0
+
+OCHAR4,        TAD OCHARY
+       CLL RAL         /BITS 4-10
+       TAD I OPOINT
+OC10A7,        DCA I OPOINT    /SET WORD 3
+       ISZ OPOINT
+       DCA CHARNO      /RESET CHARACTER NUMBER
+       JMP OCHARC
+
+OC10A6,        ISZ OPOINT
+       TAD OCHARY
+       JMP OC10A7
+       PAGE
+\f/PDP-10 CHARACTER INPUT
+/
+/CALL:
+/      JMS ICHR10      /PDP-10 INPUT
+/      -EOF-           /END OF FILE RETURN
+/      (AC)            /NORMAL RETURN - CHARACTER IN AC
+
+ICHR10,        0               /PCP-10 INPUT ROUTINE
+       TAD CHARNI
+       TAD (JMP I ICHARX
+       DCA ICHARY      /USE CHARACTER NUMBER TO FORM JUMP
+       CDF 10          /BUFFER IS IN FIELD 1
+ICHARY,        0               /TEMPORARY AND JUMP CELL
+
+ICHARX,        ICHAR0
+       ICHAR1
+       ICHAR2
+       ICHAR3
+       ICHAR4
+
+/INPUT CHARACTER #0 - BITS 0-6 WORD 1
+
+ICHAR0,        TAD WORDS       /GET NUMBER OF WORD LEFT
+       SZA CLA
+       JMP ICHARA      /STILL MORE WORDS LEFT
+       TAD IBLOCK      /GET NEXT BLOCK
+       SNA
+       JMP ICHARC+1    /NONE - EOF
+       DCA .+5         /SET NEXT BLOCK
+       TAD IUNIT
+       DCA UNIT10      /SET OUR UNIT
+       JMS I (READT    /READ PDP-10 DECTAPE
+       IBUF10
+       0               /OUR BLOCK IS SET
+       CDF 10          /BACK TO FIELD 1
+       TAD I [IBUF10+2
+       AND [177
+       DCA WORDS       /SET NUMBER OF WORDS
+       TAD I [IBUF10+1
+       RTR
+       RTR
+       RTR
+       AND [77
+       DCA IBLOCK      /SET NEXT BLOCK
+       TAD I [IBUF10
+       AND [77
+       CLL RTL
+       RTL
+       RTL
+       TAD IBLOCK
+       DCA IBLOCK      /SET NEXT BLOCK
+       TAD (IBUF10+3
+       DCA IPOINT      /RESET POINTER
+       JMP ICHAR0
+
+ICHARA,        CLA CMA
+       TAD WORDS
+       DCA WORDS       /COUNT DOWM ON NUMBER OF WORDS
+       TAD MODE        /IMAGE MODE?
+       SNA
+       JMP ICHARB      /NO
+       SMA CLA
+       JMP IC10A1
+       ISZ IPOINT      /YES
+       ISZ IPOINT
+       TAD I IPOINT    /GET WORD 3
+       ISZ IPOINT
+       AND [377        /USE 8 BITS
+ICHARC,        ISZ ICHR10      /2ND EXIT
+       CDF             /BACK TO FIELD 0
+       JMP I ICHR10    /EXIT
+
+ICHARB,        TAD SAVELN      /PRESERVE OPTION?
+       SZA CLA
+       JMP ICHARF      /YES
+       CLL CLA CML RTL /NO
+       TAD IPOINT
+       DCA ICHARY      /POINT TO WORD 3
+       TAD I ICHARY
+       CLL RAR
+       SNL CLA
+       JMP ICHARF      /WORD O.K.
+       ISZ IPOINT
+       ISZ IPOINT      /IGNORE THIS WORD
+       ISZ IPOINT
+       JMP ICHAR0
+
+ICHARF,        TAD I IPOINT
+       RTR
+       RTR             /GET BITS 0-6
+       RAR
+ICHARD,        ISZ CHARNI      /BUMP COUNTER
+       AND [177        /USE 7 BITS
+       TAD [200        /ADD BIT 8
+       JMP ICHARC
+
+/INPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
+
+ICHAR1,        TAD MODE
+       SZA CLA
+       JMP IC10A1
+       TAD I IPOINT
+       AND [37
+       CLL RTL         /GET BITS 7-11
+       DCA ICHARY
+       ISZ IPOINT      /USE WORD 2 NOW
+       TAD I IPOINT
+       CLL RTL
+       RAL
+       AND [3          /GET BITS 0-1
+ICHARE,        TAD ICHARY      /ADD IN OTHER BITS
+       JMP ICHARD
+
+/INPUT CHARACTER #2 - BITS 2-8 WORD 2
+
+ICHAR2,        TAD MODE
+       SZA CLA
+       JMP IC10A3
+       TAD I IPOINT
+       RAR
+       RTR             /GET BITS 2-8
+       JMP ICHARD
+
+/INPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
+
+ICHAR3,        TAD I IPOINT
+       AND [7
+       CLL RTL
+       RTL             /GET BITS 9-11
+       DCA ICHARY
+       ISZ IPOINT      /USE WORD 3 NOW
+       TAD I IPOINT
+       RTL
+       RTL
+       RAL
+       AND [17         /GET BITS 0-3
+       JMP ICHARE
+
+/INPUT CHARACTER #4 - BITS 4-10 WORD 3
+
+ICHAR4,        DCA CHARNI      /RESET CHARACTER COUNT
+       TAD I IPOINT
+       ISZ IPOINT
+       RAR
+       JMP ICHARD+1
+
+IC10A3,        DCA CHARNI
+       SKP
+IC10A1,        ISZ CHARNI
+       TAD I IPOINT
+       ISZ IPOINT
+       JMP ICHARC
+       PAGE
+\f/CLOSE A PDP-10 FILE
+/
+/CALL:
+/      JMS CLOS10      /CLOSE A PDP-10 FILE
+/      -RETURN-
+
+CLOS10,        0               /CLOSE A PDP-10 FILE
+       TAD MODE        /IMAGE MODE?
+       SPA CLA
+       JMP CLOS1A      /YES - NO FILL NEEDED
+       TAD CHARNO
+       SNA CLA
+       JMP CLOS1A      /CHARACTER NUMBER IS 0 - FILL DONE
+       JMS I (OCHR10   /0 FILL
+       JMP .-4         /LOOP
+
+CLOS1A,        TAD OUNIT
+       DCA UNIT10      /SET OUR UNIT
+       TAD OBLOCK
+       DCA .+3         /SET THE BLOCK
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       OBUF10
+       0               /BLOCK IS SET
+       TAD (MOUTPU
+       JMS I (DELETE   /DELETE THE OLD FILE
+       NOP             /O.K. IF IT IS NOT THERE
+       TAD FREEP
+       DCA INDEX0      /POINT TO THE FREE SPOT
+       TAD [MOUTPU
+       DCA INDEX1      /POINT TO THE FILE NAME
+       CDF 10          /TO FIELD 1
+       TAD I INDEX1
+       DCA I INDEX0
+       TAD I INDEX1    /SET THE NAME
+       DCA I INDEX0
+       TAD I INDEX1
+       DCA I INDEX0
+       TAD INDEX0
+       TAD [77
+       DCA INDEX0      /POINT TO THE EXTENSION
+       TAD I INDEX1
+       DCA I INDEX0    /SET THE EXTENSION
+       TAD I INDEX1
+       DCA I INDEX0
+       TAD DATE
+       DCA I INDEX0    /SET THE DATE
+       JMS I (FIX75    /V3C SET HIGH ORDER BIT TOO
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       DIRECT          /DIRECTORY
+       144             /BLOCK 100 BASE 10
+       JMP I CLOS10    /EXIT
+\f/OPEN A PDP-10 FILE FOR OUTPUT
+/
+/CALL:
+/      JMS OOPN10      /OPEN A PDP-10 FILE
+/      -RETURN-
+
+OOPN10,        0               /OPEN A PDP-10 FILE
+       TAD (ZFREE-1
+       JMS I (FIND     /FIND A FREE SPOT
+       JMP I (NOROOM   /NO ROOM LEFT
+       DCA I (SLOTNO   /SET THIS SLOT
+       TAD INDEX0
+       DCA FREEP       /SAVE POINTER TO FREE SPOT
+       CLA CMA
+       DCA I (NEXTDI   /SET DIRECTION = -1
+       TAD (144
+       JMS I (NEXTSL   /FIND FIRST OPEN SLOT
+       DCA OBLOCK      /AND SET IT
+       CDF 10
+       TAD I [MOUTPU
+       DCA OUNIT       /SET UNIT
+       TAD OBLOCK
+       AND [17
+       CLL RTR
+       RTR
+       RAR
+       DCA I [OBUF10+2 /SET FIRST BLOCK POINTER
+       TAD OBLOCK
+       CLL RTR
+       RTR
+       AND [77
+       DCA I [OBUF10+1 /SET FIRST BLOCK POINTER
+       DCA I [OBUF10   /ZERO LINK POINTER
+       DCA CHARNO      /RESET CHARACTER NUMBER
+       TAD (OBUF10+3
+       DCA OPOINT      /RESET POINTER
+       CDF
+       JMP I OOPN10    /EXIT
+\f/OPEN PDP-10 INPUT FILE
+/
+/CALL:
+/      (AC)            /POINT TO FILE NAME-1
+/      JMS IOPN10      /OPEN PDP-10 INPUT FILE
+/      -NO-            /NOT THERE
+/      (AC)            /ANY BLOCK OF THE FILE
+
+IOPN10,        0               /OPEN PDP-10 INPUT FILE
+       JMS I (FIND     /FIND THE FILE
+       JMP I IOPN10    /NOT THERE
+       DCA IOPN1B      /SAVE SLOT NUMBER
+       TAD (143
+       DCA IOPN1A
+       TAD (CLA CMA
+       DCA IOPN1D
+IOPN1F,        JMS I (FINDSL   /FIND A SLOT
+IOPN1A,        0               /SLOT TO FIND
+       CIA
+       TAD IOPN1B      /IS IT US?
+       SNA CLA
+       JMP IOPN1C      /YES
+IOPN1D,        CLA CMA
+       TAD IOPN1A      /BUMP BLOCK NUMBER
+       SPA
+       JMP IOPN1E      /TOO FAR
+       TAD [-1102
+       SMA
+       JMP I IOPN10    /TOO FAR - EXIT
+       TAD (1102
+       DCA IOPN1A      /SET NEW BLOCK
+       JMP IOPN1F      /RETRY
+
+IOPN1B,        0               /SLOT THAT WE WANT
+
+IOPN1E,        CLA
+       TAD (CLA IAC
+       JMP IOPN1F-1    /CHANGE DIRECTION AND RETRY
+
+IOPN1C,        TAD IOPN1A
+       CDF
+       ISZ IOPN10
+       JMP I IOPN10    /EXIT
+       PAGE
+\f/CONVERT OS8 DATE TO PDP-10 DATE
+
+CVDATE,        0
+       SNA
+       JMP I CVDATE    /0 CONVERTS TO 0
+       DCA TEMP1
+       TAD TEMP1       /V3C
+       RTR
+       RAR
+       AND [37
+       TAD (-1         /GET DAY
+       DCA DATE4       /V3C
+       TAD TEMP1
+       AND [7          /GET OS8 YEAR (-1970)
+DECIMAL
+       TAD (1970-1964
+OCTAL
+       DCA DATE1       /SAVE YEAR
+       TAD DATE1
+       CLL RAL         /*2
+       TAD DATE1       /*2+1=*3
+       CLL RTL         /*3*4=*12
+       DCA DATE1       /DATE1=DATE1*12
+       TAD TEMP1
+       RTL
+       RTL
+       RAL
+       AND [17         /GET MONTH
+       TAD (-1
+       TAD DATE1       /ADD IN MONTH
+       DCA DATE1
+       TAD DATE1
+       CLL RAL         /*2
+       TAD DATE1       /*2+1=*3
+       DCA TEMP2
+       TAD TEMP2
+       CLL RTL         /*3*4=*12
+       TAD TEMP2       /*12+*3=*15
+       CLL RAL         /*15*2=*30
+       TAD DATE1       /*30+1=*31
+       TAD DATE4       /V3C ADD IN DAY
+       DCA DATE1       /DATE1=DATE1+MONTH-1 * 31
+       RAL             /V3C LINK NOW HAS HIGH ORDER DATE BIT
+       DCA HIDATE      /ONLY WITHIN RANGE OF OS/8
+       TAD DATE1       /RETURN LOW ORDER 12 BITS OF DATE
+       JMP I CVDATE
+
+DATE1, 0
+DATE4, 0
+
+/TYPE A PDP-10 DATE
+\fDATE10,       0
+       SZL             /LINK HAD HIGH ORDER BIT
+       TAD (4          /IF ON, WANT ADDITIONAL 11 YEARS, 4 DAYS
+       DCA DATE1       /SAVE VALUE
+       RAL             /V3C
+       DCA DATE75      /SAVE FACT THAT NEED 'NUTHER 11 YEARS
+       TAD (100        /V3C BASE IS (19)64
+       DCA DATE2       /WILL BE YEAR
+DATE11,        TAD DATE1
+       SMA CLA
+       JMP DATE12      /MUST BE POSITIVE
+       ISZ DATE2       /BUMP YEAR
+       TAD DATE1
+       TAD (-564       /-372 DECIMAL (DAYS PER YEAR)
+       DCA DATE1
+       JMP DATE11
+
+DATE12,        DCA DATE3       /WILL BE MONTH
+       TAD DATE1       /DIVIDE BY 31
+       TAD (-37
+       SPA
+       JMP .+4
+       ISZ DATE3       /BUMP MONTH
+       DCA DATE1
+       JMP .-6
+
+       CLA
+       ISZ DATE1       /+1 IS DAY
+       TAD DATE3       /DIVIDE BY 12
+       TAD (-14
+       SPA
+       JMP .+4
+       ISZ DATE2       /BUMP YEAR
+       DCA DATE3
+       JMP .-6
+
+       CLA
+       TAD DATE1
+       TAD (-12
+       SMA CLA
+       JMP DATE9
+       TAD ("0
+       JMS I OUTPUT    /PRINT LEADING 0 IF NECESSARY
+DATE9, TAD DATE1
+       JMS I (PRINT    /PRINT DAY
+       TAD ("-
+       JMS I OUTPUT
+       TAD DATE3
+       TAD DATE3
+       TAD DATE3       /V3C MULTIPLY BY 3
+       TAD (MONTBL     /ADD IN BASE OF MONTH NAMES
+       DCA MONPTR      /POINT TO PROPER MONTH NAME
+       TAD I MONPTR    /GET CHAR 1
+       JMS I OUTPUT    /PRINT IT
+       ISZ MONPTR      /POINT TO NEXT CHAR
+       TAD I MONPTR    /GET CHAR 2
+       JMS I OUTPUT    /PRINT IT
+       ISZ MONPTR      /V3C
+       TAD I MONPTR
+       JMS I OUTPUT
+       TAD ("-
+       JMS I OUTPUT
+       TAD DATE75      /V3C
+       SZA CLA
+       TAD (13         /ADD 11 YEARS IF H.O. BIT ON
+       TAD DATE2
+       JMS I (PRINT    /PRINT YEAR
+       JMP I DATE10
+
+DATE2, 0               /YEAR
+DATE3, 0               /MONTH
+MONPTR,        0               /V3C POINTS TO MONTH NAME
+       PAGE
+\fDECIMAL
+PRINTL,        -1000
+       -100
+       -10
+OCTAL
+
+PRINTZ,        0               /PRINT WITH LEADING SPACES
+       DCA PRINT0
+       TAD PRINTZ
+       DCA I (PRINT
+       TAD (240
+       JMP I (PRINT7
+
+/ZERO A DIRECTORY (PDP-10)
+
+ZERO10,        0               /ZERO THE PDP-10 DIRECTORY
+       TAD I [MOUTPU
+       AND [17
+       SZA CLA
+       JMP I (NOT10F   /NOT A PDP-10
+       TAD I [MOUTPU
+       DCA UNIT10      /SET UNIT
+       TAD (DIRECT-1
+       DCA INDEX0      /POINT TO DIRECTORY
+       TAD (-600
+       DCA CNTR        /COUNT OF 600
+       DCA I INDEX0    /ZERO THE DIRECTORY
+       ISZ CNTR
+       JMP .-2         /LOOP
+       TAD (7570
+       DCA I (DIRECT   /SAVE BLOCKS 1 AND 2
+       TAD (170
+       DCA I (DIRECT+52        /SAVE BLOCK 144
+       TAD (777
+       DCA I (DIRECT+367       /SAVE BLOCKS 1102 ON UP
+       CLA CMA
+       DCA I (DIRECT+370
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       DIRECT          /DIRECTORY
+       144             /DIRECTORY BLOCK
+       CDF 10
+       JMP I ZERO10    /EXIT
+\f/DELETE A PDP-10 FILE
+
+DELE10,        0               /DELETE A PDP-10 FILE
+       TAD I [MOUTPU
+       AND [17
+       SZA
+       JMP DELOS8      /DELETE A OS8 FILE
+       TAD I [MOUTPU
+       DCA UNIT10      /SET UNIT
+       TAD [MOUTPU
+       CDF
+       JMS I (DELETE   /DELETE THE PDP-10 FILE
+       JMP I (ERDELF   /NOT THERE
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       DIRECT
+       144             /DIRECTORY BLOCK
+       JMP I DELE10    /EXIT
+
+DELOS8,        CIF CDF 10
+       JMS I (DELPS1   /DELETE A OS8 FILE
+       JMP I DELE10
+       JMP I (ERDELF   /ERROR DELETING THE FILE
+\fPAGE
+
+/GET THE NEXT INPUT FILE
+
+NEXIFL,        0               /GET THE NEXT INPUT FILE
+       DCA CHARNI      /RESET STUFF
+       DCA WORDS
+       CDF 10
+       CLA CMA
+       DCA I (INCHCT
+       DCA I (INEOF
+       TAD (INDEVH+1
+       DCA INDEVX
+       TAD I IXR       /GET NEXT
+       SNA
+       JMP NEXIF2      /E.O.F
+       DCA IUNIT
+       TAD I IXR
+       DCA IBLOCK      /SET START BLOCK
+       CDF
+       TAD IUNIT
+       AND [17
+       SNA
+       JMP NEXIF1      /PDP-10 FILE
+       CIF 10
+       JMS I [200
+       1
+INDEVX,        0
+       JMP I (NOOFIL
+       CDF 10
+       TAD INDEVX
+       DCA I (INHNDL
+       TAD IBLOCK
+       DCA I (INREC
+       TAD IUNIT
+       AND [7760
+       SZA
+       TAD [17
+       CLL CML RTR
+       RTR
+       DCA I (INCTR
+       TAD (ICHRPS
+       JMP NEXIF3
+
+NEXIF1,        TAD IUNIT
+       DCA UNIT10
+       TAD IBLOCK
+       DCA .+3
+       JMS I (READT
+       IBUF10
+       0               /READ ANY BLOCK
+       CDF 10
+       TAD I [IBUF10+2
+       RTL
+       RTL
+       RAL
+       AND [17
+       DCA IBLOCK
+       TAD I [IBUF10+1
+       AND [77
+       CLL RTL
+       RTL
+       TAD IBLOCK
+       DCA IBLOCK      /SET START BLOCK
+       TAD (ICHR10
+NEXIF3,        DCA INPUT       /SET ROUTINE POINTER
+       ISZ NEXIFL
+NEXIF2,        CDF
+       JMP I NEXIFL    /EXIT
+
+ICHRPS,        0
+       CIF CDF 10
+       JMS I (ICHARP
+       SKP
+       ISZ ICHRPS
+       JMP I ICHRPS
+
+OCHRPS,        0
+       CIF 10
+       JMS I (OCHARP
+       JMP I (IOERR
+       JMP I OCHRPS
+       PAGE
+\fPIP10,        CDF 10          /STARTS HERE - JUMPED TO FROM 200
+       DCA HIDATE      /V3C
+       TAD I (MDATE    /GET TODAY'S DATE
+       CDF
+       JMS I (CVDATE   /CONVERT IT
+       DCA DATE        /AND STORE IT
+       TAD     (3401   /UNRESTARTABLE, DOESN'T DESTROY BATCH OR USR AREA
+       DCA I   (JSBITS
+PIPCD, CDF
+       JMS I (CD       /COMMAND DECODE
+       CDF 10
+       TAD I (MPARAM
+       AND (2010
+       CLL RAL
+       DCA MODE        /SET /I SWITCH
+       TAD I (MPARAM+1
+       AND (400
+       DCA SAVELN      /SET /P SWITCH
+       TAD I (MPARAM
+       AND (101
+       SZA CLA
+       JMP I (LIST10   /EITHER /F OR /L
+       TAD I [MOUTPU
+       SZA CLA
+       JMP PIP001      /IS AN OUTPUT FILE
+       TAD I (MINPUT
+       SNA CLA
+       JMP PIPCD       /NO OUTPUT OR INPUT FILES
+       JMP I (NOOOFL   /INPUT, BUT NO OUTPUT
+
+PIP001,        CLL CLA CML RTR
+       AND I (MPARAM+2
+       SZA CLA
+       JMS I (ZERO10   /IT IS /Z OPTION
+       TAD (OUDEVH+1
+       DCA OUDEVX
+       TAD I [MOUTPU
+       AND [17
+       SZA
+       JMP PIPB        /OUTPUT IS OS8
+       TAD I [MOUTPU
+       DCA UNIT10      /SET UNIT
+       JMS I (READT
+       DIRECT          /GET DIRECTORY INTO CORE
+       144
+PIPA,  CDF 10
+       TAD OUDEVX
+       DCA I (OUHNDL
+       TAD I (MPARAM
+       AND (400
+       SZA CLA
+       JMS I (DELE10   /DELETE A PDP-10 FILE FIRST
+       CDF 10
+       TAD (MINPUT-1
+       DCA IXR
+       TAD I IXR
+       SNA CLA
+       JMP PIPCD       /NO INPUT
+       TAD (MINPUT-1
+       DCA IXR         /SET INPUT LIST
+       TAD I [MOUTPU
+       AND [17
+       CDF
+       SZA CLA
+       JMP PIPC        /OUTPUT IS OS8
+       JMS I (OOPN10   /OPEN PDP-10 OUTPUT
+       TAD (OCHR10
+PIPD,  DCA OUTPUT      /SET OUTPUT ROUTINE
+PIPE,  SZA CLA         /IS IT ERROR OR EOF
+       JMP I (IOERR    /ERROR
+       JMS I (NEXIFL   /GET NEXT FILE
+       JMP PIPF        /FINAL EOF
+       JMS I INPUT     /GET INPUT
+       JMP PIPE        /EOF OR ERROR
+       JMS I OUTPUT    /OUTPUT
+       JMP .-3         /LOOP
+
+PIPC,  CIF CDF 10
+       JMS I (OOPNPS   /OPEN OS8 OUTPUT
+       JMP I (NOOOFL
+       TAD (OCHRPS
+       JMP PIPD
+
+PIPB,  CDF 0
+       CIF 10
+       JMS I [200
+       1               /GET OS8 OUTPUT HANDLER
+OUDEVX,        0
+       JMP I (NOOFIL
+       JMP PIPA
+
+PIPF,  CDF 10
+       TAD I [MOUTPU   /NOW CLOSE THE OUTPUT FILE
+       AND [17
+       CDF
+       SZA CLA
+       JMP PIPG
+       JMS I (CLOS10
+       JMP PIPCD
+
+PIPG,  CIF CDF 10
+       JMS I (OCLOSE
+       JMP I (IOERR
+       JMP PIPCD
+       PAGE
+\fLIST10,       TAD (OUDEVH+1
+       DCA OUDEVY
+       TAD (OUDEVH+1
+       DCA OUDEVZ
+       TAD (3100       /RESET THINGS
+       DCA LISTDV+1
+       TAD I [MOUTPU
+       SZA
+       JMP LIST11      /OUTPUT FILE EXISTS
+       CDF 0
+       CIF 10
+       JMS I [200
+       1
+LISTDV,        TEXT /TTY/      /LOOKUP THE TTY:
+OUDEVY,        0
+       JMP I (NOOOFL
+       CDF 10
+       TAD LISTDV+1
+       DCA I [MOUTPU   /SET TTY: DEVICE NUMBER
+       TAD I [MOUTPU
+LIST11,        AND [17
+       SNA
+       JMP I (NOTPSF   /NOT A OS8 FILE
+       CDF 0
+       CIF 10
+       JMS I [200
+       1               /LOOKUP DEVICE
+OUDEVZ,        0
+       JMP I (NOOFIL
+LIST12,        CDF CIF 10
+       TAD OUDEVZ
+       DCA I (OUHNDL
+       JMS I (OOPNPS   /OPEN OUTPUT FILE
+       JMP I (NOOOFL
+       TAD (OCHRPS
+       DCA OUTPUT      /SET OUTPUT ROUTINE
+       CDF 10
+       TAD I (MINPUT
+       DCA UNIT10
+       CDF
+       TAD UNIT10
+       SNA
+       JMP I (PIPCD    /NO INPUT
+       AND [17
+       SZA CLA
+       JMP I (NOT10F
+       JMS I (READT    /READ THE DIRECTORY
+       DIRECT
+       144
+       TAD (LISTL-1
+       DCA INDEX0
+       TAD (-40
+       DCA CNTR
+       DCA I INDEX0    /CLEAR THE COUNTS
+       ISZ CNTR
+       JMP .-2
+       TAD (-1101
+       DCA LIST13
+       CLA IAC
+       DCA LIST14
+       JMS I (FINDSL   /FIND ALL SLOTS
+LIST14,        0
+       TAD (LISTL
+       DCA LIST15
+       ISZ I LIST15    /COUNT THE NUMBER IN EACH SLOT
+       ISZ LIST14
+       ISZ LIST13
+       JMP LIST14-1
+       JMS I   (CRLF
+       TAD I (LISTL
+       JMS I (PRINTZ   /PRINT FREE BLOCKS
+       TAD (LISTM1-1
+       DCA INDEX0
+       JMS I (ERROR4   /"FREE BLOCKS"
+       JMS I   (CRLF
+       TAD (-26
+       DCA LIST13
+       TAD (DIRECT+370
+       DCA INDEX6
+       TAD (DIRECT+2   /HIGH ORDER BIT (4096'S) OCCURS AT END OF EACH
+       DCA XDATE       /PDP-10 WORD AT BEGIN OF DIRECTORY
+                       /THIS IS END OF EVERY 3RD PDP-8 WORD
+LIST17,        CDF 10          /MAIN LOOP
+       TAD I INDEX6
+       SNA
+       JMP I (LIST16   /DO NOT PRINT THIS BLANK ENTRY
+       JMS I (LIST18
+       TAD I INDEX6
+       JMS I (LIST18
+       TAD I INDEX6
+       JMS I (LIST18
+       CDF
+       TAD (".
+       JMS I OUTPUT
+       JMP I (LIST22
+
+LIST13,        0
+LIST15,        0
+       PAGE
+\fLIST22,       CDF 10
+       TAD INDEX6
+       TAD [77
+       DCA INDEX5
+       TAD I INDEX5    /GET EXTENSION
+       JMS LIST18
+       TAD I INDEX5
+       AND [7700
+       JMS LIST18
+       CLA IAC
+       AND I (MPARAM
+       SNA CLA
+       JMP LIST19      /NO EXTRA IF NOT /L
+       JMS LIST18
+       CDF
+       TAD I (LIST13
+       TAD (LISTL+27
+       DCA LIST23
+       TAD I LIST23    /GET NUMBER OF BLOCKS
+       JMS I (PRINTZ
+       JMS LIST18
+       TAD I XDATE     /V3C
+       RAR             /HIGH ORDER BIT OF DATE TO LINK
+       CLA
+       TAD I INDEX5
+       CDF
+       JMS I (DATE10
+LIST19,        CDF
+       JMS CRLF
+LIST20,        CDF
+       TAD XDATE       /V3C
+       TAD (3          /POINT TO NEXT DATE H.O. BIT
+       DCA XDATE
+       ISZ I (LIST13
+       JMP I (LIST17   /LOOP
+       JMS CRLF
+       JMP I (PIPG     /CLOSE THE FILE
+
+LIST16,        ISZ INDEX6
+       ISZ INDEX6
+       JMP LIST20
+
+CRLF,  0
+       TAD [215
+       JMS I OUTPUT
+       TAD [212
+       JMS I OUTPUT
+       JMP I CRLF
+
+LIST23,        0
+
+LIST18,        0
+       CDF
+       DCA TEMP1
+       TAD TEMP1
+       RTR
+       RTR
+       RTR
+       JMS LIST21
+       TAD TEMP1
+       JMS LIST21
+       CDF 10
+       JMP I LIST18
+
+LIST21,        0
+       AND [77
+       TAD [240
+       JMS I OUTPUT
+       JMP I LIST21
+\f/FIND A PDP-10 ENTRY IN DIRECTORY
+/
+/CALL:
+/      (AC)            /POINT TO NAME-1 (FIELD 1)
+/      JMS FIND        /FIND A PDP-10 ENTRY
+/      -NO-            /NOT FOUND
+/      (AC)            /SLOT NUMBER IF FOUND
+
+FIND,  0               /FIND A PDP-10 FILE
+       DCA FIND4       /SAVE POINTER
+       TAD (DIRECT+370
+       DCA INDEX0      /POINT TO DIRECTORY START
+       TAD (-26
+       DCA CNTR        /22 DECIMAL FILES
+       CDF 10          /DIRECTORY IS IN FIELD 1
+FIND2, TAD FIND4               /GET POINTER
+       DCA INDEX2      /POINT TO NAME,EXT
+       TAD I INDEX0
+       CIA
+       TAD I INDEX2    /CHECK WORD 1
+       SZA CLA
+       JMP FIND1       /NO
+       TAD I INDEX0
+       CIA
+       TAD I INDEX2    /CHECK WORD 2
+       SZA CLA
+       JMP FIND1+1     /NO
+       TAD I INDEX0
+       CIA
+       TAD I INDEX2    /CHECK WORD 3
+       SZA CLA
+       JMP FIND1+2     /NO
+       TAD INDEX0
+       TAD [77
+       DCA INDEX1      /POINT TO EXTENSIONS
+       TAD I INDEX1
+       CIA
+       TAD I INDEX2    /CHECK WORD 4
+       SZA CLA
+       JMP FIND1+2     /NO
+       TAD I INDEX1
+       AND [7700
+       CIA
+       TAD I INDEX2    /CHECK WORD 5
+       SZA CLA
+       JMP FIND1+2     /NO
+       CLL CLA CMA RTL
+       TAD INDEX0
+       DCA INDEX0      /POINT TO ENTRY AGAIN
+       TAD CNTR
+       TAD (27
+       ISZ FIND        /WE FOUND IT - 2ND EXIT
+FIND3, CDF             /BACK TO FIELD 0
+       JMP I FIND      /EXIT
+
+FIND1, ISZ INDEX0      /EXTRA POINTER BUMPS
+       ISZ INDEX0
+       ISZ CNTR        /MORE FILES?
+       JMP FIND2       /YES - LOOP
+       JMP FIND3       /NO - NOT FOUND
+
+FIND4, 0               /POINTER TO NAME-1
+       PAGE
+\fLINBUF=.
+LISTL, ZBLOCK 105
+
+LISTM1,        TEXT / FREE BLOCKS   PIP10  V/
+VERLOC,        *.-1
+       60+VERSION^100+SUBVER
+       3700
+
+ERMES0,        TEXT    /_PIP10 CANNOT BE CHAINED TO_/
+ERMES1,        TEXT #_I/O ERROR_#
+
+ERMES2,        TEXT /_DEVICE FULL_/
+
+ERMES3,        TEXT /_NO SUCH DEVICE_/
+
+ERMES4,        TEXT /_NOT PDP-10 FILE_/
+
+ERMES5,        TEXT /_ERROR DELETING FILE_/
+
+ERMES6,        TEXT /_NOT OS8 FILE_/
+
+ERMES7,        TEXT /_OUTPUT FILE OPEN ERROR_/
+
+ERMES8,        TEXT /_SYNTAX ERROR_/
+ERMES9,        TEXT    /_FILE NOT FOUND_/
+\f/ROUTINE TO SET TD8E UNIT INFORMATION FROM UNIT10
+
+TDUSET,        0
+       TAD     UNIT10
+       CLL RTL
+       RAL
+       AND     (7
+       TAD     (DVCTBL
+       DCA     DVCPTR
+       RAR
+       DCA     TDUNIT  /SAVE EVEN/ODD BIT
+       TAD     (TDUTBL
+       DCA     TDUPTR
+TDULP, TAD I   TDUPTR
+       SNA
+       JMP I   TDUSET
+       DCA     TDUT
+       TAD I   TDUT
+       AND     (7
+       TAD I   DVCPTR
+       DCA I   TDUT
+       ISZ     TDUPTR
+       JMP     TDULP
+TDUPTR,        0
+TDUT,  0
+DVCPTR,        0
+DVCTBL,        6770;6760;6750;6740
+
+TDUTBL,        DIO01
+       DIO02
+       DIO03
+       DIO04
+       DIO05
+       DIO06
+       DIO07
+       DIO08
+       DIO09
+       DIO10
+       DIO11
+       DIO12
+       DIO13
+       DIO14
+       DIO15
+       DIO16
+       DIO17
+       DIO18
+       DIO19
+       DIO20
+       DIO21
+       DIO22
+       IOTX1
+       IOTX2
+       IOTX3
+       IOTX4
+       IOTX5
+       IOTX6
+       IOTX7
+       IOTX8
+       0
+       PAGE
+\f/GET A CHARACTER
+
+GCH,   0
+       TAD I IXR       /GET A CHAR
+       TAD (-240
+       SNA
+       JMP GCH+1       /IGNORE SPACES
+       TAD (240-"/
+       SNA
+       JMP SLASH
+       TAD ("/-"(
+       SNA
+       JMP OPENP
+       TAD ("(
+       JMP I GCH       /EXIT
+
+SLASH, TAD I IXR
+       JMS SLSHCH      /GET OPTION
+       JMP GCH+1
+
+OPENP, TAD I IXR
+       TAD (-")
+       SNA
+       JMP GCH+1       /END
+       TAD (")
+       JMS SLSHCH      /GET OPTION
+       JMP OPENP
+
+SLSHCH,        0
+       SNA
+       JMP I (SYNTAX   /ERROR
+       DCA TEMP6
+       TAD (MPARAM-1
+       DCA TEMP5       /POINT TO PARAMETERS
+       JMS DECODE
+       JMP I (SYNTAX
+       SZL
+       TAD (32         /ADD
+       TAD (-14
+       ISZ TEMP5
+       SMA
+       JMP .-3         /FIND DIVIDED BY 12
+       DCA TEMP4
+       CLL CML
+       RAL
+       ISZ TEMP4
+       JMP .-2         /SHIFT A BIT
+       DCA TEMP4       /SAVE IT
+       CDF 10
+       TAD TEMP4
+       CMA
+       AND I TEMP5
+       TAD TEMP4       /OR IN THAT BIT
+       DCA I TEMP5
+       CDF
+       JMP I SLSHCH
+
+DECODE,        0
+       TAD TEMP6
+       TAD (-"9-1
+       CLL
+       TAD ("9+1-"0
+       SZL
+       JMP DECOD1
+       TAD ("0-"Z-1
+       CLL CML
+       TAD ("Z-"A+1
+       SNL
+DECOD1,        ISZ DECODE
+       JMP I DECODE
+
+EXA40, 0
+       TAD (CDNAME
+       DCA TEMP5
+       TAD (-5
+       DCA TEMP4
+EXA401,        CLL CLA CML RAR
+       TAD I TEMP5
+       AND [7700
+       CLL RAL
+       SZA
+       RAR
+       DCA TEMP3
+       TAD I TEMP5
+       TAD (40
+       AND [77
+       TAD (-40
+       SZA
+       TAD (40
+       TAD TEMP3
+       DCA I TEMP5
+       ISZ TEMP5
+       ISZ TEMP4
+       JMP EXA401
+       JMP I EXA40
+       PAGE
+\f/GET A NAME ROUTINE
+
+GNAME, 0
+       DCA CDDEV       /CLEAR AREA
+       DCA CDDEV+1
+       CLA CMA
+       DCA DEVSW       /ALLOW DEVICES
+GNAME1,        DCA CDNAME      /CLEAR NAME,EXTENSION
+       DCA CDNAME+1
+       DCA CDNAME+2
+       DCA CDEXT
+       DCA CDEXT+1
+       CLA CMA
+       DCA PERSW       /ALLOW EXTENSIONS
+       TAD (CDNAME
+       DCA POINT       /SET POINTER
+       DCA CNTR        /SET SWITCH
+GNAME2,        JMS I (GCH      /GET A CHAR
+       DCA TEMP6
+       TAD TEMP6
+       SNA
+       JMP GNAME6      /END
+       TAD (-":
+       SNA
+       JMP GNAME5      /: IS DEVICE
+       TAD (":-".
+       SNA
+       JMP GNAME4      /. IS EXTENSION
+       TAD (".
+       DCA TEMP6       /SAVE THE CHAR
+       JMS I (DECODE
+       JMP GNAME6-1    /NOT 0-9 OR A-Z IS END
+       CLA
+       TAD TEMP6
+       AND [77         /GET TRIMMED ASCII
+       ISZ CNTR
+       JMP GNAME3      /LEFT HALF
+       TAD I POINT
+       DCA I POINT     /SET RIGHT HALF
+       ISZ POINT
+       JMP GNAME2      /LOOP
+
+GNAME3,        CLL RTL
+       RTL
+       RTL
+       DCA I POINT     /SET LEFT HALF
+       CLA CMA
+       DCA CNTR
+       TAD POINT
+       TAD (-CDEXT-2
+       SZA CLA
+       JMP GNAME2      /LOOP
+       JMP GNAME2-1    /LOOP - IGNORE
+
+GNAME4,        TAD CDNAME
+       SZA CLA
+       ISZ PERSW
+       JMP I (SYNTAX   /ERROR
+       DCA CDEXT
+       DCA CDEXT+1     /CLEAR EXTENSION
+       TAD (CDEXT
+       JMP GNAME2-2    /GET EXTENSION
+
+GNAME5,        ISZ DEVSW
+       JMP I (SYNTAX   /ERROR
+       ISZ PERSW
+       JMP I (SYNTAX   /ERROR
+       TAD CDNAME
+       SNA
+       JMP I (SYNTAX   /ERROR
+       DCA CDDEV
+       TAD CDNAME+1
+       DCA CDDEV+1     /SET DEVICE
+       JMP GNAME1      /NOW GET THE NAME
+
+       CLA
+GNAME6,        DCA CDEXT+2
+       TAD CDEXT+1
+       AND [7700
+       DCA CDEXT+1
+       ISZ PERSW
+       JMP I GNAME     /EXIT
+       DCA CDEXT
+       DCA CDEXT+1     /CLEAR EXTENSION
+       JMP I GNAME     /EXIT
+       PAGE
+\fCD,   0
+       TAD [MOUTPU-1
+       DCA INDEX0
+       TAD (-47
+       DCA CNTR
+       CDF 10
+       DCA I INDEX0    /CLEAR AREAS
+       ISZ CNTR
+       JMP .-2
+       CDF
+       CIF 10
+       JMS I [200
+       13              /RESET TABLES
+       0
+       DCA INSEG       /NO DIRECTORY IN CORE
+       DCA PDP10D      /NO KNOWN PDP-10 DRIVES
+       DCA PDP10D+1
+       DCA PDP10D+2
+       DCA PDP10D+3
+       DCA PDP10D+4
+       DCA PDP10D+5
+       DCA PDP10D+6
+       DCA PDP10D+7
+       DCA CDCNT       /ZERO INPUT COUNT
+       JMS I (GLINE    /GET A LINE
+       TAD [LINBUF-1
+       DCA IXR
+       TAD I IXR
+       SNA
+       JMP NOBAKB      /NO "<" IS LINE
+       TAD (-"<
+       SZA CLA
+       JMP .-5
+       TAD [LINBUF-1
+       DCA IXR
+       TAD XDSK
+       DCA CDDEVF      /SET "DSK" AS DEFAULT
+       TAD XDSK+1
+       DCA CDDEVF+1
+       JMS I (GNAME    /GET THE NAME
+       TAD TEMP6
+       TAD (-"[
+       SZA CLA
+       JMP CDX03       /NO SIZE SPECIFIED
+CDX01, JMS I (GCH
+       TAD (-"]
+       SNA
+       JMP CDX02       /END OF SIZE
+       TAD ("]-"0
+       SPA
+       JMP I (SYNTAX   /ERROR
+       DCA TEMP1
+       TAD CDEXT+2
+       CLL RTL
+       TAD CDEXT+2
+       RAL
+       TAD TEMP1
+       DCA CDEXT+2     /ADD IN NUMBER
+       TAD TEMP1
+       TAD (-11
+       SMA SZA CLA
+       JMP I (SYNTAX   /ERROR
+       JMP CDX01
+
+CDX02, JMS I (GCH
+       SKP
+CDX03, TAD TEMP6
+       TAD (-"<
+       SZA CLA
+       JMP I (SYNTAX   /ERROR
+       JMS I (CDOUTX   /SET OUTPUT STUFF
+NOBAKA,        TAD (MINPUT-1
+       DCA INDEX6
+       TAD XDSK
+       DCA CDDEVF      /SET DEFAULT
+       TAD XDSK+1
+       DCA CDDEVF+1
+       TAD IXR
+       DCA CDI04       /SAVE POINTER
+       JMS I (GCH
+       SNA CLA
+       JMP I CD        /NO INPUT FILES
+       TAD CDI04
+       DCA IXR         /RESET POINTER
+CDI01, JMS I (GNAME    /GET A FILE
+       ISZ DEVSW
+       JMP CDI02       /DEVICE SPECIFIED
+       TAD CDDEVF
+       DCA CDDEV
+       TAD CDDEVF+1
+       DCA CDDEV+1     /SET DEFAULT DEVICE
+CDI02, TAD CDDEV
+       DCA CDDEVF
+       TAD CDDEV+1
+       DCA CDDEVF+1    /SET NEW DEFAULT
+       ISZ CDCNT       /COUNT INPUT FILES
+       TAD CDCNT
+       TAD (-12
+       SMA CLA
+       JMP I (SYNTAX   /TOO MANY FILES
+       JMS I (CDINX    /SET INPUT STUFF
+       TAD TEMP6
+       SNA
+       JMP I CD        /MAIN EXIT
+       TAD (-",
+       SNA CLA
+       JMP CDI01
+       JMP I (SYNTAX   /ERROR
+
+NOBAKB,        TAD [LINBUF-1
+       DCA IXR
+       JMP NOBAKA
+       PAGE
+\fCDOUTX,       0               /SET OUTPUT STUFF
+       ISZ DEVSW
+       JMP CDOUT9      /DEVICE SPECIFIED
+       TAD CDNAME
+       SNA CLA
+       JMP I CDOUTX    /NO NAME AND NO DEVICE IS NOTHING
+       TAD CDDEVF
+       DCA CDDEV
+       TAD CDDEVF+1
+       DCA CDDEV+1     /SET DEFAULT DEVICE
+CDOUT9,        TAD (OUDEVH+1
+       DCA CDOUT2      /SET OUTPUT HANDLER ADDRESS
+       TAD [MOUTPU-1
+       DCA INDEX6
+       TAD CDDEV
+       DCA CDOUT1
+       TAD CDDEV+1
+       DCA CDOUT1+1    /SET DEVICE
+       CIF 10
+       JMS I [200
+       12              /FIND HANDLER
+CDOUT1,        0
+       0
+CDOUT2,        0
+       JMP I (NOOFIL
+       TAD CDOUT1+1
+       JMS I   (GTDVTP /GET DEVICE TYPE AND COMPARE WITH TC08 AND TD8E
+       SZA CLA
+       JMP CDOUT3      /NOT DECTAPE
+       TAD (OUDEVH+1
+       DCA CDOUT5
+       TAD CDOUT1+1
+       CIF 10
+       JMS I [200
+       1               /GET HANDLER
+CDOUT5,        0
+       JMP I (NOOFIL
+       TAD CDOUT5
+       JMS     SETUNT  /SET UP PHYSICAL UNIT FROM HANDLER ENTRY POINT
+       JMS I (ROCK     /CHECK THE TAPE
+       JMP CDOUT3      /NOT PDP-10 DECTAPE
+       JMS I (EXA40    /EXCESS 40 CONVERSION
+       TAD UNIT10
+       JMP CDOUT4      /SET PARAMETERS
+
+CDOUT3,        DCA CDEXT+1
+       TAD CDEXT+2     /GET LENGTH
+       TAD (-400
+       SPA CLA
+       TAD CDEXT+2     /O.K. - USE LENGTH
+       CLL RTL
+       RTL
+       AND [7760       /8 BIT LENGTH
+       TAD CDOUT1+1    /ADD IN DEVICE NUMBER
+CDOUT4,        CDF 10
+       DCA I INDEX6    /SET DEVICE
+       TAD CDNAME
+       DCA I INDEX6    /SET NAME
+       TAD CDNAME+1
+       DCA I INDEX6
+       TAD CDNAME+2
+       DCA I INDEX6
+       TAD CDEXT
+       DCA I INDEX6
+       TAD CDEXT+1
+       DCA I INDEX6
+       CDF
+       JMP I CDOUTX    /EXIT
+
+SETUNT,        0
+       STL
+       TAD     (-7607
+       SZA             /IF IT IS 7607,
+       TAD     (7      /ITS UNIT 0
+       AND     (7
+       CLL CML RTR
+       RTR
+       DCA     UNIT10
+       TAD     DVTYPE
+       AND     (10
+       SNA CLA
+       JMP I   SETUNT  /TC08 - FINISHED
+       CLL
+       TAD     UNIT10
+       AND     (7000   /TD8E ENTRY POINTS ARE STRANGE -
+       TAD     UNIT10  /MUST ROTATE UNIT NUMBER LEFT 1
+       SZL
+       TAD     (1000
+       DCA     UNIT10
+       JMS I   (TDUSET /SET UP TD8E OPCODES
+       JMP I   SETUNT
+       PAGE
+\fCDINX,        0               /SET INPUT STUFF
+       TAD (OUDEVH+1
+       DCA CDIN1
+       TAD CDDEV
+       DCA CDIN2       /SET DEVICE
+       TAD CDDEV+1
+       DCA CDIN2+1
+       CIF 10
+       JMS I [200
+       1               /GET HANDLER
+CDIN2, 0
+       0
+CDIN1, 0
+       JMP I (NOOFIL
+       TAD CDIN2+1
+       JMS     GTDVTP  /COMPARE DCB ENTRY WITH TC08 OR TD8E
+       SZA CLA
+       JMP CDIN3       /NOT DECTAPE
+       TAD CDIN1
+       JMS I   (SETUNT /SET UP UNIT NUMBER
+       JMS I (ROCK     /CHECK THE TAPE
+       JMP CDIN3       /NOT PDP-10 DECTAPE
+       JMS I (EXA40    /DO EXCESS 40
+       TAD INSEG
+       CIA
+       TAD UNIT10      /IS DIRECTORY IN CORE?
+       SNA CLA
+       JMP CDIN8       /YES - NO READ
+       TAD CDNAME
+       SNA CLA
+       JMP CDIN7       /NO NAME - NO READ
+       JMS I (READT
+       DIRECT          /READ DIRECTORY
+       144
+       TAD UNIT10
+       DCA INSEG       /SET DIRECTORY IN CORE
+CDIN8, TAD (-5
+       DCA CNTR
+       TAD (CDNAME-1
+       DCA INDEX0
+       TAD (CDINXX-1
+       DCA INDEX1
+       TAD I INDEX0
+       CDF 10
+       DCA I INDEX1
+       CDF
+       ISZ CNTR
+       JMP .-5
+       TAD (CDINXX-1
+       JMS I (IOPN10   /OPEN THE PDP-10 FILE
+       JMP I (FNOTFD
+CDIN7, DCA CDIN4
+       TAD UNIT10
+       JMP CDIN6
+
+CDIN3, TAD (CDNAME
+       DCA CDIN4
+       TAD CDNAME
+       SNA CLA
+       JMP CDIN9       /NO LOOKUP IF NO NAME
+       TAD CDIN2+1
+       CIF 10
+       JMS I [200
+       2
+CDIN4, CDNAME          /LOOKUP
+CDIN5, 0
+       JMP I (FNOTFD
+       TAD CDIN5
+       TAD (400
+       SPA
+       CLA
+       CLL RTL
+       RTL
+       AND [7760       /GET LENGTH
+       TAD CDIN2+1     /ADD DEVICE
+CDIN6, CDF 10
+       DCA I INDEX6
+       TAD CDIN4
+       DCA I INDEX6    /SET BLOCK STARTING
+       CDF
+       JMP I CDINX
+
+CDIN9, DCA CDIN4
+       JMP CDIN6-1
+
+GTDVTP,        0
+       TAD (DCB-1
+       DCA TEMP1
+       CDF 10
+       TAD I TEMP1     /GET DCB ENTRY
+       CDF
+       DCA     DVTYPE
+       TAD     DVTYPE
+       AND     (770
+       TAD     (-210
+       SZA
+       TAD     (30
+       JMP I   GTDVTP
+       PAGE
+\fROCK, 0
+       JMS     GET10D  /GET ENTRY IN TAPE TYPE TABLE
+       SNA
+       JMP ROCK4       /UNKNOWN - ROCK IT
+       SMA CLA
+       ISZ ROCK
+       JMP I ROCK      /EXIT
+
+GET10D,        0
+       TAD UNIT10
+       CLL RTL
+       RTL
+       TAD (PDP10D
+       DCA TEMP5       /POINT TO KNOWN TABLE
+       TAD I TEMP5
+       JMP I   GET10D
+
+ROCK4, CLA CMA
+       DCA I TEMP5
+       TAD     DVTYPE
+       AND     (10
+       SZA CLA         /WHAT KIND OF TAPE?
+       JMP     TDCHK   /TD8E
+       TAD (OBUF10-1
+       DCA I (7755
+       TAD (10
+       DTLB
+ROCK1, RTL
+       RAL
+       SZL CLA
+       TAD (-400
+       TAD UNIT10
+       TAD (210
+       DTCA DTXA
+ROCK2, JMS     DTWAIT
+
+ROCK3, SPA
+       JMP ROCK1
+       CLA
+       TAD (OBUF10-1
+       DCA I (7755
+       TAD (-600
+       DCA I (7754
+       TAD (30
+       DTXA
+       DTSF DTRB
+       JMP .-1
+       SPA CLA
+       JMP ROCK4       /RETRY
+       TAD [200
+       DTXA            /STOP DRIVE
+       TAD I (7754
+       SZA CLA
+       JMP I ROCK      /OS8 UNIT
+       CLA IAC
+SET10, DCA I TEMP5
+       ISZ ROCK
+       JMP I ROCK      /PDP-10 UNIT
+
+DTWAIT,        0               /WAIT FOR DECTAPE FLAG
+       DTSF DTRB
+       SKP CLA
+       JMP I   DTWAIT
+       KSF
+       JMP DTWAIT+1
+       TAD [200
+       KRS
+       TAD (-203
+       SZA CLA
+       JMP DTWAIT+1
+       TAD     [200
+       DTXA    /STOP THE TAPE
+       JMP I [7600
+
+TDCHK, CLA STL RTR
+       TAD     TDUNIT
+IOTX1, SDLC
+       CLA
+IOTX2, SDRC
+       AND     (100    /CHECK FOR TAPE NOT READY
+       SZA CLA
+       JMP     TDCHK   /WAIT FOR TAPE TO COME UP
+       TAD     TDUNIT
+       TAD     (1000
+IOTX3, SDLC
+       JMS     SKIP4
+       JMS     SKIP4
+IOTX4, SDSS
+       JMP     .-1
+IOTX5, SDRC
+       AND     [77
+       TAD     (-26
+       SZA CLA         /WAIT FOR GUARD
+       JMP     IOTX4
+       DCA     TDT
+TDCLP, JMS     SKIP4
+       ISZ     TDT
+       AND     [77
+       TAD     (-51    /SEARCH FOR SOME CRAP NEAR END OF RECORD
+       SZA CLA
+       JMP     TDCLP
+       TAD I   (UNIT
+IOTX6, SDLC            /STOP TAPE
+       CLA
+       TAD     TDT
+       TAD     (-611   /9 WORDS FOR GOOD LUCK
+       SZA CLA
+       JMP I   ROCK
+       STL RTL         /SET TABLE ENTRY TO 2 FOR TD8E TAPE
+       JMP     SET10
+
+SKIP4, 0
+IOTX7, SDSQ
+       JMP     .-1
+IOTX8, SDRC
+       JMP I   SKIP4
+TDT,   0
+       PAGE
+       FIELD 0         /DUMP PG 0 LITERALS HERE
+\f/TD8E DECTAPE ROUTINE
+/VERSION 01
+
+/JULY 2 1971           GB/RL/EF
+
+/COPYRIGHT 1971                DIGITAL EQUIPMENT CORP.
+/                      MAYNARD, MASS.
+
+/ABSTRACT--
+/      THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
+/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
+/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
+/WHICH IS COMPATIBLE WITH PS/8 DEVICE HANDLER CALLING
+/SEQUENCES.
+\f
+/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
+/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
+/CONTROL:
+/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
+/B) THE ORIGIN OF THE TWO PAGE ROUTINE
+/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
+/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
+
+/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
+/DEC VERSION OF THIS ROUTINE:
+
+       DRIVE=10        /UNITS 0 AND 1 SELECTED
+       ORIGIN=6200     /ENTRIES AT 6200 AND 6204
+       AFIELD=0        /INITIAL FIELD SETTING
+       MFIELD=00       /AFIELD*10=MFIELD
+       WDSBLK=600      /384 WORDS PER BLOCK
+
+/THE USE OF THE PARAMETERS IS AS FOLLOWS:
+
+/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
+/      DRIVE=10 IMPLIES UNITS 0 &1
+/      DRIVE=20 IMPLIES UNITS 2&3
+/      DRIVE=30 IMPLIES UNITS 4&5
+/      DRIVE=40 IMPLIES UNITS 6&7
+
+/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
+/      MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
+/THAT THIS IS A TWO PAGE ROUTINE.
+
+/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
+/      LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
+
+/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
+/      THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
+/      THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
+
+/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE 
+/      IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
+/      128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
+/      BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
+/      FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
+/      FORMATTED TO CONTAIN.
+
+/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
+/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
+/PER BLOCK, THE PARAMETERS WOULD BE:
+/      DRIVE=20
+/      ORIGIN=3000
+/      AFIELD=2
+/      MFIELD=20
+/      WDSBLK=400
+\f
+/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
+/CALLING SEQUENCE FOR PS/8 DEVICE HANDLERS.
+/THE CALLING SEQUENCE IS:
+
+/      CDF CURRENT
+/      CIF MFIELD      /MFIELD=FIELD ASSEMBLED IN
+/      JMS ENTRY       /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
+                       /AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
+/      ARG1
+/      ARG2
+/      ARG3
+/      ERROR RETURN
+/      NORMAL RETURN
+
+/THE ARGUMENTS ARE:
+
+/ARG1: FUNCTION WORD   BIT0: 0=READ, 1=WRITE
+/                      BITS 1-5: # BLOCKS IN OPERATION
+/                      BITS 6-8: FIELD OF BUFFER AREA
+/                      BIT 9: UNUSED
+/                      BIT 10: # OF WORDS/BLOCK.
+/                      0= WDSBLK, 1=WDSBLK-1
+/                      BIT 11: 1=START FORWARD, 0=REVERSE
+
+/ARG2: BUFFER ADDRESS FOR OPERATION
+/ARG3: STARTING BLOCK FOR OPERATION
+
+/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
+/              TOO GREAT A BLOCK NUMBER
+/      FATAL ERRORS TAKE ERROR RETURN WITH THE
+/      AC=4000.
+/B) NON-FATAL- SELECT ERROR.
+/      IF NO PROPER UNIT IS SELECTED, THE ERROR
+/      RETURN IS TAKEN WITH CLEAR AC.
+/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
+/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
+/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
+\f
+/THE TD8E IOT'S ARE:
+       SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
+       SDST=7002-DRIVE /SKIP ON TIMING ERROR
+       SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
+       SDLC=7004-DRIVE /LOAD COMMAND REGISTER
+       SDLD=7005-DRIVE /LOAD DATA REGISTER
+       SDRC=7006-DRIVE /READ COMMAND REGISTER
+       SDRD=7007-DRIVE /READ DATA REGISTER
+
+/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
+/THE OTHERS CONTROL UNITS 2-7.
+
+       BLOCK=DTA1
+
+       FIELD AFIELD
+       *ORIGIN
+DTA0,  0               /ENTRY POINT FROM UNIT 0
+       CLA CLL         /0 TO LINK
+       JMP DTA1X
+C1000, 1000
+DTA1,  0               /UNIT 2 ENTRY
+       CLA CLL CML     /1 TO LINK
+       TAD DTA1
+       DCA DTA0        /PICK UP ARGS AT DTA0
+DTA1X, RAR
+       DCA UNIT        /LINK TO UNIT POSITION
+       RDF
+       TAD C6203       /GET DATA FIELD AND SETUP RETURN
+       DCA LEAVE
+       TAD I DTA0      /GET FUNCTION WORD
+DIO01, SDLD            /PUT FUNCTION INTO DATA REGISTER
+       CLL RTR         /AC STILL HAS FUNCTION. PUT # WORDS PER
+                       /BLOCK INTO LINK
+       SZL CLA         /KNOCK ONE OFF WDSBLK?
+       IAC             /YES
+       TAD MWORDS
+       DCA WCOUNT      /STORE MASTER WORD COUNT
+       ISZ DTA0        /TO BUFFER
+       TAD I DTA0
+       DCA BUFF
+       ISZ DTA0        /TO BLOCK NUMBER
+       TAD I DTA0
+       DCA BLOCK
+       ISZ DTA0        /POINT TO ERROR EXIT
+       CIF CDF MFIELD  /TO ROUTINES DATA FIELD
+DIO02, SDRD            /GET FUNCTION INTO AC
+       CLL RAL
+       AND CM200       /GET # PAGES TO XFER
+       DCA PGCT
+DIO03, SDRD
+C374,  AND C70         /GET FIELD FOR XFER
+       TAD C6203       /FORM CDF N
+       DCA XFIELD      /IF=0 AND DF=N AT XFER.
+       CLA CLL CMA RTL
+       DCA TRYCNT      /3 ERROR TRIES
+       TAD UNIT        /TEST FOR SELECT ERROR
+DIO04, SDLC
+DIO05, SDRC
+       AND C100
+       SZA CLA
+       JMP FATAL-1
+\f
+DIO06, SDRD            /PUT FUNCT INTO XFUNCT IN SECOND PG.
+       DCA I CXFUN
+       TAD WCOUNT
+       DCA I CXWCT
+DIO07, SDRD            /GET MOTION BIT TO LINK
+       CLL RAR
+       JMP GO          /AND START THE MOTION.
+DIO08,
+RWCOM, SDST            /ANY CHECKSUM ERRORS?
+       SZA CLA         /OR CHECKSUM ERRORS?
+       JMP TRY3        /PLEASE NOTE THAT THE LINK IS ALWAYS
+                       /SET AT RWCOM. GETCHK SETS IT.
+       TAD PGCT        /NO ERROR..FINISHED XFER?
+       TAD CM200
+       SNA
+       JMP EXIT        /ALL DONE. GET OUT
+       DCA PGCT        /NEW PAGE COUNT
+       ISZ BLOCK       /NEXT BLOCK TO XFER
+       TAD WCOUNT      /FORM NEXT BUFFER ADDRESS
+       CIA
+       TAD BUFF
+       DCA BUFF
+       CLL CML         /FORCES MOTION FORWARD
+GO,    CLA CML RTR     /LINK BECOMES MOTION BIT
+       TAD C1000
+       TAD UNIT        /PUT IN 'GO' AND UNIT #
+DIO09, SDLC            /LOOK FOR BLOCK NO.
+
+       JMS I CRDQUD    /WAIT AT LEAST 6 LINES TO LOOK
+       JMS I CRDQUD
+CM200, 7600            /COULD HAVE SAVED A LOC. HERE
+DIO10,
+SRCH,  SDSS
+       JMP .-1         /WAIT FOR SINGLE LINE FLAG
+DIO11, SDRC
+       CLL RTL         /DIRECTION TO LINK. INFO BITS 
+                       /ARE SHIFTED.
+       AND C374        /ISOLATE MARK TRACK BITS
+       TAD M110        /IS IT END ZONE?
+       SNA             /THE LINK STAYS SAME THRU THIS
+       JMP ENDZ
+       TAD M20         /CHECK FOR BLOCK MARK
+       SZA CLA
+       JMP SRCH
+DIO12, SDRD            /GET THE BLOCK NUMBER
+       SZL             /IF WE ARE IN REVERSE, LOOK FOR 3
+                       /BLOCKS BEFORE TARGET BLOCK. THIS
+                       /ALLOWS TURNAROUND AND UP TO SPEED.
+       TAD C3          /REVERSE
+       CMA
+       TAD BLOCK
+       CMA             /IS IT RIGHT BLOCK?
+       SNA
+       JMP FOUND       /YES..HOORAY!
+M110,  SZL SNA CLA     /NO, BUT ARE WE HEADED FOR IT?
+                       /ABOVE SNA IS SUPERFLUOUS.
+       JMP SRCH        /YES
+DIO13,
+ENDZ,  SDRC            /WE ARE IN THE END ZONE
+       CLL RTL         /DIRECTION TO LINK
+/V3C   SZL CLA         /ARE WE IN REVERSE?
+       JMP GO          /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3,  CLA CLL         /V3C
+       ISZ TRYCNT
+       JMP GO          /TRY 3 TIMES
+       JMP FATAL               /LINK OFF MEANS AC=4000 ON RETURN
+EXIT,  ISZ DTA0
+       CLL CML         /AC=0 ON NORMAL RETURN
+FATAL, TAD UNIT
+DIO14, SDLC            /STOP THE UNIT
+       CLA CML RAR
+LEAVE, HLT
+       JMP I DTA0
+
+\f
+C6203, 6203
+CRDQUD,        RDQUAD
+WCOUNT,        0
+BUFF,  0
+MWORDS,        -WDSBLK
+UNIT,  0
+CXFUN, XFUNCT
+M20,   -20
+PGCT,  0
+CXWCT, XWCT
+C100,  100
+TRYCNT,        -3
+
+
+       *ORIGIN+170
+FOUND, SZL CLA         /RIGHT BLOCK. HOW ABOUT DIRECTION?
+       JMP GO          /WRONG..TURN AROUND
+       TAD UNIT        /PUT UNIT INTO LINK
+       CLL RAL         /AC IS NOW 0
+C70,   70              /********DON'T MOVE THIS!!!!******
+C3,    3
+       TAD BUFF        /GET BUFFER ADDRESS
+XFIELD,        HLT             /INTO NEXT PAGE
+
+       *ORIGIN+200
+
+       CIF MFIELD
+       DCA XBUFF       /SAVE ADDRESS
+       RAR             /NOW GET UNIT #
+       DCA XUNIT
+       SDRC            /V3C
+       SDLC            /V3C
+       TAD XWCT
+       DCA DWORDS      /WORD COUNTER
+DIO15,
+REVGRD,        SDSS
+       JMP .-1         /LOOK FOR REVERSE GUARD
+DIO16, SDRC
+       AND K77
+       TAD CM32        /IS IT REVERSE GUARD?
+       SZA CLA
+       JMP REVGRD      /NO.KEEP LOOKING
+       TAD XFUNCT      /GET FUNCTION  READ OR WRITE
+K7700, SMA CLA
+       JMP READ        /NEG. IS WRITE
+DIO17,
+WRITE, SDRC
+       AND C300        /CHECK FOR WRITE LOCK AND SELECT ERROR
+       CLL CML         /LOCK OUT AND SELECT ARE AC 0 ERRORS
+       SZA CLA
+       JMP I CFATAL    /FATAL ERROR. LINK MUST BE ON
+/      JMS RDQUAD      /NO ONE EVER USES THIS WORD!
+/      CLA
+       STA             /V3C HACK FOR PDP-6
+       JMS WRQUAD      /V3C 7777 FOR REV CHECKSUM AND SKIP OVER LOCK
+       TAD C1400
+       TAD XUNIT       /INITIATE WRITE MODE
+DIO18, SDLC
+       CLA CMA
+       JMS WRQUAD      /PUT 77 IN REVERSE CHECKSUM
+       CLA CMA
+       DCA CHKSUM
+WRLP,  TAD I XBUFF     /GLORY BE! THE ACTUAL WRITE!
+       JMS WRQUAD
+       ISZ XBUFF       /BUMP CORE POINTER
+K77,   77              /ABOVE MAY SKIP
+       ISZ DWORDS      /DONE THIS BLOCK?
+       JMP WRLP        /NOT YET..LOOP A WHILE
+       TAD XFUNCT      /IS THE OPERATION FOR WDSBLK PER BLOCK?
+       CLL RTR         /IF NO, WRITE A 0 WORD
+       SZL CLA
+
+       JMS WRQUAD      /WRITE A WORD OF 0
+       JMS GETCHK      /DO THE CHECK SUM
+       JMS WRQUAD      /WRITE FORWARD CHECKSUM
+       JMS WRQUAD      /ALLOW CHECKSUM TO BE WRITTEN
+       JMS WRQUAD      /V3C WRITE REST OF CHECKSUM [PDP-6]
+       JMP I CRWCOM
+
+
+READ,  JMS RDQUAD
+       JMS RDQUAD
+       JMS RDQUAD      /SKIP CONTROL WORDS
+       AND K77
+       TAD K7700       /TACK 7700 ONTO CHECKSUM.
+       DCA CHKSUM      /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP,  JMS RDQUAD
+       JMS EQUFUN      /COMPUT CHECKSUM AS WE GO
+       DCA I XBUFF     /IT GETS CONDENSED LATER
+       ISZ XBUFF
+C300,  300             /PROTECTION
+       ISZ DWORDS      /DONE THIS OP?
+       JMP RDLP        /NO SUCH LUCK
+       TAD XFUNCT      /IF OP WAS FOR WDSBLK-1, READ AND
+       CLL RTR         /CHECKSUM THE LAST TAPE WORD
+       SNL CLA
+       JMP RDLP2
+       JMS RDQUAD      /NOT NEEDED FOR WDSBLK/BLOCK
+       JMS EQUFUN      /CHECKSUM IT
+RDLP2, JMS RDQUAD      /READ CHECKSUM
+       AND K7700
+       JMS EQUFUN
+       JMS GETCHK      /GET SIX BIT CHECKSUM
+       JMP I CRWCOM
+
+WRQUAD,        0               /WRITE OUT A 12 BIT WORD
+       JMS EQUFUN      /ADD THIS TO CHECKSUM
+DIO19, SDSQ            /SKIP ON QUADLINE FLAG
+       JMP .-1
+DIO20, SDLD            /LOAD DATA  ONTO BUS
+       CLA             /SDLD DOESN'T CLEAR AC
+       JMP I WRQUAD
+
+RDQUAD,        0               /READ A 12 BIT WORD
+DIO21, SDSQ
+       JMP .-1
+DIO22, SDRD            /READ DATA
+       JMP I RDQUAD
+
+\f
+EQUFUN,        0               /COMPUTE EQUIVALENCE CHECKSUM
+       CMA
+       DCA EQUTMP      /ACTUALLY CHECKSUMS ON DECTAPE ARE
+       TAD EQUTMP      /EQUIVALENCE OF ALL WORDS IN A RECORD
+       AND CHKSUM      /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+       CIA             /IS ASSOCIATIVE, WE CAN DO IT 12
+       CLL RAL         /BITS AT A TIME AND CONDENSE LATER.
+       TAD EQUTMP      /THIS ROUTINE USES THESE IDENTITIES:
+       TAD CHKSUM      /A+B=(A.XOR.B)+2*(A.AND.B)
+       DCA CHKSUM      /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+       TAD EQUTMP      /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+       CMA
+       JMP I EQUFUN
+
+GETCHK,        0               /FORM 6 BIT CHECKSUM
+       CLA
+       TAD CHKSUM      
+       CMA
+       CLL RTL
+       RTL
+       RTL
+       JMS EQUFUN
+       CLA CLL CML     /FORCES LINK ON AT RWCOM
+       TAD CHKSUM
+       AND K7700
+       JMP I GETCHK
+
+CFATAL,        FATAL
+CRWCOM,        RWCOM
+XFUNCT,        0
+CM32,  -32
+C1400, 1400
+CHKSUM,        0
+DWORDS,        0
+XBUFF, 0
+XWCT,  0
+EQUTMP,        0
+XUNIT, 0
+       PAGE
+\fFIELD 1
+
+*2000
+
+ZFREE, ZBLOCK 5
+
+INCTR, 0
+INHNDL,        0
+INPTR, 0
+
+DELPS1,        0
+       JMS I (200
+       4
+       MOUTPU+1
+       0
+       ISZ DELPS1
+       CIF CDF 0
+       JMP I DELPS1
+
+ICHARP,        0
+       ISZ INJMP
+       ISZ INCHCT
+INJMPP,        JMP INJMP
+       TAD INEOF
+       SZA CLA
+       JMP INEXIT
+INGBUF,        TAD INCTR
+       CLL
+       TAD (INRECS
+       SNL
+       DCA INCTR
+       SZL
+       ISZ INEOF
+       CLL CML CMA RTR
+       RTR
+       RTR
+       TAD (INCTL+1
+       DCA INCTLW
+       CIF 0
+       JMS I INHNDL
+INCTLW,        0
+INBUFP,        INBUF
+INREC, 0
+       JMP INERRX
+INBREC,        TAD INREC
+       TAD (INRECS
+       DCA INREC
+       TAD INCTLW
+       AND (7600
+       CLL RAL
+       TAD INCTLW
+       AND (7600
+       CMA
+       DCA INCHCT
+       TAD INJMPP
+       DCA INJMP
+       TAD INBUFP
+       DCA INPTR
+       JMP ICHARP+1
+
+INERRX,        ISZ INEOF
+       SMA CLA
+       JMP INBREC
+INERR, CLL CLA CML RAR
+       JMP INEXIT
+
+INJMP, HLT
+       JMP INCHR1
+       JMP INCHR2
+INCHR3,        TAD INJMPP
+       DCA INJMP
+       TAD I INPTR
+       AND (7400
+       CLL RTR
+       RTR
+       TAD INCTLW
+       RTR
+       RTR
+       ISZ INPTR
+       JMP INCOMN
+
+INCHR2,        CDF 0
+       TAD I (MODE
+       CDF 10
+       SMA SZA CLA
+       JMP IC8A1
+       TAD I INPTR
+       AND (7400
+       DCA INCTLW
+       ISZ INPTR
+IC8A2, TAD I INPTR
+INCOMN,        AND (377
+       TAD (-232
+       SNA
+       JMP INEXIT
+       TAD (232
+       ISZ ICHARP
+INEXIT,        CIF CDF 0
+       JMP I ICHARP
+
+INEOF, 1
+INCHCT,        -1
+
+INCHR1,        CDF 0
+       TAD I (MODE
+       CDF 10
+       SPA SNA CLA
+       JMP IC8A2
+IC8A3, TAD I INPTR
+       ISZ INPTR
+       JMP INEXIT-1
+
+IC8A1, TAD INJMPP
+       DCA INJMP
+       ISZ INCHCT
+       JMP IC8A3
+       PAGE
+\fOOPNPS,       0
+       TAD (MOUTPU+1
+       DCA OUBLK
+       TAD I (MOUTPU
+       JMS I (200
+       3
+OUBLK, 0
+OUELEN,        0
+       JMP OUEFAL
+       DCA OUCCNT
+       JMS I (OUSETP
+       ISZ OOPNPS
+OUEEXT,        CIF CDF 0
+       JMP I OOPNPS
+
+OUEFAL,        TAD I (MOUTPU
+       AND (7760
+       SNA CLA
+       JMP OUEEXT
+       TAD I (MOUTPU
+       AND (17
+       DCA I (MOUTPU
+       JMP OOPNPS+1
+
+OUHNDL,        0
+
+OUTDMP,        0
+       DCA OUCTLW
+       TAD OUCCNT
+       SNA
+       ISZ OUCTLW
+       TAD OUBLK
+       DCA OUREC
+       TAD OUCTLW
+       CLL RTL
+       RTL
+       RTL
+       AND (17
+       TAD OUCCNT
+       DCA OUCCNT
+       TAD OUCCNT
+       CLL CML
+       TAD OUELEN
+       SNL SZA CLA
+       JMP I OUTDMP
+       CIF 0
+       JMS I OUHNDL
+OUCTLW,        0
+       OUBUF
+OUREC, 0
+       JMP I OUTDMP
+       ISZ OUTDMP
+       JMP I OUTDMP
+
+OCLOSE,        0
+       CDF 0
+       TAD I (MODE
+       CDF 10
+       SMA SZA CLA
+       JMP OULLLP+2
+       JMS I (OTYPE
+       AND (770
+       TAD (-PTP
+       SZA CLA
+       TAD (232
+       JMS I (OCHARP
+       JMP OURET
+       JMS I (OCHARP
+       JMP OURET
+OULLLP,        JMS I (OCHARP
+       JMP OURET
+       JMS I (OTYPE
+       SPA CLA
+       TAD (100
+       TAD (77
+       AND I (OUDWCT
+       SZA CLA
+       JMP OULLLP
+       TAD I (OUDWCT
+       TAD (OUCTL&3700
+       SNA
+       JMP OUDUMP
+       TAD (4010
+       JMS OUTDMP
+       JMP OURET
+OUDUMP,        TAD I (MOUTPU
+       JMS I (200
+       4
+       MOUTPU+1
+OUCCNT,        0
+       SKP
+       ISZ OCLOSE
+OURET, CIF CDF 0
+       JMP I OCLOSE
+       PAGE
+\fOUTEMP,       0
+
+OUJMP, HLT
+       JMP OCHR1
+       JMP OCHR2
+OCHR3, TAD OUTEMP
+       CLL RTL
+       RTL
+       AND (7400
+       TAD I OUPOLD
+       DCA I OUPOLD
+       TAD OUTEMP
+       CLL RTR
+       RTR
+       RAR
+       AND (7400
+       TAD I OUPTR
+OC8A1, DCA I OUPTR
+       TAD OUJMPP
+       DCA OUJMP
+       ISZ OUPTR
+       ISZ OUDWCT
+       JMP OUCOMN
+       TAD (OUCTL
+       JMS I (OUTDMP
+       JMP OUCRET
+       JMS OUSETP
+       JMP OUCOMN
+
+OUSETP,        0
+       TAD (OUCTL&3700
+       CIA
+       DCA OUDWCT
+       TAD (OUBUF
+       DCA OUPTR
+       TAD OUJMPP
+       DCA OUJMP
+       JMP I OUSETP
+
+OCHARP,        0
+       DCA OUTEMP
+       RDF
+       TAD (CIF CDF 0
+       DCA OUCRET
+       CDF 0
+       TAD I (MODE
+       SMA SZA CLA
+       JMP .+4
+       TAD OUTEMP
+       AND (377
+       DCA OUTEMP
+       CDF 10
+       ISZ OUJMP
+OUJMPP,        JMP OUJMP
+
+OCHR2, CDF 0
+       TAD I (MODE
+       CDF 10
+       SMA SZA CLA
+       JMP OC8A2
+       TAD OUPTR
+       DCA OUPOLD
+       ISZ OUPTR
+OCHR1, TAD OUTEMP
+       DCA I OUPTR
+OUCOMN,        ISZ OCHARP
+OUCRET,        CIF CDF 0
+       JMP I OCHARP
+
+OUPOLD,        0
+OUPTR, 0
+OUDWCT,        0
+
+OTYPE, 0
+       TAD I (MOUTPU
+       AND (17
+       TAD (DCB-1
+       DCA OUSETP
+       TAD I OUSETP
+       JMP I OTYPE
+
+CDINXX,        ZBLOCK 5
+
+OC8A2, ISZ OUPTR
+       TAD OUTEMP
+       JMP OC8A1
+       PAGE
+\f$-$-$
+\f