/DIRECTORY LISTING PROGRAM.
/PRINTS DIRECTORY ON SYS: OR
/ON A DTA: (PUTR FORMAT).
/BY JOHN WILSON 26-JUN-84.
*0
	DUP		/TURN ON ECHO
	TAD (202	/LF,VT,FF,CR,ESC
	KSB		/SET KB BREAK
	TAD (7		/SET ^C VECTOR
	SRA
	JMP I .+1	/START PROGRAM
	200
	HLT		/^C ADDRESS
*10
POINT,	0	/AUTOINDEXING POINTER
DTAPTR,	0	/DECTAPE BUFFER POINTER
*20
UFD,	.+1
	0	/CHANNEL 0
	1	/SYS:[1]
	0	/PPN
	0	/PS
	0	/WD
/
MCB,	.+1
	0	/HIGH FILE ADDRESS
	0	/CHANNEL NUMBER
	0	/WORD COUNT
	0	/CORE ADDRESS
	0	/LOW FILE ADDRESS
	0	/ERROR ON RETURN
/
DSKBUF,	0	/BUFFER FOR UFD RECORD
	0
	0
	0
	0
	0
	0
	0
/
TYPE,	0	/ROUTINE TO PRINT .ASCIZ STRING AT @(PC) ON K:
	STA		/AC=-1
	TAD I TYPE	/GET PTR-1
	DCA POINT	/SAVE
TYPE1,	TAD I POINT	/GET A CHAR
	SNA		/SKIP IF .NE. 0
	JMP I TYPE	/ELSE RETURN
	TLS		/PRINT IT
	CLA
	JMP TYPE1	/LOOP
/
PRDEC,	0	/PRINT AC IN DECIMAL IN A FIELD OF COLUMN CHARS, PADDED WITH PAD
	DCA QUOTNT	/SAVE THE NUMBER
	DCA NUMTXT	/CLEAR CHAR CNT
	TAD (NUMEND	/POINT AT END OF STRING
	DCA NUMTXT+1
	TAD (-12	/GET RADIX (10.)
	DCA DIVSOR
PRDEC1,	JMS DIVIDE	/DIVIDE NUMBER BY 10.
	TAD ("0		/CONVERT REMAINDER TO ASCII
	TAD REMNDR
	DCA I NUMTXT+1	/PUT CHAR IN BUFF
	STA		/DEC PTR
	TAD NUMTXT+1
	DCA NUMTXT+1
	ISZ NUMTXT	/INC CTR (NEGATE LATER)
	ISZ COLUMN	/INC COLUMNS USED
	TAD QUOTNT	/ANYTHING LEFT FROM DIVISION?
	SZA CLA		/NO, EXIT
	JMP PRDEC1	/YES, LOOP
PRDEC2,	ISZ COLUMN	/FIELD FILLED?
	SKP		/CONTINUE IF NOT
	JMP PRDEC3	/ELSE EXIT LOOP
	STA		/DEC PTR
	TAD NUMTXT+1
	DCA NUMTXT+1
	TAD PAD		/GET PADDING CHAR
	DCA I NUMTXT+1	/PUT IN BUFFER
	ISZ NUMTXT	/INC CTR
	JMP PRDEC2	/LOOP
PRDEC3,	TAD NUMTXT	/NEGATE CHAR CNT
	CIA
	DCA NUMTXT	/REPLACE IT
	TAD (NUMTXT	/PRINT THE NUMBER
	SAS
	JMP .-2		/LOOP UNTIL ALL PUT IN TTY BUFF
	JMP I PRDEC	/RETURN
NUMTXT,	0	/LENGTH OF NUMBER
	0	/PTR TO BEGN OF NUMBER TEXT
	0	/ALLOW 4 DIGITS FOR NUMBER
	0
	0
NUMEND,	0	/LAST DIGIT
COLUMN,	0	/-<NUMBER OF COLUMNS IN FIELD +1>
PAD,	0	/CHARACTER TO PAD WITH
/
DIVIDE,	0	/DIVIDE QUOTNT BY -<DIVSOR>, GIVING QUOTNT AND REMNDR
	CLA
	TAD QUOTNT	/GET NUMBER
	DCA REMNDR	/SAVE IN REMAINDER
	DCA QUOTNT	/CLEAR NUMBER
	TAD REMNDR	/GET NUMBER BACK
DVD1,	CLL		/CLEAR LINK
	TAD DIVSOR	/SUBTRACT DIVISOR
	SNL		/SKIP IF NO BORROW
	JMP DVD2	/OTHERWISE JUMP OUT OF LOOP
	DCA REMNDR	/UPDATE REMAINDER
	ISZ QUOTNT	/UPDATE QUOTIENT
	TAD REMNDR	/GET REMAINDER BACK
	JMP DVD1	/LOOP
DVD2,	CLA
	JMP I DIVIDE	/RETURN
QUOTNT,	0	/QUOTIENT
DIVSOR,	0	/DIVISOR
REMNDR,	0	/REMAINDER
/
KBBUF,	0	/KB BUFFER - WORD COUNT
	0	/ADDR
	0	/2 CHARS (DIGIT, LF/VT/FF/CR/ESC)
	0
/
	PAGE
BSW=7002	/PALD BUG, BSW NOT ON PERM. SYMBOL TABLE
/
BEG,	JMS TYPE	/PRINT "UNIT? "
	UNTTXT
/GET UNIT NUMBER, OR CR IF SYS:
	CLA CLL CMA RAL	/LOAD -2
	DCA KBBUF	/READ 2 CHARS
	TAD (KBBUF+1	/PT AT KB BUFF
	DCA KBBUF+1
	TAD (KBBUF	/PT AT CTRL BLOCK
	KSR		/READ 2 CHARS FROM K:
	JMS TYPE	/CR, LF
	CRLF
	TAD KBBUF+2	/GET FIRST CHAR
	AND (7770	/REMOVE BOTTOM 3 BITS
	TAD (-"0	/MAKE SURE IT'S AN OCTAL DIGIT
	SZA CLA		/SKIP IF SO
	JMP DISK	/SEE IF ONLY CR TYPED
	TAD KBBUF+2	/GET FIRST CHAR BACK
	RTR		/ROTATE INTO AC0-AC2
	RTR
	AND (7000	/CLEAR AC3-AC11
	TAD (20		/MAKE READ COMMAND
	DCA DTA+1	/SAVE
	CLL CML RTL	/LOAD 2
	DCA DTA+2	/START WITH BLOCK 2
	TAD (DTABUF-1	/PT AT DECTAPE BUFFER
	DCA DTA+3
	TAD DTA		/PT AT DTA CTRL BLOCK
	DTXA		/READ BLOCK 2
	DTRB		/GET STATUS REGISTER B
	AND (7776	/CLEAR DTF
	SZA		/SKIP IF NO ERROR
	JMP I (DTAERR	/PRINT MESSAGE IF ERROR
	TAD I (DTABUF	/GET FILE COUNT
	DCA NUMENT	/SAVE NUMBER OF ENTRIES
	TAD (-175	/-<WORDS LEFT IN BLOCK +1>
	DCA WRDREM
	TAD (DTABUF+4	/GET PTR TO FIRST FILENAME (OFF BY 1)
	DCA DTAPTR
/
DTA1,	JMS GETWRD	/GET A WORD FROM THE TAPE
	SNA		/SKIP IF NOT .EMPTY. ENTRY
	JMP DTA2	/GO PRINT .EMPTY. ENTRY
	JMS TRIM2	/PRINT AS 2 TRIMMED ASCII CHARS
	JMS GETWRD	/DO REST OF FILENAME
	JMS TRIM2
	JMS GETWRD
	JMS TRIM2
	JMS GETWRD	/GET EXTENSION
	AND (17		/REMOVE OTHER BITS
	JMS I (TYPEXT	/PRINT EXTENSION, ONE SPACE
	JMS GETWRD	/GET DATE
	DCA TEMP	/SAVE IT
	TAD (-12	/BASE 10.
	DCA DIVSOR
	TAD (240	/PAD WITH SPACES
	DCA PAD
	TAD (-5		/PAD TO 4 COLUMNS
	DCA COLUMN
	JMS GETWRD	/GET SIZE
	CIA		/MAKE POSITIVE
	JMS PRDEC	/PRINT IT
	JMS TYPE	/PRINT 3 SPACES
	SPACE3
	TAD ("0		/NOW PAD WITH ZEROES
	DCA PAD
	TAD (-3		/PAD TO 2 COLUMNS
	DCA COLUMN
	TAD TEMP	/GET DATE
	RTR		/ROTATE TO AC9-AC11
	RAR
	AND (37		/CLEAR AC0-AC6
	JMS PRDEC	/PRINT DAY
	TAD TEMP	/GET DATE, AGAIN
	RTR		/MOVE MONTH TO AC8-AC11
	BSW
	AND (17		/CLEAR AC0-AC7
	JMS I (MONTH	/PRINT MONTH
	TAD (-3		/PAD TO 2 COLUMNS
	DCA COLUMN
	TAD TEMP	/GET DATE, YET AGAIN
	AND (7		/CLEAR AC0-AC8
	TAD (116	/CONVERT TO YEAR (PUTR IS OFF BY 8. YEARS)
	JMS PRDEC	/PRINT YEAR
	JMP DTA3	/CR, LF, AND SEE IF DONE
DTA2,	/PRINT ".EMPTY." AND SIZE
	JMS TYPE	/PRINT ".EMPTY."
	EMPTY
	TAD (-5		/FILL TO 4 COLUMNS
	DCA COLUMN
	TAD (240	/PAD WITH SPACES
	DCA PAD
	JMS GETWRD	/GET A WORD
	CIA		/MAKE POSITIVE
	JMS PRDEC	/PRINT SIZE
DTA3,	JMS TYPE	/PRINT CR, LF
	CRLF
	ISZ NUMENT	/DONE?
	JMP DTA1	/LOOP IF NOT
	JMP BEG		/START OVER IF SO
/
NUMENT,	0	/NUMBER OF ENTRIES IN DIR
/
TRIM2,	0	/PRINT 2 TRIMMED ASCII CHARS IN AC ON K:
	DCA TRIM2A	/SAVE
	TAD TRIM2A	/GET BACK
	BSW		/SWITCH CHARS
	JMS TRIM2B	/PRINT A CHAR
	TAD TRIM2A	/GET BACK
	JMS TRIM2B	/PRINT OTHER (RIGHT) CHAR
	JMP I TRIM2	/RETURN
TRIM2A,	0	/HOLDS PAIR OF CHARS BEING PRINTED
TRIM2B,	0	/PRINT CHAR IN AC6-AC11
	AND (77		/CLEAR HIGH BYTE
	DCA TRIM2C	/SAVE
	TAD TRIM2C	/CHECK BIT 6
	AND (40
	SNA CLA		/SKIP IF SET
	TAD (100	/ADD ANOTHER 100 IF CLEAR
	TAD (200	/CVT TO ASCII
	TAD TRIM2C	/GET CHAR
	TLS		/PRINT IT
	CLA
	JMP I TRIM2B	/RETURN
TRIM2C,	0
/
	PAGE
GETWRD,	0	/ROUTINE TO READ A WORD FROM THE TAPE
	CLA
	ISZ WRDREM	/AT END OF BLOCK?
	SKP		/CONTINUE IF NOT
	JMP GTWRD1	/READ ANOTHER BLOCK IF SO
	TAD I DTAPTR	/GET A WORD
	JMP I GETWRD	/RETURN
GTWRD1,	TAD DTA+2	/GET CURRENT BLOCK
	TAD (13		/ADVANCE TO NEXT BLOCK IN DIR
	DCA DTA