--- /dev/null
+/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
+ $