File: DIRECT.PA of Tape: OS8/OS8-V3/dec-s8-osysb-a-ua8
(Source file text)
/ OS/8 V3 DIRECT
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1974 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.
/
/
/
/
/
/
/
/
/
/
/JANUARY 17, 1974 H.J.
/DIRECTORY LISTING PROGRAM
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
BUF=5200 /THE FILE OUTPUT BUFFER
/5 BLOCKS LONG, TO 7577
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
/ 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 #
SZA CLA /SKIP IF JUST DUMPED ONE
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
ABORT, TAD I (ALTOPT
SMA CLA
JMP I (CDCALL
CIF CDF 0
JMP I (7605
BADEQ, JMS I (ERROR
BIGEQ+40
JMP I (EOLIN
PAGE
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 (RPOS1
DCA I (RPOS
TAD (-1200 /NUMBER OF WORDS IN BUFFER
DCA I (OUWDCT
DCA I (CLEN
TAD I (7605
SNA
AC2
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
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
PAGE
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
PAGE
/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
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
/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
GOT1, 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 I (OPRNT
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
PAGE
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
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
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 (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
PAGE
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 (OPRNT
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
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
VERNO, TEXT /DIRECT V3 /
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
PAGE
*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
$