; FINDIR.MAC-FROM JUNE-JULY AMUS NEWSLETTER-KHALSA COMPUTER-ROBERT FOWLER
; converted to L Bob Rubendunst 9/13/83. One fine program I needed on L.
; donated to AMUS 7/26/84 rpr
;
; Assembly instructions:
;	M68 FINDIR
;	LNKLIT FINDIR
;
	SEARCH	SYS
	SEARCH	SYSSYM
	EXTERN $ODTIM			; link to system library routine

; impure variable map
	ASECT
DDBIN:	BLKB	D.DDB
DDBOUT:	BLKB	D.DDB
OFLAG:	BLKW	1			; output flags
NFLAG:	BLKW	1			; for OCVT use
MAXREC:	BLKW	1			; maximum record on disk
PAKBUF:	BLKB	12. 			; UNPACK workspace
	EVEN
MEMLTH=.
.=0

; MACRO to make directed messages easier.
DEFINE	OUTS	ARG
	OUTI
	ASCIZ	/ARG/
	EVEN				; make sure it ends evenly!
	ENDM

	PSECT


	GETIMP	MEMLTH,A5		; get some memory
	CLEAR	@A5,MEMLTH		;  clear it out
	BYP				; SCAN PAST BLANKS & TABS
	LIN				; TEST FOR LIN TERMINATOR
	BNE	DSKFI1
	TYPECR	<usage: FINDIR devN:>
	EXIT

DSKFI1:
	MOVW	#OT$TRM,OFLAG(A5)	; default to screen
	FSPEC	DDBIN(A5)		; stuff device name in input ddb
	INIT	DDBIN(A5)		; get a buffer area
	TYPE	<Output file name or CR for screen only: >
	KBD
	BYP
	LIN
	BEQ	10$
	FSPEC	DDBOUT(A5)
	INIT	DDBOUT(A5)
	OPENO	DDBOUT(A5)
	MOVW	#OT$DDB,OFLAG(A5)	; set output flag word
10$:	MOVW	OFLAG(A5),D7
	ORW	#OT$ZER,D7		; add zero suppression
	RORW	D7,#8.			; swap bytes
	ORW	#40006,D7		; set digit count & octal flag
	MOVW	D7,NFLAG(A5)		; save it
	ORB	#D$BYP!D$ERC,D.FLG+DDBIN(A5)	; do not abort to AMOS on errors.
	READ	DDBIN(A5)		; set up driver address
	MOV	D.DVR(A5),A6		; index the driver
	MOV	DD.DSZ(A6),D7
	MOVW	D7,MAXREC(A5)	; store maximum record #
	TYPESP	<Enter 1st block to scan or CR for whole disk:>
	KBD				; get some input
	CTRLC	EOFGO			; let user abort
	BYP				; scan past blanks

	CLR	D1			; preset to 1st block
	LIN				; check for null line
	BEQ	SCAN			; yes-use default of 0
	GTOCT				; no-convert string to octal in D1

SCAN:	MOV	D1,DDBIN+D.REC(A5)	; save record number
	LEA	A2,DDBOUT(A5)		; index output DDB
	MOVW	OFLAG(A5),D6
	OUTL	TITL			; show title
	LEA	A1,DDBIN+D.DEV(A5)
	LEA	A2,PAKBUF(A5)
	UNPACK				; unpack device name
	CLR	D1
	MOVW	DDBIN+D.DRV(A5),D1	; and unit #
	DCVT	0,OT$MEM		;  to memory
	MOVB	#':,(A2)+		; 
	CLRB	@A2			; add 2 CR & null
	LEA	A2,DDBOUT(A5)		; index output DDB
	MOVW	OFLAG(A5),D6
	OUTL	PAKBUF(A5)		; output the whole line
	MOVW	OFLAG(A5),D6
	OUTL	MADE
; perform $ODTIM call
	LEA	A2,DDBOUT(A5)		; index output DDB
	CLR	D3			; use current date & time
	CLR	D4			; not used
; bit ruler        5432109876543210
	MOV	#^B1100110011100110,D5	; control options
	CMPW	OFLAG(A5),#OT$TRM	; just to terminal ?
	BNE	20$			;  no-to file
	BCLR	#15.,D5			;  yes -shut down file flag
	SUB	A2,A2			;   and clear A2
20$:	CALL	$ODTIM 			; output date & time
	MOVW	OFLAG(A5),D6
	OUTL	HDR
	MOV	DDBIN+D.REC(A5),D1		; set initial record

; read all the records on disk, finding UFD entry by checking for entries
; that are NOT UFD entries. The records that are NOT NOT UFD are very likely
; UFDs...
READ:	CTRLC	EOFGO
; clear buffer before read in case this read fails....
	MOV	DDBIN+D.BUF(A5),A6	; get buffer address
	MOV	DDBIN+D.SIZ(A5),D7	;  and size
	SUB	#1,D7			; adjust for DBF
10$:	CLRB	(A6)+
	DBF	D7,10$			; clear out buffer before read
	MOV	D1,DDBIN+D.REC(A5)	; insert record number
	READ	DDBIN(A5)		; read the block
	TSTB	DDBIN+D.ERR(A5)		; check for errors
	BEQ	SETREG			; no error
; show disk read errors.
	TYPE	<(Error >
	CLR	D1
	DCVT	0,OT$TRM!OT$TSP
	TYPE	<at record>
	CLR	D1
	MOV	DDBIN+D.REC(A5),D1
	OCVT	5,2!OT$LSP			; show the record number
	TYPECR	< )>
	CLRB	DDBIN+D.ERR(A5)		; clear the error
SETREG:	MOV	DDBIN+D.BUF(A5),A3	; index contents of record
	TSTW	772(A3)			; is the end blank ?
	BNE	10$			;  not a valid directory.
	MOVW	(A3)+,D7		; get possible link to next block
	CMPW	D7,MAXREC(A5)		; is it reasonable ?
	BHI	10$ 			;  no
	TSTW	@A3			; are first three letters of dir blank?
	BEQ	10$			; no-dir not empty
	CALL	CHECK			; check for proper form
	BNE	10$			; not proper
	CALL	SHOW			; show the first few filenames
10$:	MOV	DDBIN+D.REC(A5),D1	; get block #
	INC	D1			; bump it
	CMPW	D1,MAXREC(A5)		; compare to disk size.
	JLO	READ			;  still legal, keep reading
END2:	TYPECR	<Directory scan complete.>
EOFGO:	CMPW	OFLAG(A5),#OT$DDB
	BNE	10$
	CLOSE	DDBOUT(A5)
10$:	EXIT

; check checks each possible UFD entry for good form. 
; At entry, A3 indexs the UFD elements.
; At exit, if all looks well, Z is set.
CHECK:	MOV	#40.,D2			; set up count for all DIR entries
4$:	TSTW	@A3			; end of DIR entries ?
	BEQ	60$			;  yes-test for garbage
	CMPW	@A3,#-1			; is it an erased file ?
	BEQ	50$			;  yes-exit ok.
	MOV	A3,A1  			; index RAD50 filename
	LEA	A2,PAKBUF(A5)		;  and buffer zone
	CLRB	(A2)+			; set initial null
	UNPACK
	UNPACK				; unpack filename
10$:	CMPB	-(A2),#40		; trailing space ?
	BEQ	10$			;  yes-keep backing up
	TSTB	(A2)+			; was the whole thing blank ?
	BEQ	C.BAD			;  yes-not a valid entry
	UNPACK				; unpack extension
14$:	CMPB	-(A2),#40
	BEQ	14$			; strip extension trailing spaces
	CLRB	1(A2)			; set null at end
	LEA	A2,PAKBUF(A5)		; index the filename
; check for legal filename characters, plus $, which is used sometimes.
20$:	ADDW	#1,A2			; bump to next character
	LIN				; end of filename ?
	BEQ	30$			;  ok-check block stuff
	ALF				; alphabetic
	BEQ	20$			;  ok
	NUM				; numeral
	BEQ	20$			;  ok
	CMPB	@A2,#'$			; allow dollar sign, too.
	BNE	C.BAD			;  invalid character
	BR	20$
; check file parameters for proper range.
30$:	CMMW	6(A3),MAXREC(A5)	; see if too big for disk.
	BHI	C.BAD			;  yes-more records than whole disk.
	MOVW	10(A3),D7		; get active bytes in last block
	CMPW	D7,#-1			; test for random file
	BEQ	40$			;  yes-that's ok
	CMPW	D7,#512.		; test for sequential file
	BHI	C.BAD			;  that isn't any good
40$:	MOVW	12(A3),D7		; get link block number
	BEQ	C.BAD			;  no link, no file!
	CMPW	D7,MAXREC(A5)		; is it too big for drive?
	BHI	C.BAD			;  yes-impossible
50$:	ADD	#14,A3
	DBF	D2,4$			; loop thru all entries
	BR	C.OK			; OK if all blocks pass inspection
; check remianing space after null entry for another entry. This does not
; occur on live UFD blocks.
60$:	TST	@A3
	BNE	C.BAD			; garbage 
	TST	4(A3)
	BNE	C.BAD			; garbage
	TST	10(A3)
	BNE	C.BAD			; garbage
	ADD	#14,A3
	DBF	D2,60$
C.OK:	LCC	#4			; flag ok with Z set
	RTN
C.BAD:	LCC	#0			; flag invalid entry with Z clear
	RTN


SHOW:	LEA	A2,DDBOUT(A5)		; A2 indexs output DDB
	MOVW	OFLAG(A5),D6
	MOV	DDBIN+D.REC(A5),D1		; get record number
	CLR	D6
	MOVW	NFLAG(A5),D6
	OCVT
	MOVW	OFLAG(A5),D6
	OUTS	< next >
	MOV	DDBIN+D.BUF(A5),A1		; index the buffer
	CLR	D1
	MOVW	(A1)+,D1			; get the link
	MOVW	NFLAG(A5),D6
	OCVT				; show link
	MOV	#5-1,D3			; show 5 filename
10$:	CALL	SHOFIL			; display the filename entry
	ADDW	#6,A1			; index next entry
	DBF	D3,10$			; loop 
	MOVW	OFLAG(A5),D6
	OUTI
	BYTE	215,212,0,0		; output a CRLF
	RTN

; SHOFIL outputs the filename indexs via UFD pointer A1.
SHOFIL:	MOVW	OFLAG(A5),D6
	OUTS	<  >			; space out
	CMPW	@A1,#-1			; file been erased ?
	BNE	10$			;  no
	MOVW	OFLAG(A5),D6		; yes
	OUTS	<--erased-->		;  say erased
	ADD	#6,A1			; adjust for no UNPACKs
	BR	100$			; done
10$:	PUSH	A2
	LEA	A2,PAKBUF(A5)		; index workspace for UNPACK
	UNPACK
	UNPACK
	MOVB	#'.,(A2)+			; add a dot
	UNPACK				; and extension
	CLRB	@A2
	POP	A2
	MOVW	OFLAG(A5),D6
	OUTL	PAKBUF(A5)		; output the filename
100$:	RTN


TITL:	ASCII	/Directory scan of /
	BYTE	0
MADE:	ASCII	/ made on /
	BYTE	0
HDR:	BYTE	215,212,215,212
	ASCII	/Record ---Link----  -----------------------File Entries-----------------------/
	BYTE	215,212,0
	EVEN

	END

.