/1
	.EXTERNAL PRINT,FREEDV,READI,CRLF,OPRINT,DPRINT
	.EXTERNAL SLOTAB
	.ENTRY DIRT,ZEROSL,CNTSLT

	FAST=20
	EXTEN=22

	X0=10

	.MACRO .PRINT ARG
	JMS I (PRINT
	TEXT	"ARG"
	.ENDM

	.RSECT OV2,LEVEL=1,OVERLAY=2
	FIELD 1

	.NOLIST ME,MEB

DIRT,	0
	JMS I (READI
	1400		/READ 6 BLOCKS
	4000		/INTO 04000
	1		/FROM BLOCK 1
	JMS I (DVALID	/CHECK IF VALID DIRECTORY
	TAD FAST
	SNA CLA
	JMP I DIRT	/NO DIRECT IN FAST MODE
	JMS I (CRLF
	DCA USED
	DCA UNUSED
	DCA NFILES
	DCA NMTS
	DCA NSEGS
	STL CLA RAR	/4000
LUP$:	DCA DIRPTR
	ISZ NSEGS
	JMS GETDIR
	DCA NENTRY	/- NO. OF ENTRIES IN SEGMENT
	JMS GETDIR
	DCA STBLK	/STARTING BLOCK # OF FIRST FILE IN SEGMENT
	JMS GETDIR
	DCA LINK	/LINK TO NEXT SEGMENT
	JMS GETDIR
	CLA		/IGNORE FLAG WORD TO TENTATIVE FILE
	JMS GETDIR
	DCA AIW		/# OF ADDITIONAL INFO WORDS
	TAD NENTRY
	DCA DKNT
L$:	JMS GETDIR
	SNA CLA
	JMP MT$		/AN EMPTY ENTRY
	TAD AIW
	CIA
	TAD (3
	TAD DIRPTR
	DCA DIRPTR	/POINT TO FILE LENGTH
	JMS GETDIR	/GET NEG OF NUMBER OF BLOCKS IN FILE
	SNA
	JMP 2$	/A TENTATIVE FILE, IGNORE
	CIA
	TAD USED
	DCA USED
	ISZ NFILES
	JMP 2$
MT$:	JMS GETDIR
	CIA
	TAD UNUSED
	DCA UNUSED
	ISZ NMTS
2$:	ISZ DKNT	/ANY MORE ENTRIES IN THIS SEGMENT?
	JMP L$		/YES
	TAD LINK
	SNA CLA
	JMP 3$
	TAD NSEGS
	CMA
	TAD LINK	/ASSUME LINKS ARE IN ORDER
	SZA CLA
	JMP I (BADDIR
	STA		/GO TO NEXT SEGMENT
	TAD DIRPTR
	AND (7400
	TAD (400
	JMP LUP$

3$:	JMS I (PRINFO
LVDIR,	JMS I (CRLF
	JMS I (CRLF
	JMP I DIRT

DKNT,	0
USED,	0		/NO. OF BLOCKS USED
UNUSED,	0		/# OF UNUSED BLOCKS ON DEVICE
NFILES,	0		/# OF FILES
NMTS,	0		/# OF EMPTIES
NSEGS,	0		/# OF DIRECTORY SEGMENTS USED

NENTRY,	0		/- # OF ENTRIES IN SEGMENT
STBLK,	0		/STARTING BLOCK # OF FIRST FILE IN SEGMENT
LINK,	0		/LINK TO NEXT SEGMENT
AIW,	0		/# OF ADDITIOANAL INFORMATION WORDS

GETDIR,	0
	CDF 0
	TAD I DIRPTR
	CDF 10
	ISZ DIRPTR
	JMP I GETDIR

DIRPTR,	0
	PAGE

PRINFO,	0
	TAD EXTEN
	SNA CLA
	JMP 2$		/JUST # OF FREE BLOCKS UNLESS /E
	TAD I (NFILES
	SNA
	JMP 2$
	STL
	JMS I (DPRINT
	.PRINT " FILES IN "
	TAD I (USED
	STL
	JMS I (DPRINT
	.PRINT " BLOCKS"
	STA
	TAD I (NSEGS
	SNA CLA
	JMP 1$
	.PRINT " USING "
	TAD I (NSEGS
	STL
	JMS I (DPRINT
	.PRINT " SEGMENTS"
1$:	JMS I (CRLF
2$:	TAD I (UNUSED
	STL
	JMS I (DPRINT
	.PRINT " FREE BLOCKS"
	TAD EXTEN
	SNA CLA
	JMP I PRINFO
	TAD I (NMTS
	CLL RAR
	SNA CLA
	JMP 3$
	.PRINT " ("
	TAD I (NMTS
	STL
	JMS I (DPRINT
	.PRINT " EMPTIES)"
3$:	CLA IAC
	TAD I (AIW
	SZA CLA
	JMS PRAIW
	JMP I PRINFO

PRAIW,	0
	JMS I (CRLF
	TAD I (AIW
	CIA
	STL
	JMS I (DPRINT
	.PRINT " EXTRA INFO WDS"
	JMP I PRAIW
	PAGE

DVALID,	0
	STL CLA RAR	/4000
	DCA I (DIRPTR
	JMS I (GETDIR
	CLL
	TAD (200
	SNL CLA
	JMP BADDIR
	JMS I (GETDIR
	SNA
	JMP BADDIR
	TAD (-400	/REMEMBER COS
	SMA CLA
	JMP BADDIR
	JMS I (GETDIR
	CLA		/LINKS THOROUGHLY CHECKED ELSEWHERE
	JMS I (GETDIR
	SNA
	JMP OKDIR
	TAD (-1400
	CLL
	TAD (-1000
	SZL CLA
	JMP BADDIR
OKDIR,	JMS I (GETDIR
	SPA SNA CLA
	JMP I DVALID
BADDIR,	.PRINT "?BAD DIRECTORY"
	JMP I (LVDIR

SLTM,	0

SLKNT,
ZEROSL,	0
	TAD (-10
	DCA SLTM
	TAD (SLOTAB-1
	DCA X0
	DCA I X0
	ISZ SLTM
	JMP .-2
	JMP I ZEROSL

CNTSLT,	0
	TAD (-10
	DCA SLTM
	DCA SLKNT
	TAD (SLOTAB-1
	DCA X0
L$:	TAD I X0
	SNA CLA
	ISZ SLKNT
	ISZ SLTM
	JMP L$
	.PRINT "FREE DEVICE SLOTS: "
	TAD I (FREEDV
	JMS XPRINT
	.PRINT ",  FREE BLOCK SLOTS: "
	TAD SLKNT
	JMS XPRINT
	JMS I (CRLF
	JMP I CNTSLT

XPRINT,	0
	SNA
	JMP 1$
	JMS I (OPRINT
	JMP I XPRINT

1$:	.PRINT "NONE"
	JMP I XPRINT
	PAGE