software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape6 / DIRECT.PA
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/DIRECT.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/DIRECT.PA
new file mode 100644 (file)
index 0000000..2711c63
--- /dev/null
@@ -0,0 +1,1148 @@
+/DIRECT V3D FOR OS/78 V1A AND OS/8 V3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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/JANUARY 17, 1974                     H.J.
+/
+/5-AUGUST-1975 MAINT. RELEASE CHANGES          S.R.
+/1.    UPDATED COPYRIGHT DATE
+/2.    CHANGED VERSION NUMBER TO V4
+/3.    INCORPORATED PATCH (SEQ #2) OF FEB 1975 DSN
+/      (FIXES BUG RE: DEFAULTING TO TTY: AND DSK:)
+/
+/ 5-APR-77     MH      OS/78 FIXES     (V5A)
+/ 18-MAY-77    MH      SPR 2286        (V6A)
+/
+/DIRECTORY LISTING PROGRAM
+/
+/ START ADDRESS 14600;  JSW 6403
+/
+
+       PTR=20
+       CNT=21
+       INFPTR=22
+       OUHAND=23
+       INHAND=24
+       EPTR=26
+       INSCNT=27
+       TEMP=30
+       OKFLAG=31
+       IFCNT=32
+       OSWTCH=33
+       INFWDS=34
+       BDPTR=35
+       GPTR1=36
+
+
+       XR=10
+       XR1=11
+       XR2=12
+
+
+       AC2=CLA CLL CML RTL
+       AC4000=CLA CLL CML RAR
+       ACM2=CLA CLL CMA RAL
+       ACM3=CLA CLL CMA RTL
+
+
+       ALTOPT=7642
+       OPT1=7643
+       OPT2=7644
+       EQLS=7646       /EQUALS OPTION
+       DATE=7666
+       BIPCCL=7777     /CONTAINS DATE EXTENSION IN BITS 3 AND 4 (MH)
+       BUF=5200        /THE FILE OUTPUT BUFFER
+                       /5 BLOCKS LONG, TO 7577
+
+\f
+       FIELD 1
+       *2000
+       SKP CLA         /NORMAL ENTRY
+       JMP MSTRT       /CHAIN ENTRY
+CDCALL,        JMS I (200      /SEE WHAT THE PERSON WANTS
+       5
+STAR,  5200            /IN SPECIAL MODE
+
+MSTRT, TAD I (OPT2     /GET OPTION /W
+       RTR
+       SNL CLA         /SKIP FOR VESION NUMBER
+       JMP EQUALT
+       JMS I (ERROR    /PRINT VERSION NUMBER
+       VERNO+40
+       TAD (215
+       JMS I (TYPE
+
+/SET UP FOR MULTIPLE ENTRIES ON A LINE
+
+EQUALT,        TAD I (EQLS     /EQUALS OPTION WORD
+       SPA             /MUST BE POSITIVE
+       CLA CLL CML RTR /SET AC LARGE POSITIVE
+       TAD (-10        /CHECK LEGALITY OF OPTION
+       SMA SZA CLA     /SKIP IF GOOD
+       JMP BADEQ
+
+/SUBSTITUTE .DI IF NULL EXTENSION
+
+       TAD I (7604     /GET EXTENSION
+       SNA             /SKIP IF GIVEN
+       TAD (0411       /.DI
+       DCA I (7604     /PUT EXTENSION BACK
+/ GET THE DATE INCREMENT BITS
+       CDF     0       /GET GET WORD FORM FIELD 0(MH)
+       TAD I   (BIPCCL /THE BITS WITH DATE EXT. ARE 3 AND 4 (MH)
+       CDF     10      /BACK TO FIELD 1 (MH)
+       RTR             /SHIFT THOSE BITS SO THEY CREATE A 0,10,20, OR 30(MH)
+       RTR             /AFTER MASKING (MH)
+       AND     (0030   /MASK (MH)
+       DCA     DATINC  /SAVE THE DATE EXTENSION (MH)
+
+/ CHECK FOR ? IN OUTPUT SPECIFICATION
+       TAD (-10
+       DCA CNT         /CNT HAVING -10 PUTS US AT FIRST CHAR
+S1C,   TAD (7605
+       JMS I (GTSXBT   /GET A CHAR
+       TAD (-"?!7700   /CHECK FOR ?
+       SNA
+       JMP QINO
+       TAD ("?-"*
+       SNA CLA
+       JMP AINO
+       ISZ CNT
+       JMP S1C
+
+
+/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
+       TAD (7605
+S4L,   DCA PTR
+       TAD (-10
+       DCA CNT
+ACK,   TAD PTR
+       JMS I (GTSXBT
+       TAD (-"*!7700
+       SZA CLA
+       JMP CNTUP
+       AC2
+       TAD CNT
+       SZA
+       TAD (6
+       SNA CLA
+       ISZ CNT
+       TAD PTR
+       JMS I (GTSXBT
+       SZA CLA
+       JMP AINO
+CNTUP, ISZ CNT
+       JMP ACK
+       TAD I PTR
+       SNA CLA
+       JMP I (NULLCK
+       TAD (5
+       TAD PTR
+       JMP S4L
+
+/THIS IS THE END OF OPERATION CODE
+/IT CLOSES THE FILE AND HANDLES RETURNS
+
+ENDCHK,        ISZ I (ECHO
+       TAD (232
+OLOOP, JMS I (OUTCHR
+       TAD I (OUWDCT   /GET -WORDS LEFT IN BUFFER
+       AND (177        /CHECK AGAINST NEW BUFFER #
+       SNA             /SPR 2286, CHECK CAREFULLY (MH)
+       TAD     RPOS    /TO SEE IF ANY TRAILING (MH)
+       CIA             /OR DANGLING CHARS (MH)
+       TAD     (RPOS-1 /ARE LEFT OVER (MH)
+       SZA!CLA         /(MH)
+       JMP OLOOP       /KEEP GOING TO DUMP ONE
+       TAD I (OUWDCT
+       TAD (1200       /DONT DUMP IF AT END
+       SZA CLA
+       JMS DUMP        /DUMP BUFFER
+       TAD I (7600
+       JMS I (200
+       4
+       7601
+CLEN,  0
+       JMP CLOERR
+       JMP     ABORT   /CODE MOVED TO ANOTHER PAGE (MH)
+
+       PAGE
+\f
+NULLCK,        TAD (7201
+       DCA AO2
+       TAD (7201
+       DCA AO1
+       TAD I (7600
+       SNA
+       JMP TTYHND
+       JMS I (200
+       1
+AO1,   7201
+       HLT
+       TAD AO1
+       JMP CMN
+TTYHND,        TAD (2424
+       DCA TTY1
+       TAD (3100
+       DCA TTY2
+       JMS I (200
+       1
+TTY1,  0
+TTY2,  0
+AO2,   7201
+       JMP I (IDBLVT
+       TAD TTY2
+       DCA I (7600
+       TAD AO2
+CMN,   DCA OUHAND
+       TAD (7601
+       DCA BLCK
+       TAD I (7600
+       JMS I (200
+       3
+BLCK,  7601
+LENGTH,        0
+       JMP I (NOROOM
+       TAD BLCK
+       DCA I (BLCKN
+       TAD (BUF
+       DCA I (OCPTR
+       TAD (RPOS-1     /SPR 2286 (MH)
+       DCA I (RPOS
+       TAD (-1200      /NUMBER OF WORDS IN BUFFER
+       DCA I (OUWDCT
+       DCA I (CLEN
+       TAD I (7605
+       SNA
+       JMP FINDSK      /V3C    IF NO DEVICE SPECIFIED, LOOKUP 'DSK'
+SETDEV,        DCA I (7605
+       TAD (7605
+DOMOIN,        DCA INFPTR
+       TAD (6601
+       DCA AI1
+       TAD I INFPTR
+       SNA
+       JMP I (ENDCHK
+       JMS I (200
+       1
+AI1,   6601
+       HLT
+       TAD AI1
+       DCA INHAND
+       TAD (OUTCHR
+       DCA OSWTCH
+       JMS I (CRLF
+       TAD I (DATE
+       DCA I   (DATNOW /SAVE CURRENT DATE (MH)
+       TAD I   (DATE   /GET DATE BACK INTO AC (MH)
+       JMS I (PDATE
+       JMS I (CRLF
+       JMS I (CRLF
+       DCA I (ECOUNT
+       CMA
+       TAD I (EQLS
+       SMA             /SET UP NEGATIVE COUNT
+       CMA
+       DCA I (ALNCNT   /SAVE FOR LATER
+       TAD I (ALNCNT   /SAVE FOR LATER
+       DCA I (LNCNT    /SAVE FOR LATER
+       JMP I (PG1
+
+AINO,  JMS I (ERROR
+       ILLA+40
+       JMP EOLIN
+QINO,  JMS I (ERROR
+       ILLQ+40
+EOLIN, TAD (215        /COME HERE TO ABORT DIRECTORY
+       JMS I (TYPE     /AND PRINT CRLF
+       JMP I (ABORT    /ABORT OPERATION AND  GOTO ENDUP
+
+FINDSK,        DCA XX          /V3C
+       JMS I (200      /CALL USR
+       12              /TO DO AN INQUIRE
+       5723            /TO LOCATE 'DSK'
+XX,    0
+       0
+       JMP I (IDBLVT   /NO 'DSK' IMPOSSIBLE (SO SAY NO 'TTY')
+       TAD XX          /RETURN DEVICE NUMBER OF DSK
+       JMP SETDEV
+       PAGE
+\f      DIRCTY=0        /LOCATION OF INPUT DIRECTORY
+
+PG1,   TAD I INFPTR
+       TAD (7757
+       DCA TEMP
+       TAD I TEMP
+       SMA CLA
+       JMP NFIN
+       CIF 0
+       JMS I INHAND
+       1400
+       DIRCTY
+       1
+       JMP INDERR
+       CDF 0           /CODE TO CHECK FOR
+       TAD I (DIRCTY   /LEGALITY OF DIRECTORY
+       CMA CLL
+       TAD I (DIRCTY+2
+       CDF 10
+       SNL
+       TAD (7700
+       SZL CLA
+       JMP BIDIR       /DIRECTORY IS BAD
+
+/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
+       TAD INFPTR
+       SKP
+GETCNT,        TAD PTR
+       IAC
+       DCA PTR
+       TAD I PTR
+       SZA CLA
+       JMP NOSUB
+       TAD (5200
+       DCA I PTR
+       TAD (3
+       TAD PTR
+       DCA TEMP
+       TAD (5200
+       DCA I TEMP
+NOSUB, TAD PTR
+       TAD (4
+       DCA PTR
+       ISZ CNT
+       TAD I (OPT2
+       AND (10
+       SZA CLA
+       JMP NOPTIM
+       TAD I PTR
+       CIA
+       TAD I INFPTR
+       SNA CLA
+       JMP GETCNT
+NOPTIM,        TAD CNT
+       CIA
+       DCA INSCNT
+       TAD PTR
+       DCA I (MOIN
+       DCA BDPTR
+       JMP I (NBLOCK
+
+BIDIR, JMS I (ERROR
+       BADDIR+40
+       JMP I (EOLIN
+NFIN,  JMS I (ERROR
+       NFLEIN+40
+       JMP I (EOLIN
+INDERR,        JMS I (ERROR
+       BADIRD+40
+       JMP I (EOLIN
+
+/THIS IS THE ERROR MESSAGE PRINTER
+
+ERROR, 0
+       ISZ I (ECHO
+       CLA CLL
+       TAD (TYPE
+       DCA OSWTCH
+       TAD (-100
+       DCA CNT
+PLOOP, TAD I ERROR
+       JMS I (GTSXBT
+       DCA DFLAG
+       TAD DFLAG
+       JMS I (CONVTP
+       ISZ CNT
+       TAD DFLAG
+       SZA CLA
+       JMP PLOOP
+       ISZ ERROR
+       JMP I ERROR
+
+DFLAG, 0
+ABORT, TAD I   (ALTOPT /MOVED (MH)
+       SMA CLA
+       JMP I   (CDCALL
+       CIF CDF 0
+       JMP I   (7605
+BADEQ, JMS I   (ERROR
+       BIGEQ+40
+       JMP I   (EOLIN
+
+       PAGE
+\f
+/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE
+
+/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
+/IS FOUND USING THE INPUT GROUPING
+/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC
+
+NBLOCK,        TAD BDPTR       /POINTER TO START OF DIR BLOCK
+       DCA XR
+       CDF 0
+       TAD I XR        /GET BLOCK NUMBER FIRST FILE
+       DCA BLOCK
+       TAD I XR        /NEXT SEGMENT NUMBER
+       DCA LFLAG       /IF IT 0 WE AT END
+       ISZ XR          /SKIP TENTATIVE FILE WORD
+       TAD I XR        /GET -NUMBER OF INFO WORDS
+       CIA             /MAKE POSITVE
+       DCA INFWDS
+       TAD XR          /POINT TO FIRST
+       IAC             /ENTRY
+       DCA EPTR
+
+BLOOP, TAD I EPTR      /GET FILENAME WORD
+       CDF 10
+       SNA CLA         /SKIP IF FILE HERE
+       JMP EMPTY       /NO... ITS REALLY AN EMPTY
+       TAD INSCNT      /SET NUMBER OF INPUT TO LOOK
+       DCA NCNT        /AT ALL AT ONCE
+       DCA MATFLG      /CLEAR MATCH FLAG
+       TAD INFPTR      /ADDRESS OF FIRST INPUT
+       SKP
+MN1,   TAD GPTR2       /ADDRESS OF CURRENT INPUT
+       TAD (5          /GTSXBT SUBR REQUIRES US TO
+       DCA GPTR2       /POINT TO END OF FIELD
+       TAD EPTR        /POINT DIRECTORY POINTER TO
+       TAD (4          /END OF ENTRY FOR SAME REASON
+       DCA GPTR1
+       TAD GPTR1       /SET EPNEXT TO POINT TO
+       TAD INFWDS      /MINUS NUMBER OF BLOCKS IN
+       DCA EPNEXT      /FILE WORD
+       TAD (-10        /NUMBER OF CHARS TO LOOK AT
+WILDNM,        DCA CNT
+\f
+MLP,   TAD GPTR2       /OK - GET A CHARACTER FROM
+       JMS I (GTSXBT   /STRING
+       TAD (-"*!7700   /IS IT AN *
+       SNA             /SKIP IF NOT *
+       JMP WILDA       /YEP... ITS A WILD CARD
+       TAD ("*-"?      /IS IT A ?
+       SNA             /SKIP IF NOT
+       JMP WILD        /YES... FORCE MATCH ON THIS CHAR
+       TAD ("?&77      /RESTORE VALUE
+       CIA             /NEGATE
+       DCA CHAR        /AND SAVE
+       TAD GPTR1       /NOW GET CHAR FROM DIRECTORY
+       CDF 0
+       JMS I (GTSXBT
+       CDF 10
+       TAD CHAR        /DO CHARS MATCH
+       SZA CLA         /SKIP IF THEY DO
+       JMP NM1         /NO MATCH ON THIS INPUT
+WILD,  ISZ CNT         /BUMP COUNT OF CHARS & POINTER
+       JMP MLP         /COMPARE ALL 8
+MEXT,  ISZ MATFLG      /A MATCH!!!!!!!
+NM1,   CLA             /WILD CARD COMES HERE WITH ICHY AC
+       ISZ NCNT        /HAVE WE CHECKED GROUP OF INPUTS
+       JMP MN1         /NO CHECK WHOLE GROUP
+       TAD MATFLG      /HAVE THERE BEEN ANY MATCHES
+       SZA CLA         /SKIP IF NOT
+       TAD (4          /WILL INVERT /V SWITCH
+       TAD I (OPT2     /ADD SWITCH
+       AND (4          /ISOLATE IT
+       CDF 0
+/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
+/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
+/OF THE INPUTS AND /V WAS NOT SPECIFIED   OR
+/A MATCH WAS FOUND AND /V WAS SPECIFIED
+
+/THIS ALLOWS /V TO MEAN EVERYTHING BUT...
+
+       SZA CLA
+       TAD I EPNEXT    /GET -NUMBER OF BLOCKS
+       CDF 10
+       SZA             /SKIPS IF TENTATIVE OR NOT CANDIDATE
+       JMP I (GOT1     /PROCESS FILE
+NENT,  TAD EPNEXT      /POINT EPTR TO BLOCK
+       DCA EPTR        /COUNT OF FILE
+       JMP NEMPTY
+EMPTY, ISZ EPTR        /ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
+       JMS I (HEMPTY   /HANDLE EMPTY SLOTS
+NEMPTY,        CDF 0
+       TAD I EPTR      /GET BLOCK COUNT
+       CIA             /MAKE POSITIVE
+       TAD BLOCK
+       DCA BLOCK       /KEEP SUM
+       ISZ EPTR        /POINT TO NEXT ENTRY
+       ISZ I BDPTR     /POINTS TO -NUMBER OF ENTRIES
+       JMP BLOOP       /NOT DONE WITH SEGMENT
+       CDF 10
+       TAD (400        /BUMP TO NEXT SEGMENT
+       TAD BDPTR
+       DCA BDPTR
+       TAD LFLAG       /DID WE PROCESS LAST SEGMENT
+       SZA CLA         /SKIP IF WE DID
+       JMP NBLOCK      /PROCESS NEW SEGNENT
+       JMP I (SAYNON
+\f
+/HANDLE WILD CARDS
+
+WILDA, TAD CNT         /GET CURRENT CHAR POSITION
+       TAD (6          /ADD SIZE OF FILENAME
+       SPA             /SKIP IF IN EXTENSION FIELD
+       JMP WILDNM      /THIS BUMPS TO EXTENSION
+       JMP MEXT        /THIS MEANS IT HAS TO BE A MATCH
+
+
+CHAR,  0
+EPNEXT,        0
+GPTR2, 0
+LFLAG, 0
+NCNT,  0
+BLOCK, 0
+MATFLG,        0
+
+
+       PAGE
+\fGOT1, DCA IFCNT       /-# OF BLOCKS IN AC
+       JMS I (DATCHK   /VERIFY /C AND /O SWITCHES
+       TAD (OUTCHR
+       DCA OSWTCH
+       TAD I (OPT2
+       SPA CLA
+       JMP I (NENT
+       JMS I (ADDINF   /SEE IF ADDITIONAL INFO WORDS
+       TAD I (OPT2
+       AND (100        /IS /R USED
+       SNA CLA
+       JMP NOR
+       TAD INFPTR      /FILL IN *.* FOR FILENAME
+       IAC
+       DCA TEMP
+       TAD (5200       /*
+       DCA I TEMP
+       ISZ TEMP
+       ISZ TEMP
+       ISZ TEMP        /POINT TO EXTENSION
+       TAD (5200       /.*
+       DCA I TEMP      /SUBSTITUTE IT
+NOR,   TAD GPTR1
+       CDF
+       JMS I (PNMSUB
+       TAD I (OPT1
+       RTL
+       SNL CLA
+       JMP SKPBLK
+       JMS I (CONVTP
+       TAD I (BLOCK
+       JMS BSPACE      /(MH) PATCH FOR /B/E
+SKPBLK,        TAD I (OPT1
+       AND (100
+       SZA CLA
+       JMP NODATE
+       TAD IFCNT
+       CIA
+       JMS I (PRNUM
+       TAD INFWDS
+       SNA CLA
+       JMP NODATE
+       CDF
+       TAD I GPTR1
+       CDF 10
+       JMS I (PDATE
+NODATE,        ISZ LNCNT       /IS LINE FILLED?
+       JMP MOROLN      /NO
+       JMS CRLF
+       TAD ALNCNT      /RESET COUNT
+       DCA LNCNT
+       JMP I (NENT
+MOROLN,        TAD (5          /OUTPUT 5 BLANKS
+       JMS I (BLANK
+       JMP I (NENT
+
+/BLANKS ROUTINE
+BLANK, 0
+       CIA
+       DCA BLTMP
+       JMS I (CONVTP
+       ISZ BLTMP
+       JMP .-2
+       JMP I BLANK
+BLTMP, 0
+
+
+ALNCNT,        0
+LNCNT, 0
+
+OUTCHR,        0
+       JMP I RPOS
+RPOS1, DCA I OCPTR
+       JMS RPOS
+RPOS2, DCA HOLD
+       JMS RPOS
+RPOS3, RTL
+       RTL
+       DCA HOLD2
+       TAD HOLD2
+       AND (7400
+       TAD I OCPTR
+       DCA I OCPTR
+       ISZ OCPTR
+       TAD HOLD2
+       RTL
+       RTL
+       AND (7400
+       TAD HOLD
+       DCA I OCPTR
+       ISZ OCPTR
+       ISZ OUWDCT
+       SKP
+       JMS DUMP
+       JMS RPOS
+       JMP RPOS1
+RPOS,  RPOS1
+       JMP I OUTCHR
+
+OUWDCT,        0
+OCPTR, 0
+HOLD,  0
+HOLD2, 0
+BSPACE,        0       /(MH) PATCH FOR /B/E
+       JMS I   (OPRNT
+       CLA!IAC
+       JMS I   (BLANK
+       JMP I   BSPACE
+
+       PAGE
+\f
+GTSXBT,        HLT
+       CLL RAL
+       TAD CNT
+       CML RAR
+       DCA TEMP
+       TAD I TEMP
+       SNL
+       JMS ROTR6
+       AND (77
+       JMP I GTSXBT
+
+
+ROTR6, 0
+       RTR
+       RTR
+       RTR
+       JMP I ROTR6
+
+CONVTP,        HLT
+       SZA
+       TAD (240
+       AND (77
+       TAD (240
+       JMS I OSWTCH
+       JMP I CONVTP
+
+TYPE,  HLT
+       DCA HOLD1
+       TAD (217
+       JMS I (CTYPE
+       SKP
+       DCA ECHO
+       TAD ECHO
+       SNA CLA
+       JMP I TYPE
+       JMS I (CINTER
+       SKP
+       JMP I (ABORT
+       TAD HOLD1
+       JMS TTY
+       JMP I TYPE
+
+HOLD1, 0
+
+TTY,   0
+       TLS
+       TSF
+       JMP .-1
+       TAD (-215
+       SZA CLA
+       JMP I TTY
+       TAD (12
+       JMP TTY+1
+
+ECHO,  1
+
+OPRNT, 0
+       DCA GTSXBT
+       TAD (-4
+       DCA CNT
+OPLP,  TAD GTSXBT
+       RTL CLL
+       RAL
+       DCA GTSXBT
+       TAD GTSXBT
+       RAL
+       AND (7
+       TAD (260
+       JMS I (CONVTP
+       ISZ CNT
+       JMP OPLP
+       JMP I OPRNT
+
+
+/ROUTINE TO MAKE SURE USER SPECIFIED
+//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE
+
+DATCHK,        0
+       TAD I (OPT1     /CHECK /C
+       JMS MDATE
+       NOP             /RETURN HERE WITH AC=0 IF NO /C
+       SZA CLA         /RETURN HERE WITH AC=0 IF DATES MATCH
+       JMP I (NENT     /DATES DONT MATCH AND /C GIVEN
+       TAD I (OPT2     /CHECK /V
+       JMS MDATE
+       CMA CLA         /SET AC=-1 IF NO /V
+       SNA CLA         /RETURN HERE AC=0 IF DATES SAME
+       JMP I (NENT     /DATES SAME WITH /V-IGNORE FILE
+       JMP I DATCHK    /CONTINUE
+
+MDATE, 0               //O AND /V ARE AC2
+       RTL             /IS IT OPTION ON?
+       SMA CLA         /SKIP IF IT IS
+       JMP I MDATE     /NO- RETURN WITH 0 AC
+       ISZ MDATE       /SKIP RETURN
+       CDF 0
+       TAD I GPTR1     /GET DATE WORD
+       CIA
+       CDF 10
+       TAD I (DATE     /COMPARE WITH MONITORS, 0 IF =
+       JMP I MDATE
+
+       PAGE
+\f
+PRNUM, 0
+       DCA NUM
+       TAD (PWRTEN
+       DCA PTR
+PRNTLP,        ISZ MPNTCNT
+       SKP
+       AC4000
+       DCA PNTFLG
+       DCA DIG
+DIVLPY,        TAD I PTR
+       SNA
+       JMP I PRNUM
+       CLL
+       TAD NUM
+       SNL
+       JMP PRTDIG
+       DCA NUM
+       ISZ DIG
+       JMP DIVLPY
+PRTDIG,        CLA
+       TAD DIG
+       TAD PNTFLG
+       SNA
+STPBLK,        JMP PRBLNK
+       TAD (260
+       JMS I (CONVTP
+       CLA CLL CML RAR
+NXTPWR,        ISZ PTR
+       JMP PRNTLP
+PRBLNK,        JMS I (CONVTP
+       JMP NXTPWR
+
+NUM,   0
+PNTFLG,        0
+DIG,   0
+MPNTCNT,0
+
+PWRTEN,        -1750;-144;-12;-1;0
+
+PDATE, 0
+       SNA
+       JMP FDATE
+       DCA DATEY
+       TAD     DATNOW  /WAS A DATE ENTERED AT BOOT TIME?(MH)
+       SNA             /SKIP IF SO(MH)
+       JMP     FDATE   /NO -- DON'T PRINT DATE IF NOT ENTERED(MH)
+       AND     (7      /YES -- SAVE YR NEGATED(MH)
+       CMA!IAC         /(MH)
+       DCA     DATTMP  /SAVE THIS RESULT TEMP(MH)
+       ISZ I (STPBLK
+       JMS I (CONVTP
+       ACM3
+       DCA I (MPNTCNT
+       TAD DATEY
+       RTR
+       RAR
+       AND (37
+       JMS I (PRNUM
+       TAD ("-
+       JMS I (CONVTP
+       TAD DATEY
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA PRNUM
+       TAD PRNUM
+       TAD PRNUM
+       TAD PRNUM
+       TAD (DATTAB-4
+       DCA XR
+       ACM3
+       DCA CNT
+       TAD I XR
+       JMS I OSWTCH
+       ISZ CNT
+       JMP .-3
+       TAD ("-
+       JMS I OSWTCH
+       TAD DATEY
+       AND (7
+       TAD     DATTMP  /ADD -ENTERED YR(MH)
+       CLL             /CLEAR LINK FOR FLAG USE(MH)
+       SZA!SMA!CLA     /SKIP AND CLEAR IF ENTERED YR BIGGER,SAME(MH)
+       CML             /SET LINK IF DIR YR BIGGER THAN ENETERED YR (MH)
+       TAD     DATEY   /GET DATE BACK(MH)
+       AND     (7      /GET THE YR(MH)
+       SZL             /SKIP IF ENTERED YR WAS BIG OR SAME(MH)
+       TAD     (-10    /SUBTRACT 10 OCTAL IF DIR YR WAS BIGGER(MH)
+       TAD     DATINC  /ADD DATE INCREMENT(MH)
+       TAD (106
+       JMS I (PRNUM
+       CLA CMA
+       TAD I (STPBLK
+       DCA I (STPBLK
+       JMP I PDATE
+FDATE, TAD I (LNCNT    /SEE IF AT END OF LINE?
+       IAC             /AC=0 NOW IF YES
+       SNA CLA         /OUT PUT SPACES TO FILL DATE SLOT
+       JMP I PDATE     /NO NEED FOR SPACES IF AT END OF LINE
+       TAD (12         /10 SPACES IS WHATS NEEDED
+       JMS I (BLANK
+       JMP I PDATE     /LEAVE
+
+DATEY, 0
+DATNOW,        0       /CURRENT DATE IF ONE WAS ENTERED(MH)
+DATINC,        0       /DATE ENXTENSION TO 1970 (0,10,20, OR 30) (MH)
+DATTMP,        0       /TEMP STORE (MH)
+
+       PAGE
+\f
+CTYPE, 0
+       DCA T2
+       TAD (200
+       KRS
+       CIA
+       TAD T2
+       SNA CLA
+       KSF
+       JMP I CTYPE
+       KCC
+       TAD ("^
+       JMS I (TTY
+       TAD T2
+       TAD (100
+       JMS I (TTY
+       TAD (215
+       JMS I (TTY
+       ISZ CTYPE
+       JMP I CTYPE
+
+T2,    0
+
+CINTER,        0
+       TAD (203
+       JMS CTYPE
+       JMP UPPCK
+       JMP SPURGE
+UPPCK, TAD (220
+       JMS CTYPE
+       JMP I CINTER
+       SKP
+SPURGE,        CMA
+       DCA I (ALTOPT
+       ISZ CINTER
+       JMP I CINTER
+
+HEMPTY,        0
+       CDF 0
+       TAD I EPTR
+       CDF 10
+       CIA
+       TAD ECOUNT
+       DCA ECOUNT
+       TAD I (OPT1
+       AND (200
+       SZA CLA
+       JMP LISTEM
+       TAD I (OPT2
+       SMA CLA
+       JMP I HEMPTY
+LISTEM,        TAD I (OPT1
+       AND (10         /IS /I GIVEN
+       SNA CLA         /IF YES PAD BY ADDIDTIONAL INFO WORDS
+       JMP EMSG
+       CLA CMA
+       TAD INFWDS      /NUMBER OF SPACES=5*(INFWDS-1)
+       DCA DFLAG
+       TAD DFLAG
+       RTL CLL
+       TAD DFLAG
+       SZA             /DONT OUTPUT 4096 BLANKS
+       JMS I (BLANK
+EMSG,  TAD (EMPTYM-1
+       DCA XR1
+       TAD (-11
+       DCA CNT
+EOLP,  TAD I XR1
+       JMS I (OUTCHR
+       ISZ CNT
+       JMP EOLP
+       TAD I (OPT1
+       RTL
+       SNL CLA
+       JMP SKIPES
+       JMS I (CONVTP
+       TAD I (BLOCK
+       JMS I   (BSPACE /(MH) PATCH FOR /B/E
+SKIPES,        CDF 0
+       TAD I EPTR
+       CDF 10
+       CIA
+       JMS I (PRNUM
+       ISZ I (LNCNT    /AT END OF LINE
+       JMP WORK        /NO. HAVE TO DO BLANK PADDING
+       JMS I (CRLF
+       TAD I (ALNCNT   /RESET COUNT
+       DCA I (LNCNT
+       JMP I HEMPTY
+WORK,  TAD (5          /FORCES 5 BLANKS
+       JMS I (BLANK
+       TAD I (OPT1
+       AND (100        /CHECK FOR /F
+       SZA CLA         /ADD 10 SPACES TO COVER DATE
+       JMP I HEMPTY
+       TAD (12
+       JMS I (BLANK
+       JMP I HEMPTY
+
+ECOUNT,        0
+
+       PAGE
+\f
+PNMSUB,        0
+       DCA NMEPLC
+       RDF
+       TAD (CDF
+       DCA FLDFUD
+       TAD (-10
+       DCA CNT
+PNLOOP,        TAD NMEPLC
+FLDFUD,        HLT
+       JMS I (GTSXBT
+       CDF 10
+       JMS I (CONVTP
+       TAD (3
+       TAD CNT
+       SZA CLA
+       JMP .+3
+       TAD (".
+       JMS I OSWTCH
+       ISZ CNT
+       JMP PNLOOP
+       JMP I PNMSUB
+
+NMEPLC,        0
+
+WRTERR,        JMS I (ERROR
+       OUERR+40
+       JMP I (EOLIN
+CLOERR,        JMS I (ERROR
+       CLERR+40
+       JMP I (EOLIN
+NOROOM,        JMS I (ERROR
+       SPRBLM+40
+       JMP I (EOLIN
+IDBLVT,        JMS I (ERROR
+       NOTTY+40
+       JMP I (EOLIN
+
+SAYNON,        TAD (OUTCHR
+       DCA OSWTCH
+       JMS I (CRLF
+       JMS I (CRLF
+       TAD (-4         /FORCE PRINTING OF ONLY 1 DIGIT
+       DCA I (MPNTCNT  /FOR 0 FREE BLOCKS
+       TAD I (ECOUNT
+       JMS I (PRNUM
+       JMS I (CONVTP
+       TAD (FRBLM-1
+       DCA XR1
+       TAD (-13
+       DCA CNT
+FRBLP, TAD I XR1
+       JMS I (OUTCHR
+       ISZ CNT
+       JMP FRBLP
+       JMS I (CRLF
+       TAD (14         /FORM FEED
+       JMS I (OUTCHR
+       TAD MOIN
+       JMP I (DOMOIN
+
+MOIN,  0
+
+CRLF,  0
+       TAD (215
+       JMS OUTCHR
+       TAD (212
+       JMS OUTCHR
+       JMP I CRLF
+
+/ROUTINE TO DUMP ADDITIONAL INFO WORDS IF WANTED
+
+ADDINF,        0
+       TAD I (OPT1
+       AND (10         /CHECK /I SWITCH
+       SNA CLA
+       JMP I ADDINF
+       CLA CMA
+       TAD INFWDS      /GET NUMBER
+       SPA SNA         /MUST BE 2 OR MORE TO PRINT
+       JMP CLARET      /RETURN
+       CIA
+       DCA CNTX
+       TAD GPTR1
+       IAC             /BUMP TO FIRST ONE
+       DCA PGPTR1
+ADDLP, CDF 0
+       TAD I PGPTR1    /GET WORD
+       CDF 10
+       JMS I (OPRNT    /PRINT IT IN OCTAL
+       JMS I (CONVTP   /OUTPUT A BLANK
+       ISZ PGPTR1      /BUMP
+       ISZ CNTX        /COUNT NUMBER
+       JMP ADDLP
+CLARET,        CLA             /RETRN
+       JMP I ADDINF
+
+PGPTR1,        0
+CNTX,  0
+
+       PAGE
+\f
+VERNO, TEXT /DIRECT V6A /
+BADIRD,        TEXT /ERROR READING INPUT DIRECTORY/
+SPRBLM,        TEXT /NO ROOM FOR OUTPUT FILE/
+OUERR, TEXT /ERROR WRITING FILE/
+CLERR, TEXT /ERROR CLOSING FILE/
+NFLEIN,        TEXT /DEVICE DOES NOT HAVE DIRECTORY/
+BIGEQ, TEXT /EQUALS OPTION BAD/
+ILLQ,  TEXT /ILLEGAL ?/
+ILLA,  TEXT /ILLEGAL */
+BADDIR,        TEXT /BAD INPUT DIRECTORY/
+NOTTY, TEXT /THERE IS NO HOPE-THERE IS NO TTY HANDLER IN YOUR SYSTEM/
+EMPTYM,        "<;"E;"M;"P;"T;"Y;">;240;240
+FRBLM, "F;"R;"E;"E;240;"B;"L;"O;"C;"K;"S
+
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+DATTAB, "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
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+
+DUMP,  0
+       TAD I (LENGTH   /GET LENGTH AVAILABLE
+       SNA             /IF ZERO ITS NON FILE STRUCTURE
+       JMP NOMATR      /IF ZERO DOESNT MATTER
+       CLL
+       TAD I (CLEN     /ADD CURRENT SIZE
+       TAD (5          /ADD # OF BLOCKS
+       SZL CLA         /WE ARE OK IF SKIPS
+       JMP I (NOROOM
+       TAD I (CLEN     /UPDATE CLOSING LENGTH
+       TAD (5          /BY NUMBER OF BLOCKS
+       DCA I (CLEN     /SAVE FOR CLOSE
+NOMATR,        TAD OUWDCT
+       TAD (5210
+       DCA CTLWD
+       CIF 0
+       JMS I OUHAND
+CTLWD, 5210
+BUFAD, BUF
+BLCKN, 0
+       JMP WRTERR
+       TAD (5
+       TAD BLCKN       /UPDATE BLOCK # BY 5
+       DCA BLCKN
+       TAD (-1200
+       DCA OUWDCT
+       TAD BUFAD
+       DCA OCPTR
+       JMP I DUMP
+/
+\f
+       *4600
+
+       JMS INIT
+       JMS INIT
+       JMP I (2000
+       JMP I (2001
+INIT,  0
+       ISZ INIT
+       CLA CLL
+       TAD (2000
+       CDF 0
+       DCA I (7745
+       TAD (6403
+       DCA I (7746
+       CDF 10
+       JMP I INIT
+       $