C** DIRECTORY  ** PROGRAM TO LIST DISK DIRECTORIES ***
C
C
	IMPLICIT INTEGER*2(A-Z)
	INTEGER  VVS(5), FTAB(7), SARRAY(8,250), UNUSED(3), SORDER(6,4)
	INTEGER    IBUF(512), OBUF(256), IRB(250), ILB(250), IORD(250)
	INTEGER  LKBLK(4),MONTHS(12),UDATE(4),DIR(2)
	LOGICAL *1 CHARS(11),CR, SPACE, PATRNS(11,6),IREV
	INTEGER    FSPEC(39),SWITS(4,15),DEFEXT(4)
	COMMON /OBUF/OBUF,CLOC,CBLK,OCHAN
	COMMON /IBUF/IBUF,ICHAN
	COMMON /ABORT/ABORT
C
C+++SARRAY FORMAT:
C	(1,N)=NAME (RAD50)
C	(2,N)=NAME
C	(3,N)=EXT  (RAD50)
C	(4,N)=BLOCKS
C	(5,N)=FDAY
C	(6,N)=FMONTH
C	(7,N)=FYEAR
C	(8,N)=STARTING BLOCK NUMBER
C
C***** SWITCH FORMATS:
C	/B= LIST STARTING BLOCK OF EACH FILE
C	/C:N= MAKE N COLUMNS ON OUTPUT
C	/E=   INCLUDE EMPTY SPACES IN LISTING
C	/Q=    DO NOT PRINT DATE OR SIZE
C	/L=    DEFAULT, LIST DIRECTORY
C	/M=    LIST ONLY UNUSED SPACES (/S:POS ONLY)
C	/V=    INCLUDE DIRECTORY''S VERSION NUMBER
C	/F=    PRINT NUMBER OF FREE BLOCKS
C	/S:NNN  SORT BY 'EXT','NAM','DAT','POS', 'SIZ', DEFAULT IS 'NAM'
C	/D[:BEF][!DAY:MON!YER]= INCLUDE ONLY THOSE [BEFORE] OR AFTER THIS DATE
C	/H=    PRINT HELP OF SWITCH SYNTAX ON TERMINAL.
C
C /S TAKES :NAM, :EXT, :DAT, :SIZ, :POS
C A 2ND /S CAN TAKE :REV TO REVERSE OUTPUT ORDER
	DATA SWITS(1,1)/'H'/, SWITS(1,2)/'B'/, SWITS(1,3)/'C'/,
	+SWITS(1,4)/'E'/, SWITS(1,5)/'Q'/, SWITS(1,6)/'L'/,
	+SWITS(1,7)/'M'/, SWITS(1,8)/'V'/, SWITS(1,9)/'F'/,
	+SWITS(1,10)/'S'/, SWITS(1,11)/'S'/, SWITS(1,12)/'D'/,
	+SWITS(1,13)/'D'/, SWITS(1,14)/'D'/, SWITS(1,15)/'D'/
C
	DATA SORDER/1,2,3,7,6,5,
	+           3,1,2,7,6,5,
	+           7,6,5,1,2,3,
	+           4,1,2,3,7,6/	!BY NAME,EXT,DATE,SIZE
C
	DATA ICHAN/0/,OCHAN/0/
	DATA LKBLK/4*0/,REV/3RREV/
	DATA VVS/3RNAM,3REXT,3RDAT,3RSIZ,3RPOS/
	DATA FTAB/1,16,20,24,28,32,36/
	DATA UNUSED/"130002,"20044,"131574/		!".FREE...."
	DATA TT/3RTT /, DK/3RDK /, DIR/3RDIR,3RECT/
	DATA DEFEXT/"132500,3RDIR,0,0/
	DATA CR/"15/, SPACE/"40/
	DATA EOFSM/"4000/,PERM/"2000/,EMPTY/"1000/,BEFORE/3RBEF/
	DATA MONTHS/3RJAN,3RFEB,3RMAR,3RAPR,3RMAY,3RJUN,3RJUL,
	+3RAUG,3RSEP,3ROCT,3RNOV,3RDEC/
C
C
	IF (ICHAN.NE.0.OR.OCHAN.NE.0) GOTO 2		!THIS IS FOR RESTARTS
	ICOLS=2				!**DEFAULT COLUMNS FOR /C
	OCHAN=IGETC()
	ICHAN=IGETC()
C
2	CALL RCTRLO
	DO 4 I=1,250
4	IORD(I)=I		!SET UP FOR A 'POS' PRINTOUT
	CLOC=1
	CBLK=0
	I=ICSI(FSPEC,DEFEXT,,SWITS,15)
	IF (I.EQ.0) GOTO 8
	IF (I.EQ.3) GOTO 6
	CALL OUTMSG('*ILLEGAL COMMAND*')
	GOTO 2
6	CALL OUTMSG('*BAD SWITCH*')
	GOTO 2
8	CONTINUE
	IF (SWITS (2,1) .EQ. 0) GO TO 10
	CALL RCTRLO					!/H
	CALL PRINT ('DIRECTORY SWITCH FORMATS:')
	CALL PRINT ('/B    INCLUDE STARTING BLOCK NUMBER')
	CALL PRINT ('/C:N  FORMAT DIRECTORY INTO N COLUMNS')
	CALL PRINT ('/D[:BEF][!DAY:MON!YER]   INCLUDE ONLY FILES [BEFORE] OR
	+ AFTER THIS DATE')
	CALL PRINT ('/E    INCLUDE EMPTY SPACES ON THE DISK')
	CALL PRINT ('/F    TO PRINT NUMBER OF FREE BLOCKS ON DISK')
	CALL PRINT ('/H    TO PRINT THIS HELP ON THE TERMINAL')
	CALL PRINT ('/L    LIST THE DIRECTORY (DEFAULT)')
	CALL PRINT ('/M    INCLUDE ONLY UNUSED SPACES ON THE DISK ONLY')
	CALL PRINT ('/Q    DO NOT PRINT FILES'' DATE OR SIZE')
	CALL PRINT ('/S[:NAM][:EXT][POS][DAT][SIZ]   SORT BY NAME,EXTEN
	+TION,DISK POSITION,')
	CALL PRINT ('          FILE SIZE, OR DATE. ALSO /S:REV TO
	+ REVERSE ORDER.')
	CALL PRINT ('/V    TO PRINT DIRECTORYS VERSION NUMBER')
	CALL PRINT ('    NO SWITCH = /L/S:NAM')
	CALL PRINT ('    NAME OR EXTENSION MAY BE "*", MEANING "ALL"')
	CALL PRINT ('    DEFAULT FILE NAME IS *.*')
	GO TO 2
C
10	CONTINUE
	IF (SWITS(2,2).EQ.2) GOTO 6
	IF (SWITS(2,3).EQ.1) GOTO 6
	IF (SWITS(2,4).EQ.2) GOTO 6
	IF (SWITS(2,5).EQ.2) GOTO 6
	IF (SWITS(2,6).EQ.2) GOTO 6
	IF (SWITS(2,7).EQ.2) GOTO 6
	IF (SWITS(2,8).EQ.2) GOTO 6
	IF (SWITS(2,9).EQ.2) GOTO 6
	IF (SWITS(2,11).EQ.1) GOTO 6
	IF (SWITS(2,10).EQ.1) GOTO 6
	IREV=.FALSE.					!ASSUME ACCENDING SORT
	IF (SWITS(4,10) .EQ. REV .OR. SWITS(4,11) .EQ. REV) IREV=.TRUE.
	IF (SWITS(2,10).NE.2) SWITS(4,10)=VVS(1)	!**DEFAULT SORT=NAME
	IF (SWITS(2,11).NE.2) SWITS(4,11)=VVS(1)	!**DEFAULT SORT=NAME
	IF (SWITS(2,7).GT.0) SWITS(4,10)=VVS(5)		!EXCEPT /M IS POS ONLY
	DO 12 I=10,11
	DO 12 ISORT=1,5
	IF (SWITS(4,I).EQ.VVS(ISORT)) GOTO 14			!/S
12	CONTINUE
	GOTO 6
C
14	CONTINUE
	IF (SWITS(2,3).NE.2) SWITS(4,3)=ICOLS			!STAYS SET UNTIL CHANGED
	IF (SWITS(4,3).LE.8.AND.SWITS(4,3).GT.0) GOTO 16
	CALL OUTMSG('*COLUMN COUNT OUT OF RANGE*')
	GOTO 2
16	CALL IDATE(MONTH,DAY,YEAR)
	ICOLS=SWITS(4,3)
C
C--IF A /D WAS SPECIFIED, FIGURE IT OUT
C
	DO 18 I=1,4
18	UDATE(I)=0
	IF (SWITS(2,12)-1) 28, 20, 22
20	IF ((SWITS(2,13)+SWITS(2,14)+SWITS(2,15)).NE.0) GOTO 6
	SWITS(4,12)=DAY
	SWITS(4,13)=MONTHS(MONTH)		!/D WITHOUT ARGUMENTS=TODAY
	SWITS(4,14)=YEAR
22	UDATE(4)=1
	UDATE(3)=YEAR
	DO 26 J=12,15
	IF (SWITS(4,J).EQ.BEFORE) UDATE(4)=-UDATE(4)
	IF (SWITS(4,J).GT.0.AND.SWITS(4,J).LE.31) UDATE(1)=SWITS(4,J)
	DO 24 I=1,12
24	IF (SWITS(4,J).EQ.MONTHS(I)) UDATE(2)=I
	IF (SWITS(4,J).LE.71.AND.SWITS(4,J).GE.58)
	+ UDATE(3)=SWITS(4,J)+14
	IF (SWITS(4,J).GE.72.AND.SWITS(4,J).LE.99) 
	+ UDATE(3)=SWITS(4,J)
26	CONTINUE
28	CONTINUE
C
30	DO 32 I=2,7					!SET UP DEFAULT AS WILDCARDS
	IF (FSPEC(FTAB(I)+1).EQ.0) FSPEC(FTAB(I)+1)="132500
	IF (FSPEC(FTAB(I)+3).EQ.0) FSPEC(FTAB(I)+1)="132500
32	CONTINUE
	IF (FSPEC(1).EQ.0) FSPEC(1)=TT
	IF (FSPEC(16).EQ.0) FSPEC(16)=DK
	IF (FSPEC(2) .NE. 0) GO TO 33
	FSPEC(2)=DIR(1)
	FSPEC(3)=DIR(2)		!**DEFAULT OUTPUT FILENAME=DIRECT.DIR
C
33	DO 34 J=1,2				!GET HANDLERS
	I=IFETCH(FSPEC(FTAB(J)))
	IF (I.EQ.0) GOTO 34
	IF (I.EQ.2) CALL OUTMSG('*NOT ENOUGH CORE SPACE*')
	IF (I.EQ.1.OR.I.EQ.3) CALL OUTMSG('*NO HANDLER*')
	GOTO 2
34	CONTINUE
C
	I=IENTER(OCHAN,FSPEC(1),FSPEC(5))		!OPEN OUTPUT
	IF (I.GT.0) GOTO 36
	CALL OUTMSG('*OUTPUT OPEN FAILURE*')
	GOTO 2
C
36	CALL OUTDAT(DAY,MONTH,YEAR)
	IF (SWITS(2,8)) CALL MOVE('   DIRECT V1',10)		!/V
	CALL OUTCHR(CR)
C
	DO 38 I=1,6
	J=I+I+I+I				!GET INPUT SPECIFICATIONS
	IF (FSPEC(J+12).EQ.0) GOTO 40
	PATRNS(11,I)=SPACE
	PATRNS(7,I)=SPACE
	CALL R50ASC(6,FSPEC(J+13),PATRNS(1,I))
	CALL R50ASC(3,FSPEC(J+15),PATRNS(8,I))
38	CONTINUE
40	INSPCS=I-1
C
	LKBLK(1)=FSPEC(16)		!DEVICE
	I=LOOKUP(ICHAN,LKBLK)
	IF (I.GE.0) GOTO 42
	CALL OUTMSG('*INPUT OPEN FAILURE*')
	GOTO 2
C
C+++READ THE DIRECTORY BLOCKS
C
42	SEG=1
	NUMBER=0			!NUMBER OF FILES TO SORT
	FCNT=0				!NUMBER OF FILES FOUND
	FSIZ=0
	EBLKS=0
	COLCNT=0
44	I=IREADW(512,IBUF,SEG*2+4,ICHAN)		!READ A DIRECTORY BLOCK
	IF (I.GT.0) GOTO 46
	CALL OUTMSG('*DIRECTORY I/O ERROR*')
	GOTO 2
C
46	DPTR=-1-IBUF(4)
	BLKNUM=IBUF(5)
48	DPTR=DPTR+7+IBUF(4)
	IF (SWITS(2,7).EQ.1 .OR. SWITS(2,9) .EQ. 1) GOTO 68		!/F&/M
	IF ((IBUF(DPTR).AND.PERM).EQ.0) GOTO 68
C
C--CHECK THIS FILE NAME AGAINST EACH INPUT FILE SPECIFICATION
C
	CALL R50ASC(6,IBUF(DPTR+1),CHARS(1))
	CALL R50ASC(3,IBUF(DPTR+3),CHARS(8))
	CHARS(7)=SPACE
	CHARS(11)=SPACE
	FLAG=0
	DO 50 I=1,INSPCS
	IF (MATCH(PATRNS(8,I),CHARS(8)).EQ.0) GOTO 50
	IF (MATCH(PATRNS(1,I),CHARS(1)).NE.0) FLAG=1
50	CONTINUE
C
	IF (FLAG .EQ. 0) GOTO 68			!/F
C
	FDAY=(IBUF(DPTR+6).AND."1740)/"40
	FMONTH=(IBUF(DPTR+6).AND."36000)/"2000		!GET FILES' DATE
	FYEAR=(IBUF(DPTR+6).AND."37)+"110
C
	IF (UDATE(4)) 58, 64, 52
52	IF (FYEAR-UDATE(3)) 68, 54, 64		!IF /D, THROW AWAY FILES NOT
54	IF (FMONTH-UDATE(2)) 68, 56, 64		!MATCHING DATA SPEC.
56	IF (FDAY-UDATE(1)) 68, 64, 64
58	IF (FYEAR-UDATE(3)) 64, 60, 68
60	IF (FMONTH-UDATE(2)) 64, 62, 68
62	IF (FDAY-UDATE(1)) 64, 68, 68
C
C--FOUND A FILE THAT MATCHES, SAVE IT'S DATA
C
64	FCNT=FCNT+1
	NUMBER=NUMBER+1
	FSIZ=FSIZ+IBUF(DPTR+4)
	DO 66 I=1,4			!SAVE NAME,EXT,BLOCKS
66	SARRAY(I,NUMBER)=IBUF(DPTR+I)
	SARRAY(5,NUMBER)=FDAY
	SARRAY(6,NUMBER)=FMONTH
	SARRAY(7,NUMBER)=FYEAR
	SARRAY(8,NUMBER)=BLKNUM		!STARTING BLOCK NUMBER
	GO TO 72
C
C--INCLUDE UNUSED BLOCKS
C
68	IF ((IBUF(DPTR).AND.EMPTY).EQ.0) GOTO 72
	EBLKS=EBLKS+IBUF(DPTR+4)
	IF ((SWITS(2,4).EQ.0).AND.(SWITS(2,7).EQ.0)) GOTO 72	!/E&/M
	NUMBER=NUMBER+1
	DO 70 I=1,3
	SARRAY(I,NUMBER)=UNUSED(I)		!SAVE ".FREE..."
70	SARRAY(I+4,NUMBER)=0			!NO DATE
	SARRAY(4,NUMBER)=IBUF(DPTR+4)
	SARRAY(8,NUMBER)=BLKNUM
C
72	BLKNUM=BLKNUM+IBUF(DPTR+4)
	IF (NUMBER .LT. 250) GO TO 74
	CALL OUTMSG ('*TOO MANY FILES*')
	GO TO 92
74	IF ((IBUF(DPTR).AND.EOFSM).EQ.0) GOTO 48	!NEXT FILE NAME
	SEG=IBUF(2)
	IF (SEG.NE.0) GOTO 44			!NEXT DIRECTORY SEGMENT
C
C+++SORT THE DATA INTO SPECIFIED ORDER. IF 'POS', IT'S ALREADY IN ORDER
C
	IF (NUMBER .EQ. 0) GO TO 90			!NOTHING TO SORT
	IF (ISORT .EQ. 5) GO TO 76
	CALL SORTIT (SARRAY,8,NUMBER,IORD,IRB,ILB,SORDER(1,ISORT),6)
C
C+++ PRINT OUT THE SAVED DATA IN THE SPECIFIED ORDER
C
76	CONTINUE
	X1=1
	X2=NUMBER			!ACCENDING SORT
	X3=1
	IF (.NOT. IREV) GO TO 78
	X1=NUMBER
	X2=1				!DECENDING (REVERSE) SORT
	X3=-1
78	DO 86 I=X1,X2,X3
	IFILE=IORD(I)
	CALL R50ASC(9,SARRAY(1,IFILE),CHARS(1))		!DECODE NAME
	CALL MOVE (CHARS(1),6)
	CALL OUTCHR('.')
	CALL MOVE(CHARS(7),3)
	IF (SWITS(2,5).EQ.1) GOTO 80		!/Q
	CALL OUTNUM(SARRAY(4,IFILE),5)
	CALL OUTDAT(SARRAY(5,IFILE),SARRAY(6,IFILE),SARRAY(7,IFILE))
C
80	IF (SWITS(2,2).EQ.0) GOTO 82		!/B
	CALL OUTNUM(SARRAY(8,IFILE),6)
C
82	COLCNT=COLCNT+1
	IF (SWITS(4,3).EQ.COLCNT) GOTO 84
	CALL BLANK(4)				!LINE HOUSEKEEPING
	GOTO 86
84	COLCNT=0
	CALL OUTCHR(CR)
86	CONTINUE
C
C--DONE,  PRINT SUMMARY INFO.
C
88	CONTINUE
	IF (COLCNT.NE.0) CALL OUTCHR(CR)
	IF (FCNT.EQ.0) GOTO 90
	CALL OUTNUM(FCNT,3)
	CALL MOVE(' FILES,',7)
	CALL OUTNUM(FSIZ,6)
	CALL MOVE(' BLOCKS',7)
	CALL OUTCHR(CR)
90	CALL OUTNUM(EBLKS,6)
	CALL MOVE(' FREE BLOCKS',12)
	CALL OUTCHR(CR)
C
92	DO 94 I=1,511			!CLEAR OUTPUT BUFFER
94	CALL OUTCHR(0)
	CALL CLOSEC(OCHAN)
	CALL CLOSEC(ICHAN)
	GOTO 2
C
	END
	SUBROUTINE OUTDAT(DAY,MONTH,YEAR)
C
	IMPLICIT INTEGER*2(A-Z)
	LOGICAL*1 DATES(3,16)
	DATA DATES/'B','A','D','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','B','A','D','B','A','D'/
C
	IF (DAY.NE.0.OR.MONTH.NE.0) GOTO 96
	CALL BLANK(10)
	RETURN
96	CALL OUTNUM(DAY,3)
	CALL OUTCHR('-')
	CALL MOVE(DATES(1,MONTH+1),3)
	CALL OUTCHR('-')
	CALL OUTNUM(YEAR,2)
	RETURN
	END
	SUBROUTINE OUTNUM(VALUE,SIZE)
C
	IMPLICIT INTEGER*2 (A-Z)
	LOGICAL*1 LOC(10)
C
	CALL ASCNUM(LOC,VALUE,SIZE)
	CALL MOVE(LOC,SIZE)
	RETURN
	END
	SUBROUTINE ASCNUM(LOC,VALUE,SIZE)
C
	IMPLICIT INTEGER*2 (A-Z)
	LOGICAL*1 LOC(1), SPACE
	DATA SPACE/"40/
C
	DO 98 I=1,SIZE
98	LOC(I)=SPACE
	I=SIZE
	J=VALUE
100	LOC(I)="60+J-10*(J/10)
	J=J/10
	I=I-1
	IF (J.NE.0) GOTO 100
	RETURN
	END
	SUBROUTINE BLANK(I)
C
	LOGICAL*1 BLANK
	DATA BLANK/"40/
C
	DO 102 J=1,I
102	CALL OUTCHR (BLANK)
	RETURN
	END
	SUBROUTINE MOVE(INCHRS,LEN)
C
	IMPLICIT INTEGER*2(A-Z)
	LOGICAL*1 INCHRS(1)
C
	COMMON /ABORT/ABORT
C
	DO 104 I=1,LEN
104	CALL OUTCHR(INCHRS(I))
	RETURN
	END
	SUBROUTINE OUTCHR(CHAR)
C
	IMPLICIT INTEGER*2 (A-Z)
	LOGICAL*1 OBUF(512),CHAR
	LOGICAL*1 CR,LF,CCHAR
C
	DATA CR/"15/,LF/"12/
	COMMON /OBUF/OBUF,CLOC,CBLK,OCHAN
	COMMON /ABORT/ABORT
C
	CCHAR=CHAR
106	IF (ABORT.EQ.1) RETURN
	OBUF(CLOC)=CCHAR
	CLOC=CLOC+1
	IF (CLOC.LE.512) GOTO 108
	I=IWRITW(256,OBUF,CBLK,OCHAN)
	CLOC=1
	CBLK=CBLK+1
	IF (I.GT.0) GOTO 108
	IF (I.EQ.-1) CALL OUTMSG('*FILE FULL*')
	IF (I.EQ.-2) CALL OUTMSG('*OUTPUT I/O ERROR*')
	ABORT=1
108	IF (CCHAR.NE.CR) RETURN
	CCHAR=LF
	GOTO 106
	END
	SUBROUTINE OUTMSG(STRING)
C
	IMPLICIT INTEGER*2 (A-Z)
C
	CALL RCTRLO
	CALL PRINT(STRING)
	RETURN
	END